X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=202893c96d4e92c2b7f0ee1dbab307c747e3e21b;hb=8f45dd3a5a074998e1aa697ba8f2a8b1b7388427;hp=1f1eeb5627ff6d08cdfafdcfeea2eafce503437d;hpb=485d9c8e2d3a4ae0561cd57b55a6c6a28cd4bce4;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 1f1eeb5..202893c 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -583,11 +583,11 @@ :element-type 'compact-info-entry)) (sorted (sort (names) #+sb-xc-host #'< - ;; (This MAKE-FIXNUM hack implements - ;; pointer comparison, as explained above.) + ;; POINTER-HASH hack implements pointer + ;; comparison, as explained above. #-sb-xc-host (lambda (x y) - (< (%primitive make-fixnum x) - (%primitive make-fixnum y)))))) + (< (pointer-hash x) + (pointer-hash y)))))) (/show0 "done making/sorting vectors in COMPACT-INFO-ENVIRONMENT") (let ((entries-idx 0)) (dolist (types sorted) @@ -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. @@ -936,7 +929,7 @@ :default #+sb-xc-host (specifier-type 'function) #-sb-xc-host (if (fboundp name) - (extract-fun-type (fdefinition name)) + (specifier-type (sb!impl::%fun-type (fdefinition name))) (specifier-type 'function))) ;;; the ASSUMED-TYPE for this function, if we have to infer the type @@ -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 @@ -1050,6 +1046,12 @@ :type :definition :type-spec (or fdefn null) :default nil) + +(define-info-type + :class :function + :type :structure-accessor + :type-spec (or defstruct-description null) + :default nil) ;;;; definitions for other miscellaneous information @@ -1060,7 +1062,7 @@ :class :variable :type :kind :type-spec (member :special :constant :macro :global :alien) - :default (if (symbol-self-evaluating-p name) + :default (if (typep name '(or boolean keyword)) :constant :global)) @@ -1078,21 +1080,14 @@ :type-spec (member :declared :assumed :defined) :default :assumed) -;;; the Lisp object which is the value of this constant, if known +;;; We only need a mechanism different from the +;;; usual SYMBOL-VALUE for the cross compiler. +#+sb-xc-host (define-info-type :class :variable - :type :constant-value + :type :xc-constant-value :type-spec t - ;; CMU CL used to return two values for (INFO :VARIABLE :CONSTANT-VALUE ..). - ;; Now we don't: it was the last remaining multiple-value return from - ;; the INFO system, and bringing it down to one value lets us simplify - ;; things, especially simplifying the declaration of return types. - ;; Software which used to check the second value (for "is it defined - ;; as a constant?") should check (EQL (INFO :VARIABLE :KIND ..) :CONSTANT) - ;; instead. - :default (if (symbol-self-evaluating-p name) - name - (bug "constant lookup of nonconstant ~S" name))) + :default nil) ;;; the macro-expansion for symbol-macros (define-info-type @@ -1163,17 +1158,6 @@ :type-spec (or ctype null) :default nil) -;;; If this is a class name, then the value is a cons (NAME . CLASS), -;;; where CLASS may be null if the class hasn't been defined yet. Note -;;; that for built-in classes, the kind may be :PRIMITIVE and not -;;; :INSTANCE. The name is in the cons so that we can signal a -;;; meaningful error if we only have the cons. -(define-info-type - :class :type - :type :classoid - :type-spec (or sb!kernel::classoid-cell null) - :default nil) - ;;; layout for this type being used by the compiler (define-info-type :class :type @@ -1182,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