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

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

: remember-loop-info ( #recursive -- )
    V{ } clone label-stack get length loop-info boa
    swap label>> loop-infos get set-at ;

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

M: #call-recursive collect-loop-info*
    label>> loop-infos get at
    [ label-stack get swap height>> tail recursive-call boa ]
    [ calls>> ]
    bi push ;

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


: collect-loop-info ( node -- )
    { } label-stack set
    H{ } clone loop-calls set
    H{ } clone loop-heights set
    <hashed-dlist> work-list set
    t swap (collect-loop-info) ;

: disqualify-loops ( -- )
    work-list get [
        dup loop?>> [
            [ f >>loop? drop ]
            [ loop-calls get at [ disqualify-loop ] each ]
            bi
        ] [ drop ] if
    ] slurp-dequeue ;

: detect-loops ( nodes -- nodes )
    dup collect-loop-info disqualify-loops ;
