         tri or or
     ] map (tail-calls) ;
 
+SYMBOL: loop-heights
+SYMBOL: loop-calls
+SYMBOL: label-stack
+SYMBOL: work-list
+
 GENERIC: collect-loop-info* ( tail? node -- )
 
 : non-tail-label-info ( nodes -- )

! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences namespaces assocs accessors fry
compiler.tree ;
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

: (tail-calls) ( tail? seq -- seq' )
    reverse [ swap [ and ] keep ] map nip reverse ;


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