0.8.1.3:

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

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index d2b0c96..71ec219 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -431,6 +431,8 @@
 \f
 ;;;; 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)