X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fproclaim.lisp;h=a7d1ff77726d322716e5717a8449f6240e6d6803;hb=d61775ee52828f379eb6acedca421d5a55bfa2bd;hp=acea77974b8252a0fbe15ddda0672a4ba5d2bcaf;hpb=d40a76606c86722b0aef8179155f9f2840739b72;p=sbcl.git diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp index acea779..a7d1ff7 100644 --- a/src/compiler/proclaim.lisp +++ b/src/compiler/proclaim.lisp @@ -19,7 +19,7 @@ (defvar *undefined-warnings*) (declaim (list *undefined-warnings*)) -;;; Look up some symbols in *FREE-VARIABLES*, returning the var +;;; Look up some symbols in *FREE-VARS*, returning the var ;;; structures for any which exist. If any of the names aren't ;;; symbols, we complain. (declaim (ftype (function (list) list) get-old-vars)) @@ -28,7 +28,7 @@ (dolist (name names (vars)) (unless (symbolp name) (compiler-error "The name ~S is not a symbol." name)) - (let ((old (gethash name *free-variables*))) + (let ((old (gethash name *free-vars*))) (when old (vars old)))))) ;;; Return a new POLICY containing the policy information represented @@ -48,11 +48,11 @@ (compiler-warn "ignoring unknown optimization quality ~ ~S in ~S" quality spec)) - ((not (and (typep raw-value 'real) (<= 0 raw-value 3))) + ((not (typep raw-value 'policy-quality)) (compiler-warn "ignoring bad optimization value ~S in ~S" raw-value spec)) (t - (push (cons quality (rational raw-value)) + (push (cons quality raw-value) result))))) ;; Add any nonredundant entries from old POLICY. (dolist (old-entry policy) @@ -123,8 +123,8 @@ ;; when we have to ignore a PROCLAIM because the type system is ;; uninitialized. (when *type-system-initialized* - (let ((type (specifier-type (first args)))) - (unless (csubtypep type (specifier-type 'function)) + (let ((ctype (specifier-type (first args)))) + (unless (csubtypep ctype (specifier-type 'function)) (error "not a function type: ~S" (first args))) (dolist (name (rest args)) @@ -142,13 +142,13 @@ #| (when (eq (info :function :where-from name) :declared) (let ((old-type (info :function :type name))) - (when (type/= type old-type) + (when (type/= ctype old-type) (style-warn "new FTYPE proclamation~@ ~S~@ for ~S does not match old FTYPE proclamation~@ ~S" - (list type name old-type))))) + (list ctype name old-type))))) |# ;; Now references to this function shouldn't be warned @@ -161,18 +161,18 @@ (note-name-defined name :function) ;; the actual type declaration - (setf (info :function :type name) type + (setf (info :function :type name) ctype (info :function :where-from name) :declared))))) (freeze-type (dolist (type args) (let ((class (specifier-type type))) - (when (typep class 'sb!xc:class) - (setf (class-state class) :sealed) - (let ((subclasses (class-subclasses class))) + (when (typep class 'classoid) + (setf (classoid-state class) :sealed) + (let ((subclasses (classoid-subclasses class))) (when subclasses (dohash (subclass layout subclasses) (declare (ignore layout)) - (setf (class-state subclass) :sealed)))))))) + (setf (classoid-state subclass) :sealed)))))))) (optimize (setq *policy* (process-optimize-decl form *policy*))) ((inline notinline maybe-inline)