0.7.8.7:

[sbcl.git] / src / compiler / ir1tran.lisp

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 7b53cb5..0002cb2 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -544,21 +544,23 @@
 ;;; functional instead.
 (defun reference-leaf (start cont leaf)
   (declare (type continuation start cont) (type leaf leaf))
-  (let* ((leaf (or (and (defined-fun-p leaf)
-                       (not (eq (defined-fun-inlinep leaf)
-                                :notinline))
-                       (let ((functional (defined-fun-functional leaf)))
-                         (when (and functional
-                                    (not (functional-kind functional)))
-                           (maybe-reanalyze-functional functional))))
-                  leaf))
-        (res (make-ref (or (lexenv-find leaf type-restrictions)
-                           (leaf-type leaf))
-                       leaf)))
-    (push res (leaf-refs leaf))
-    (setf (leaf-ever-used leaf) t)
-    (link-node-to-previous-continuation res start)
-    (use-continuation res cont)))
+  (with-continuation-type-assertion
+      (cont (or (lexenv-find leaf type-restrictions) *wild-type*)
+            "in DECLARE")
+    (let* ((leaf (or (and (defined-fun-p leaf)
+                          (not (eq (defined-fun-inlinep leaf)
+                                   :notinline))
+                          (let ((functional (defined-fun-functional leaf)))
+                            (when (and functional
+                                       (not (functional-kind functional)))
+                              (maybe-reanalyze-functional functional))))
+                     leaf))
+           (res (make-ref (leaf-type leaf)
+                          leaf)))
+      (push res (leaf-refs leaf))
+      (setf (leaf-ever-used leaf) t)
+      (link-node-to-previous-continuation res start)
+      (use-continuation res cont))))
 
 ;;; Convert a reference to a symbolic constant or variable. If the
 ;;; symbol is entered in the LEXENV-VARS we use that definition,
@@ -756,6 +758,7 @@
     (setf (continuation-dest fun-cont) node)
     (assert-continuation-type fun-cont
                              (specifier-type '(or function symbol)))
+    (setf (continuation-%externally-checkable-type fun-cont) nil)
     (collect ((arg-conts))
       (let ((this-start fun-cont))
        (dolist (arg args)
@@ -894,7 +897,7 @@
 ;;; macro, we just wrap a THE around the expansion.
 (defun process-type-decl (decl res vars)
   (declare (list decl vars) (type lexenv res))
-  (let ((type (specifier-type (first decl))))
+  (let ((type (compiler-specifier-type (first decl))))
     (collect ((restr nil cons)
              (new-vars nil cons))
       (dolist (var-name (rest decl))
@@ -942,7 +945,7 @@
 ;;; functions.
 (defun process-ftype-decl (spec res names fvars)
   (declare (list spec names fvars) (type lexenv res))
-  (let ((type (specifier-type spec)))
+  (let ((type (compiler-specifier-type spec)))
     (collect ((res nil cons))
       (dolist (name names)
        (let ((found (find name fvars
@@ -1115,7 +1118,7 @@
                                       `(values ,@types))
                                   cont
                                   res
-                                  'values))))
+                                  "in VALUES declaration"))))
       (dynamic-extent
        (when (policy *lexenv* (> speed inhibit-warnings))
         (compiler-note
@@ -1233,9 +1236,10 @@
 (declaim (ftype (function (list) (values list boolean boolean list list))
                make-lambda-vars))
 (defun make-lambda-vars (list)
-  (multiple-value-bind (required optional restp rest keyp keys allowp aux
+  (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux
                        morep more-context more-count)
       (parse-lambda-list list)
+    (declare (ignore auxp)) ; since we just iterate over AUX regardless
     (collect ((vars)
              (names-so-far)
              (aux-vars)
@@ -1491,6 +1495,7 @@
              (setf (lambda-tail-set lambda) tail-set)
              (setf (lambda-return lambda) return)
              (setf (continuation-dest result) return)
+              (setf (continuation-%externally-checkable-type result) nil)
              (setf (block-last block) return)
              (link-node-to-previous-continuation return result)
              (use-continuation return dummy))
@@ -1949,7 +1954,7 @@
 
   (multiple-value-bind (vars keyp allow-other-keys aux-vars aux-vals)
       (make-lambda-vars (cadr form))
-    (multiple-value-bind (forms decls) (sb!sys:parse-body (cddr form))
+    (multiple-value-bind (forms decls) (parse-body (cddr form))
       (let* ((result-cont (make-continuation))
             (*lexenv* (process-decls decls
                                      (append aux-vars vars)