 <PRIVATE
 
 : <natural-loop> ( header index -- loop )
-    H{ } clone H{ } clone natural-loop boa ;
+    HS{ } clone H{ } clone natural-loop boa ;
 
 : lookup-header ( header -- loop )
     loops get [

        {
            [ visited get adjoin ]
            [ active get adjoin ]
            [ dup successors>> [ visit-edge ] with each ]
            [ active get delete ]
        } cleave
    ] if ;

SYMBOLS: visited active ;

: record-back-edge ( from to -- )
    lookup-header ends>> adjoin ;

DEFER: find-loop-headers

: visit-edge ( from to active -- )
    dupd in?
    [ record-back-edge ]
    [ nip find-loop-headers ]
    if ;
