diff --git a/basis/compiler/cfg/copy-prop/copy-prop.factor b/basis/compiler/cfg/copy-prop/copy-prop.factor index 7594e9c409..64f0f26f3e 100644 --- a/basis/compiler/cfg/copy-prop/copy-prop.factor +++ b/basis/compiler/cfg/copy-prop/copy-prop.factor @@ -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 ; diff --git a/basis/compiler/tree/escape-analysis/allocations/allocations.factor b/basis/compiler/tree/escape-analysis/allocations/allocations.factor index 2f9aecead5..4a42d39938 100644 --- a/basis/compiler/tree/escape-analysis/allocations/allocations.factor +++ b/basis/compiler/tree/escape-analysis/allocations/allocations.factor @@ -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 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 ; : ( -- value ) dup introduce-value ; diff --git a/basis/compiler/tree/propagation/copy/copy.factor b/basis/compiler/tree/propagation/copy/copy.factor index e5595daeed..defb504034 100644 --- a/basis/compiler/tree/propagation/copy/copy.factor +++ b/basis/compiler/tree/propagation/copy/copy.factor @@ -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 ; diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index de82349f19..9de2cbaba1 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -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 ;