Small shuffle optimization cleanup
parent
940d3307f5
commit
ec1890b2b3
|
@ -102,35 +102,18 @@ M: #call linearize* ( node -- next )
|
||||||
M: #call-label linearize* ( node -- next )
|
M: #call-label linearize* ( node -- next )
|
||||||
node-param renamed-label linearize-call ;
|
node-param renamed-label linearize-call ;
|
||||||
|
|
||||||
SYMBOL: live-d
|
|
||||||
SYMBOL: live-r
|
|
||||||
|
|
||||||
: value-dropped? ( value -- ? )
|
|
||||||
dup value?
|
|
||||||
over live-d get member? not
|
|
||||||
rot live-r get member? not and
|
|
||||||
or ;
|
|
||||||
|
|
||||||
: filter-dropped ( seq -- seq )
|
|
||||||
[ dup value-dropped? [ drop f ] when ] map ;
|
|
||||||
|
|
||||||
: prepare-inputs ( values -- values templates )
|
: prepare-inputs ( values -- values templates )
|
||||||
filter-dropped dup [ any-reg swap 2array ] map ;
|
dup [ any-reg swap 2array ] map ;
|
||||||
|
|
||||||
: do-inputs ( node -- )
|
: do-inputs ( shuffle -- )
|
||||||
dup node-in-d prepare-inputs rot node-in-r prepare-inputs
|
dup shuffle-in-d prepare-inputs
|
||||||
|
rot shuffle-in-r prepare-inputs
|
||||||
template-inputs ;
|
template-inputs ;
|
||||||
|
|
||||||
: live-stores ( instack outstack -- stack )
|
|
||||||
#! Avoid storing a value into its former position.
|
|
||||||
dup length [ pick ?nth dupd eq? [ drop f ] when ] 2map nip ;
|
|
||||||
|
|
||||||
M: #shuffle linearize* ( #shuffle -- )
|
M: #shuffle linearize* ( #shuffle -- )
|
||||||
0 vreg-allocator set
|
0 vreg-allocator set
|
||||||
dup node-in-d over node-out-d live-stores live-d set
|
node-shuffle dup do-inputs
|
||||||
dup node-in-r over node-out-r live-stores live-r set
|
dup shuffle-out-d swap shuffle-out-r template-outputs
|
||||||
do-inputs
|
|
||||||
live-d get live-r get template-outputs
|
|
||||||
iterate-next ;
|
iterate-next ;
|
||||||
|
|
||||||
: ?static-branch ( node -- n )
|
: ?static-branch ( node -- n )
|
||||||
|
|
|
@ -3,8 +3,6 @@ USING: hashtables kernel math namespaces sequences ;
|
||||||
|
|
||||||
TUPLE: shuffle in-d in-r out-d out-r ;
|
TUPLE: shuffle in-d in-r out-d out-r ;
|
||||||
|
|
||||||
: empty-shuffle { } { } { } { } <shuffle> ;
|
|
||||||
|
|
||||||
: load-shuffle ( d r shuffle -- )
|
: load-shuffle ( d r shuffle -- )
|
||||||
tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ;
|
tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ;
|
||||||
|
|
||||||
|
@ -59,3 +57,26 @@ M: shuffle clone ( shuffle -- shuffle )
|
||||||
[ shuffle-out-d clone ] keep
|
[ shuffle-out-d clone ] keep
|
||||||
shuffle-out-r clone
|
shuffle-out-r clone
|
||||||
<shuffle> ;
|
<shuffle> ;
|
||||||
|
|
||||||
|
SYMBOL: live-d
|
||||||
|
SYMBOL: live-r
|
||||||
|
|
||||||
|
: value-dropped? ( value -- ? )
|
||||||
|
dup value?
|
||||||
|
over live-d get member? not
|
||||||
|
rot live-r get member? not and
|
||||||
|
or ;
|
||||||
|
|
||||||
|
: filter-dropped ( seq -- seq )
|
||||||
|
[ dup value-dropped? [ drop f ] when ] map ;
|
||||||
|
|
||||||
|
: live-stores ( instack outstack -- stack )
|
||||||
|
#! Avoid storing a value into its former position.
|
||||||
|
dup length [ pick ?nth dupd eq? [ drop f ] when ] 2map nip ;
|
||||||
|
|
||||||
|
: trim-shuffle ( shuffle -- shuffle )
|
||||||
|
dup shuffle-in-d over shuffle-out-d live-stores live-d set
|
||||||
|
dup shuffle-in-r over shuffle-out-r live-stores live-r set
|
||||||
|
dup shuffle-in-d filter-dropped
|
||||||
|
swap shuffle-in-r filter-dropped
|
||||||
|
live-d get live-r get <shuffle> ;
|
||||||
|
|
Loading…
Reference in New Issue