projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.6.12.21:
[sbcl.git]
/
src
/
compiler
/
proclaim.lisp
diff --git
a/src/compiler/proclaim.lisp
b/src/compiler/proclaim.lisp
index
792c37c
..
3c94f2f
100644
(file)
--- a/
src/compiler/proclaim.lisp
+++ b/
src/compiler/proclaim.lisp
@@
-71,7
+71,8
@@
;;; defaulted from the POLICY argument.
(declaim (ftype (function (list policy) policy) process-optimize-decl))
(defun process-optimize-decl (spec policy)
;;; defaulted from the POLICY argument.
(declaim (ftype (function (list policy) policy) process-optimize-decl))
(defun process-optimize-decl (spec policy)
- (let ((result policy)) ; may have new entries pushed on it below
+ (let ((result nil))
+ ;; Add new entries from SPEC.
(dolist (q-and-v-or-just-q (cdr spec))
(multiple-value-bind (quality raw-value)
(if (atom q-and-v-or-just-q)
(dolist (q-and-v-or-just-q (cdr spec))
(multiple-value-bind (quality raw-value)
(if (atom q-and-v-or-just-q)
@@
-88,6
+89,11
@@
(t
(push (cons quality (rational raw-value))
result)))))
(t
(push (cons quality (rational raw-value))
result)))))
+ ;; Add any nonredundant entries from old POLICY.
+ (dolist (old-entry policy)
+ (unless (assq (car old-entry) result)
+ (push old-entry result)))
+ ;; Voila.
result))
;;; ANSI defines the declaration (FOO X Y) to be equivalent to
result))
;;; ANSI defines the declaration (FOO X Y) to be equivalent to
@@
-96,7
+102,7
@@
(defun canonized-decl-spec (decl-spec)
(let ((id (first decl-spec)))
(unless (symbolp id)
(defun canonized-decl-spec (decl-spec)
(let ((id (first decl-spec)))
(unless (symbolp id)
- (error "The declaration identifier is not a symbol: ~S" what))
+ (error "The declaration identifier is not a symbol: ~S" id))
(let ((id-is-type (info :type :kind id))
(id-is-declared-decl (info :declaration :recognized id)))
(cond ((and id-is-type id-is-declared-decl)
(let ((id-is-type (info :type :kind id))
(id-is-declared-decl (info :declaration :recognized id)))
(cond ((and id-is-type id-is-declared-decl)
@@
-190,11
+196,12
@@
(when (eq (info :function :where-from name) :declared)
(let ((old-type (info :function :type name)))
(when (type/= type old-type)
(when (eq (info :function :where-from name) :declared)
(let ((old-type (info :function :type name)))
(when (type/= type old-type)
- (style-warn "new FTYPE proclamation~@
- ~S~@
- for ~S does not match old FTYPE proclamation~@
- ~S"
- (list type name old-type)))))
+ (style-warn
+ "new FTYPE proclamation~@
+ ~S~@
+ for ~S does not match old FTYPE proclamation~@
+ ~S"
+ (list type name old-type)))))
(proclaim-as-function-name name)
(note-name-defined name :function)
(proclaim-as-function-name name)
(note-name-defined name :function)
@@
-203,7
+210,7
@@
(freeze-type
(dolist (type args)
(let ((class (specifier-type type)))
(freeze-type
(dolist (type args)
(let ((class (specifier-type type)))
- (when (typep class 'class)
+ (when (typep class 'sb!xc:class)
(setf (class-state class) :sealed)
(let ((subclasses (class-subclasses class)))
(when subclasses
(setf (class-state class) :sealed)
(let ((subclasses (class-subclasses class)))
(when subclasses
@@
-211,10
+218,7
@@
(declare (ignore layout))
(setf (class-state subclass) :sealed))))))))
(optimize
(declare (ignore layout))
(setf (class-state subclass) :sealed))))))))
(optimize
- (setq *default-policy* (process-optimize-decl form *default-policy*)))
- (optimize-interface
- (setq *default-interface-policy*
- (process-optimize-decl form *default-interface-policy*)))
+ (setq *policy* (process-optimize-decl form *policy*)))
((inline notinline maybe-inline)
(dolist (name args)
(proclaim-as-function-name name)
((inline notinline maybe-inline)
(dolist (name args)
(proclaim-as-function-name name)