X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=0002cb214aad8fd92288ded92c10fb972d399ad2;hb=96b310113978665980a8d65ad5dd83deab05c28b;hp=7b53cb5f0c7229a8921a41b6336edcf16b451781;hpb=41ed816c7915806abca6b09ecd2136458f27adcc;p=sbcl.git

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 7b53cb5..0002cb2 100644
--- 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)