[Sbcl-commits] CVS: sbcl/contrib/sb-cltl2 env.lisp, 1.6, 1.7 tests.lisp, 1.7, 1.8

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/contrib/sb-cltl2
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv31092/contrib/sb-cltl2

Modified Files:
	env.lisp tests.lisp 
Log Message:
1.0.28.30: DEFGLOBAL, ALWAYS-BOUND, GLOBAL, SYMBOL-GLOBAL-VALUE

 * ALWAYS-BOUND allows the compiler to elide boundness checks
   for symbol value access, and prohibits MAKUNBOUND. This is
   handled via a new globaldb entry.

   GLOBAL makes the compiler elide TLS checking for symbol
   values access, and prohibits rebinding. This is handled via
   new globaldb :variable :type, namely :global.

   DEFGLOBAL is build on top of these. Global variables are mainly an
   efficiency measure on threaded builds, but can also express
   intention as they prohibit rebinding.

 * Add %SET-SYMBOL-GLOBAL-VALUE, FAST-SYMBOL-GLOBAL-VALUE, and
   SYMBOL-GLOBAL-VALUE VOPs to all backends. On unithreaded
   builds these are trivial copies of the non-global versions.

 * Tell SB-CLTL2 about both GLOBAL and ALWAYS-BOUND declarations too.

 * Document in the Efficiency chapter of the manual.

 * Prohibit declaring constants special.

 * Tests.

  Later: use these new features inside SBCL itself. For now there is
  only a single DEFGLOBAL used, but more could well be.


Index: env.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-cltl2/env.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- env.lisp	10 Sep 2007 12:14:43 -0000	1.6
+++ env.lisp	8 May 2009 19:08:07 -0000	1.7
@@ -111,7 +111,7 @@
 
 (declaim (ftype (sfunction
                  (symbol &optional (or null lexenv))
-                 (values (member nil :special :lexical :symbol-macro :constant)
+                 (values (member nil :special :lexical :symbol-macro :constant :global)
                          boolean
                          list))
                 variable-information))
@@ -138,6 +138,9 @@
     NAME refers to a named constant defined using DEFCONSTANT, or NAME
     is a keyword.
 
+  :GLOBAL
+    NAME refers to a global variable. (SBCL specific extension.)
+
 The second value is true if NAME is bound locally. This is currently
 always NIL for special variables, although arguably it should be T
 when there is a lexically apparent binding for the special variable.
@@ -159,8 +162,12 @@
     T if there is explicit type declaration or proclamation associated
     with NAME. The type specifier may be equivalent to or a supertype
     of the original declaration. If the CDR is T the alist element may
-    be omitted."
+    be omitted.
+
+Additionally, the SBCL specific SB-EXT:ALWAYS-BOUND declaration will
+appear with CDR as T if the variable has been declared always bound."
   (let* ((*lexenv* (or env (make-null-lexenv)))
+         (kind (info :variable :kind name))
          (var (lexenv-find name vars))
          binding localp dx ignorep type)
     (etypecase var
@@ -181,8 +188,10 @@
          ;; -- though it is _possible_ to declare them ignored, but
          ;; we don't keep the information around.
          (sb-c::global-var
-          (setf binding :special
-                ;; FIXME: Lexically apparent binding or not?
+          (setf binding (if (eq :global kind)
+                            :global
+                            :special)
+                ;; FIXME: Lexically apparent binding or not for specials?
                 localp nil))
          (sb-c::constant
           (setf binding :constant
@@ -191,11 +200,10 @@
        (setf binding :symbol-macro
              localp t))
        (null
-        (let ((global-type (info :variable :type name))
-              (kind (info :variable :kind name)))
+        (let ((global-type (info :variable :type name)))
           (setf binding (case kind
                           (:macro :symbol-macro)
-                          (:global nil)
+                          (:unknown nil)
                           (t kind))
                 type (if (eq *universal-type* global-type)
                          nil
@@ -208,6 +216,8 @@
               (when (and type (neq *universal-type* type))
                 (push (cons 'type (type-specifier type)) alist))
               (when dx (push (cons 'dynamic-extent t) alist))
+              (when (info :variable :always-bound name)
+                (push (cons 'sb-ext:always-bound t) alist))
               alist))))
 
 (declaim (ftype (sfunction (symbol &optional (or null lexenv)) t)

Index: tests.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-cltl2/tests.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- tests.lisp	1 Dec 2008 15:25:36 -0000	1.7
+++ tests.lisp	8 May 2009 19:08:07 -0000	1.8
@@ -6,7 +6,7 @@
 ;;;; more information.
 
 (defpackage :sb-cltl2-tests
-  (:use :sb-cltl2 :cl :sb-rt))
+  (:use :sb-cltl2 :cl :sb-rt :sb-ext))
 
 (in-package :sb-cltl2-tests)
 
@@ -209,6 +209,16 @@
     (var-info #:undefined)
   (nil nil nil))
 
+(declaim (global this-is-global))
+(deftest global-variable
+    (var-info this-is-global)
+  (:global nil nil))
+
+(defglobal this-is-global-too 42)
+(deftest global-variable.2
+    (var-info this-is-global-too)
+  (:global nil ((always-bound . t))))
+
 ;;;; FUNCTION-INFORMATION
 
 (defmacro fun-info (var &environment env)
@@ -269,4 +279,3 @@
       (fun-info identity))
   (:function nil ((inline . inline)
                   (ftype function (t) (values t &optional)))))
-