diff options
| author | Stas Boukarev <stassats@gmail.com> | 2022-08-19 20:26:28 +0300 |
|---|---|---|
| committer | Stas Boukarev <stassats@gmail.com> | 2022-08-19 20:26:28 +0300 |
| commit | c909791cd96901c6fad8e87be6ccad06efb3d52f (patch) | |
| tree | 34993f50bd4faefac35b1446ba4c5acbebff2a30 | |
| parent | f88863439853bfd56f3e32a2ab376880b99f10b4 (diff) | |
structure-typep vop-optimize: follow the true branch too.
| -rw-r--r-- | src/compiler/ir2opt.lisp | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/src/compiler/ir2opt.lisp b/src/compiler/ir2opt.lisp index 5fc725510..d508ceb0c 100644 --- a/src/compiler/ir2opt.lisp +++ b/src/compiler/ir2opt.lisp @@ -1225,17 +1225,26 @@ (let (vops stop (value (tn-ref-tn (vop-args vop)))) - (labels ((chain (vop) + (labels ((good-vop-p (vop) + (and (singleton-p (ir2block-predecessors (vop-block vop))) + (eq (vop-name vop) 'structure-typep) + (eq (tn-ref-tn (vop-args vop)) value))) + (chain (vop &optional (collect t)) (let ((next (branch-destination vop nil))) (cond (next - (push vop vops) - (if (and (singleton-p (ir2block-predecessors (vop-block next))) - (eq (vop-name next) 'structure-typep) - (eq (tn-ref-tn (vop-args next)) value)) - (chain next) - (setf stop (vop-block next)))) - (t - (setf stop (vop-block vop)))))) + (when collect + (push vop vops)) + (cond ((good-vop-p next) + (chain next)) + ((not stop) + (setf stop (vop-block next))))) + ((not stop) + (setf stop (vop-block vop))))) + (let ((true (branch-destination vop))) + (when (and true + (good-vop-p true)) + (push true vops) + (chain true nil)))) (ir2-block-label (block) (or (ir2-block-%label block) (setf (ir2-block-%label block) (gen-label))))) |