X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir1opt.lisp;h=b538652ed0d60021d48a9254a26dd1af0216d401;hb=e0697854ef9f4999c8585b64be1b282ce4725176;hp=6fe4c361e4efd29cf197ae2dcc8b220ac4fd6f79;hpb=de66d0244088badaf0898195d3112b62e11727ea;p=sbcl.git diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 6fe4c36..b538652 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -977,7 +977,7 @@ (:aborted (setf (combination-kind node) :error) (when args - (apply #'compiler-warn args)) + (apply #'warn args)) (remhash node table) nil) (:failure @@ -1084,10 +1084,9 @@ (block-next (node-block call))) (let ((new-fun (ir1-convert-inline-lambda res - :debug-name (debug-namify "LAMBDA-inlined ~A" - (as-debug-name - source-name - "")))) + :debug-name (debug-namify "LAMBDA-inlined " + source-name + ""))) (ref (lvar-use (combination-fun call)))) (change-ref-leaf ref new-fun) (setf (combination-kind call) :full) @@ -1752,7 +1751,9 @@ (unless next-block (when ctran (ensure-block-start ctran)) (setq next-block (first (block-succ (node-block cast)))) - (ensure-block-start (node-prev cast))) + (ensure-block-start (node-prev cast)) + (reoptimize-lvar lvar) + (setf (lvar-%derived-type value) nil)) (%delete-lvar-use use) (add-lvar-use use lvar) (unlink-blocks (node-block use) (node-block cast)) @@ -1773,7 +1774,9 @@ ;; FIXME: Do it in one step. (filter-lvar value - `(multiple-value-call #'list 'dummy)) + (if (cast-single-value-p cast) + `(list 'dummy) + `(multiple-value-call #'list 'dummy))) (filter-lvar (cast-value cast) ;; FIXME: Derived type.