{Record file}

Where

Let (file text)
    (run text
        (bind1 (recursive_parser `expr)
            Func expr. (recursive_parser `package_block.expr)))

Where

Define (recursive_parser mode)
    Match mode
    | `expr
        Let (dispatch_on_symbol text)
            Let parse_expr (recursive_parser `expr)
            In
            Cond
            | (STRING.equal text "~")
                (lift1 parse_expr
                    Func expr. `app.{`prim."negate" [expr]})
            | (STRING.equal text "!")
                (lift1 parse_expr
                    Func expr. `if.{expr `false `true})
            | (STRING.equal text "(")
                (parse_applications parse_expr)
            | (STRING.equal text "{")
                (if_match "Record"
                    (lift1 (parse_record_inits parse_expr)
                        Func labels_and_inits.
                            `record.(LIST.unzip labels_and_inits))
                    (lift1 (parse_sequence parse_expr "}")
                        Func exprs. `tuple.exprs))
            | (STRING.equal text "[")
                (lift1 (parse_sequence parse_expr "]")
                    Func exprs. `list.exprs)
            | (STRING.equal text "`")
                (bind1 parse_id
                    Func label.
                        (if_match "."
                            (lift1 parse_expr
                                Func expr. `labeled.{label expr})
                            (pure `labeled.{label `tuple.[]})))
            | (STRING.equal text "True")
                (pure `true)
            | (STRING.equal text "False")
                (pure `false)
            | (STRING.equal text "And")
                (lift2 parse_expr parse_expr
                    Func test then. `and.{test then})
            | (STRING.equal text "Or")
                (lift2 parse_expr parse_expr
                    Func test else. `or.{test else})
            | (STRING.equal text "If")
                (lift3 parse_expr parse_expr parse_expr
                    Func test then else. `if.{test then else})
            | (STRING.equal text "Cond")
                Let parse_cond_clause
                    (sequence2 (match "|")
                        (lift2 parse_expr (recursive_parser `block_body)
                            Func test body. {test body}))
                In
                (lift1 (parse_sequence parse_cond_clause ";")
                    Func clauses. `cond.clauses)
            | (STRING.equal text "Switch")
                Let parse_switch_clause
                    (sequence2 (match "|")
                        (lift2 parse_switch_pattern (recursive_parser `block_body)
                            Func pat body. {pat body}))
                In
                (lift2 parse_expr (parse_sequence parse_switch_clause ";")
                    Func expr clauses. `switch.{expr clauses})
            | (STRING.equal text "Match")
                Let parse_match_clause
                    (sequence2 (match "|")
                        (lift2 parse_match_pattern (recursive_parser `block_body)
                            Func pat body. {pat body}))
                In
                (lift2 parse_expr (parse_sequence parse_match_clause ";")
                    Func expr clauses. `match.{expr clauses})
            | (STRING.equal text "Func")
                (bind1 (parse_patterns ".")
                    Func pats.
                        (lift1 (recursive_parser `block_body)
                            Func expr. `func.{`nothing pats expr}))
            | (STRING.equal text "Prim")
                (lift1 parse_id
                    Func name. `prim.name)
            | (STRING.equal text "Package")
                (bind1 pop
                    Func token.
                        Match token
                        | `str.s (pure `package.(strip_quotes s))
                        | _ (fail "Malformed Package expression.")
                        ;)
            | (STRING.equal text "Block")
                (recursive_parser `block_body)
            | (STRING.equal text "For")
                (bind2 parse_expr
                    (if_match "Let" (pure parse_let_binder)
                        (if_match "Do" (pure parse_do_binder)
                            (if_match "Define" (pure parse_define_binder)
                                (sequence2 pop (fail "Expected binder.")))))
                    Func expr parser.
                        (lift1 (parser (recursive_parser `block_body))
                            Func binder.
                                `block.{[binder] expr}))
            | (STRING.equal text "Iterate")
                (bind1 (sequence2 (match "{") (parse_patterns "}"))
                    Func pats.
                        Let vars (simplify_patterns pats)
                        In
                        (lift2
                            (sequence2 (match "From")
                                (sequence2 (match "{")
                                    (parse_sequence parse_expr "}")))
                            (recursive_parser `block_body)
                            Func inits expr. `iterate.{vars inits expr}))
            | (STRING.equal text "Continue")
                (lift1 (sequence2 (match "{") (parse_sequence parse_expr "}"))
                    Func exprs. `continue.exprs)
            | (STRING.equal text "Begin")
                (lift1 (parse_sequence parse_expr "End")
                    Func stmts.
                        Let binders
                            (LIST.reduce stmts []
                                Func binders stmt. (`do.stmt :: binders))
                        In
                        Match binders
                        | `nil `tuple.[]
                        | `cons._ `block.{binders `tuple.[]}
                        ;)
            | (STRING.equal text "When")
                (lift2 parse_expr (parse_sequence parse_expr "End")
                    Func test stmts.
                        Let binders
                            (LIST.reduce stmts []
                                Func binders stmt. (`do.stmt :: binders))
                        In
                        Let then
                            Match binders
                            | `nil `tuple.[]
                            | `cons._ `block.{binders `tuple.[]}
                            ;
                        In
                        `if.{test then `tuple.[]})
            | True (fail "Unexpected token while parsing expression.")
            ;
        In
        (bind1 pop
            Func token.
                Match token
                | `num.n (pure `num.n)
                | `str.s (pure `str.s)
                | `id.name
                    (lift1 parse_chain
                        Func chain.
                            Match chain
                            | `nil `var.name
                            | `cons._ `chain.{`var.name chain}
                            ;)
                | `sym.text (dispatch_on_symbol text)
                | `eof (fail "Unexpected end of file.")
                ;)
    | `block_body
        Let (continue binders)
            (bind1 pop
                Func token.
                    Match token
                    | `sym.s
                        Cond
                        | (STRING.equal s "In")
                            (lift1 (recursive_parser `block_body)
                                Func expr. `block.{binders expr})
                        | True (fail "Unexpected token while parsing binders.")
                        ;
                    | `eof (fail "Unexpected end of file.")
                    | _ (fail "Unexpected token while parsing binders.")
                    ;)
        In
        (bind1 peek
            Func token.
                Match token
                | `sym.s
                    Let has_binder
                        Cond
                        | (STRING.equal s "Let") True
                        | (STRING.equal s "Do") True
                        | (STRING.equal s "Define") True
                        | True False
                        ;
                    In
                    If has_binder
                        (recursive_parser `binder_group.{[] continue})
                        (recursive_parser `expr)
                | _ (recursive_parser `expr)
                ;)
    | `package_block.expr
        (bind1 pop
            Func token.
                Match token
                | `eof (pure expr)
                | `sym.s
                    Cond
                    | (STRING.equal s "Where")
                        Let (continue binders)
                            (recursive_parser
                                `package_block.`block.{binders expr})
                        In
                        (recursive_parser `binder_group.{[] continue})
                    | True (fail "Unexpected token while parsing package.")
                    ;
                | _ (fail "Unexpected token while parsing package.")
                ;)
    | `binder_group.{binders continue}
        (bind1 peek
            Func token.
                Match token
                | `sym.s
                    Let maybe_parser
                        Cond
                        | (STRING.equal s "Let") `just.parse_let_binder
                        | (STRING.equal s "Define") `just.parse_define_binder
                        | (STRING.equal s "Do") `just.parse_do_binder
                        | True `nothing
                        ;
                    In
                    Match maybe_parser
                    | `just.parser
                        (bind1 (sequence2 pop (parser (recursive_parser `block_body)))
                            Func binder.
                                Let binders (binder :: binders)
                                In
                                (recursive_parser `binder_group.{binders continue}))
                    | `nothing (continue binders)
                    ;
                | _ (continue binders)
                ;)
    ;

Where

Let (parse_applications parse_expr)
    Let (parse_left_apply expr)
        (lift1 (parse_sequence parse_expr ")")
            Func exprs.
                Match exprs
                | `nil expr
                | `cons._ `app.{expr exprs}
                ;)
    Define (parse_right_apply expr)
        (if_match ")"
            (pure expr)
            (lift1 (bind1 parse_expr parse_right_apply)
                Func expr_right.
                    `app.{expr [expr_right]}))
    Define (parse_left_general expr_left op expr_right)
        Let expr_left `app.{`prim.op [expr_left expr_right]}
        In
        (bind1 maybe_parse_binary_op
            Func maybe_op.
                Match maybe_op
                | `nothing
                    (if_match ")"
                        (pure expr_left)
                        (sequence2 pop
                            (fail "Expected binary operator or close paren.")))
                | `just.op'
                    If (STRING.equal op op')
                        (bind1 parse_expr
                            Func expr_right.
                                (parse_left_general expr_left op expr_right))
                        (fail "Mismatched operator.")
                ;)
    Define (parse_right_general expr_left op expr_right)
        (bind1 maybe_parse_binary_op
            Func maybe_op.
                Match maybe_op
                | `nothing
                    (if_match ")"
                        (pure `app.{`prim.op [expr_left expr_right]})
                        (sequence2 pop
                            (fail "Expected binary operator or close paren.")))
                | `just.op'
                    If (STRING.equal op op')
                        (lift1
                            Block
                                Let expr_left expr_right
                                In
                                (bind1 parse_expr
                                    Func expr_right.
                                        (parse_right_general expr_left op expr_right))
                            Func expr_right.
                                `app.{`prim.op [expr_left expr_right]})
                        (fail "Mismatched operator.")
                ;)
    In
    (bind2 (if_match "Right" (pure `right) (pure `left)) parse_expr
        Func assoc expr.
            (bind1 maybe_parse_binary_op
                Func maybe_op.
                    Match maybe_op
                    | `nothing
                        Match assoc
                        | `left (parse_left_apply expr)
                        | `right (parse_right_apply expr)
                        ;
                    | `just.op
                        (bind1 parse_expr
                            Func expr_right.
                                Match assoc
                                | `left (parse_left_general expr op expr_right)
                                | `right (parse_right_general expr op expr_right)
                                ;)
                    ;))

Let parse_chain
    Define (chain_parser _)
        (if_match "."
            Block
                Let (parse_access token)
                    Match token
                    | `id.name
                        (lift1 (chain_parser {})
                            Func chain. (`id.name :: chain))
                    | `num.n
                        (lift1 (chain_parser {})
                            Func chain. (`num.n :: chain))
                    | `eof (fail "Unexpected end of file.")
                    | _ (fail "Unexpected token while parsing access chain.")
                    ;
                In
                (bind1 pop parse_access)
            (pure []))
    In
    (chain_parser {})

Let parse_switch_pattern
    (bind1 pop
        Func token.
            Match token
            | `sym.s
                Cond
                | (STRING.equal s "_")
                    (pure `default.`nothing)
                | (STRING.equal s "~")
                    (bind1 pop
                        Func token.
                            Match token
                            | `num.n (pure `value.~n)
                            | _ (fail "Malformed Switch pattern.")
                            ;)
                | True (fail "Malformed Switch pattern.")
                ;
            | `num.n (pure `value.n)
            | `id.name (pure `default.`just.name)
            | `eof (fail "Unexpected end of file.")
            | _ (fail "Malformed Switch pattern.")
            ;)

Let parse_match_pattern
    Let parse_vars
        (if_match "{"
            (lift1 (parse_patterns "}")
                Func pats. `tuple.(simplify_patterns pats))
            (if_match "_" (pure `ignore)
                (lift1 parse_id
                    Func name. `var.name)))
    In
    (bind1 pop
        Func token.
            Match token
            | `sym.s
                Cond
                | (STRING.equal s "_") (pure `default)
                | (STRING.equal s "`")
                    (lift2 parse_id (if_match "." parse_vars (pure `tuple.[]))
                        Func label vars. `labeled.{label vars})
                | True (fail "Malformed Match pattern.")
                ;
            | `eof (fail "Unexpected end of file.")
            | _ (fail "Malformed Match pattern.")
            ;)

Where

Let maybe_parse_binary_op
    Define (gather_symbols _)
        (bind1 peek
            Func token.
                Match token
                | `sym.s
                    Let maybe_symbol
                        Cond
                        | (STRING.equal s "+") `just.s
                        | (STRING.equal s "-") `just.s
                        | (STRING.equal s "*") `just.s
                        | (STRING.equal s ":") `just.s
                        | (STRING.equal s "<") `just.s
                        | (STRING.equal s ">") `just.s
                        | (STRING.equal s "=") `just.s
                        | True `nothing
                        ;
                    In
                    Match maybe_symbol
                    | `just.symbol
                        (sequence2 pop
                            (lift1 (gather_symbols {})
                                Func symbols. (symbol :: symbols)))
                    | `nothing (pure [])
                    ;
                | _ (pure [])
                ;)
    In
    (lift1 (gather_symbols {})
        Func symbols.
            Match symbols
            | `nil `nothing
            | `cons._
                Let op (STRING.concat symbols)
                In
                Cond
                | (STRING.equal op "+") `just."add"
                | (STRING.equal op "-") `just."subtract"
                | (STRING.equal op "*") `just."multiply"
                | (STRING.equal op "<") `just."less"
                | (STRING.equal op ">") `just."greater"
                | (STRING.equal op "=") `just."equal"
                | (STRING.equal op "<=") `just."less_or_equal"
                | (STRING.equal op ">=") `just."greater_or_equal"
                | (STRING.equal op "::") `just."cons"
                | True `nothing
                ;
            ;)

Let (parse_let_binder parse_block_body)
    (bind1 peek
        Func token.
            Match token
            | `sym.s
                Cond
                | (STRING.equal s "{")
                    (lift2 (sequence2 pop (parse_patterns "}"))
                        parse_block_body
                        Func pats expr.
                            Let pats (simplify_patterns pats)
                            In
                            `let.{`tuple.pats expr})
                | (STRING.equal s "(")
                    (lift3 (sequence2 pop parse_id)
                        (parse_patterns ")")
                        parse_block_body
                        Func name pats expr.
                            `let.{`var.name `func.{`nothing pats expr}})
                ;
            | `eof (fail "Unexpected end of file.")
            | _
                (lift2 parse_id parse_block_body
                    Func name expr. `let.{`var.name expr})
            ;)

Let (parse_do_binder parse_block_body)
    (lift1 parse_block_body
        Func expr. `do.expr)

Let (parse_define_binder parse_block_body)
    (lift3 (sequence2 (match "(") parse_id)
        (parse_patterns ")")
        parse_block_body
        Func name pats expr.
            `let.{`var.name `func.{`just.name pats expr}})

Where

Let (parse_record_inits parse_expr)
    (parse_sequence (parse_record_init parse_expr) "}")

Let (parse_patterns terminator)
    (parse_sequence (parse_pattern {}) terminator)

Where

Let (parse_record_init parse_expr)
    (bind1 parse_id
        Func name.
            (if_match ":"
                (lift1 parse_expr
                    Func expr. {name expr})
                (pure {name `var.name})))

Define (parse_pattern _)
    (bind1 pop
        Func token.
            Match token
            | `id.name (pure `var.name)
            | `sym.s
                Cond
                | (STRING.equal s "{")
                    (lift1 (parse_sequence (parse_pattern {}) "}")
                        Func pats. `tuple.(simplify_patterns pats))
                | (STRING.equal s "_") (pure `ignore)
                | True (fail "Invalid pattern.")
                ;
            | `eof (fail "Unexpected end of file.")
            | _ (fail "Expected token while parsing patterns.")
            ;)

Where

Define (parse_sequence parser terminator)
    (if_match terminator
        (pure [])
        (bind1 parser
            Func item.
                (lift1 (parse_sequence parser terminator)
                    Func items. (item :: items))))

Where

Let (simplify_patterns pats)
    (LIST.map pats
        Func pat. Match pat | `ignore "_" | `var.name name ;)

Let parse_id
    (bind1 pop
        Func token.
            Match token
            | `id.name (pure name)
            | `sym.s (fail (STRING.append "Expected identifier, got " s))
            | `eof (fail "Unexpected end of file.")
            | _ (fail "Unexpected token.")
            ;)

Let (match s1)
    (bind1 pop
        Func token.
            Match token
            | `sym.s2
                If (STRING.equal s1 s2)
                    (pure {})
                    (fail (STRING.concat ["Expected \"" s1 "\"."]))
            | `eof (fail "Unexpected end of file.")
            | _ (fail (STRING.concat ["Expected \"" s1 "\"."]))
            ;)

Let (check_for_match s1)
    (lift1 peek
        Func token.
            Match token
            | `sym.s2 (STRING.equal s1 s2)
            | _ False
            ;)

Let (if_match s1 then else)
    (bind1 peek
        Func token.
            Match token
            | `sym.s2 If (STRING.equal s1 s2) (sequence2 pop then) else
            | _ else
            ;)

Where

Let (pop text i)
    Let i (SCAN.whitespace text i)
    In
    Let {i token} (SCAN.token text i)
    In
    `succeed.{token i}

Let (peek text i)
    Let j (SCAN.whitespace text i)
    In
    Let {_ token} (SCAN.token text j)
    In
    `succeed.{token i}

Where

Let (run text parser)
    Match (parser text 0)
    | `succeed.{expr _}
        `succeed.expr
    | `fail.{message i}
        `fail.{message i}
    ;

Let (fail message)
    Func text i.
        `fail.{message i}

Let (pure x)
    Func text i. `succeed.{x i}

Let (bind1 m1 f)
    Func text i.
        Let r1 (m1 text i)
        In
        Match r1
        | `succeed.{x1 i}
            Let m2 (f x1)
            In
            (m2 text i)
        | `fail._ r1
        ;

Let (bind2 m1 m2 f)
    Func text i.
        Let r1 (m1 text i)
        In
        Match r1
        | `succeed.{x1 i}
            Let r2 (m2 text i)
            In
            Match r2
            | `succeed.{x2 i}
                Let m3 (f x1 x2)
                In
                (m3 text i)
            | `fail._ r2
            ;
        | `fail._ r1
        ;

Let (lift1 m1 f)
    Func text i.
        Let r1 (m1 text i)
        In
        Match r1
        | `succeed.{x1 i}
            `succeed.{(f x1) i}
        | `fail._ r1
        ;

Let (lift2 m1 m2 f)
    Func text i.
        Let r1 (m1 text i)
        In
        Match r1
        | `succeed.{x1 i}
            Let r2 (m2 text i)
            In
            Match r2
            | `succeed.{x2 i}
                `succeed.{(f x1 x2) i}
            | `fail._ r2
            ;
        | `fail._ r1
        ;

Let (lift3 m1 m2 m3 f)
    Func text i.
        Let r1 (m1 text i)
        In
        Match r1
        | `succeed.{x1 i}
            Let r2 (m2 text i)
            In
            Match r2
            | `succeed.{x2 i}
                Let r3 (m3 text i)
                In
                Match r3
                | `succeed.{x3 i}
                    `succeed.{(f x1 x2 x3) i}
                | `fail._ r3
                ;
            | `fail._ r2
            ;
        | `fail._ r1
        ;

Let (sequence2 m1 m2)
    Func text i.
        Let r1 (m1 text i)
        In
        Match r1
        | `succeed.{_ i} (m2 text i)
        | `fail._ r1
        ;

Where

Let (strip_quotes s)
    (STRING.clip s 1 ((STRING.length s) - 1))

Where

Let LIST Package "list"
Let OS Package "os"
Let SCAN Package "scan"
Let STDIO Package "stdio"
Let STRING Package "string"