X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=7930502121ce54d138d663e994840376dc60d8ef;hb=2f492b2a39b1361e1dd97d5243bc47238b98ca8f;hp=b9768cad8e219e883b4d736d5ac79986472ff593;hpb=eda073ca21407c12c30b5d27ab9dbdd5e446a4b8;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index b9768ca..7930502 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) @@ -758,7 +758,7 @@ (&whole whole class type name &optional (env-list nil env-list-p)) ;; 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)) + (if (and (keywordp class) (keywordp type)) (let ((info (type-info-or-lose class type))) (with-unique-names (value foundp) `(multiple-value-bind (,value ,foundp) @@ -768,6 +768,7 @@ (declare (type ,(type-info-type info) ,value)) (values ,value ,foundp)))) whole)) + (defun (setf info) (new-value class type @@ -786,25 +787,23 @@ 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. -;;; It might make more sense to just convert INFO :FOO :BAR into -;;; an ordinary function, so that instead of calling INFO :FOO :BAR -;;; you call e.g. INFO%FOO%BAR. Then dynamic linking could be handled -;;; by the ordinary Lisp mechanisms and we wouldn't have to maintain -;;; all this cruft.. -#| #!-sb-fluid (progn + ;; Not all xc hosts are happy about SETF compiler macros: CMUCL 19 + ;; 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)) - ;; Constant CLASS and TYPE is an overwhelmingly common special case, and we - ;; can resolve it much more efficiently than the general case. - (if (and (constantp class) (constantp type)) + 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. + (if (and (keywordp class) (keywordp type)) (let* ((info (type-info-or-lose class type)) (tin (type-info-number info))) (if env-list-p @@ -814,9 +813,8 @@ (get-write-info-env ,env-list)) `(set-info-value ,name ,tin - ,new-value))) - whole))) -|# + ,new-value)))) + whole)) ;;; the maximum density of the hashtable in a volatile env (in ;;; names/bucket) @@ -938,7 +936,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 @@ -955,15 +953,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 @@ -1052,6 +1053,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 @@ -1062,7 +1069,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)) @@ -1080,21 +1087,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 @@ -1165,17 +1165,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 @@ -1184,6 +1173,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