X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=579e41df75f0ea64f25341b3b699f1bf05ea6566;hb=422b88abf96f4842a3d0999cd3b80d96f5a153d6;hp=fd63e74b67ac0f2ed894a2459dd87bd56927fa2e;hpb=8731c1a7c1a585d190151fa881050fb5e14c0616;p=sbcl.git

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index fd63e74..579e41d 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -124,9 +124,8 @@
 ;;; names a macro or special form, then we error out using the
 ;;; supplied context which indicates what we were trying to do that
 ;;; demanded a function.
+(declaim (ftype (function (t string) global-var) find-free-fun))
 (defun find-free-fun (name context)
-  (declare (string context))
-  #+nil (declare (values global-var))
   (or (let ((old-free-fun (gethash name *free-funs*)))
 	(and (not (invalid-free-fun-p old-free-fun))
 	     old-free-fun))
@@ -171,8 +170,8 @@
 ;;; corresponding value. Otherwise, we make a new leaf using
 ;;; information from the global environment and enter it in
 ;;; *FREE-VARS*. If the variable is unknown, then we emit a warning.
+(declaim (ftype (function (t) (or leaf cons heap-alien-info)) find-free-var))
 (defun find-free-var (name)
-  #+nil (declare (values (or leaf cons heap-alien-info))) ; see FIXME comment
   (unless (symbolp name)
     (compiler-error "Variable name is not a symbol: ~S." name))
   (or (gethash name *free-vars*)
@@ -1055,7 +1054,7 @@
 	)
        ((functional-p var)
 	(setf (leaf-ever-used var) t))
-       ((lambda-var-specvar var)
+       ((and (lambda-var-specvar var) (eq (first spec) 'ignore))
 	;; ANSI's definition for "Declaration IGNORE, IGNORABLE"
 	;; requires that this be a STYLE-WARNING, not a full WARNING.
 	(compiler-style-warn "declaring special variable ~S to be ignored"
@@ -1187,7 +1186,6 @@
 			      :where-from (leaf-where-from specvar)
 			      :specvar specvar)))
 	  (t
-	   (note-lexical-binding name)
 	   (make-lambda-var :%source-name name)))))
 
 ;;; Make the default keyword for a &KEY arg, checking that the keyword
@@ -1468,30 +1466,11 @@
 	(setf (node-lexenv bind) *lexenv*)
 	
 	(let ((cont1 (make-continuation))
-	      (cont2 (make-continuation))
-	      (revised-body (if (policy bind
-					(or (> safety
-					       (max speed space))
-					    (= safety 3)))
-				;; (Stuffing this in at IR1 level like
-				;; this is pretty crude. And it's
-				;; particularly inefficient to execute
-				;; it on *every* LAMBDA, including
-				;; LET-converted LAMBDAs. Improvements
-				;; are welcome, but meanwhile, when
-				;; SAFETY is high, it's still arguably
-				;; an improvement over the old CMU CL
-				;; approach of doing nothing (waiting
-				;; for evolution to breed careful
-				;; users:-). -- WHN)
-				`((%detect-stack-exhaustion)
-				  ,@body)
-				body)))
+	      (cont2 (make-continuation)))
 	  (continuation-starts-block cont1)
 	  (link-node-to-previous-continuation bind cont1)
 	  (use-continuation bind cont2)
-	  (ir1-convert-special-bindings cont2 result
-					revised-body
+	  (ir1-convert-special-bindings cont2 result body
 					aux-vars aux-vals (svars)))
 
 	(let ((block (continuation-block result)))
@@ -2086,8 +2065,8 @@
       (setf (functional-inlinep fun) (defined-fun-inlinep var))
       (assert-new-definition var fun)
       (setf (defined-fun-inline-expansion var) var-expansion)
-      ;; If definitely not an interpreter stub, then substitute for any
-      ;; old references.
+      ;; If definitely not an interpreter stub, then substitute for
+      ;; any old references.
       (unless (or (eq (defined-fun-inlinep var) :notinline)
 		  (not *block-compile*)
 		  (and fun-info