{
:sort
:gather_imports
:link
:QUEUE
}

Where

Let QUEUE
    Let STRING_SET (SEARCH.SET STRING.compare)
    In
    Define (new root_path)
        Let stack [root_path & 'nil]
        In
        {stack (STRING_SET.new stack)}
    Define (push_all queue paths)
        (LIST.reduce paths queue
            Func {queue path}
                Let {stack filter} queue
                In
                Match (STRING_SET.search filter path) {
                | 'nothing {[path & stack] (STRING_SET.insert filter path)}
                | 'just._ queue
                })
    Define (pop {stack filter})
        Match stack {
        | 'nil 'nothing
        | 'cons.{path stack} 'just.{path {stack filter}}
        }
    In
    {
    :new
    :push_all
    :pop
    }

Define (sort packages)
    Let components
        Let MAP (SEARCH.MAP STRING.compare [Func {path _} path])
        Let SET (SEARCH.SET STRING.compare)
        In
        Let G (GRAPH MAP SET)
        Let g (MAP.new (LIST.map packages [Func p {p.path p.imports}]))
        In
        (G.strongly_connected_components g)
    Define (is_self_referential package)
        (LIST.reduce package.imports False
            Func {b path}
                (Or b (STRING.equal path package.path)))
    In
    (LIST.fold components 'succeed.'nil
        Func {component result}
            Match result {
            | 'fail._ result
            | 'succeed.ordered_packages
                Match component {
                | 'cons.{path paths}
                    Match paths {
                    | 'cons._ 'fail.component
                    | 'nil
                        Define (has_matching_path package)
                            (STRING.equal path package.path)
                        In
                        Match (LIST.filter packages has_matching_path) {
                        | 'cons.{package _}
                            If (is_self_referential package)
                                'fail.[package & 'nil]
                                'succeed.[package & ordered_packages]
                        }
                    }
                }
            })

Define (gather_imports expr)
    Let SET (SEARCH.SET STRING.compare)
    In
    Let f
        Let empty Func set set
        In
        Unfold exprs From [expr & 'nil]
            Match exprs {
            | 'nil empty
            | 'cons.{expr exprs}
                Let g (Fold exprs)
                Let f
                    Match expr {
                    | 'true empty
                    | 'false empty
                    | 'num._ empty
                    | 'str._ empty
                    | 'package.path [Func set (SET.insert set path)]
                    | 'prim._ empty
                    | 'var._ empty
                    | 'record_fetch._ empty
                    | 'tuple.exprs (Fold exprs)
                    | 'record.{_ inits} (Fold inits)
                    | 'block.{binders expr}
                        (Fold
                            (LIST.cons expr
                                (LIST.reduce binders 'nil
                                    Func {exprs binder}
                                        Match binder {
                                        | 'let.{_ expr} [expr & exprs]
                                        | 'open.{expr _} [expr & exprs]
                                        })))
                    | 'app.{func args} (Fold [func & args])
                    | 'app_infix.{_ left rights} (Fold [left & rights])
                    | 'func.{_ expr} (Fold [expr & 'nil])
                    | 'iterate.{_ inits expr} (Fold [expr & inits])
                    | 'continue.exprs (Fold exprs)
                    | 'unfold.{_ inits expr} (Fold [expr & inits])
                    | 'fold.exprs (Fold exprs)
                    | 'cond.clauses
                        (Fold
                            (LIST.concat_map clauses
                                Func {test body}
                                    [test & body & 'nil]))
                    | 'if.{test then else}
                        (Fold [test & then & else & 'nil])
                    | 'and.{test then}
                        (Fold [test & then & 'nil])
                    | 'or.{test else}
                        (Fold [test & else & 'nil])
                    | 'pattern_matches.{_ expr} (Fold [expr & 'nil])
                    | 'labeled.{_ expr} (Fold [expr & 'nil])
                    | 'match.{expr clauses}
                        (Fold [expr & (LIST.map clauses [Func {_ body} body])])
                    }
                In
                [f >> g]
            }
    In
    (SET.list (f SET.empty))

Define (link packages)
    Let MAP (SEARCH.MAP STRING.compare [Func {path _} path])
    In
    Define ((compile env) expr)
        Match expr {
        | 'true (pure expr)
        | 'false (pure expr)
        | 'num._ (pure expr)
        | 'str._ (pure expr)
        | 'package.path
            Match (MAP.search env path) {
            | 'just.{_ var} (pure 'var.var)
            }
        | 'prim._ (pure expr)
        | 'var._ (pure expr)
        | 'record_fetch._ (pure expr)
        | 'tuple.exprs
            (lift1 (map exprs eval)
                Func exprs 'tuple.exprs)
        | 'record.{labels inits}
            (lift1 (map inits eval)
                Func inits 'record.{labels inits})
        | 'block.{binders expr}
            (lift2
                (map binders
                    Func binder
                        Match binder {
                        | 'let.{pat expr}
                            (lift1 (eval expr)
                                Func expr 'let.{pat expr})
                        | 'open.{expr pairs}
                            (lift1 (eval expr)
                                Func expr 'open.{expr pairs})
                        })
                (eval expr)
                Func {binders expr} 'block.{binders expr})
        | 'app.{func args}
            (lift2 (eval func) (map args eval)
                Func {func args} 'app.{func args})
        | 'app_infix.{op left rights}
            (lift2 (eval left) (map rights eval)
                Func {left rights}
                    'app_infix.{op left rights})
        | 'func.{param_pats expr}
            (lift1 (eval expr)
                Func expr 'func.{param_pats expr})
        | 'iterate.{vars inits expr}
            (lift2 (map inits eval) (eval expr)
                Func {inits expr} 'iterate.{vars inits expr})
        | 'continue.exprs
            (lift1 (map exprs eval)
                Func exprs 'continue.exprs)
        | 'unfold.{vars inits expr}
            (lift2 (map inits eval) (eval expr)
                Func {inits expr} 'unfold.{vars inits expr})
        | 'fold.exprs
            (lift1 (map exprs eval)
                Func exprs 'fold.exprs)
        | 'cond.clauses
            Define (eval_clause {test body})
                (lift2 (eval test) (eval body)
                    Func clause clause)
            In
            (lift1 (map clauses eval_clause)
                Func clauses 'cond.clauses)
        | 'if.{test then else}
            (lift3 (eval test) (eval then) (eval else)
                Func {test then else} 'if.{test then else})
        | 'and.{test then}
            (lift2 (eval test) (eval then)
                Func {test then} 'and.{test then})
        | 'or.{test else}
            (lift2 (eval test) (eval else)
                Func {test else} 'or.{test else})
        | 'pattern_matches.{pat match_expr}
            (lift1 (eval match_expr)
                Func match_expr 'pattern_matches.{pat match_expr})
        | 'labeled.{label expr}
            (lift1 (eval expr)
                Func expr 'labeled.{label expr})
        | 'match.{expr clauses}
            Define (eval_clause {pat body})
                (lift1 (eval body)
                    Func body {pat body})
            In
            (lift2 (eval expr) (map clauses eval_clause)
                Func {expr clauses} 'match.{expr clauses})
        }
    In
    Define (link expr env)
        Let compile (compile env)
        In
        Unfold c From (compile expr)
            Match c {
            | 'pure.expr expr
            | 'lift1.{c1 f} (f (Fold c1))
            | 'lift2.{c1 c2 f} (f (Fold c1) (Fold c2))
            | 'lift3.{c1 c2 c3 f} (f (Fold c1) (Fold c2) (Fold c3))
            | 'eval.expr (Fold (compile expr))
            }
    In
    Match packages {
    | 'cons.{package packages}
        Unfold {i package packages env} From {1 package packages MAP.empty}
            Let path package.path
            Let expr (link package.expr env)
            In
            Match packages {
            | 'nil expr
            | 'cons.{package packages}
                Let var (STRING.append "Package" (Z.show i))
                In
                Let env (MAP.insert env {path var})
                In
                'block.{
                    ['let.{'var.var expr} & 'nil]
                    (Fold [i + 1] package packages env)
                }
            }
    }

Where

Define (map xs f)
    (LIST.fold xs (pure 'nil)
        Func {x c} (lift2 (f x) c LIST.cons))

Where

Define (pure x) 'pure.x
Define (lift1 c1 f) 'lift1.{c1 f}
Define (lift2 c1 c2 f) 'lift2.{c1 c2 f}
Define (lift3 c1 c2 c3 f) 'lift3.{c1 c2 c3 f}
Define (eval expr) 'eval.expr

Where

Open Z
    {
    :Infix +
    }

Open LIST {:Infix &}
Open FUNC {:Infix >>}

Where

Let FUNC Package "func"
Let GRAPH Package "graph"
Let LIST Package "list"
Let OS Package "os"
Let SEARCH Package "search"
Let STRING Package "string"
Let Z Package "z"