 ! Maps basic-blocks to states
 SYMBOLS: state-in state-out ;
 
-: with-state ( state quot -- )
-    [ state ] dip with-variable ; inline
+: initial-state ( bb states -- state ) 2drop <state> ;
+
+: single-predecessor ( bb states -- state ) nip first clone ;
 
 ERROR: must-equal-failed seq ;
 

UNION: neutral-insn
    ##flushable
    ##effect
    ##branch
    ##loop-entry
    ##conditional-branch
    ##compare-imm-branch
    ##dispatch ;

M: neutral-insn visit , ;

UNION: sync-if-back-edge
    ##branch
    ##conditional-branch
    ##compare-imm-branch ;

M: sync-if-back-edge visit
    basic-block get [ successors>> ] [ number>> ] bi '[ number>> _ < ] any?
    [ sync-state ] when
    , ;


        dup basic-block set
        dup block-in-state
        [ swap set-block-in-state ] [
            state [
                [ instructions>> [ visit ] each ]
                [ [ state get ] dip set-block-out-state ]
                [ ]
                tri
            ] with-variable
        ] 2bi
    ] V{ } make >>instructions drop ;

