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

Simplify inference code a bit

slava 2006-08-10 20:33:15 +00:00
parent 69092b2851
commit b19a6672bf
1 changed files with 11 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
library/compiler/inference/words.factor
View File

@ -29,28 +29,21 @@ IN: inference
TUPLE: rstate label base-case? ; TUPLE: rstate label base-case? ;
: nest-node ( -- dataflow current ) : nest-node ( -- ) #entry node, ;
dataflow-graph get dataflow-graph off
current-node get current-node off ;
: unnest-node ( new-node dataflow current -- new-node ) : unnest-node ( new-node -- new-node )
>r >r dataflow-graph get 1array over set-node-children dup node-param #return node,
r> dataflow-graph set dataflow-graph get 1array over set-node-children ;
r> current-node set ;
: with-recursive-state ( word label base-case quot -- ) : add-recursive-state ( word label base-case -- )
>r <rstate> 2array recursive-state [ swap add ] change r> <rstate> 2array recursive-state [ swap add ] change ;
nest-node 2slip unnest-node ; inline
: inline-block ( word base-case -- node-block variables ) : inline-block ( word base-case -- node-block variables )
[ [
copy-inference copy-inference nest-node
>r gensym 2dup r> [ >r gensym 2dup r> add-recursive-state
dup #label >r #label >r word-def infer-quot r>
#entry node, unnest-node
swap word-def infer-quot
#return node, r>
] with-recursive-state
] make-hash ; ] make-hash ;
: apply-infer ( hash -- ) : apply-infer ( hash -- )
@ -62,7 +55,7 @@ GENERIC: collect-recursion* ( label node -- )
M: node collect-recursion* ( label node -- ) 2drop ; M: node collect-recursion* ( label node -- ) 2drop ;
M: #call-label collect-recursion* ( label node -- ) M: #call-label collect-recursion* ( label node -- )
tuck node-param = [ node-in-d , ] [ drop ] if ; tuck node-param eq? [ node-in-d , ] [ drop ] if ;
: collect-recursion ( #label -- seq ) : collect-recursion ( #label -- seq )
#! Collect the input stacks of all #call-label nodes that #! Collect the input stacks of all #call-label nodes that