[ 0 swap associate \ ds-heights pick set-at ]
[ 0 swap associate \ rs-heights pick set-at ] tri
initial-height-state \ height-state pick set-at
- H{ } clone \ local-peek-set pick set-at
- H{ } clone \ replace-mapping pick set-at
+ HS{ } clone \ local-peek-set pick set-at
+ H{ } clone \ replaces pick set-at
H{ } <biassoc> \ locs>vregs pick set-at
H{ } clone \ peek-sets pick set-at
H{ } clone \ replace-sets pick set-at
[ dup n>> 0 < [ bad-peek ] [ ##peek, ] if ] each-insertion ;
: insert-replaces ( from to -- )
- [ inserting-replaces ] keep
- [ dup n>> 0 < [ 2drop ] [ ##replace, ] if ] each-insertion ;
+ 2drop ;
: visit-edge ( from to -- )
! If both blocks are subroutine calls, don't bother
USING: accessors arrays assocs combinators compiler.cfg
compiler.cfg.instructions compiler.cfg.parallel-copy
compiler.cfg.registers compiler.cfg.stacks.height
-hash-sets kernel make math math.order namespaces sequences sets ;
+fry hash-sets kernel make math math.order namespaces sequences sets ;
FROM: namespaces => set ;
IN: compiler.cfg.stacks.local
: translate-local-loc ( loc state -- loc' )
[ clone ] dip over >loc< 0 1 ? rot nth first - >>n ;
+: untranslate-local-loc ( loc state -- loc' )
+ [ clone ] dip over >loc< 0 1 ? rot nth first + >>n ;
+
: clone-height-state ( state -- state' )
[ clone ] map ;
: replaces>copy-insns ( replaces -- insns )
[ [ loc>vreg ] dip ] assoc-map parallel-copy ;
+: replaces>replace-insns ( replaces height-state -- insns )
+ [ keys ] dip
+ '[ [ loc>vreg ] [ _ untranslate-local-loc ] bi f ##replace boa ] map
+ [ loc>> n>> 0 >= ] filter ;
+
: changes>insns ( replaces height-state -- insns )
- [ replaces>copy-insns ] [ height-state>insns ] bi* append ;
+ [ drop replaces>copy-insns ]
+ [ nip height-state>insns ]
+ [ replaces>replace-insns ] 2tri 3append ;
: emit-changes ( replaces height-state -- )
building get pop -rot changes>insns % , ;