0.pre7.127:

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

diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp
index 66d201d..fe64801 100644 (file)
--- a/src/compiler/ltn.lisp
+++ b/src/compiler/ltn.lisp
@@ -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))
@@ -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"))
@@ -801,37 +801,37 @@
     (when (losers)
       (collect ((messages)
                (count 0 +))
-       (flet ((frob (string &rest stuff)
+       (flet ((lose1 (string &rest stuff)
                 (messages string)
                 (messages stuff)))
          (dolist (loser (losers))
            (when (and *efficiency-note-limit*
                       (>= (count) *efficiency-note-limit*))
-             (frob "etc.")
+             (lose1 "etc.")
              (return))
            (let* ((type (template-type loser))
                   (valid (valid-function-use call type))
                   (strict-valid (valid-function-use call type
                                                     :strict-result t)))
-             (frob "unable to do ~A (cost ~D) because:"
-                   (or (template-note loser) (template-name loser))
-                   (template-cost loser))
+             (lose1 "unable to do ~A (cost ~W) because:"
+                    (or (template-note loser) (template-name loser))
+                    (template-cost loser))
              (cond
               ((and valid strict-valid)
-               (strange-template-failure loser call ltn-policy #'frob))
+               (strange-template-failure loser call ltn-policy #'lose1))
               ((not valid)
                (aver (not (valid-function-use call type
-                                              :error-function #'frob
-                                              :warning-function #'frob))))
+                                              :lossage-fun #'lose1
+                                              :unwinnage-fun #'lose1))))
               (t
                (aver (ltn-policy-safe-p ltn-policy))
-               (frob "can't trust output type assertion under safe policy")))
+               (lose1 "can't trust output type assertion under safe policy")))
              (count 1))))
 
        (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,7 +895,7 @@
       ;; to implement an out-of-line version in terms of inline
       ;; transforms or VOPs or whatever.
       (unless template
-       (when (let ((funleaf (physenv-function (node-physenv call))))
+       (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))
@@ -904,13 +904,12 @@
                                (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~:>"
-                             (lexenv-policy (node-lexenv call))
-                             (mapcar (lambda (arg)
-                                       (type-specifier (continuation-type
-                                                        arg)))
-                                     args))))
+           (compiler-warn "~@<recursion in known function definition~2I ~
+                            ~_policy=~S ~_arg types=~S~:>"
+                          (lexenv-policy (node-lexenv call))
+                          (mapcar (lambda (arg)
+                                    (type-specifier (continuation-type arg)))
+                                  args))))
        (ltn-default-call call ltn-policy)
        (return-from ltn-analyze-known-call (values)))
       (setf (basic-combination-info call) template)