0.pre8.85

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

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index e55c0be..4f59a87 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -138,7 +138,7 @@
               `(declare (ignore ,n-supplied))
               `(%verify-arg-count ,n-supplied ,nargs))
          (locally
-           (declare (optimize (let-convertion 3)))
+           (declare (optimize (merge-tail-calls 3)))
            (%funcall ,fun ,@temps)))))
     (optional-dispatch
      (let* ((min (optional-dispatch-min-args fun))
@@ -166,11 +166,7 @@
                       `(multiple-value-bind (,n-context ,n-count)
                            (%more-arg-context ,n-supplied ,max)
                          (locally
-                           ;; KLUDGE: As above, we're trying to
-                           ;; enable tail recursion optimization and
-                           ;; any other effects of this declaration
-                           ;; are accidental. -- WHN 2002-07-08
-                           (declare (optimize (speed 2) (debug 1)))
+                           (declare (optimize (merge-tail-calls 3)))
                            (%funcall ,more ,@temps ,n-context ,n-count)))))))
             (t
              (%arg-count-error ,n-supplied)))))))))
@@ -537,8 +533,8 @@
         (with-ir1-environment-from-node call
           (ir1-convert-lambda
            `(lambda ,vars
-              (declare (ignorable . ,ignores))
-              (%funcall ,entry . ,args))
+              (declare (ignorable ,@ignores))
+              (%funcall ,entry ,@args))
            :debug-name (debug-namify "hairy function entry ~S"
                                      (continuation-fun-name
                                       (basic-combination-fun call)))))))
@@ -641,7 +637,7 @@
       (collect ((call-args))
        (do ((var arglist (cdr var))
             (temp temps (cdr temp)))
-           (())
+           ((null var))
          (let ((info (lambda-var-arg-info (car var))))
            (if info
                (ecase (arg-info-kind info)
@@ -948,12 +944,21 @@
     (cond ((not return))
          ((or next-block call-return)
           (unless (block-delete-p (node-block return))
+             (when (and (node-tail-p call)
+                        call-return
+                        (not (eq (node-cont call)
+                                 (return-result call-return))))
+               ;; We do not care to give a meaningful continuation to
+               ;; a tail combination, but here we need it.
+               (delete-continuation-use call)
+               (add-continuation-use call (return-result call-return)))
             (move-return-uses fun call
                               (or next-block (node-block call-return)))))
          (t
           (aver (node-tail-p call))
           (setf (lambda-return call-fun) return)
-          (setf (return-lambda return) call-fun))))
+          (setf (return-lambda return) call-fun)
+           (setf (lambda-return fun) nil))))
   (move-let-call-cont fun)
   (values))
 
@@ -982,9 +987,6 @@
 
 ;;; Are there any declarations in force to say CLAMBDA shouldn't be
 ;;; LET converted?
-(define-optimization-quality let-convertion
-    (if (<= debug speed) 3 0)
-  ("off" "maybe" "on" "on"))
 (defun declarations-suppress-let-conversion-p (clambda)
   ;; From the user's point of view, LET-converting something that
   ;; has a name is inlining it. (The user can't see what we're doing