{ : elaborate_recursion : collect_free_variables : lift_functions : collect_constants : elaborate_patterns } Where Define (lift_functions exprs) Let {_ modules} (LIST.fold exprs {1 'nil} Func {expr {i modules}} Let {init i functions} (lift_functions i expr) In {i [{init functions} & modules]}) In modules Where Define (elaborate_recursion expr) 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 (sequence cs) 'sequence.cs Define (push_loop expr) 'push_loop.expr Define (use expr) 'use.expr Define (pass expr) 'pass.expr In Define (compile 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 (use expr) Func expr 'chain.{expr chain}) | 'tuple.exprs (lift1 (sequence (LIST.map exprs use)) Func exprs 'tuple.exprs) | 'record.{labels inits} (lift1 (sequence (LIST.map inits use)) Func inits 'record.{labels inits}) | 'block.{binders expr} Define (compile_binder binder) Match binder { | 'let.{pat body} (lift1 (use body) Func body 'let.{pat body}) } In (lift2 (sequence (LIST.map binders compile_binder)) (pass expr) Func {binders expr} 'block.{binders expr}) | 'app.{func args} (lift2 (use func) (sequence (LIST.map args use)) Func {func args} 'app.{func args}) | 'func.{param_pats expr} (lift1 (use expr) Func expr 'func.{param_pats expr}) | 'iterate.{vars inits expr} (lift2 (sequence (LIST.map inits use)) (push_loop expr) Func {inits expr} 'iterate.{vars inits expr}) | 'continue.exprs (lift1 (sequence (LIST.map exprs use)) Func exprs 'continue.exprs) | 'unfold.{vars inits expr} Let tagged_vars (LIST.map vars [Func name 'var.name]) In (pass 'block.{ [ 'let.{ 'var."Fold" 'func.{ ['var."Fold" & tagged_vars] 'iterate.{vars tagged_vars expr} } } & 'nil ] 'app.{'var."Fold" ['var."Fold" & inits]} }) | 'fold.exprs (pass 'app.{'var."Fold" ['var."Fold" & exprs]}) | 'cond.clauses Define (compile_clause {test body}) (lift2 (use test) (pass body) Func clause clause) In (lift1 (sequence (LIST.map clauses compile_clause)) Func clauses 'cond.clauses) | 'if.{test then else} (lift3 (use test) (pass then) (pass else) Func {test then else} 'if.{test then else}) | 'not.expr (lift1 (use expr) Func expr 'not.expr) | 'and.{test then} (lift2 (use test) (pass then) Func {test then} 'and.{test then}) | 'or.{test else} (lift2 (use test) (pass else) Func {test else} 'or.{test else}) | 'labeled.{label expr} (lift1 (use expr) Func expr 'labeled.{label expr}) | 'match.{expr clauses} Define (compile_clause {pat body}) (lift1 (pass body) Func body {pat body}) In (lift2 (use expr) (sequence (LIST.map clauses compile_clause)) Func {expr clauses} 'match.{expr clauses}) } In Unfold {command context} From {(compile expr) 'other} Match command { | 'pure.expr expr | 'lift1.{c1 f} (f (Fold c1 context)) | 'lift2.{c1 c2 f} (f (Fold c1 context) (Fold c2 context)) | 'lift3.{c1 c2 c3 f} (f (Fold c1 context) (Fold c2 context) (Fold c3 context)) | 'sequence.cs Match cs { | 'nil 'nil | 'cons.{c cs} 'cons.{(Fold c context) (Fold 'sequence.cs context)} } | 'push_loop.expr (Fold 'pass.expr 'loop) | 'use.expr (Fold (compile expr) 'other) | 'pass.expr Let expr Match context { | 'loop Match expr { | 'fold.exprs 'continue.exprs | _ expr } | 'other expr } In (Fold (compile expr) context) } Define (collect_free_variables expr) 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 (collect name) 'collect.name Define (in_context vars c) 'in_context.{vars c} Define (eval expr) 'eval.expr Define (eval_func vars expr) 'eval_func.{vars expr} In Define (sequence cs) (LIST.fold cs (pure 'nil) Func {c1 c2} (lift2 c1 c2 LIST.cons)) In Define (compile expr) Match expr { | 'true (pure expr) | 'false (pure expr) | 'num._ (pure expr) | 'str._ (pure expr) | 'package._ (pure expr) | 'prim._ (pure expr) | 'var.name (lift1 (collect name) [Func _ expr]) | 'chain.{expr chain} (lift1 (eval expr) Func expr 'chain.{expr chain}) | 'tuple.exprs (lift1 (sequence (LIST.map exprs eval)) Func exprs 'tuple.exprs) | 'record.{labels inits} (lift1 (sequence (LIST.map inits eval)) 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 (sequence (LIST.map binder_exprs eval)) (in_context vars (eval expr)) Func {binder_exprs expr} Let binders (LIST.map (LIST.zip binders binder_exprs) Func {binder expr} Match binder { | 'let.{pat _} 'let.{pat expr} }) In 'block.{binders expr}) | 'app.{func args} (lift2 (eval func) (sequence (LIST.map args eval)) Func {func args} 'app.{func args}) | 'func.{param_pats expr} Let vars (LIST.concat_map param_pats pattern_variables) In (lift1 (eval_func vars expr) Func {func_free_list expr} 'func.{func_free_list param_pats expr}) | 'iterate.{vars inits expr} (lift2 (sequence (LIST.map inits eval)) (in_context vars (eval expr)) Func {inits expr} 'iterate.{vars inits expr}) | 'continue.exprs (lift1 (sequence (LIST.map exprs eval)) Func exprs 'continue.exprs) | 'cond.clauses Define (compile_clause {test body}) (lift2 (eval test) (eval body) Func clause clause) In (lift1 (sequence (LIST.map clauses compile_clause)) Func clauses 'cond.clauses) | 'if.{test then else} (lift3 (eval test) (eval then) (eval else) Func {test then else} 'if.{test then else}) | 'not.expr (lift1 (eval expr) Func expr 'not.expr) | '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}) | 'labeled.{label expr} (lift1 (eval expr) Func expr 'labeled.{label expr}) | 'match.{expr clauses} Define (compile_clause {pat body}) Let vars Match pat { | 'default 'nil | 'labeled.{_ pat} (pattern_variables pat) } In (lift1 (in_context vars (eval body)) Func body {pat body}) In (lift2 (eval expr) (sequence (LIST.map clauses compile_clause)) Func {expr clauses} 'match.{expr clauses}) } In Let SET (SEARCH.SET STRING.compare) Let MAP (SEARCH.MAP STRING.compare Func var var.name) In Define (insert_each env depth vars) (LIST.reduce vars env Func {env var} (MAP.insert env {: name var : depth})) Define (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." & 'nil])) } In Let {expr _} Unfold {command env depth free} From {'eval.expr MAP.empty 0 SET.empty} Match command { | 'pure.x {x free} | 'lift1.{c1 f} Let {x1 free} (Fold c1 env depth free) In {(f x1) free} | 'lift2.{c1 c2 f} Let {x1 free} (Fold c1 env depth free) In Let {x2 free} (Fold c2 env depth free) In {(f x1 x2) free} | 'lift3.{c1 c2 c3 f} Let {x1 free} (Fold c1 env depth free) In Let {x2 free} (Fold c2 env depth free) In Let {x3 free} (Fold c3 env depth free) In {(f x1 x2 x3) free} | 'collect.name {{} (maybe_insert env depth free name)} | 'in_context.{vars c} Let env (insert_each env depth vars) In (Fold c env depth free) | 'eval.expr (Fold (compile expr) env depth free) | 'eval_func.{vars expr} Let {expr func_free} Let depth [depth + 1] In Let env (insert_each env depth vars) In (Fold (compile expr) 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_free_list expr} free} } In expr Define (lift_functions i expr) 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 (bind1 c1 f) 'bind1.{c1 f} Define (lookup var) 'lookup.var Define (in_context bindings c) 'in_context.{bindings c} Define (insert_func f) 'insert_func.f Define (eval expr) 'eval.expr In Define (sequence cs) (LIST.fold cs (pure 'nil) Func {c1 c2} (lift2 c1 c2 LIST.cons)) In Define (compile 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 (eval expr) Func expr 'chain.{expr chain}) | 'tuple.exprs (lift1 (sequence (LIST.map exprs eval)) Func exprs 'tuple.exprs) | 'record.{labels inits} (lift1 (sequence (LIST.map inits eval)) Func inits 'record.{labels inits}) | 'block.{binders expr} Let binder_exprs (LIST.map binders binder_expr) In (bind1 (sequence (LIST.map binder_exprs eval)) Func binder_exprs Let binders (LIST.map (LIST.zip binders binder_exprs) Func {binder expr} Match binder { | 'let.{pat _} 'let.{pat expr} }) In Let bindings (LIST.concat_map binders Func binder Match binder { | 'let.{pat expr} Match pat { | 'ignore 'nil | 'var.var Match expr { | 'closure.{i _ num_params} [{var 'func.{i num_params}} & 'nil] | _ [{var 'expr} & 'nil] } | 'tuple.vars (LIST.map vars Func var {var 'expr}) } }) In (lift1 (in_context bindings (eval expr)) Func expr 'block.{binders expr})) | 'app.{func args} Match func { | 'var.var (bind1 (lookup var) Func expr Match expr { | 'func.{i num_params} Let num_args (LIST.length args) In Let {} Let is_compatible (Or [num_params = num_args] [num_params = 1] [num_args = 1]) In When !is_compatible { (die "Protocol mismatch in function application.") } In (lift2 (eval func) (sequence (LIST.map args eval)) Func {func args} If [num_params = num_args] 'app_known.{i func args} 'app.{func args}) | 'expr (lift2 (eval func) (sequence (LIST.map args eval)) Func {func args} 'app.{func args}) }) | _ (lift2 (eval func) (sequence (LIST.map args eval)) Func {func args} 'app.{func args}) } | 'func.{free param_pats expr} Let bindings (LIST.map (LIST.concat_map param_pats pattern_variables) Func var {var 'expr}) In (bind1 (in_context bindings (eval expr)) Func expr (insert_func Func i Let closure 'closure.{i free (LIST.length param_pats)} Let func 'func.{i free param_pats expr} In {closure func})) | 'iterate.{vars inits expr} Let bindings (LIST.map vars Func var {var 'expr}) In (lift2 (sequence (LIST.map inits eval)) (in_context bindings (eval expr)) Func {inits expr} 'iterate.{vars inits expr}) | 'continue.exprs (lift1 (sequence (LIST.map exprs eval)) Func exprs 'continue.exprs) | 'cond.clauses Define (compile_clause {test body}) (lift2 (eval test) (eval body) Func clause clause) In (lift1 (sequence (LIST.map clauses compile_clause)) Func clauses 'cond.clauses) | 'if.{test then else} (lift3 (eval test) (eval then) (eval else) Func {test then else} 'if.{test then else}) | 'not.expr (lift1 (eval expr) Func expr 'not.expr) | '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}) | 'labeled.{label expr} (lift1 (eval expr) Func expr 'labeled.{label expr}) | 'match.{expr clauses} Define (compile_clause {pat body}) Let bindings Match pat { | 'default 'nil | 'labeled.{_ pat} (LIST.map (pattern_variables pat) Func var {var 'expr}) } In (lift1 (in_context bindings (eval body)) Func body {pat body}) In (lift2 (eval expr) (sequence (LIST.map clauses compile_clause)) Func {expr clauses} 'match.{expr clauses}) } In Let MAP (SEARCH.MAP STRING.compare Func {key _} key) In Unfold {command env i funcs} From {'eval.expr MAP.empty i 'nil} Match command { | 'pure.x {x i funcs} | 'lift1.{c1 f} Let {x1 i funcs} (Fold c1 env i funcs) In {(f x1) i funcs} | 'lift2.{c1 c2 f} Let {x1 i funcs} (Fold c1 env i funcs) In Let {x2 i funcs} (Fold c2 env i funcs) In {(f x1 x2) i funcs} | 'lift3.{c1 c2 c3 f} Let {x1 i funcs} (Fold c1 env i funcs) In Let {x2 i funcs} (Fold c2 env i funcs) In Let {x3 i funcs} (Fold c3 env i funcs) In {(f x1 x2 x3) i funcs} | 'bind1.{c1 f} Let {x1 i funcs} (Fold c1 env i funcs) In (Fold (f x1) env i funcs) | 'lookup.var Match (MAP.search env var) { | 'just.{_ expr} {expr i funcs} | 'nothing (die "No var.") } | 'in_context.{bindings c} Let env (LIST.reduce bindings env MAP.insert) In (Fold c env i funcs) | 'insert_func.f Let {x func} (f i) In {x [i + 1] [func & funcs]} | 'eval.expr (Fold (compile expr) env i funcs) } Define (collect_constants program) 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 (bind1 c1 f) 'bind1.{c1 f} Define (intern_string s) 'intern_string.s Define (intern_label name) 'intern_label.name Define (intern_layout layout) 'intern_layout.layout Define (eval expr) 'eval.expr In Define (sequence cs) (LIST.fold cs (pure 'nil) Func {c1 c2} (lift2 c1 c2 LIST.cons)) In Let package_table Let MAP (SEARCH.MAP STRING.compare [Func {key _} key]) In Let {_ map} (LIST.reduce program {0 MAP.empty} Func {{i map} package} {[i + 1] (MAP.insert map {package.path i})}) In Define (lookup path) Match (MAP.search map path) { | 'just.{_ i} i } In {: lookup} In Define (compile 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} Define (compile_access access) Match access { | 'id.name (lift1 (intern_label name) Func id 'record_fetch.id) | 'num.i (pure 'tuple_fetch.i) } In (lift2 (eval expr) (sequence (LIST.map chain compile_access)) Func {expr chain} 'chain.{expr chain}) | 'tuple.exprs (lift1 (sequence (LIST.map exprs eval)) Func exprs 'tuple.exprs) | 'record.{labels inits} (bind1 (sequence (LIST.map labels intern_label)) Func ids Let {layout inits} Define (sort pairs) (SORT.list_insertion Func {{i _} {j _}} (Z.compare i j) pairs) In (LIST.unzip (sort (LIST.zip ids inits))) In (lift2 (intern_layout layout) (sequence (LIST.map inits eval)) Func {layout_id inits} 'record.{layout_id inits})) | 'block.{binders expr} Let binder_exprs (LIST.map binders binder_expr) In (lift2 (sequence (LIST.map binder_exprs eval)) (eval expr) Func {binder_exprs expr} Let binders (LIST.map (LIST.zip binders binder_exprs) Func {binder expr} Match binder { | 'let.{pat _} 'let.{pat expr} }) In 'block.{binders expr}) | 'app_known.{j func args} (lift2 (sequence (LIST.map args eval)) (eval func) Func {args func} 'closure_app_known.{j func args}) | 'app.{func args} Match func { | 'prim.name Cond { | (STRING.equal name "cons") (eval 'labeled.{"cons" 'tuple.args}) | (STRING.equal name "not_equal") (eval 'if.{'app.{'prim."equal" args} 'false 'true}) | True (lift1 (sequence (LIST.map args eval)) Func args 'prim_app.{name args}) } | _ (lift2 (sequence (LIST.map args eval)) (eval func) Func {args func} 'closure_app.{func args}) } | 'closure._ (pure expr) | 'func.{j free param_pats expr} (lift1 (eval expr) Func expr 'func.{j free param_pats expr}) | 'iterate.{vars inits expr} (lift2 (sequence (LIST.map inits eval)) (eval expr) Func {inits expr} 'iterate.{vars inits expr}) | 'continue.exprs (lift1 (sequence (LIST.map exprs eval)) Func exprs 'continue.exprs) | 'cond.clauses Define (compile_clause {test body}) (lift2 (eval test) (eval body) Func clause clause) In (lift1 (sequence (LIST.map clauses compile_clause)) Func clauses 'cond.clauses) | 'if.{test then else} (lift3 (eval test) (eval then) (eval else) Func {test then else} 'if.{test then else}) | 'not.expr (lift1 (eval expr) Func expr 'not.expr) | '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}) | 'labeled.{label expr} (bind1 (intern_label label) Func id (lift1 (eval expr) Func expr 'labeled.{id expr})) | 'match.{expr clauses} Define (compile_clause {pat body}) Match pat { | 'default (lift1 (eval body) Func body {pat body}) | 'labeled.{label vars} (lift2 (intern_label label) (eval body) Func {id body} {'labeled.{id vars} body}) } In (lift2 (eval expr) (sequence (LIST.map clauses compile_clause)) Func {expr clauses} 'match.{expr clauses}) } In Let command Define (eval_package package) (lift2 (eval package.init) (sequence (LIST.map package.functions eval)) Func {init functions} { : path package.path : imports package.imports : init : functions }) In (lift3 (intern_label "nil") (intern_label "cons") (sequence (LIST.map program eval_package)) Func {nil_label cons_label packages} {nil_label cons_label packages}) Let state Let string_env {STRING_ID_MAP.empty 0} Let label_env { : name_of_id ID_LABEL_MAP.empty : id_of_name LABEL_ID_MAP.empty : i 0 } Let layout_env { : indexes 'nil : map LAYOUT_ID_MAP.empty : i 0 } In {string_env label_env layout_env} In Let {output state} Unfold {command state} Match command { | 'pure.x {x state} | 'lift1.{c1 f} Let {x1 state} (Fold c1 state) In {(f x1) state} | 'lift2.{c1 c2 f} Let {x1 state} (Fold c1 state) In Let {x2 state} (Fold c2 state) In {(f x1 x2) state} | 'lift3.{c1 c2 c3 f} Let {x1 state} (Fold c1 state) In Let {x2 state} (Fold c2 state) In Let {x3 state} (Fold c3 state) In {(f x1 x2 x3) state} | 'bind1.{c1 f} Let {x1 state} (Fold c1 state) In (Fold (f x1) state) | 'intern_string.s 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} } | 'intern_label.name 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 { : 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}} } | 'intern_layout.layout 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 { : 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}} } | 'eval.expr (Fold (compile expr) state) } 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 { : constants : label_names : record_indexes : packages : nil_label : cons_label } 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) Define (elaborate_patterns program) Let VAR_MAP (SEARCH.MAP STRING.compare [Func {key _} key]) In Let packages (LIST.map program.packages Func package Let functions (LIST.map package.functions Func function (elaborate_patterns VAR_MAP 0 VAR_MAP.empty 'nothing function)) Let init (elaborate_patterns VAR_MAP 0 VAR_MAP.empty 'nothing package.init) In { : path package.path : imports package.imports : functions : init }) In { : packages : constants program.constants : label_names program.label_names : record_indexes program.record_indexes : nil_label program.nil_label : cons_label program.cons_label } Where Define (elaborate_patterns VAR_MAP m env loop expr) Define (fresh_var m) {[m + 1] 'x.m} In Unfold {m env loop expr} Match expr { | 'true 'true | 'false 'false | 'num.n 'num.(RUNTIME.encode_small_integer n) | 'const.i 'c.i | 'package.i 'p.i | 'var.name Match (VAR_MAP.search env name) { | 'nothing (die "Unexpected scope error.") | 'just.{_ xm} xm } | 'chain.{expr chain} (LIST.reduce chain (Fold m env 'nothing expr) Func {code access} Match access { | 'tuple_fetch.i 'tuple_fetch.{code i} | 'record_fetch.i 'record_fetch.{code i} }) | 'tuple.exprs Match exprs { | 'nil 'empty_tuple | 'cons._ 'alloc_tuple.(LIST.map exprs [Func expr (Fold m env 'nothing expr)]) } | 'record.{layout inits} Let inits (LIST.map inits Func init (Fold m env 'nothing init)) In 'alloc_record.{layout inits} | 'block.{binders expr} Let m0 m Let {m env stmts} Let env_outer env In (LIST.fold binders {m env_outer QUEUE.empty} Func {binder {m env_inner stmts}} Match binder { | 'let.{pat expr} Match pat { | 'var.name Cond { | (STRING.equal name "_") {m env_inner (QUEUE.push stmts 'expr.(Fold m env_outer 'nothing expr))} | True Let {m xm} (fresh_var m) In {m (VAR_MAP.insert env_inner {name xm}) (QUEUE.push stmts 'assign.{xm (Fold m env_outer 'nothing expr)})} } | 'tuple.names Let {m tuple_var} (fresh_var m) In Let stmts (QUEUE.push stmts 'assign.{tuple_var (Fold m env_outer 'nothing expr)}) In Let {_ m env_inner stmts} (LIST.reduce names {0 m env_inner stmts} Func {{i m env_inner stmts} name} Cond { | (STRING.equal name "_") {[i + 1] m env_inner stmts} | True Let {m xm} (fresh_var m) In Let env_inner (VAR_MAP.insert env_inner {name xm}) Let stmts (QUEUE.push stmts 'assign.{xm 'tuple_fetch.{tuple_var i}}) In {[i + 1] m env_inner stmts} }) In {m env_inner stmts} } }) In Cond { | (QUEUE.is_empty stmts) (Fold m env loop expr) | True Let stmts (QUEUE.pop_all stmts) In Let stmts Cond { | [m = m0] stmts | True Let decls (LIST.map (LIST.iota [m - m0]) Func i {'x.[m0 + i] 'nothing}) In ['decls.decls & stmts] } In 'stmt_expr.{stmts (Fold m env loop expr)} } | 'func.{i free param_pats expr} Let {m args inits env} {0 QUEUE.empty QUEUE.empty VAR_MAP.empty} In Let {m args env} Let {m xm} (fresh_var m) In {m (QUEUE.push args xm) env} In Let {m args inits env} (LIST.reduce param_pats {m args inits env} Func {{m args inits env} pat} Let {m arg} (fresh_var m) In Let args (QUEUE.push args arg) In Match pat { | 'ignore {m args inits env} | 'var.name {m args inits (VAR_MAP.insert env {name arg})} | 'tuple.names Let {_ m inits env} (LIST.reduce names {0 m inits env} Func {{j m inits env} name} \ TODO Handle name="_" case better. Let {m xm} (fresh_var m) In Let env (VAR_MAP.insert env {name xm}) Let init {xm 'just.'tuple_fetch.{arg j}} In {[j + 1] m (QUEUE.push inits init) env}) In {m args inits env} }) In Let {m maybe_env_access env} Match free { | 'nil {m 'nothing env} | _ Let {_ m pairs env} (LIST.reduce free {0 m QUEUE.empty env} Func {{j m pairs env} name} Let {m xm} (fresh_var m) In {[j + 1] m (QUEUE.push pairs {xm j}) (VAR_MAP.insert env {name xm})}) In {m 'just.'env_access.{'x.0 (QUEUE.pop_all pairs)} env} } In Let expr (Fold m env 'nothing expr) Let stmts Let stmts Match maybe_env_access { | 'nothing 'nil | 'just.stmt [stmt & 'nil] } In If (QUEUE.is_empty inits) stmts ['decls.(QUEUE.pop_all inits) & stmts] In 'func.{i (QUEUE.pop_all args) stmts expr} | 'prim_app.{name args} Define (transform arg) (Fold m env 'nothing arg) In 'prim_app.{name (LIST.map args transform)} | 'closure_app_known.{i func args} Define (transform expr) (Fold m env 'nothing expr) In 'closure_app_known.{i (transform func) (LIST.map args transform)} | 'closure_app.{func args} Define (transform expr) (Fold m env 'nothing expr) In 'closure_app.{(transform func) (LIST.map args transform)} | 'closure.{i free num_params} Let free (LIST.map free Func name Match (VAR_MAP.search env name) { | 'nothing (die "Unexpected scope error.") | 'just.{_ xm} xm }) In 'alloc_closure.{i free num_params} | 'iterate.{vars inits expr} Let inits (LIST.map inits Func init 'just.(Fold m env 'nothing init)) Let {vars expr} Let {m vars env} (LIST.fold vars {m 'nil env} Func {name {m vars env}} Let {m var} (fresh_var m) In Let env (VAR_MAP.insert env {name var}) In {m [var & vars] env}) In {vars (Fold m env 'just.vars expr)} In 'iterate.{(LIST.zip vars inits) expr} | 'continue.exprs Match loop { | 'nothing (die "Unexpected loop scoping error.") | 'just.params Let args exprs Let m0 m In Let {_ evals} (LIST.reduce args {m QUEUE.empty} Func {{m evals} arg} Let {m xm} (fresh_var m) Let arg_code (Fold m0 env 'nothing arg) In {m (QUEUE.push evals {xm 'just.arg_code})}) In Let stmts If (QUEUE.is_empty evals) QUEUE.empty (QUEUE.new ['decls.(QUEUE.pop_all evals) & 'nil]) In Let {_ stmts} (LIST.reduce params {m0 stmts} Func {{m stmts} param} Let {m xm} (fresh_var m) In {m (QUEUE.push stmts 'assign.{param xm})}) In 'continue.(QUEUE.pop_all stmts) } | 'cond.clauses (LIST.fold clauses 'stuck_cond Func {{test body} expr} Match test { | 'true (Fold m env loop body) | 'false expr | _ 'if.{(Fold m env 'nothing test) (Fold m env loop body) expr} }) | 'if.{test_expr then_expr else_expr} 'if.{(Fold m env 'nothing test_expr) (Fold m env loop then_expr) (Fold m env loop else_expr)} | 'not.expr 'if.{(Fold m env 'nothing expr) 'false 'true} | 'and.{test_expr then_expr} 'if.{(Fold m env 'nothing test_expr) (Fold m env loop then_expr) 'false} | 'or.{test_expr else_expr} 'if.{(Fold m env 'nothing test_expr) 'true (Fold m env loop else_expr)} | 'labeled.{label expr} Let expr_is_empty_tuple Match expr { | 'tuple.exprs Match exprs { | 'nil True | _ False } | _ False } In If expr_is_empty_tuple 'labeled_empty_tuple.label 'alloc_labeled_value.{label (Fold m env 'nothing expr)} | 'match.{expr clauses} Let {m expr_var} (fresh_var m) In Let {m pat_var} (fresh_var m) In Let default_clause (LIST.reduce clauses 'default.'stuck Func {clause {pat body}} Match pat { | 'default 'default.'expr.(Fold m env loop body) | 'labeled._ clause }) Define (labeled_clause label vars body) Match vars { | 'ignore 'labeled.{label (Fold m env loop body)} | 'var.name Let env (VAR_MAP.insert env {name pat_var}) In 'labeled.{label (Fold m env loop body)} | 'tuple.names Let n (LIST.length names) In Cond { | [n = 0] 'labeled.{label (Fold m env loop body)} | True Let {_ m env inits} (LIST.fold names {[n - 1] m env 'nil} Func {name {i m env inits}} Cond { | (STRING.equal name "_") {[i - 1] m env inits} | True Let {m xm} (fresh_var m) In Let env (VAR_MAP.insert env {name xm}) Let init {xm 'just.'tuple_fetch.{pat_var i}} In {[i - 1] m env [init & inits]} }) In Let expr (Fold m env loop body) In Match inits { | 'nil 'labeled.{label expr} | 'cons._ 'labeled.{label 'stmt_expr.{['decls.inits & 'nil] expr}} } } } In Let clauses (LIST.reduce clauses [default_clause & 'nil] Func {clauses {pat body}} Match pat { | 'default clauses | 'labeled.{label vars} Let clause (labeled_clause label vars body) In [clause & clauses] }) In 'match.{expr_var pat_var (Fold m env 'nothing expr) clauses} | _ (die "Unexpected expression class.") } Where Define (pattern_variables pat) Match pat { | 'tuple.vars vars | 'var.var [var & 'nil] | 'ignore 'nil } Define (binder_variables binder) Match binder { | 'let.{pat _} Match pat { | 'tuple.vars vars | 'var.var [var & 'nil] } } Define (binder_expr binder) Match binder { | 'let.{_ expr} expr } Where Let die OS.die Where Let LIST Package "list" Let OS Package "os" Let QUEUE Package "queue" Let RUNTIME Package "runtime" Let SEARCH Package "search" Let SORT Package "sort" Let STDIO Package "stdio" Let STRING Package "string" Let Z Package "z"