GRAPH

Where

Define (GRAPH MAP SET)
    Define (graph_vertices g)
        (LIST.map (MAP.list g) [Func {v _} v])
    In
    Define (strongly_connected_components g)
        Let unreachable_depth (MAP.size g)
        In
        Let result_empty {'nil unreachable_depth 'bottom}
        Define (result_is_empty {components depth _})
            (And [Pattern 'nil Matches components] [depth = unreachable_depth])
        Define (result_components {components _ _})
            components
        Define (tree_merge a b)
            Cond {
            | [Pattern 'bottom Matches a] b
            | [Pattern 'bottom Matches b] a
            | True 'across.{a b}
            }
        Define (tree_flatten tree)
            Unfold {tree vertices} From {tree 'nil}
                Match tree {
                | 'bottom vertices
                | 'up.{v tree} [v & (Fold tree vertices)]
                | 'across.{left right} (Fold left (Fold right vertices))
                }
        In
        Define (probe v vs_path marked)
            Match (MAP.search vs_path v) {
            | 'nothing
                Match (SET.search marked v) {
                | 'nothing
                    Let ws
                        Match (MAP.search g v) {
                        | 'just.{_ ws} ws
                        | 'nothing 'nil
                        }
                    Let ws_path (MAP.insert vs_path {v (MAP.size vs_path)})
                    In
                    {'nonterminal.{ws ws_path} (SET.insert marked v)}
                | 'just._ {'terminal.result_empty marked}
                }
            | 'just.{_ depth}
                {'terminal.{'nil depth 'bottom} marked}
            }
        Define (result_extend {components work_depth work} v vs_path)
            Let tree 'up.{v work}
            In
            If [work_depth < (MAP.size vs_path)]
                {components work_depth tree}
                {[tree & components] unreachable_depth 'bottom}
        Define (result_merge a b)
            Cond {
            | (result_is_empty a) b
            | (result_is_empty b) a
            | True
                Let {a_comps a_depth a_work} a
                Let {b_comps b_depth b_work} b
                In
                Let comps (LIST.append b_comps a_comps)
                Let depth (Z.min b_depth a_depth)
                Let work (tree_merge b_work a_work)
                In
                {comps depth work}
            }
        In
        Let {result _}
            Unfold {vs vs_path marked} From {(graph_vertices g) MAP.empty SET.empty}
                Match vs {
                | 'nil {result_empty marked}
                | 'cons.{v vs}
                    Let {v_result marked}
                        Let {mode marked} (probe v vs_path marked)
                        In
                        Match mode {
                        | 'terminal.v_result {v_result marked}
                        | 'nonterminal.{ws ws_path}
                            Let {ws_result marked} (Fold ws ws_path marked)
                            In
                            {(result_extend ws_result v vs_path) marked}
                        }
                    In
                    Let {vs_result marked} (Fold vs vs_path marked)
                    In
                    {(result_merge v_result vs_result) marked}
                }
        In
        (LIST.reverse (LIST.map (result_components result) tree_flatten))
    In
    {
    :strongly_connected_components
    }

Where

Open Z
    {
    :Infix <
    :Infix =
    }

Open LIST {:Infix &}

Where

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