steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.tree: Renamed high-level IR node constructors to <#foo> from #foo. Moving towards making classes/word names not conflict.

db4
Doug Coleman 2011-11-06 20:41:31 -08:00
parent ec19171220
commit d65bd97a54
9 changed files with 64 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/compiler/tree/builder/builder.factor
View File

@ -50,7 +50,7 @@ PRIVATE>
in-d word/quot build-tree-with unclip-last in-d>> :> in-d'
{
{ [ dup not ] [ ] }
{ [ dup ends-with-terminate? ] [ out-d [ f swap #push ] map append ] }
[ in-d' out-d [ [ length ] bi@ assert= ] [ #copy suffix ] 2bi ]
{ [ dup ends-with-terminate? ] [ out-d [ f swap <#push> ] map append ] }
[ in-d' out-d [ [ length ] bi@ assert= ] [ <#copy> suffix ] 2bi ]
} cond
] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ;
] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ;

14
basis/compiler/tree/cleanup/cleanup.factor
View File

@ -46,9 +46,9 @@ GENERIC: cleanup* ( node -- node/nodes )
#! inputs followed by #push nodes for the outputs.
[
[ node-output-infos ] [ out-d>> ] bi
[ [ literal>> ] dip #push ] 2map
[ [ literal>> ] dip <#push> ] 2map
]
[ in-d>> #drop ]
[ in-d>> <#drop> ]
bi prefix ;
: >predicate-folding< ( #call -- value-info class result )
@ -125,8 +125,8 @@ M: #call cleanup*
#! If only one branch is live we don't need to branch at
#! all; just drop the condition value.
dup live-children sift dup length {
{ 0 [ drop in-d>> #drop ] }
{ 1 [ first swap in-d>> #drop prefix ] }
{ 0 [ drop in-d>> <#drop> ] }
{ 1 [ first swap in-d>> <#drop> prefix ] }
[ 2drop ]
} case ;
@ -144,12 +144,12 @@ M: #branch cleanup*
} cleave ;
: output-fs ( values -- nodes )
[ f swap #push ] map ;
[ f swap <#push> ] map ;
: eliminate-single-phi ( #phi -- node )
[ phi-in-d>> first ] [ out-d>> ] bi over [ +bottom+ eq? ] all?
[ [ drop ] [ output-fs ] bi* ]
[ #copy ]
[ <#copy> ]
if ;
: eliminate-phi ( #phi -- node )
@ -168,7 +168,7 @@ M: #phi cleanup*
eliminate-phi
live-branches off ;
: >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi #copy ;
: >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi <#copy> ;
: flatten-recursive ( #recursive -- nodes )
#! convert #enter-recursive and #return-recursive into

2
basis/compiler/tree/dead-code/branches/branches.factor
View File

@ -39,7 +39,7 @@ M: #branch remove-dead-code*
[ drop filter-live ] [ swap nths ] 2bi
[ length make-values ] keep
[ drop ] [ zip ] 2bi
#data-shuffle ;
<#data-shuffle> ;
: insert-drops ( nodes values indices -- nodes' )
'[

6
basis/compiler/tree/dead-code/simple/simple.factor
View File

@ -57,7 +57,7 @@ M: #alien-node compute-live-values* nip look-at-inputs ;
outputs
mapping-keys
mapping-values
filter-corresponding zip #data-shuffle ; inline
filter-corresponding zip <#data-shuffle> ; inline
:: drop-dead-values ( outputs -- #shuffle )
outputs length make-values :> new-outputs
@ -92,7 +92,7 @@ M: #push remove-dead-code*
: remove-flushable-call ( #call -- node )
[ word>> depends-on-flushable ]
[ in-d>> #drop remove-dead-code* ]
[ in-d>> <#drop> remove-dead-code* ]
bi ;
: define-simplifications ( word seq -- )
@ -142,7 +142,7 @@ M: #shuffle remove-dead-code*
M: #copy remove-dead-code*
[ in-d>> ] [ out-d>> ] bi
2dup swap zip #data-shuffle
2dup swap zip <#data-shuffle>
remove-dead-code* ;
M: #terminate remove-dead-code*

4
basis/compiler/tree/identities/identities.factor
View File

@ -62,12 +62,12 @@ SYMBOL: X
GENERIC: apply-identities* ( node -- node )
: simplify-to-constant ( #call constant -- nodes )
[ [ in-d>> #drop ] [ out-d>> first ] bi ] dip swap #push
[ [ in-d>> <#drop> ] [ out-d>> first ] bi ] dip swap <#push>
2array ;
: select-input ( node n -- #shuffle )
[ [ in-d>> ] [ out-d>> ] bi ] dip
pick nth over first associate #data-shuffle ;
pick nth over first associate <#data-shuffle> ;
M: #call apply-identities*
dup word>> "identities" word-prop [

2
basis/compiler/tree/normalization/normalization.factor
View File

@ -113,7 +113,7 @@ M: node normalize* ;
dup count-introductions make-values
H{ } clone rename-map set
[ (normalize) ] [ nip ] 2bi
[ #introduce prefix ] unless-empty
[ <#introduce> prefix ] unless-empty
rename-node-values
] with-scope ;

2
basis/compiler/tree/propagation/inlining/inlining.factor
View File

@ -16,7 +16,7 @@ IN: compiler.tree.propagation.inlining
! Splicing nodes
: splicing-call ( #call word -- nodes )
[ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
[ [ in-d>> ] [ out-d>> ] bi ] dip <#call> 1array ;
: open-code-#call ( #call word/quot -- nodes/f )
[ [ in-d>> ] [ out-d>> ] bi ] dip build-sub-tree ;

86
basis/compiler/tree/tree.factor
View File

@ -12,12 +12,12 @@ TUPLE: node < identity-tuple ;
TUPLE: #introduce < node out-d ;
: #introduce ( out-d -- node )
: <#introduce> ( out-d -- node )
\ #introduce new swap >>out-d ;
TUPLE: #call < node word in-d out-d body method class info ;
: #call ( inputs outputs word -- node )
: <#call> ( inputs outputs word -- node )
\ #call new
swap >>word
swap >>out-d
@ -25,7 +25,7 @@ TUPLE: #call < node word in-d out-d body method class info ;
TUPLE: #call-recursive < node label in-d out-d info ;
: #call-recursive ( inputs outputs label -- node )
: <#call-recursive> ( inputs outputs label -- node )
\ #call-recursive new
swap >>label
swap >>out-d
@ -33,7 +33,7 @@ TUPLE: #call-recursive < node label in-d out-d info ;
TUPLE: #push < node literal out-d ;
: #push ( literal value -- node )
: <#push> ( literal value -- node )
\ #push new
swap 1array >>out-d
swap >>literal ;
@ -42,7 +42,7 @@ TUPLE: #renaming < node ;
TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ;
: #shuffle ( in-d out-d in-r out-r mapping -- node )
: <#shuffle> ( in-d out-d in-r out-r mapping -- node )
\ #shuffle new
swap >>mapping
swap >>out-r
@ -50,15 +50,15 @@ TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ;
swap >>out-d
swap >>in-d ;
: #data-shuffle ( in-d out-d mapping -- node )
[ f f ] dip #shuffle ; inline
: <#data-shuffle> ( in-d out-d mapping -- node )
[ f f ] dip <#shuffle> ; inline
: #drop ( inputs -- node )
{ } { } #data-shuffle ;
: <#drop> ( inputs -- node )
{ } { } <#data-shuffle> ;
TUPLE: #terminate < node in-d in-r ;
: #terminate ( in-d in-r -- node )
: <#terminate> ( in-d in-r -- node )
\ #terminate new
swap >>in-r
swap >>in-d ;
@ -72,17 +72,17 @@ TUPLE: #branch < node in-d children live-branches ;
TUPLE: #if < #branch ;
: #if ( ? true false -- node )
: <#if> ( ? true false -- node )
2array \ #if new-branch ;
TUPLE: #dispatch < #branch ;
: #dispatch ( n branches -- node )
: <#dispatch> ( n branches -- node )
\ #dispatch new-branch ;
TUPLE: #phi < node phi-in-d phi-info-d out-d terminated ;
: #phi ( d-phi-in d-phi-out terminated -- node )
: <#phi> ( d-phi-in d-phi-out terminated -- node )
\ #phi new
swap >>terminated
swap >>out-d
@ -90,19 +90,19 @@ TUPLE: #phi < node phi-in-d phi-info-d out-d terminated ;
TUPLE: #declare < node declaration ;
: #declare ( declaration -- node )
: <#declare> ( declaration -- node )
\ #declare new
swap >>declaration ;
TUPLE: #return < node in-d info ;
: #return ( stack -- node )
: <#return> ( stack -- node )
\ #return new
swap >>in-d ;
TUPLE: #recursive < node in-d word label loop? child ;
: #recursive ( label inputs child -- node )
: <#recursive> ( label inputs child -- node )
\ #recursive new
swap >>child
swap >>in-d
@ -110,7 +110,7 @@ TUPLE: #recursive < node in-d word label loop? child ;
TUPLE: #enter-recursive < node in-d out-d label info ;
: #enter-recursive ( label inputs outputs -- node )
: <#enter-recursive> ( label inputs outputs -- node )
\ #enter-recursive new
swap >>out-d
swap >>in-d
@ -118,7 +118,7 @@ TUPLE: #enter-recursive < node in-d out-d label info ;
TUPLE: #return-recursive < #renaming in-d out-d label info ;
: #return-recursive ( label inputs outputs -- node )
: <#return-recursive> ( label inputs outputs -- node )
\ #return-recursive new
swap >>out-d
swap >>in-d
@ -126,7 +126,7 @@ TUPLE: #return-recursive < #renaming in-d out-d label info ;
TUPLE: #copy < #renaming in-d out-d ;
: #copy ( inputs outputs -- node )
: <#copy> ( inputs outputs -- node )
\ #copy new
swap >>out-d
swap >>in-d ;
@ -141,22 +141,22 @@ TUPLE: #alien-node < node params ;
TUPLE: #alien-invoke < #alien-node in-d out-d ;
: #alien-invoke ( params -- node )
: <#alien-invoke> ( params -- node )
\ #alien-invoke new-alien-node ;
TUPLE: #alien-indirect < #alien-node in-d out-d ;
: #alien-indirect ( params -- node )
: <#alien-indirect> ( params -- node )
\ #alien-indirect new-alien-node ;
TUPLE: #alien-assembly < #alien-node in-d out-d ;
: #alien-assembly ( params -- node )
: <#alien-assembly> ( params -- node )
\ #alien-assembly new-alien-node ;
TUPLE: #alien-callback < node params child ;
: #alien-callback ( params child -- node )
: <#alien-callback> ( params child -- node )
\ #alien-callback new
swap >>child
swap >>params ;
@ -173,25 +173,25 @@ M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
[ f ] [ last #terminate? ] if-empty ;
M: vector child-visitor V{ } clone ;
M: vector #introduce, #introduce node, ;
M: vector #call, #call node, ;
M: vector #push, #push node, ;
M: vector #shuffle, #shuffle node, ;
M: vector #drop, #drop node, ;
M: vector #introduce, <#introduce> node, ;
M: vector #call, <#call> node, ;
M: vector #push, <#push> node, ;
M: vector #shuffle, <#shuffle> node, ;
M: vector #drop, <#drop> node, ;
M: vector #>r, [ [ f f ] dip ] [ swap zip ] 2bi #shuffle, ;
M: vector #r>, [ swap [ f swap ] dip f ] [ swap zip ] 2bi #shuffle, ;
M: vector #return, #return node, ;
M: vector #enter-recursive, #enter-recursive node, ;
M: vector #return-recursive, #return-recursive node, ;
M: vector #call-recursive, #call-recursive node, ;
M: vector #terminate, #terminate node, ;
M: vector #if, #if node, ;
M: vector #dispatch, #dispatch node, ;
M: vector #phi, #phi node, ;
M: vector #declare, #declare node, ;
M: vector #recursive, #recursive node, ;
M: vector #copy, #copy node, ;
M: vector #alien-invoke, #alien-invoke node, ;
M: vector #alien-indirect, #alien-indirect node, ;
M: vector #alien-assembly, #alien-assembly node, ;
M: vector #alien-callback, #alien-callback node, ;
M: vector #return, <#return> node, ;
M: vector #enter-recursive, <#enter-recursive> node, ;
M: vector #return-recursive, <#return-recursive> node, ;
M: vector #call-recursive, <#call-recursive> node, ;
M: vector #terminate, <#terminate> node, ;
M: vector #if, <#if> node, ;
M: vector #dispatch, <#dispatch> node, ;
M: vector #phi, <#phi> node, ;
M: vector #declare, <#declare> node, ;
M: vector #recursive, <#recursive> node, ;
M: vector #copy, <#copy> node, ;
M: vector #alien-invoke, <#alien-invoke> node, ;
M: vector #alien-indirect, <#alien-indirect> node, ;
M: vector #alien-assembly, <#alien-assembly> node, ;
M: vector #alien-callback, <#alien-callback> node, ;

6
basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor
View File

@ -27,7 +27,7 @@ GENERIC: unbox-tuples* ( node -- node/nodes )
[ object-slots ] [ drop ] [ ] tri*
[ (expand-#push) ] 2map-flat
] [
drop #push
drop <#push>
] if ;
: expand-#push ( #push -- nodes )
@ -37,7 +37,7 @@ M: #push unbox-tuples* ( #push -- nodes )
dup unbox-output? [ expand-#push ] when ;
: unbox-<tuple-boa> ( #call -- nodes )
dup unbox-output? [ in-d>> 1 tail* #drop ] when ;
dup unbox-output? [ in-d>> 1 tail* <#drop> ] when ;
: (flatten-values) ( values accum -- )
dup '[
@ -60,7 +60,7 @@ M: #push unbox-tuples* ( #push -- nodes )
] tri ;
: slot-access-shuffle ( tuple-values outputs slot-values -- #shuffle )
[ drop ] [ zip ] 2bi #data-shuffle ;
[ drop ] [ zip ] 2bi <#data-shuffle> ;
: unbox-slot-access ( #call -- nodes )
dup out-d>> first unboxed-slot-access? [