{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"