X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=202893c96d4e92c2b7f0ee1dbab307c747e3e21b;hb=8f45dd3a5a074998e1aa697ba8f2a8b1b7388427;hp=843673061ee98b0213348f9dae9bbeacc96e4bae;hpb=45bc305be4e269d2e1a477c8e0ae9a64df1ccd1c;p=sbcl.git

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 8436730..202893c 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -759,7 +759,8 @@
   ;; Constant CLASS and TYPE is an overwhelmingly common special case,
   ;; and we can implement it much more efficiently than the general case.
   (if (and (keywordp class) (keywordp type))
-      (let ((info (type-info-or-lose class type)))
+      (let (#+sb-xc-host (sb!xc:*gensym-counter* sb!xc:*gensym-counter*)
+            (info (type-info-or-lose class type)))
         (with-unique-names (value foundp)
           `(multiple-value-bind (,value ,foundp)
                (get-info-value ,name
@@ -769,11 +770,8 @@
              (values ,value ,foundp))))
       whole))
 
-(defun (setf info) (new-value
-                    class
-                    type
-                    name
-                    &optional (env-list nil env-list-p))
+(defun (setf info)
+    (new-value class type name &optional (env-list nil env-list-p))
   (let* ((info (type-info-or-lose class type))
          (tin (type-info-number info)))
     (when (type-info-validate-function info)
@@ -793,13 +791,8 @@
   ;; does not accept them at all, and older SBCLs give a full warning.
   ;; So the easy thing is to hide this optimization from all xc hosts.
   #-sb-xc-host
-  (define-compiler-macro (setf info) (&whole whole
-                                             new-value
-                                             class
-                                             type
-                                             name
-                                             &optional (env-list nil
-                                                                 env-list-p))
+  (define-compiler-macro (setf info)
+      (&whole whole new-value class type name &optional (env-list nil env-list-p))
     ;; Constant CLASS and TYPE is an overwhelmingly common special case,
     ;; and we can resolve it much more efficiently than the general
     ;; case.
@@ -953,15 +946,18 @@
 ;;; where this information came from:
 ;;;    :ASSUMED  = from uses of the object
 ;;;    :DEFINED  = from examination of the definition
+;;;    :DEFINED-METHOD = implicit, incremental declaration by CLOS.
 ;;;    :DECLARED = from a declaration
-;;; :DEFINED trumps :ASSUMED, and :DECLARED trumps :DEFINED.
+;;; :DEFINED trumps :ASSUMED, :DEFINED-METHOD trumps :DEFINED,
+;;; and :DECLARED trumps :DEFINED-METHOD.
 ;;; :DEFINED and :ASSUMED are useful for issuing compile-time warnings,
-;;; and :DECLARED is useful for ANSIly specializing code which
-;;; implements the function, or which uses the function's return values.
+;;; :DEFINED-METHOD and :DECLARED are useful for ANSIly specializing
+;;; code which implements the function, or which uses the function's
+;;; return values.
 (define-info-type
   :class :function
   :type :where-from
-  :type-spec (member :declared :assumed :defined)
+  :type-spec (member :declared :defined-method :assumed :defined)
   :default
   ;; Again (as in DEFINE-INFO-TYPE :CLASS :FUNCTION :TYPE :KIND) it's
   ;; not clear how to generalize the FBOUNDP expression to the
@@ -1084,6 +1080,15 @@
   :type-spec (member :declared :assumed :defined)
   :default :assumed)
 
+;;; We only need a mechanism different from the
+;;; usual SYMBOL-VALUE for the cross compiler.
+#+sb-xc-host
+(define-info-type
+  :class :variable
+  :type :xc-constant-value
+  :type-spec t
+  :default nil)
+
 ;;; the macro-expansion for symbol-macros
 (define-info-type
   :class :variable
@@ -1161,6 +1166,19 @@
   :default (let ((class (find-classoid name nil)))
              (when class (classoid-layout class))))
 
+;;; DEFTYPE lambda-list
+(define-info-type
+   :class :type
+   :type :lambda-list
+   :type-spec list
+   :default nil)
+
+(define-info-type
+   :class :type
+   :type :source-location
+   :type-spec t
+   :default nil)
+
 (define-info-class :typed-structure)
 (define-info-type
   :class :typed-structure