X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=f370eb35a1201ca02bb727953c29e340f618c312;hb=dcf5978d9d33098e868ae6eea28e1b310038c03d;hp=a4bf8fa1209da25a019cbc14f99bb6444560d4ac;hpb=11f02398a1a9ccbde847c82fd233e8378e45c29c;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index a4bf8fa..f370eb3 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -438,22 +438,23 @@ (defun convert-mv-call (ref call fun) (declare (type ref ref) (type mv-combination call) (type functional fun)) (when (and (looks-like-an-mv-bind fun) - (not (functional-entry-fun fun)) (singleton-p (leaf-refs fun)) (singleton-p (basic-combination-args call))) (let* ((*current-component* (node-component ref)) (ep (optional-dispatch-entry-point-fun fun (optional-dispatch-max-args fun)))) - (aver (= (optional-dispatch-min-args fun) 0)) - (setf (basic-combination-kind call) :local) - (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) - (merge-tail-sets call ep) - (change-ref-leaf ref ep) + (when (null (leaf-refs ep)) + (aver (= (optional-dispatch-min-args fun) 0)) + (aver (not (functional-entry-fun fun))) + (setf (basic-combination-kind call) :local) + (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) + (merge-tail-sets call ep) + (change-ref-leaf ref ep) - (assert-lvar-type - (first (basic-combination-args call)) - (make-short-values-type (mapcar #'leaf-type (lambda-vars ep))) - (lexenv-policy (node-lexenv call))))) + (assert-lvar-type + (first (basic-combination-args call)) + (make-short-values-type (mapcar #'leaf-type (lambda-vars ep))) + (lexenv-policy (node-lexenv call)))))) (values)) ;;; Attempt to convert a call to a lambda. If the number of args is @@ -952,11 +953,13 @@ ;;; new references to it. (defun let-convert (fun call) (declare (type clambda fun) (type basic-combination call)) - (let ((next-block (if (node-tail-p call) - nil - (insert-let-body fun call)))) + (let* ((next-block (insert-let-body fun call)) + (next-block (if (node-tail-p call) + nil + next-block))) (move-return-stuff fun call next-block) - (merge-lets fun call))) + (merge-lets fun call) + (setf (node-tail-p call) nil))) ;;; Reoptimize all of CALL's args and its result. (defun reoptimize-call (call) @@ -1031,6 +1034,7 @@ (eq (basic-combination-fun dest) ref-lvar) (eq (basic-combination-kind dest) :local) (not (node-to-be-deleted-p dest)) + (not (block-delete-p (lambda-block clambda))) (cond ((ok-initial-convert-p clambda) t) (t (reoptimize-lvar ref-lvar) @@ -1070,7 +1074,8 @@ ;;; tail-convert. The second is the value of M-C-T-A. (defun maybe-convert-tail-local-call (call) (declare (type combination call)) - (let ((return (lvar-dest (node-lvar call)))) + (let ((return (lvar-dest (node-lvar call))) + (fun (combination-lambda call))) (aver (return-p return)) (when (and (not (node-tail-p call)) ; otherwise already converted ;; this is a tail call @@ -1081,10 +1086,10 @@ ;; non-tail so that we can use known return inside the ;; component. (not (eq (functional-kind (node-home-lambda call)) - :external))) + :external)) + (not (block-delete-p (lambda-block fun)))) (node-ends-block call) - (let ((block (node-block call)) - (fun (combination-lambda call))) + (let ((block (node-block call))) (setf (node-tail-p call) t) (unlink-blocks block (first (block-succ block))) (link-blocks block (lambda-block fun))