! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs arrays namespaces accessors sequences deques fry
-search-deques dlists combinators.short-circuit make sets compiler.tree ;
+USING: accessors combinators.short-circuit compiler.tree fry
+kernel namespaces sequences sets ;
+FROM: namespaces => set ;
IN: compiler.tree.recursive
TUPLE: call-site tail? node label ;
] with-scope ;
M: #return-recursive node-call-graph
- nip dup label>> (>>return) ;
+ nip dup label>> return<< ;
M: #call-recursive node-call-graph
[ dup label>> call-site boa ] keep
M: #branch node-call-graph
children>> [ (build-call-graph) ] with each ;
+M: #alien-callback node-call-graph
+ child>> (build-call-graph) ;
+
M: node node-call-graph 2drop ;
SYMBOLS: not-loops recursive-nesting ;
-: not-a-loop ( label -- ) not-loops get conjoin ;
+: not-a-loop ( label -- ) not-loops get adjoin ;
-: not-a-loop? ( label -- ? ) not-loops get key? ;
+: not-a-loop? ( label -- ? ) not-loops get in? ;
: non-tail-calls ( call-graph-node -- seq )
- calls>> [ tail?>> not ] filter ;
+ calls>> [ tail?>> ] reject ;
: visit-back-edges ( call-graph -- )
[
recursive-nesting get pop*
] each ;
-: while-changing ( quot: ( -- ) -- )
+: while-changing ( ... quot: ( ... -- ... ) -- ... )
changed? off
[ call ] [ changed? get [ while-changing ] [ drop ] if ] bi ;
inline recursive
: detect-loops ( call-graph -- )
- H{ } clone not-loops set
+ HS{ } clone not-loops set
V{ } clone recursive-nesting set
[ visit-back-edges ]
[ '[ _ detect-cross-frame-calls ] while-changing ]