compiler: fewer namespace lookups.
parent
042a0f26a6
commit
7da4a74588
|
@ -20,8 +20,14 @@ SYMBOL: phis
|
|||
: resolve ( vreg -- vreg )
|
||||
copies get at ;
|
||||
|
||||
: (record-copy) ( dst src copies -- )
|
||||
swapd maybe-set-at [ changed? on ] when ; inline
|
||||
|
||||
: record-copy ( dst src -- )
|
||||
swap copies get maybe-set-at [ changed? on ] when ; inline
|
||||
copies get (record-copy) ; inline
|
||||
|
||||
: record-copies ( seq -- )
|
||||
copies get '[ dup _ (record-copy) ] each ; inline
|
||||
|
||||
GENERIC: visit-insn ( insn -- )
|
||||
|
||||
|
@ -46,7 +52,7 @@ M: ##phi visit-insn
|
|||
] if ;
|
||||
|
||||
M: vreg-insn visit-insn
|
||||
defs-vregs [ dup record-copy ] each ;
|
||||
defs-vregs record-copies ;
|
||||
|
||||
M: insn visit-insn drop ;
|
||||
|
||||
|
|
|
@ -29,7 +29,7 @@ SYMBOL: allocations
|
|||
(allocation) set-at ;
|
||||
|
||||
: record-allocations ( allocations values -- )
|
||||
[ record-allocation ] 2each ;
|
||||
(allocation) '[ _ set-at ] 2each ;
|
||||
|
||||
! We track slot access to connect constructor inputs with
|
||||
! accessor outputs.
|
||||
|
@ -53,13 +53,15 @@ SYMBOL: +escaping+
|
|||
: init-escaping-values ( -- )
|
||||
<escaping-values> escaping-values set ;
|
||||
|
||||
: introduce-value ( values -- )
|
||||
escaping-values get
|
||||
: (introduce-value) ( values escaping-values -- )
|
||||
2dup disjoint-set-member?
|
||||
[ 2drop ] [ add-atom ] if ;
|
||||
[ 2drop ] [ add-atom ] if ; inline
|
||||
|
||||
: introduce-value ( values -- )
|
||||
escaping-values get (introduce-value) ;
|
||||
|
||||
: introduce-values ( values -- )
|
||||
[ introduce-value ] each ;
|
||||
escaping-values get '[ _ (introduce-value) ] each ;
|
||||
|
||||
: <slot-value> ( -- value )
|
||||
<value> dup introduce-value ;
|
||||
|
|
|
@ -18,12 +18,18 @@ SYMBOL: copies
|
|||
|
||||
: resolve-copy ( copy -- val ) copies get compress-path ;
|
||||
|
||||
: resolve-copies ( copies -- vals )
|
||||
copies get [ compress-path ] curry map ;
|
||||
|
||||
: is-copy-of ( val copy -- ) copies get set-at ;
|
||||
|
||||
: are-copies-of ( vals copies -- ) [ is-copy-of ] 2each ;
|
||||
|
||||
: introduce-value ( val -- ) copies get conjoin ;
|
||||
|
||||
: introduce-values ( vals -- )
|
||||
copies get [ conjoin ] curry each ;
|
||||
|
||||
GENERIC: compute-copy-equiv* ( node -- )
|
||||
|
||||
M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
|
||||
|
@ -32,8 +38,8 @@ M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
|
|||
#! An output is a copy of every input if all inputs are
|
||||
#! copies of the same original value.
|
||||
[
|
||||
swap remove-bottom [ resolve-copy ] map
|
||||
dup [ all-equal? ] [ empty? not ] bi and
|
||||
swap remove-bottom resolve-copies
|
||||
dup [ f ] [ all-equal? ] if-empty
|
||||
[ first swap is-copy-of ] [ 2drop ] if
|
||||
] 2each ;
|
||||
|
||||
|
@ -43,6 +49,6 @@ M: #phi compute-copy-equiv*
|
|||
M: node compute-copy-equiv* drop ;
|
||||
|
||||
: compute-copy-equiv ( node -- )
|
||||
[ node-defs-values [ introduce-value ] each ]
|
||||
[ node-defs-values introduce-values ]
|
||||
[ compute-copy-equiv* ]
|
||||
bi ;
|
||||
|
|
|
@ -290,7 +290,8 @@ DEFER: (value-info-union)
|
|||
SYMBOL: value-infos
|
||||
|
||||
: value-info* ( value -- info ? )
|
||||
resolve-copy value-infos get assoc-stack [ null-info or ] [ >boolean ] bi ; inline
|
||||
resolve-copy value-infos get assoc-stack
|
||||
[ null-info or ] [ >boolean ] bi ; inline
|
||||
|
||||
: value-info ( value -- info )
|
||||
value-info* drop ;
|
||||
|
|
Loading…
Reference in New Issue