~% ~S~%*** possible internal error? Please report this."
(type-specifier rtype) (type-specifier node-type))))
(setf (node-derived-type node) int)
+ (when (and (ref-p node)
+ (member-type-p int)
+ (null (rest (member-type-members int)))
+ (lambda-var-p (ref-leaf node)))
+ (change-ref-leaf node (find-constant (first (member-type-members int)))))
(reoptimize-continuation (node-cont node))))))
(values))
(let ((last (block-last block)))
(typecase last
(cif
- (flush-dest (if-test last))
- (when (unlink-node last)
- (return)))
+ (if (memq (continuation-type-check (if-test last))
+ '(nil :deleted))
+ ;; FIXME: Remove the test above when the bug 203
+ ;; will be fixed.
+ (progn
+ (flush-dest (if-test last))
+ (when (unlink-node last)
+ (return)))
+ (return)))
(exit
(when (maybe-delete-exit last)
(return)))))
(convert-if-if use node)
(when (continuation-use test) (return)))))
- (let* ((type (continuation-type test))
- (victim
- (cond ((constant-continuation-p test)
- (if (continuation-value test)
- (if-alternative node)
- (if-consequent node)))
- ((not (types-equal-or-intersect type (specifier-type 'null)))
- (if-alternative node))
- ((type= type (specifier-type 'null))
- (if-consequent node)))))
- (when victim
- (flush-dest test)
- (when (rest (block-succ block))
- (unlink-blocks block victim))
- (setf (component-reanalyze (node-component node)) t)
- (unlink-node node))))
+ (when (memq (continuation-type-check test)
+ '(nil :deleted))
+ ;; FIXME: Remove the test above when the bug 203 will be fixed.
+ (let* ((type (continuation-type test))
+ (victim
+ (cond ((constant-continuation-p test)
+ (if (continuation-value test)
+ (if-alternative node)
+ (if-consequent node)))
+ ((not (types-equal-or-intersect type (specifier-type 'null)))
+ (if-alternative node))
+ ((type= type (specifier-type 'null))
+ (if-consequent node)))))
+ (when victim
+ (flush-dest test)
+ (when (rest (block-succ block))
+ (unlink-blocks block victim))
+ (setf (component-reanalyze (node-component node)) t)
+ (unlink-node node)))))
(values))
;;; Create a new copy of an IF node that tests the value of the node
;;; possible to do this starting from debug names as well as source
;;; names, but as of sbcl-0.7.1.5, there was no need for this
;;; generality, since source names are always known to our callers.)
-(defun transform-call (node res source-name)
- (declare (type combination node) (list res))
+(defun transform-call (call res source-name)
+ (declare (type combination call) (list res))
(aver (and (legal-fun-name-p source-name)
(not (eql source-name '.anonymous.))))
- (with-ir1-environment-from-node node
+ (node-ends-block call)
+ (with-ir1-environment-from-node call
+ (with-component-last-block (*current-component*
+ (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
"<unknown function>"))))
- (ref (continuation-use (combination-fun node))))
+ (ref (continuation-use (combination-fun call))))
(change-ref-leaf ref new-fun)
- (setf (combination-kind node) :full)
- (locall-analyze-component *current-component*)))
+ (setf (combination-kind call) :full)
+ (locall-analyze-component *current-component*))))
(values))
;;; Replace a call to a foldable function of constant arguments with
(unlink-node call)
(when vals
(reoptimize-continuation (first vals)))
- (propagate-to-args use fun))
+ (propagate-to-args use fun)
+ (reoptimize-call use))
t)))
;;; If we see: