more dataflow work
parent
99651292cb
commit
3dccc4d2d5
|
@ -98,11 +98,11 @@ DEFER: (infer)
|
|||
[ drop f ] when
|
||||
] catch ;
|
||||
|
||||
: infer-branches ( consume instruction branchlist -- )
|
||||
: infer-branches ( branchlist consume instruction -- )
|
||||
#! Recursive stack effect inference is done here. If one of
|
||||
#! the branches has an undecidable stack effect, we set the
|
||||
#! base case to this stack effect and try again.
|
||||
f over [ recursive-branch or ] each [
|
||||
rot f over [ recursive-branch or ] each [
|
||||
[ [ car infer-branch , ] map ] make-list swap
|
||||
>r dataflow, r> unify
|
||||
] [
|
||||
|
@ -111,8 +111,10 @@ DEFER: (infer)
|
|||
|
||||
: infer-ifte ( -- )
|
||||
#! Infer effects for both branches, unify.
|
||||
3 IFTE
|
||||
pop-d pop-d 2list
|
||||
3 ensure-d
|
||||
\ drop dataflow-word, pop-d
|
||||
\ drop dataflow-word, pop-d 2list
|
||||
1 inputs IFTE
|
||||
pop-d drop ( condition )
|
||||
infer-branches ;
|
||||
|
||||
|
@ -126,15 +128,17 @@ DEFER: (infer)
|
|||
|
||||
: infer-generic ( -- )
|
||||
#! Infer effects for all branches, unify.
|
||||
2 GENERIC
|
||||
pop-d vtable>list
|
||||
2 ensure-d
|
||||
\ drop dataflow-word, pop-d vtable>list
|
||||
1 inputs GENERIC
|
||||
peek-d drop ( dispatch )
|
||||
infer-branches ;
|
||||
|
||||
: infer-2generic ( -- )
|
||||
#! Infer effects for all branches, unify.
|
||||
3 2GENERIC
|
||||
pop-d vtable>list
|
||||
3 ensure-d
|
||||
\ drop dataflow-word, pop-d vtable>list
|
||||
2 inputs 2GENERIC
|
||||
peek-d drop ( dispatch )
|
||||
peek-d drop ( dispatch )
|
||||
infer-branches ;
|
||||
|
|
|
@ -49,19 +49,19 @@ SYMBOL: 2GENERIC
|
|||
: get-dataflow ( -- IR )
|
||||
dataflow-graph get reverse ;
|
||||
|
||||
: inputs ( count -- vector )
|
||||
meta-d get [ vector-length swap - ] keep vector-tail ;
|
||||
|
||||
: dataflow, ( consume instruction parameters -- )
|
||||
#! Add a node to the dataflow IR. Each node is a list of
|
||||
#! three elements:
|
||||
#! - list of elements consumed from stack
|
||||
#! - vector of elements consumed from stack
|
||||
#! - a symbol CALL, JUMP or PUSH
|
||||
#! - parameter(s) to insn
|
||||
unit cons cons dataflow-graph cons@ ;
|
||||
|
||||
: dataflow-literal, ( lit -- )
|
||||
>r f PUSH r> dataflow, ;
|
||||
|
||||
: inputs ( count -- vector )
|
||||
meta-d get [ vector-length swap - ] keep vector-tail ;
|
||||
>r 0 inputs PUSH r> dataflow, ;
|
||||
|
||||
: dataflow-word, ( word -- )
|
||||
[
|
||||
|
|
|
@ -33,10 +33,16 @@ USE: lists
|
|||
|
||||
: meta-infer ( word -- )
|
||||
#! Mark a word as being partially evaluated.
|
||||
dup unit [ car host-word ] cons "infer" set-word-property ;
|
||||
dup unit [
|
||||
car dup dataflow-word, host-word
|
||||
] cons "infer" set-word-property ;
|
||||
|
||||
\ >r [ pop-d push-r ] "infer" set-word-property
|
||||
\ r> [ pop-r push-d ] "infer" set-word-property
|
||||
\ >r [
|
||||
\ >r dataflow-word, pop-d push-r
|
||||
] "infer" set-word-property
|
||||
\ r> [
|
||||
\ r> dataflow-word, pop-r push-d
|
||||
] "infer" set-word-property
|
||||
|
||||
\ drop meta-infer
|
||||
\ 2drop meta-infer
|
||||
|
|
|
@ -45,11 +45,11 @@ USE: hashtables
|
|||
#! either execute the word in the meta interpreter (if it is
|
||||
#! side-effect-free and all parameters are literal), or
|
||||
#! simply apply its stack effect to the meta-interpreter.
|
||||
dup car ensure-d over dataflow-word,
|
||||
swap "infer" word-property dup [
|
||||
nip call
|
||||
dup car ensure-d
|
||||
over "infer" word-property dup [
|
||||
nip nip call
|
||||
] [
|
||||
drop consume/produce
|
||||
drop swap dataflow-word, consume/produce
|
||||
] ifte ;
|
||||
|
||||
: no-effect ( word -- )
|
||||
|
@ -118,6 +118,7 @@ USE: hashtables
|
|||
] ifte ;
|
||||
|
||||
: infer-call ( [ rstate | quot ] -- )
|
||||
\ drop dataflow-word,
|
||||
[
|
||||
dataflow-graph off
|
||||
pop-d uncons recursive-state set (infer)
|
||||
|
|
|
@ -19,7 +19,6 @@ PORT* port(PORT_MODE type, CELL fd)
|
|||
port->type = type;
|
||||
port->closed = false;
|
||||
port->fd = fd;
|
||||
port->line = F;
|
||||
port->client_host = F;
|
||||
port->client_port = F;
|
||||
port->client_socket = F;
|
||||
|
|
Loading…
Reference in New Issue