 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences namespaces assocs accessors fry
-compiler.tree ;
+compiler.tree dequeues search-dequeues ;
 IN: compiler.tree.loop.detection
 
 ! A loop is a #recursive which only tail calls itself, and those
-! calls are nested inside other loops only.
-
-TUPLE: recursive-call tail? nesting ;
-
-! calls is a sequence of recursive-call instances
-TUPLE: loop-info calls height ;
-
-! Mapping inline-recursive instances to loop-info instances
-SYMBOL: loop-infos
-
-! A sequence of inline-recursive instances
-SYMBOL: label-stack
+! calls are nested inside other loops only. We optimistically
+! assume all #recursive nodes are loops, disqualifying them as
+! we see evidence to the contrary.
 
 : (tail-calls) ( tail? seq -- seq' )
     reverse [ swap [ and ] keep ] map nip reverse ;

        tri or or
    ] map (tail-calls) ;

GENERIC: collect-loop-info* ( tail? node -- )

: non-tail-label-info ( nodes -- )

: (collect-loop-info) ( tail? nodes -- )
    [ tail-calls ] keep [ collect-loop-info* ] 2each ;

: remember-loop-info ( label -- )
    label-stack get length swap loop-heights get set-at ;

M: #recursive collect-loop-info*
    nip
    [
        [
            label>>
            [ label-stack [ swap suffix ] change ]
            [ remember-loop-info ]
            [ t >>loop? drop ]
            tri
        ]
        [ t swap child>> (collect-loop-info) ] bi
    ] with-scope ;

: current-loop-nesting ( label -- labels )
    label-stack get swap loop-heights get at tail ;

: disqualify-loop ( label -- )
    work-list get push-front ;

M: #call-recursive collect-loop-info*
    label>>
    swap [ dup disqualify-loop ] unless
    dup current-loop-nesting [ loop-calls get push-at ] with each ;

M: #if collect-loop-info*
    children>> [ (collect-loop-info) ] with each ;
