0.pre7.125:

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

diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp
index ea9c1dd..bb0dcd8 100644 (file)
--- a/src/compiler/ltn.lisp
+++ b/src/compiler/ltn.lisp
@@ -78,7 +78,7 @@
 ;;; values cannot, since we must preserve EQLness.
 (defun legal-immediate-constant-p (leaf)
   (declare (type constant leaf))
-  (or (null (leaf-name leaf))
+  (or (not (leaf-has-source-name-p leaf))
       (typecase (constant-value leaf)
        ((or number character) t)
        (symbol (symbol-package (constant-value leaf)))
@@ -152,7 +152,7 @@
                         (continuation-proven-type cont)))))
         (info (make-ir2-continuation ptype)))
     (setf (continuation-info cont) info)
-    (let ((name (continuation-function-name cont t)))
+    (let ((name (continuation-fun-name cont t)))
       (if (and delay name)
          (setf (ir2-continuation-kind info) :delayed)
          (setf (ir2-continuation-locs info)
@@ -276,8 +276,8 @@
   (let ((res (make-ir2-continuation nil)))
     (if (member (continuation-type-check cont) '(:deleted nil))
        (setf (ir2-continuation-locs res) (mapcar #'make-normal-tn types))
-       (let* ((proven (mapcar #'(lambda (x)
-                                  (make-normal-tn (primitive-type x)))
+       (let* ((proven (mapcar (lambda (x)
+                                (make-normal-tn (primitive-type x)))
                               (values-types
                                (continuation-proven-type cont))))
               (num-proven (length proven))
@@ -382,7 +382,7 @@
   (declare (type mv-combination call) (type ltn-policy ltn-policy))
   (let ((fun (basic-combination-fun call))
        (args (basic-combination-args call)))
-    (cond ((eq (continuation-function-name fun) '%throw)
+    (cond ((eq (continuation-fun-name fun) '%throw)
           (setf (basic-combination-info call) :funny)
           (annotate-ordinary-continuation (first args) ltn-policy)
           (annotate-unknown-values-continuation (second args) ltn-policy)
@@ -424,7 +424,7 @@
     (node-ends-block call)
     (let ((block (node-block call)))
       (unlink-blocks block (first (block-succ block)))
-      (link-blocks block (node-block (lambda-bind callee)))))
+      (link-blocks block (lambda-block callee))))
   (values))
 
 ;;; Annotate the value continuation.
@@ -730,18 +730,18 @@
       (:arg-types
        (funcall frob "argument types invalid")
        (funcall frob "argument primitive types:~%  ~S"
-               (mapcar #'(lambda (x)
-                           (primitive-type-name
-                            (continuation-ptype x)))
+               (mapcar (lambda (x)
+                         (primitive-type-name
+                          (continuation-ptype x)))
                        (combination-args call)))
        (funcall frob "argument type assertions:~%  ~S"
-               (mapcar #'(lambda (x)
-                           (if (atom x)
-                               x
-                               (ecase (car x)
-                                 (:or `(:or .,(mapcar #'primitive-type-name
-                                                      (cdr x))))
-                                 (:constant `(:constant ,(third x))))))
+               (mapcar (lambda (x)
+                         (if (atom x)
+                             x
+                             (ecase (car x)
+                               (:or `(:or .,(mapcar #'primitive-type-name
+                                                    (cdr x))))
+                               (:constant `(:constant ,(third x))))))
                        (template-arg-types template))))
       (:conditional
        (funcall frob "conditional in a non-conditional context"))
@@ -813,7 +813,7 @@
                   (valid (valid-function-use call type))
                   (strict-valid (valid-function-use call type
                                                     :strict-result t)))
-             (frob "unable to do ~A (cost ~D) because:"
+             (frob "unable to do ~A (cost ~W) because:"
                    (or (template-note loser) (template-name loser))
                    (template-cost loser))
              (cond
@@ -831,7 +831,7 @@
        (let ((*compiler-error-context* call))
          (compiler-note "~{~?~^~&~6T~}"
                         (if template
-                            `("forced to do ~A (cost ~D)"
+                            `("forced to do ~A (cost ~W)"
                               (,(or (template-note template)
                                     (template-name template))
                                ,(template-cost template))
@@ -895,14 +895,14 @@
       ;; to implement an out-of-line version in terms of inline
       ;; transforms or VOPs or whatever.
       (unless template
-       (when (and (eq (continuation-function-name (combination-fun call))
-                      (leaf-name
-                       (environment-function
-                        (node-environment call))))
-                  (let ((info (basic-combination-kind call)))
-                    (not (or (function-info-ir2-convert info)
-                             (ir1-attributep (function-info-attributes info)
-                                             recursive)))))
+       (when (let ((funleaf (physenv-lambda (node-physenv call))))
+               (and (leaf-has-source-name-p funleaf)
+                    (eq (continuation-fun-name (combination-fun call))
+                        (leaf-source-name funleaf))
+                    (let ((info (basic-combination-kind call)))
+                      (not (or (function-info-ir2-convert info)
+                               (ir1-attributep (function-info-attributes info)
+                                               recursive))))))
          (let ((*compiler-error-context* call))
            (compiler-warning "~@<recursion in known function definition~2I ~
                                ~_policy=~S ~_arg types=~S~:>"