diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 0ebe3f288d..b6322b52bc 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -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 ; diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor index 9ca33761e5..266f1f6d55 100644 --- a/library/inference/dataflow.factor +++ b/library/inference/dataflow.factor @@ -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 -- ) [ diff --git a/library/inference/stack.factor b/library/inference/stack.factor index 78492920b6..73a9c036d4 100644 --- a/library/inference/stack.factor +++ b/library/inference/stack.factor @@ -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 diff --git a/library/inference/words.factor b/library/inference/words.factor index 12cc514f9a..905205ecd1 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -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) diff --git a/native/port.c b/native/port.c index 0b4b99e1e2..59e72d5f25 100644 --- a/native/port.c +++ b/native/port.c @@ -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;