0.8alpha.0.9:
[sbcl.git] / src / compiler / globaldb.lisp
index 7e13d0f..ee434de 100644 (file)
 ;;; At run time, we represent the type of info that we want by a small
 ;;; non-negative integer.
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant type-number-bits 6))
+  (def!constant type-number-bits 6))
 (deftype type-number () `(unsigned-byte ,type-number-bits))
 
 ;;; Why do we suppress the :COMPILE-TOPLEVEL situation here when we're
 ;;;; compact info environments
 
 ;;; The upper limit on the size of the ENTRIES vector in a COMPACT-INFO-ENV.
-(defconstant compact-info-env-entries-bits 16)
+(def!constant compact-info-env-entries-bits 16)
 (deftype compact-info-entries-index () `(unsigned-byte ,compact-info-env-entries-bits))
 
 ;;; the type of the values in COMPACT-INFO-ENTRIES-INFO
   ;; last entry.
   (entries-info (missing-arg) :type (simple-array compact-info-entry (*))))
 
-(defconstant compact-info-entry-type-mask (ldb (byte type-number-bits 0) -1))
-(defconstant compact-info-entry-last (ash 1 type-number-bits))
+(def!constant compact-info-entry-type-mask (ldb (byte type-number-bits 0) -1))
+(def!constant compact-info-entry-last (ash 1 type-number-bits))
 
 ;;; Return the value of the type corresponding to NUMBER for the
 ;;; currently cached name in ENV.
 
 ;;; the exact density (modulo rounding) of the hashtable in a compact
 ;;; info environment in names/bucket
-(defconstant compact-info-environment-density 65)
+(def!constant compact-info-environment-density 65)
 
 ;;; Return a new compact info environment that holds the same
 ;;; information as ENV.
 
   (values))
 
-;;; Given a volatile environment Env, bind Table-Var the environment's table
-;;; and Index-Var to the index of Name's bucket in the table. We also flush
+;;; Given a volatile environment ENV, bind TABLE-VAR the environment's table
+;;; and INDEX-VAR to the index of NAME's bucket in the table. We also flush
 ;;; the cache so that things will be consistent if body modifies something.
 (eval-when (:compile-toplevel :execute)
   (#+sb-xc-host cl:defmacro
   ;; Constant CLASS and TYPE is an overwhelmingly common special case,
   ;; and we can implement it much more efficiently than the general case.
   (if (and (constantp class) (constantp type))
-      (let ((info (type-info-or-lose class type))
-           (value (gensym "VALUE"))
-           (foundp (gensym "FOUNDP")))
-       `(multiple-value-bind (,value ,foundp)
-            (get-info-value ,name
-                            ,(type-info-number info)
-                            ,@(when env-list-p `(,env-list))) 
-          (declare (type ,(type-info-type info) ,value))
-          (values ,value ,foundp)))
+      (let ((info (type-info-or-lose class type)))
+       (with-unique-names (value foundp)
+         `(multiple-value-bind (,value ,foundp)
+              (get-info-value ,name
+                              ,(type-info-number info)
+                              ,@(when env-list-p `(,env-list))) 
+            (declare (type ,(type-info-type info) ,value))
+            (values ,value ,foundp))))
       whole))
 (defun (setf info) (new-value
                    class
   (let* ((info (type-info-or-lose class type))
         (tin (type-info-number info)))
     (if env-list-p
-      (set-info-value name
-                     tin
-                     new-value
-                     (get-write-info-env env-list))
-      (set-info-value name
-                     tin
-                     new-value)))
+       (set-info-value name
+                       tin
+                       new-value
+                       (get-write-info-env env-list))
+       (set-info-value name
+                       tin
+                       new-value)))
   new-value)
 ;;; FIXME: We'd like to do this, but Python doesn't support
 ;;; compiler macros and it's hard to change it so that it does.
 ;;;
 ;;; FIXME: actually seems to be measured in percent, should be
 ;;; converted to be measured in names/bucket
-(defconstant volatile-info-environment-density 50)
+(def!constant volatile-info-environment-density 50)
 
 ;;; Make a new volatile environment of the specified size.
 (defun make-info-environment (&key (size 42) (name "Unknown"))
   ;;   (or approximate-fun-type null)).
   ;; It was changed to T as a hopefully-temporary hack while getting
   ;; cold init problems untangled.
-  :type-spec t) 
+  :type-spec t)
 
 ;;; where this information came from:
 ;;;    :ASSUMED  = from uses of the object
   :type :ir1-convert
   :type-spec (or function null))
 
-;;; a function which gets a chance to do stuff to the IR1 for any call
-;;; to this function.
-(define-info-type
-  :class :function
-  :type :ir1-transform
-  :type-spec (or function null))
-
 ;;; If a function is "known" to the compiler, then this is a FUN-INFO
 ;;; structure containing the info used to special-case compilation.
 (define-info-type
 (define-info-type
   :class :function
   :type :definition
-  :type-spec t
+  :type-spec (or fdefn null)
   :default nil)
 \f
 ;;;; definitions for other miscellaneous information
 (define-info-type
   :class :variable
   :type :kind
-  :type-spec (member :special :constant :global :alien)
+  :type-spec (member :special :constant :macro :global :alien)
   :default (if (symbol-self-evaluating-p name)
               :constant
               :global))
               name
               (bug "constant lookup of nonconstant ~S" name)))
 
+;;; the macro-expansion for symbol-macros
+(define-info-type
+  :class :variable
+  :type :macro-expansion
+  :type-spec t
+  :default nil)
+
 (define-info-type
   :class :variable
   :type :alien-info
 ;;; meaningful error if we only have the cons.
 (define-info-type
   :class :type
-  :type :class
-  :type-spec (or sb!kernel::class-cell null)
+  :type :classoid
+  :type-spec (or sb!kernel::classoid-cell null)
   :default nil)
 
 ;;; layout for this type being used by the compiler
   :class :type
   :type :compiler-layout
   :type-spec (or layout null)
-  :default (let ((class (sb!xc:find-class name nil)))
-            (when class (class-layout class))))
+  :default (let ((class (find-classoid name nil)))
+            (when class (classoid-layout class))))
 
 (define-info-class :typed-structure)
 (define-info-type