+: sync-unpoisoned-states ( predecessors states -- )
+ [
+ dup poisoned?>> [ 2drop ] [
+ state [
+ instructions>> building set
+ sync-state
+ ] with-variable
+ ] if
+ ] 2each ;
+
+ERROR: must-equal-failed seq ;
+
+: must-equal ( seq -- elt )
+ dup all-equal? [ first ] [ must-equal-failed ] if ;
+
+: merge-heights ( state predecessors states -- state )
+ nip
+ [ [ d-height>> ] map must-equal >>d-height ]
+ [ [ r-height>> ] map must-equal >>r-height ] bi ;
+
+ERROR: inconsistent-vreg>loc states ;
+
+: check-vreg>loc ( states -- )
+ ! The same vreg should not store different locs in
+ ! different branches
+ dup
+ [ vregs>locs>> ] map
+ [ [ keys ] map concat prune ] keep
+ '[ _ [ at ] with map sift all-equal? ] all?
+ [ drop ] [ inconsistent-vreg>loc ] if ;
+
+: insert-peek ( predecessor loc -- vreg )
+ ! XXX critical edges
+ [ instructions>> building ] dip '[ _ ^^peek ] with-variable ;
+
+: merge-loc ( predecessors locs>vregs loc -- vreg )
+ ! Insert a ##phi in the current block where the input
+ ! is the vreg storing loc from each predecessor block
+ [ '[ [ _ ] dip at ] map ] keep
+ '[ [ ] [ _ insert-peek ] if ] 2map
+ ^^phi ;
+
+: merge-locs ( state predecessors states -- state )
+ [ locs>vregs>> ] map dup [ keys ] map prune
+ [
+ [ 2nip ] [ merge-loc ] 3bi
+ ] with with H{ } map>assoc
+ >>locs>vregs ;
+
+: merge-states ( predecessors states -- state )
+ ! If any states are poisoned, save all registers
+ ! to the stack in each branch
+ [ drop <state> ] [
+ dup [ poisoned?>> ] any? [
+ sync-unpoisoned-states <state>
+ ] [
+ dup check-vreg>loc
+ [ state new ] 2dip
+ [ merge-heights ]
+ [ merge-locs ] 2bi
+ ! what about vregs>locs
+ ] if
+ ] if-empty ;