{
:emit
}

Where

Define (emit w program)
    Define (write s)
        (IO.write_all w s)
    In
    Let emit (emitter (string_encoder program.constants) write)
    In
    Begin {
        (write "#include <support.h>\n")
        (LIST.for_each (LIST.reverse program.functions) emit)
        (write "void P(void){")
        (emit program.init)
        (write ";}\n")
        (write "const U2 record_layouts[]={")
        (LIST.for_each program.record_indexes
            Func index Begin {
                (LIST.for_each index
                    Func label Begin {
                        (write (Z.show label))
                        (write ",")
                    })
                (write "Z,")
            })
        (write "};\n")
        (write "_Alignas(4) const uint8_t constant_bytes[]=\"")
        (LIST.for_each program.constants
            Func c (write_string_literal write c))
        (write "\";\n")
    }

Where

Define (emitter encode_string write)
    Let compile
        Define (write s) 'write.s
        Define (sequence terms) 'sequence.terms
        Define (compile term) 'compile.term
        In
        Let write_comma (write ",")
        In
        Define (comma_sep terms)
            (sequence (LIST.join write_comma terms))
        Define (comma_pre terms)
            (sequence
                (LIST.fold terms 'nil
                    Func {term terms} [write_comma & term & terms]))
        In
        Func term
            Match term {
            | 'stmt.stmt
                Match stmt {
                | 'expr.expr
                    (sequence
                        (Reduce &
                            (write "({X t=s52(),x=")
                            (compile 'expr.expr)
                            (write ";s15(t);x;});")
                            'nil))
                | 'assign.{var expr}
                    (sequence
                        (Reduce &
                            (compile 'expr.var)
                            (write "=")
                            (compile 'expr.expr)
                            (write ";")
                            'nil))
                | 'env_access.{closure_var pairs}
                    Define (compile_pair {xm j})
                        (sequence
                            (Reduce &
                                (compile 'expr.xm)
                                (write "=env[")
                                (write (Z.show j))
                                (write "]")
                                'nil))
                    In
                    (sequence
                        (Reduce &
                            (write "const X*env=s62(")
                            (compile 'expr.closure_var)
                            (write ")")
                            (comma_pre (LIST.map pairs compile_pair))
                            (write ";")
                            'nil))
                | 'decls.pairs
                    Define (compile_pair {var maybe_init})
                        (sequence
                            (Reduce &
                                (compile 'expr.var)
                                Match maybe_init {
                                | 'nothing 'nil
                                | 'just.expr
                                    (Reduce &
                                        (sequence
                                            (Reduce &
                                                (write "=")
                                                (compile 'expr.expr)
                                                'nil))
                                        'nil)
                                }))
                    In
                    Match pairs {
                    | 'cons._
                        (sequence
                            (Reduce &
                                (write "X ")
                                (comma_sep (LIST.map pairs compile_pair))
                                (write ";")
                                'nil))
                    }
                }
            | 'expr.expr
                Match expr {
                | 'true (write "15")
                | 'false (write "271")
                | 'num.i (write (Z.show i))
                | 'empty_tuple (write "31")
                | 'labeled_empty_tuple.label
                    (write (Z.show (encode_empty_variant label)))
                | 'alloc_labeled_value.{label expr}
                    (sequence
                        (Reduce &
                            (write "s27(")
                            (write (Z.show label))
                            (write ",")
                            (compile 'expr.expr)
                            (write ")")
                            'nil))
                | 'remove_label.expr
                    (sequence
                        (Reduce &
                            (write "s06(")
                            (compile 'expr.expr)
                            (write ")")
                            'nil))
                | 'alloc_tuple.exprs
                    Match exprs {
                    | 'nil (compile 'expr.'empty_tuple)
                    | 'cons._
                        (sequence
                            (Reduce &
                                (write "s78(")
                                (write (Z.show (LIST.length exprs)))
                                (write ",(X[]){")
                                (comma_sep
                                    (LIST.map exprs
                                        Func expr (compile 'expr.expr)))
                                (write "})")
                                'nil))
                    }
                | 'alloc_record.{layout exprs}
                    Match exprs {
                    | 'cons._
                        (sequence
                            (Reduce &
                                (write "s30(")
                                (write (Z.show (LIST.length exprs)))
                                (write ",(X[]){")
                                (comma_sep
                                    (LIST.map exprs
                                        Func expr (compile 'expr.expr)))
                                (write "},")
                                (write (Z.show layout))
                                (write ")")
                                'nil))
                    }
                | 'tuple_fetch.{code i}
                    (sequence
                        (Reduce &
                            (write "s68(")
                            (compile 'expr.code)
                            (write ",")
                            (write (Z.show i))
                            (write ")")
                            'nil))
                | 'record_fetch.{code i}
                    (sequence
                        (Reduce &
                            (write "s31(")
                            (compile 'expr.code)
                            (write ",")
                            (write (Z.show i))
                            (write ")")
                            'nil))
                | 'iterate.{inits expr}
                    (sequence
                        (Reduce &
                            (write "({__label__ l;")
                            Match inits {
                            | 'nil (write "U4 t=s52();")
                            | 'cons._ (compile 'stmt.'decls.inits)
                            }
                            (write "l:")
                            (compile 'expr.expr)
                            (write ";})")
                            'nil))
                | 'continue.stmts
                    (sequence
                        (Reduce &
                            (write "({")
                            Match stmts {
                            | 'nil (write "s15(t);")
                            | 'cons._
                                (sequence
                                    (LIST.map stmts
                                        Func stmt (compile 'stmt.stmt)))
                            }
                            (write "goto l;31;})")
                            'nil))
                | 'stmt_expr.{stmts expr}
                    (sequence
                        (Reduce &
                            (write "({")
                            (sequence
                                (LIST.map stmts
                                    Func stmt (compile 'stmt.stmt)))
                            (compile 'expr.expr)
                            (write ";})")
                            'nil))
                | 'func.{i args stmts expr}
                    Define (compile_arg arg)
                        (sequence
                            [(write "X ") & (compile 'expr.arg) & 'nil])
                    In
                    (sequence
                        (Reduce &
                            (write "static X f")
                            (write (Z.show i))
                            (write "(")
                            (comma_sep (LIST.map args compile_arg))
                            (write "){return ")
                            Block
                                Let expr
                                    Match stmts {
                                    | 'nil expr
                                    | 'cons._ 'stmt_expr.{stmts expr}
                                    }
                                In
                                (compile 'expr.expr)
                            (write ";}\n")
                            'nil))
                | 'prim_app.{name args}
                    (sequence
                        (Reduce &
                            (write (RUNTIME.prim_short_name name))
                            (write "(")
                            (comma_sep
                                (LIST.map args
                                    Func expr (compile 'expr.expr)))
                            (write ")")
                            'nil))
                | 'closure_app_known.{i func args}
                    (sequence
                        (Reduce &
                            (write "f")
                            (write (Z.show i))
                            (write "(")
                            (comma_sep
                                (LIST.map [func & args]
                                    Func expr (compile 'expr.expr)))
                            (write ")")
                            'nil))
                | 'closure_app.{func args}
                    (sequence
                        (Reduce &
                            (write "({X c=")
                            (compile 'expr.func)
                            (write ";((X(*)(X")
                            (sequence
                                (LIST.map args
                                    Func _ (write ",X")))
                            (write "))s35(c,")
                            (write (Z.show (LIST.length args)))
                            (write "))(c")
                            (comma_pre
                                (LIST.map args
                                    Func arg (compile 'expr.arg)))
                            (write ");})")
                            'nil))
                | 'alloc_closure.{i free num_params}
                    (sequence
                        (Reduce &
                            (write "s75(f")
                            (write (Z.show i))
                            (write ",")
                            (write (Z.show num_params))
                            (write ",")
                            (write (Z.show (LIST.length free)))
                            Match free {
                            | 'nil (write ",0")
                            | 'cons._
                                (sequence
                                    (Reduce &
                                        (write ",(X[]){")
                                        (comma_sep
                                            (LIST.map free
                                                Func expr (compile 'expr.expr)))
                                        (write "}")
                                        'nil))
                            }
                            (write ")")
                            'nil))
                | 'labeled.{label expr}
                    (sequence
                        (Reduce &
                            (write "({__label__ ")
                            (compile 'expr.label)
                            (write ";")
                            (compile 'expr.label)
                            (write ":")
                            (compile 'expr.expr)
                            (write ";})")
                            'nil))
                | 'stuck_cond (write "s89()")
                | 'halt (write "s87()")
                | 'match.{expr_var pat_var expr clauses}
                    Define (compile_clause clause)
                        Match clause {
                        | 'default.body
                            (sequence
                                (Reduce &
                                    (write "default:")
                                    Match body {
                                    | 'expr.expr
                                        (sequence
                                            (Reduce &
                                                (write "r=")
                                                (compile 'expr.expr)
                                                (write ";break;")
                                                'nil))
                                    | 'stuck (write "s53();")
                                    }
                                    'nil))
                        | 'labeled.{label expr}
                            (sequence
                                (Reduce &
                                    (write "case ")
                                    (write (Z.show label))
                                    (write ":r=")
                                    (compile 'expr.expr)
                                    (write ";break;")
                                    'nil))
                        }
                    In
                    (sequence
                        (Reduce &
                            (write "({X r,")
                            (compile 'expr.expr_var)
                            (write "=")
                            (compile 'expr.expr)
                            (write ",")
                            (compile 'expr.pat_var)
                            (write "=")
                            (compile 'expr.'remove_label.expr_var)
                            (write ";switch(s09(")
                            (compile 'expr.expr_var)
                            (write ")){")
                            (sequence (LIST.map clauses compile_clause))
                            (write "}r;})")
                            'nil))
                | 'if.{test then else}
                    (sequence
                        (Reduce &
                            (write "(")
                            (compile 'expr.test)
                            (write "==15?")
                            (compile 'expr.then)
                            (write ":")
                            (compile 'expr.else)
                            (write ")")
                            'nil))
                | 'x.i (sequence [(write "x") & (write (Z.show i)) & 'nil])
                | 'c.i (write (Z.show (encode_string i)))
                | 'p.i (sequence [(write "p") & (write (Z.show i)) & 'nil])
                }
            }
    In
    Func expr
        Unfold term From (compile 'expr.expr)
            Begin Match term {
            | 'write.s (write s)
            | 'sequence.terms
                Iterate terms
                    Begin Match terms {
                    | 'nil
                    | 'cons.{term terms}
                        (Fold term)
                        (Continue terms)
                    }
            | 'compile.term
                (Fold (compile term))
            }

Where

Define (encode_empty_variant label)
    [[label * 256] + TAG_IMMEDIATE_VARIANT]

Define (write_string_literal write c)
    Begin {
        Let m (string_literal_length c)
        When [m > 255] { (OS.die "String constant is too big.") }
        (write "\\")
        (write (octal [m % 256]))
        (write "\\0\\0\\000")
        (write (STRING.clip c 1 [(STRING.length c) - 1]))
        Let padding [-m % 4]
        Iterate i From 0
            When [i < padding] {
                (write "\\0")
                (Continue [i + 1])
            }
    }

Define (string_encoder constants)
    Let STRING_MAP (SEARCH.MAP Z.compare [Func {i _} i])
    In
    Let {string_map _ _}
        (LIST.reduce constants {STRING_MAP.empty 0 0}
            Func {{map i offset} c}
                Let map
                    Let value [[offset * 16] + TAG_STATIC_CHUNK_RO]
                    In
                    (STRING_MAP.insert map {i value})
                Let m (string_literal_length c)
                In
                Let offset [offset + [[m + 7] / 4]]
                In
                {map [i + 1] offset})
    In
    Func i
        Match (STRING_MAP.search string_map i) {
        | 'just.{_ value} value
        }

Where

Define (octal n)
    Iterate {m digits n} From {0 'nil n}
        Cond {
        | [n > 0]
            (Continue [m + 1] [[n % 8] & digits] [n / 8])
        | [m = 0]
            "0"
        | True
            (CHUNK.new_ro m
                Func d
                    (LIST.for_each_numbered digits
                        Func {i digit}
                            (CHUNK.store_byte d i [`0` + digit])))
        }

Define (string_literal_length c)
    Let k [(STRING.length c) - 1]
    In
    Iterate {m i} From {0 1}
        Cond {
        | [i = k]
            m
        | [(STRING.fetch c i) = `\\`]
            (Continue [m + 1] [i + 2])
        | True
            (Continue [m + 1] [i + 1])
        }

Let TAG_IMMEDIATE_VARIANT 47

Let TAG_STATIC_CHUNK_RO 9

Where

Open Z
    {
    :Prefix -
    :Infix >
    :Infix <
    :Infix =
    :Infix +
    :Infix -
    :Infix *
    :Infix /
    :Infix %
    }

Open LIST {:Infix &}

Where

Let CHUNK Package "chunk"
Let FUNC Package "func"
Let IO Package "io"
Let LIST Package "list"
Let OS Package "os"
Let QUEUE Package "queue"
Let RUNTIME Package "runtime"
Let SEARCH Package "search"
Let STDIO Package "stdio"
Let STRING Package "string"
Let Z Package "z"