{Record collect_free_variables lift_functions collect_constants}

Where

Let (collect_free_variables expr)
    Let SET (SEARCH.SET STRING.compare)
    Let MAP
        (SEARCH.MAP
            STRING.compare
            Func var. var.name)
    In
    Let (insert_each env depth vars)
        (LIST.reduce vars env
            Func env var. (MAP.insert env {Record name:var depth}))
    Let (maybe_insert env depth free name)
        Match (MAP.search env name)
        | `just.var
            If (var.depth < depth)
                (SET.insert free name)
                free
        | `nothing
            (die (STRING.concat ["Variable \"" name "\" is not bound."]))
        ;
    In
    Let (pure x)
        Func _ _ free. {x free}
    Let (lift1 m1 f)
        Func env depth free.
            Let {x1 free} (m1 env depth free)
            In
            {(f x1) free}
    Let (lift2 m1 m2 f)
        Func env depth free.
            Let {x1 free} (m1 env depth free)
            In
            Let {x2 free} (m2 env depth free)
            In
            {(f x1 x2) free}
    Let (lift3 m1 m2 m3 f)
        Func env depth free.
            Let {x1 free} (m1 env depth free)
            In
            Let {x2 free} (m2 env depth free)
            In
            Let {x3 free} (m3 env depth free)
            In
            {(f x1 x2 x3) free}
    Let (in_context vars m)
        Func env depth free.
            Let env (insert_each env depth vars)
            In
            (m env depth free)
    In
    Define (map list f)
        Match list
        | `nil (pure [])
        | `cons.{item list}
            (lift2 (f item) (map list f)
                Func item items. (item :: items))
        ;
    In
    Define (collect expr)
        Match expr
        | `true (pure expr)
        | `false (pure expr)
        | `num._ (pure expr)
        | `str._ (pure expr)
        | `package._ (pure expr)
        | `prim._ (pure expr)
        | `var.name
            Func env depth free. {expr (maybe_insert env depth free name)}
        | `chain.{expr chain}
            (lift1 (collect expr)
                Func expr. `chain.{expr chain})
        | `tuple.exprs
            (lift1 (map exprs collect)
                Func exprs. `tuple.exprs)
        | `record.{labels inits}
            (lift1 (map inits collect)
                Func inits. `record.{labels inits})
        | `block.{binders expr}
            Let vars (LIST.concat_map binders binder_variables)
            Let binder_exprs (LIST.map binders binder_expr)
            In
            (lift2 (map binder_exprs collect) (in_context vars (collect expr))
                Func binder_exprs expr.
                    Let binders
                        (LIST.map (LIST.zip binders binder_exprs)
                            Func {binder expr}.
                                Match binder
                                | `do._ `do.expr
                                | `let.{pat _} `let.{pat expr}
                                ;)
                    In
                    `block.{binders expr})
        | `app.{func args}
            (lift2 (collect func) (map args collect)
                Func func args. `app.{func args})
        | `func.{self param_pats expr}
            Let vars
                Let vars (LIST.concat_map param_pats pattern_variables)
                In
                Match self
                | `nothing vars
                | `just.var (var :: vars)
                ;
            In
            Func env depth free.
                Let {expr func_free}
                    Let depth (depth + 1)
                    In
                    Let env (insert_each env depth vars)
                    Let m (collect expr)
                    In
                    (m env depth SET.empty)
                In
                Let func_free_list (SET.list func_free)
                In
                Let free
                    (LIST.reduce func_free_list free
                        Func free name. (maybe_insert env depth free name))
                In
                {`func.{self func_free_list param_pats expr} free}
        | `iterate.{vars inits expr}
            (lift2 (map inits collect) (in_context vars (collect expr))
                Func inits expr. `iterate.{vars inits expr})
        | `continue.exprs
            (lift1 (map exprs collect)
                Func exprs. `continue.exprs)
        | `switch.{expr clauses}
            Let (collect_in_clause {pat body})
                Let vars
                    Match pat
                    | `default.maybe_var
                        Match maybe_var | `nothing [] | `just.var [var] ;
                    | `value._ []
                    ;
                In
                (lift1 (in_context vars (collect body))
                    Func body. {pat body})
            In
            (lift2 (collect expr) (map clauses collect_in_clause)
                Func expr clauses. `switch.{expr clauses})
        | `cond.clauses
            Let (collect_in_clause {test body})
                (lift2 (collect test) (collect body)
                    Func test body. {test body})
            In
            (lift1 (map clauses collect_in_clause)
                Func clauses. `cond.clauses)
        | `if.{test then else}
            (lift3 (collect test) (collect then) (collect else)
                Func test then else. `if.{test then else})
        | `not.expr
            (lift1 (collect expr)
                Func expr. `not.expr)
        | `and.{test then}
            (lift2 (collect test) (collect then)
                Func test then. `and.{test then})
        | `or.{test else}
            (lift2 (collect test) (collect else)
                Func test else. `or.{test else})
        | `list.exprs
            (lift1 (map exprs collect)
                Func exprs. `list.exprs)
        | `labeled.{label expr}
            (lift1 (collect expr)
                Func expr. `labeled.{label expr})
        | `match.{expr clauses}
            Let (collect_in_clause {pat body})
                Let vars
                    Match pat
                    | `default []
                    | `labeled.{_ pat} (pattern_variables pat)
                    ;
                In
                (lift1 (in_context vars (collect body))
                    Func body. {pat body})
            In
            (lift2 (collect expr) (map clauses collect_in_clause)
                Func expr clauses. `match.{expr clauses})
        ;
    In
    Let m (collect expr)
    In
    For expr
        Let {expr _} (m MAP.empty 0 SET.empty)

Let (lift_functions i expr)
    Let MAP
        (SEARCH.MAP STRING.compare
            Func {key _}. key)
    In
    Let (pure x)
        Func _ i funcs. {x i funcs}
    Let (lift1 m1 f)
        Func env i funcs.
            Let {x1 i funcs} (m1 env i funcs)
            In
            {(f x1) i funcs}
    Let (lift2 m1 m2 f)
        Func env i funcs.
            Let {x1 i funcs} (m1 env i funcs)
            In
            Let {x2 i funcs} (m2 env i funcs)
            In
            {(f x1 x2) i funcs}
    Let (lift3 m1 m2 m3 f)
        Func env i funcs.
            Let {x1 i funcs} (m1 env i funcs)
            In
            Let {x2 i funcs} (m2 env i funcs)
            In
            Let {x3 i funcs} (m3 env i funcs)
            In
            {(f x1 x2 x3) i funcs}
    Let (bind m1 f)
        Func env i funcs.
            Let {x1 i funcs} (m1 env i funcs)
            In
            Let m2 (f x1)
            In
            (m2 env i funcs)
    Let (lookup var)
        Func env i funcs.
            Match (MAP.search env var)
            | `just.{_ expr} {expr i funcs}
            | `nothing (die "No var.")
            ;
    Let (in_context bindings m)
        Func env i funcs.
            Let env (LIST.reduce bindings env MAP.insert)
            In
            (m env i funcs)
    In
    Define (map list f)
        Match list
        | `nil (pure [])
        | `cons.{item items}
            (lift2 (f item) (map items f)
                Func item items. (item :: items))
        ;
    In
    Define (rewrite expr)
        Match expr
        | `true (pure expr)
        | `false (pure expr)
        | `num._ (pure expr)
        | `str._ (pure expr)
        | `package._ (pure expr)
        | `prim._ (pure expr)
        | `var._ (pure expr)
        | `chain.{expr chain}
            (lift1 (rewrite expr)
                Func expr. `chain.{expr chain})
        | `tuple.exprs
            (lift1 (map exprs rewrite)
                Func exprs. `tuple.exprs)
        | `record.{labels inits}
            (lift1 (map inits rewrite)
                Func inits. `record.{labels inits})
        | `block.{binders expr}
            Let binder_exprs (LIST.map binders binder_expr)
            In
            (bind (map binder_exprs rewrite)
                Func binder_exprs.
                    Let binders
                        (LIST.map (LIST.zip binders binder_exprs)
                            Func {binder expr}.
                                Match binder
                                | `do._ `do.expr
                                | `let.{pat _} `let.{pat expr}
                                ;)
                    In
                    Let bindings
                        (LIST.concat_map binders
                            Func binder.
                                Match binder
                                | `do._ []
                                | `let.{pat expr}
                                    Match pat
                                    | `ignore []
                                    | `var.var
                                        Match expr
                                        | `closure.{i _ num_params}
                                            [{var `func.{i num_params}}]
                                        | _ [{var `expr}]
                                        ;
                                    | `tuple.vars
                                        (LIST.map vars
                                            Func var. {var `expr})
                                    ;
                                ;)
                    In
                    (lift1 (in_context bindings (rewrite expr))
                        Func expr. `block.{binders expr}))
        | `app.{func args}
            Match func
            | `var.var
                (bind (lookup var)
                    Func expr.
                        Match expr
                        | `func.{i num_params}
                            If !(num_params = (LIST.length args))
                                (die "Protocol mismatch in function application.")
                                (lift2 (rewrite func) (map args rewrite)
                                    Func func args. `app_known.{i func args})
                        | `expr
                            (lift2 (rewrite func) (map args rewrite)
                                Func func args. `app.{func args})
                        ;)
            | _
                (lift2 (rewrite func) (map args rewrite)
                    Func func args. `app.{func args})
            ;
        | `func.{self free param_pats expr}
            Func env i funcs.
                Let rewriter
                    Let bindings
                        (LIST.map (LIST.concat_map param_pats pattern_variables)
                            Func var. {var `expr})
                    In
                    Let bindings
                        Match self
                        | `nothing bindings
                        | `just.var ({var `expr} :: bindings)
                        ;
                    In
                    (in_context bindings (rewrite expr))
                In
                Let {expr i funcs} (rewriter env i funcs)
                In
                Let closure `closure.{i free (LIST.length param_pats)}
                Let func `func.{i self free param_pats expr}
                In
                {closure (i + 1) (func :: funcs)}
        | `iterate.{vars inits expr}
            Let bindings
                (LIST.map vars
                    Func var. {var `expr})
            In
            (lift2 (map inits rewrite) (in_context bindings (rewrite expr))
                Func inits expr. `iterate.{vars inits expr})
        | `continue.exprs
            (lift1 (map exprs rewrite)
                Func exprs. `continue.exprs)
        | `switch.{expr clauses}
            Let (rewrite_clause {pat body})
                Let bindings
                    Match pat
                    | `default.maybe_var
                        Match maybe_var
                        | `nothing []
                        | `just.var [{var `expr}] ;
                    | `value._ []
                    ;
                In
                (lift1 (in_context bindings (rewrite body))
                    Func body. {pat body})
            In
            (lift2 (rewrite expr) (map clauses rewrite_clause)
                Func expr clauses. `switch.{expr clauses})
        | `cond.clauses
            Let (rewrite_clause {test body})
                (lift2 (rewrite test) (rewrite body)
                    Func test body. {test body})
            In
            (lift1 (map clauses rewrite_clause)
                Func clauses. `cond.clauses)
        | `if.{test then else}
            (lift3 (rewrite test) (rewrite then) (rewrite else)
                Func test then else. `if.{test then else})
        | `not.expr
            (lift1 (rewrite expr)
                Func expr. `not.expr)
        | `and.{test then}
            (lift2 (rewrite test) (rewrite then)
                Func test then. `and.{test then})
        | `or.{test else}
            (lift2 (rewrite test) (rewrite else)
                Func test else. `or.{test else})
        | `list.exprs
            (lift1 (map exprs rewrite)
                Func exprs. `list.exprs)
        | `labeled.{label expr}
            (lift1 (rewrite expr)
                Func expr. `labeled.{label expr})
        | `match.{expr clauses}
            Let (rewrite_clause {pat body})
                Let bindings
                    Match pat
                    | `default []
                    | `labeled.{_ pat}
                        (LIST.map (pattern_variables pat)
                            Func var. {var `expr})
                    ;
                In
                (lift1 (in_context bindings (rewrite body))
                    Func body. {pat body})
            In
            (lift2 (rewrite expr) (map clauses rewrite_clause)
                Func expr clauses. `match.{expr clauses})
        ;
    In
    Let rewriter (rewrite expr)
    In
    (rewriter MAP.empty i [])

Let (collect_constants program)
    Let package_table (package_table program)
    In
    Let (pure x)
        Func state. {x state}
    Let (lift1 m1 f)
        Func state.
            Let {x1 state} (m1 state)
            In
            {(f x1) state}
    Let (lift2 m1 m2 f)
        Func state.
            Let {x1 state} (m1 state)
            In
            Let {x2 state} (m2 state)
            In
            {(f x1 x2) state}
    Let (lift3 m1 m2 m3 f)
        Func state.
            Let {x1 state} (m1 state)
            In
            Let {x2 state} (m2 state)
            In
            Let {x3 state} (m3 state)
            In
            {(f x1 x2 x3) state}
    Let (bind1 m1 f)
        Func state.
            Let {x1 state} (m1 state)
            In
            Let m2 (f x1)
            In
            (m2 state)
    In
    Define (map items f)
        Match items
        | `nil (pure [])
        | `cons.{item items}
            (lift2 (f item) (map items f)
                Func item items. (item :: items))
        ;
    In
    Define (rewrite expr)
        Match expr
        | `true (pure expr)
        | `false (pure expr)
        | `num._ (pure expr)
        | `str.s (intern_string s)
        | `package.path (pure `package.(package_table.lookup path))
        | `var._ (pure expr)
        | `chain.{expr chain}
            Let (intern_access access)
                Match access
                | `id.name
                    (lift1 (intern_label name)
                        Func id. `record_fetch.id)
                | `num.i (pure `tuple_fetch.i)
                ;
            In
            (lift2 (rewrite expr) (map chain intern_access)
                Func expr chain. `chain.{expr chain})
        | `tuple.exprs
            (lift1 (map exprs rewrite)
                Func exprs. `tuple.exprs)
        | `record.{labels inits}
            (bind1 (map labels intern_label)
                Func ids.
                    Let {layout inits}
                        For (LIST.unzip (sort (LIST.zip ids inits)))
                            Let (sort pairs)
                                (SORT.list_insertion
                                    Func {i _} {j _}. (Z.compare i j)
                                    pairs)
                    In
                    (lift2 (intern_layout layout) (map inits rewrite)
                        Func layout_id inits.
                            `record.{layout_id inits}))
        | `block.{binders expr}
            Let binder_exprs (LIST.map binders binder_expr)
            In
            (lift2 (map binder_exprs rewrite) (rewrite expr)
                Func binder_exprs expr.
                    Let binders
                        (LIST.map (LIST.zip binders binder_exprs)
                            Func {binder expr}.
                                Match binder
                                | `do._ `do.expr
                                | `let.{pat _} `let.{pat expr}
                                ;)
                    In
                    `block.{binders expr})
        | `app_known.{j func args}
            (lift2 (map args rewrite) (rewrite func)
                Func args func. `closure_app_known.{j func args})
        | `app.{func args}
            Match func
            | `prim.name
                (lift1 (map args rewrite)
                    Func args. `prim_app.{name args})
            | _
                (lift2 (map args rewrite) (rewrite func)
                    Func args func. `closure_app.{func args})
            ;
        | `closure._ (pure expr)
        | `func.{j self free param_pats expr}
            (lift1 (rewrite expr)
                Func expr. `func.{j self free param_pats expr})
        | `iterate.{vars inits expr}
            (lift2 (map inits rewrite) (rewrite expr)
                Func inits expr. `iterate.{vars inits expr})
        | `continue.exprs
            (lift1 (map exprs rewrite)
                Func exprs. `continue.exprs)
        | `switch.{expr clauses}
            Let (rewrite_clause {pat body})
                (lift1 (rewrite body)
                    Func body. {pat body})
            In
            (lift2 (rewrite expr) (map clauses rewrite_clause)
                Func expr clauses. `switch.{expr clauses})
        | `cond.clauses
            Let (rewrite_clause {test body})
                (lift2 (rewrite test) (rewrite body)
                    Func test body. {test body})
            In
            (lift1 (map clauses rewrite_clause)
                Func clauses. `cond.clauses)
        | `if.{test then else}
            (lift3 (rewrite test) (rewrite then) (rewrite else)
                Func test then else. `if.{test then else})
        | `not.expr
            (lift1 (rewrite expr)
                Func expr. `not.expr)
        | `and.{test then}
            (lift2 (rewrite test) (rewrite then)
                Func test then. `and.{test then})
        | `or.{test else}
            (lift2 (rewrite test) (rewrite else)
                Func test else. `or.{test else})
        | `list.exprs
            Let expr
                (LIST.fold exprs `labeled.{"nil" `tuple.[]}
                    Func expr rest. `labeled.{"cons" `tuple.[expr rest]})
            In
            (rewrite expr)
        | `labeled.{label expr}
            (bind1 (intern_label label)
                Func id.
                    (lift1 (rewrite expr)
                        Func expr. `labeled.{id expr}))
        | `match.{expr clauses}
            Let (rewrite_clause {pat body})
                Match pat
                | `default
                    (lift1 (rewrite body)
                        Func body. {pat body})
                | `labeled.{label vars}
                    (lift2 (intern_label label) (rewrite body)
                        Func id body. {`labeled.{id vars} body})
                ;
            In
            (lift2 (rewrite expr) (map clauses rewrite_clause)
                Func expr clauses. `match.{expr clauses})
        ;
    In
    Let {output state}
        Let (rewrite_package package)
            (lift2 (rewrite package.init) (map package.functions rewrite)
                Func init functions.
                    {Record path:package.path imports:package.imports
                        init functions})
        In
        Let rewriter
            (lift3 (intern_label "nil") (intern_label "cons")
                (map program rewrite_package)
                Func nil_label cons_label packages.
                    {nil_label cons_label packages})
        In
        Let string_env {STRING_ID_MAP.empty 0}
        Let label_env
            {Record
                name_of_id:ID_LABEL_MAP.empty
                id_of_name:LABEL_ID_MAP.empty
                i:0}
        Let layout_env
            {Record
                indexes:[]
                map:LAYOUT_ID_MAP.empty
                i:0}
        In
        (rewriter {string_env label_env layout_env})
    In
    Let {nil_label cons_label packages} output
    Let {string_env label_env layout_env} state
    In
    Let constants
        Let {map _} string_env
        In
        (LIST.map
            (SORT.list_insertion
                Func {_ i} {_ j}. (Z.compare i j)
                (STRING_ID_MAP.list map))
            Func {s _}. s)
    Let record_indexes (LIST.reverse layout_env.indexes)
    Let label_names (ID_LABEL_MAP.list label_env.name_of_id)
    In
    {Record
        constants
        label_names
        record_indexes
        packages
        nil_label
        cons_label
        }

Where

Let (package_table packages)
    Let MAP (SEARCH.MAP STRING.compare (Func {key _}. key))
    In
    Let {_ map}
        (LIST.reduce packages {0 MAP.empty}
            Func {i map} package.
                {(i + 1) (MAP.insert map {package.path i})})
    In
    Let (lookup path)
        Match (MAP.search map path)
        | `just.{_ i} i
        ;
    In
    {Record lookup}

Let (intern_string s)
    Func state.
        Let {string_env label_env layout_env} state
        In
        Let {map i} string_env
        In
        Match (STRING_ID_MAP.search map s)
        | `nothing
            Let map (STRING_ID_MAP.insert map {s i})
            In
            {`const.i {{map (i + 1)} label_env layout_env}}
        | `just.{_ j}
            {`const.j state}
        ;

Let (intern_label name)
    Func state.
        Let {string_env label_env layout_env} state
        In
        Match (LABEL_ID_MAP.search label_env.id_of_name name)
        | `just.{_ i} {i state}
        | `nothing
            Let i label_env.i
            In
            Let label_env
                {Record
                    name_of_id:(ID_LABEL_MAP.insert label_env.name_of_id {i name})
                    id_of_name:(LABEL_ID_MAP.insert label_env.id_of_name {name i})
                    i:(i + 1)}
            In
            {i {string_env label_env layout_env}}
        ;

Let (intern_layout layout)
    Func state.
        Let {string_env label_env layout_env} state
        In
        Match (LAYOUT_ID_MAP.search layout_env.map layout)
        | `just.{_ i} {i state}
        | `nothing
            Let i layout_env.i
            In
            Let layout_env
                {Record
                    map:(LAYOUT_ID_MAP.insert layout_env.map {layout i})
                    indexes:(layout :: layout_env.indexes)
                    i:(i + (LIST.length layout) + 1)}
            In
            {i {string_env label_env layout_env}}
        ;

Where

Let STRING_ID_MAP (SEARCH.MAP STRING.compare (Func {key _}. key))

Let LABEL_ID_MAP (SEARCH.MAP STRING.compare (Func {key _}. key))
Let ID_LABEL_MAP (SEARCH.MAP Z.compare (Func {key _}. key))

Let LAYOUT_ID_MAP
    (SEARCH.MAP
        Func a b.
            Let m (LIST.length a)
            Let n (LIST.length b)
            In
            Cond
            | (m < n) `less
            | (m > n) `greater
            | True
                (LIST.reduce (LIST.zip a b) `equal
                    Func relation {ai bi}.
                        Match relation
                        | `equal
                            Cond
                            | (ai < bi) `less
                            | (ai > bi) `greater
                            | True `equal
                            ;
                        | _ relation
                        ;)
            ;
        Func {key _}. key)

Where

Let (pattern_variables pat)
    Match pat
    | `tuple.vars vars
    | `var.var [var]
    | `ignore []
    ;

Let (binder_variables binder)
    Match binder
    | `let.{pat _}
        Match pat
        | `tuple.vars vars
        | `var.var [var]
        ;
    | `do._ []
    ;

Let (binder_expr binder)
    Match binder
    | `do.expr expr
    | `let.{_ expr} expr
    ;

Where

Let die OS.die

Where

Let LIST Package "list"
Let OS Package "os"
Let SEARCH Package "search"
Let SORT Package "sort"
Let STDIO Package "stdio"
Let STRING Package "string"
Let Z Package "z"