{
: G make
}

Where

Define (make MAP)
    Let compare MAP.compare
    Let SET (SEARCH.SET MAP.compare)
    In
    Define (traverse g adj i stack preorder assigned components)
        Define (rec rec adj i stack preorder assigned components)
            Let {v neighbors} adj
            In
            Let preorder (MAP.insert preorder {v i})
            Let stack [v & stack]
            In
            Let {link j stack preorder assigned components}
                (LIST.reduce neighbors
                    {i [i + 1] stack preorder assigned components}
                    Func {state w}
                        Let {link i stack preorder assigned components} state
                        In
                        Match (SET.search assigned w)
                        | 'just._ state
                        | 'nothing
                            Match (MAP.search preorder w)
                            | 'just.{_ j}
                                Let link (Z.min link j)
                                In
                                {link i stack preorder assigned components}
                            | 'nothing
                                Let adj
                                    Match (MAP.search g w)
                                    | 'nothing {w 'nil}
                                    | 'just.adj adj
                                    ;
                                In
                                Let {link_rec i stack preorder assigned components}
                                    (rec rec adj i stack preorder assigned
                                        components)
                                In
                                Let link (Z.min link link_rec)
                                In
                                {link i stack preorder assigned components}
                            ;
                        ;)
            In
            If [i = link]
                Block
                    Let {c stack assigned}
                        Iterate {c stack assigned} From {'nil stack assigned}
                            Match stack
                            | 'cons.{w stack}
                                Let assigned (SET.insert assigned w)
                                In
                                Match (compare w v)
                                | 'equal {[v & c] stack assigned}
                                | _ Continue {[w & c] stack assigned}
                                ;
                            ;
                    In
                    {link j stack preorder assigned [c & components]}
                {link j stack preorder assigned components}
        In
        (rec rec adj i stack preorder assigned components)
    In
    Define (strongly_connected_components g)
        Iterate {adjs i stack preorder assigned components}
        From {(MAP.list g) 0 'nil MAP.empty SET.empty 'nil}
            Match adjs
            | 'nil (LIST.reverse components)
            | 'cons.{adj adjs}
                Let {v _} adj
                In
                Match (SET.search assigned v)
                | 'just._
                    Continue {adjs i stack preorder assigned components}
                | 'nothing
                    Let {link i stack preorder assigned components}
                        (traverse g adj i stack preorder assigned components)
                    In
                    Continue {adjs i stack preorder assigned components}
                ;
            ;
    In
    Define (layers g)
        Iterate {layers adjs} From {'nil (MAP.list g)}
            Let {layer adjs}
                (LIST.fold adjs {'nil 'nil}
                    Func {{v neighbors} {layer adjs}}
                        Match neighbors
                        | 'nil {[v & layer] adjs}
                        | 'cons._ {layer [{v neighbors} & adjs]}
                        ;)
            In
            Match layer
            | 'nil layers
            | 'cons._
                Let removed (LIST.reduce layer SET.empty SET.insert)
                In
                Let adjs
                    (LIST.map adjs
                        Func {{v neighbors}}
                            Let neighbors
                                (SET.list
                                    (SET.diff (SET.new neighbors) removed))
                            In
                            {v neighbors})
                In
                Continue {[layer & layers] adjs}
            ;
    In
    {
    : strongly_connected_components
    : layers
    }

Where

Let die OS.die

Where

Let LIST Package "list"
Let OS Package "os"
Let SEARCH Package "search"
Let STDIO Package "stdio"
Let Z Package "z"