diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor index 96b4ed0488..b58ae2de44 100644 --- a/basis/compiler/cfg/builder/blocks/blocks.factor +++ b/basis/compiler/cfg/builder/blocks/blocks.factor @@ -11,10 +11,10 @@ SLOT: out-d dup begin-local-analysis instructions>> building set ; : end-basic-block ( block -- ) - [ end-local-analysis ] when* building off ; + end-local-analysis building off ; : (begin-basic-block) ( block -- block' ) - swap [ over connect-bbs ] when* dup set-basic-block ; + dup set-basic-block [ connect-bbs ] keep ; : begin-basic-block ( block -- block' ) dup end-basic-block (begin-basic-block) ; @@ -54,6 +54,6 @@ SLOT: out-d sift [ f ] [ dup first second height-state set [ first ] map - f begin-basic-block + dup set-basic-block [ connect-Nto1-bbs ] keep ] if-empty ; diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index 158836f85a..00095c3c39 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -335,7 +335,9 @@ SYMBOL: foo { V{ T{ ##call { word set-slot } } T{ ##branch } } } [ - [ f call-node-1 emit-node ] V{ } make drop + [ + dup set-basic-block call-node-1 emit-node + ] V{ } make drop predecessors>> first instructions>> ] cfg-unit-test