34 lines
1.0 KiB
Factor
34 lines
1.0 KiB
Factor
! Copyright (C) 2005 Slava Pestov.
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
IN: inference
|
|
USING: kernel namespaces prettyprint sequences vectors ;
|
|
|
|
GENERIC: collect-recursion* ( label node -- )
|
|
|
|
M: node collect-recursion* ( label node -- ) 2drop ;
|
|
|
|
M: #call-label collect-recursion* ( label node -- )
|
|
tuck node-param = [ node-in-d , ] [ drop ] ifte ;
|
|
|
|
: collect-recursion ( label node -- seq )
|
|
#! Collect the input stacks of all #call-label nodes that
|
|
#! call given label.
|
|
[ [ collect-recursion* ] each-node-with ] { } make ;
|
|
|
|
GENERIC: solve-recursion*
|
|
|
|
M: node solve-recursion* ( node -- ) drop ;
|
|
|
|
: join-values ( calls entry -- new old )
|
|
add unify-lengths [ unify-stacks ] keep peek ;
|
|
|
|
M: #label solve-recursion* ( node -- )
|
|
dup node-param over collect-recursion >r
|
|
node-children first dup node-in-d r> swap
|
|
join-values rot subst-values ;
|
|
|
|
: solve-recursion ( node -- )
|
|
#! Figure out which values survive inner recursions in
|
|
#! #labels, and those that don't should be fudged.
|
|
[ solve-recursion* ] each-node ;
|