more dataflow work

cvs
Slava Pestov 2004-11-28 04:09:32 +00:00
parent 99651292cb
commit 3dccc4d2d5
5 changed files with 31 additions and 21 deletions

View File

@ -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 ;

View File

@ -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 -- )
[

View File

@ -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

View File

@ -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)

View File

@ -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;