X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=71ec219008ad911eda250df5accfb3246b2ad3d5;hb=ae1efb49d01b7f887b4e6bed741a01a28124c643;hp=d2b0c96ebdb90d0dac085011db298749d519e729;hpb=942e5de3f3e27e1cc6ae4aae69c040fa1dc7db00;p=sbcl.git

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index d2b0c96..71ec219 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -431,6 +431,8 @@
 
 ;;;; IR1-CONVERT, macroexpansion and special form dispatching
 
+(declaim (ftype (sfunction (continuation continuation t) (values))
+		ir1-convert))
 (macrolet (;; Bind *COMPILER-ERROR-BAILOUT* to a function that throws
 	   ;; out of the body and converts a proxy form instead.
 	   (ir1-error-bailout ((start
@@ -461,7 +463,6 @@
   ;; the creation using backquote of forms that contain leaf
   ;; references, without having to introduce dummy names into the
   ;; namespace.
-  (declaim (ftype (sfunction (continuation continuation t) (values)) ir1-convert))
   (defun ir1-convert (start cont form)
     (ir1-error-bailout (start cont form)
       (let ((*current-path* (or (gethash form *source-paths*)
@@ -556,6 +557,8 @@
 ;;; functional instead.
 (defun reference-leaf (start cont leaf)
   (declare (type continuation start cont) (type leaf leaf))
+  (when (functional-p leaf)
+    (assure-functional-live-p leaf))
   (let* ((type (lexenv-find leaf type-restrictions))
          (leaf (or (and (defined-fun-p leaf)
                         (not (eq (defined-fun-inlinep leaf)
@@ -701,7 +704,7 @@
                      ;; WHN 19990412
                      #+(and cmu sb-xc-host)
                      (warning (lambda (c)
-                                (compiler-note
+                                (compiler-notify
                                  "~@<~A~:@_~
                                   ~A~:@_~
                                   ~@<(KLUDGE: That was a non-STYLE WARNING. ~
@@ -794,12 +797,12 @@
 	(let ((transform (info :function
 			       :source-transform
 			       (leaf-source-name var))))
-	  (if transform
-	      (multiple-value-bind (result pass) (funcall transform form)
-		(if pass
-		    (ir1-convert-maybe-predicate start cont form var)
+          (if transform
+              (multiple-value-bind (result pass) (funcall transform form)
+                (if pass
+                    (ir1-convert-maybe-predicate start cont form var)
 		    (ir1-convert start cont result)))
-	      (ir1-convert-maybe-predicate start cont form var))))))
+              (ir1-convert-maybe-predicate start cont form var))))))
 
 ;;; If the function has the PREDICATE attribute, and the CONT's DEST
 ;;; isn't an IF, then we convert (IF <form> T NIL), ensuring that a
@@ -847,30 +850,7 @@
 ;;; are converting inline expansions for local functions during
 ;;; optimization.
 (defun ir1-convert-local-combination (start cont form functional)
-
-  ;; The test here is for "when LET converted", as a translation of
-  ;; the old CMU CL comments into code. Unfortunately, the old CMU CL
-  ;; comments aren't specific enough to tell whether the correct
-  ;; translation is FUNCTIONAL-SOMEWHAT-LETLIKE-P or
-  ;; FUNCTIONAL-LETLIKE-P or what. The old CMU CL code assumed that
-  ;; any non-null FUNCTIONAL-KIND meant that the function "had been
-  ;; LET converted", which might even be right, but seems fragile, so
-  ;; we try to be pickier.
-  (when (or
-	 ;; looks LET-converted
-	 (functional-somewhat-letlike-p functional)
-	 ;; It's possible for a LET-converted function to end up
-	 ;; deleted later. In that case, for the purposes of this
-	 ;; analysis, it is LET-converted: LET-converted functionals
-	 ;; are too badly trashed to expand them inline, and deleted
-	 ;; LET-converted functionals are even worse.
-	 (eql (functional-kind functional) :deleted))
-    (throw 'locall-already-let-converted functional))
-  ;; Any other non-NIL KIND value is a case we haven't found a
-  ;; justification for, and at least some such values (e.g. :EXTERNAL
-  ;; and :TOPLEVEL) seem obviously wrong.
-  (aver (null (functional-kind functional)))
-
+  (assure-functional-live-p functional)
   (ir1-convert-combination start
 			   cont
 			   form
@@ -970,7 +950,7 @@
 	   (found
 	    (setf (leaf-type found) type)
 	    (assert-definition-type found type
-				    :unwinnage-fun #'compiler-note
+				    :unwinnage-fun #'compiler-notify
 				    :where "FTYPE declaration"))
 	   (t
 	    (res (cons (find-lexically-apparent-fun
@@ -1017,7 +997,8 @@
   (let ((res (make-defined-fun
 	      :%source-name (leaf-source-name var)
 	      :where-from (leaf-where-from var)
-	      :type (if (eq inlinep :notinline)
+	      :type (if (and (eq inlinep :notinline)
+			     (not (eq (leaf-where-from var) :declared)))
 			(specifier-type 'function)
 			(leaf-type var))
 	      :inlinep inlinep)))
@@ -1045,9 +1026,9 @@
 	      (etypecase found
 		(functional
 		 (when (policy *lexenv* (>= speed inhibit-warnings))
-		   (compiler-note "ignoring ~A declaration not at ~
-				   definition of local function:~%  ~S"
-				  sense name)))
+		   (compiler-notify "ignoring ~A declaration not at ~
+				     definition of local function:~%  ~S"
+				    sense name)))
 		(global-var
 		 (push (cons name (make-new-inlinep found sense))
 		       new-fenv)))))))
@@ -1139,7 +1120,7 @@
 				   "in VALUES declaration"))))
       (dynamic-extent
        (when (policy *lexenv* (> speed inhibit-warnings))
-	 (compiler-note
+	 (compiler-notify
 	  "compiler limitation: ~
         ~%  There's no special support for DYNAMIC-EXTENT (so it's ignored)."))
        res)