{
Let analyze. analyze
}
Where
\ Note on `block.{binder_group expr}
\
\ Let y. 2
\ In
\ Let x. 1
\ Do (f y)
\ In
\ (g y x)
\
\ `block.{
\ [
\ [
\ `do.`app.{`var."f" [`var."y"]}
\ `let.{`var."x" [] `num.1}
\ ]
\ [`let.{`var."y" [] `num.2}]
\ ]
\ `app.{`var."g" [`var."y" `var."x"]}
\ }
\
\ Note that the abstract form holds binders and binder_groups in reversed
\ order relative to the concrete form.
\
\ Rationale: It is easy to build up environments by using list folds over
\ binder lists when they are held in this order.
Let analyze root_path.
Let STRING_SET. (SEARCH.SET STRING.compare)
In
Begin (parsing [] [root_path] STRING_SET.empty)
Define parsing analyses stack visited.
Match stack
| `cons.{path stack}
Let file_name. (STRING.append path ".84")
In
Let file. (OS.file_open file_name)
In
Let text. (OS.file_read_all file)
Do (OS.file_close file)
In
Let tokens. (scan text)
In
Let tree. (parse tokens)
Let visited. (STRING_SET.insert visited path)
In
Let imports. (gather_imports tree)
In
Let analysis.
{
Let path. path
Let imports. imports
Let text. text
Let tokens. tokens
Let tree. tree
}
Let stack.
(LIST.reduce imports stack
Func stack path.
Match (STRING_SET.search visited path)
| `just._ stack
| `nothing (path::stack)
;)
In
Goto (parsing (analysis::analyses) stack visited)
| `nil
Let ordered_paths. (sort_and_check_dependency_graph analyses)
In
Let ordered_analyses.
(LIST.fold ordered_paths []
Func path ordered_analyses.
Let analysis.
Let has_matching_path analysis.
(STRING.equal analysis.path path)
In
Match (LIST.filter analyses has_matching_path)
| `cons.{analysis _} analysis
;
In
(analysis::ordered_analyses))
In
ordered_analyses
;
Where
Let sort_and_check_dependency_graph analyses.
Let MAP.
(SEARCH.MAP STRING.compare
Func {key _}. key)
In
Let G. (GRAPH.G MAP)
Let g.
(LIST.reduce analyses MAP.empty
Func g analysis.
(MAP.insert g {analysis.path analysis.imports}))
In
Let sccs. (G.strongly_connected_components g)
In
Let ordered_paths.
(LIST.fold sccs []
Func scc ordered_paths.
If ((LIST.length scc) > 1)
(die "There is a circular dependency among the packages.")
Match scc | `cons.{path _} (path::ordered_paths) ;)
In
ordered_paths
Let scan text.
Let n. (STRING.length text)
In
Begin (scanning 0 [] `whitespace)
Define scanning i tokens state.
If (n = i)
(LIST.reverse (`eof::tokens))
Match state
| `whitespace
Let i. (scan_whitespace text i)
In
Goto (scanning i tokens `token)
| `token
Let {i token}. (scan_token text i)
In
Goto (scanning i (token::tokens) `whitespace)
;
Let parse tokens.
(parse_file_block tokens)
Let gather_imports tree.
Let SET. (SEARCH.SET STRING.compare)
In
Let reduce_binder reduce_expr set binder.
Match binder
| `let.{_ expr} (reduce_expr set expr)
| `do.expr (reduce_expr set expr)
;
In
Define reduce_expr set expr.
Let reduce_binder set binder.
(reduce_binder reduce_expr set binder)
In
Match expr
| `true set
| `false set
| `num._ set
| `str._ set
| `package.path (SET.insert set path)
| `prim._ set
| `var._ set
| `chain.{expr chain} (reduce_expr set expr)
| `tuple.exprs (LIST.reduce exprs set reduce_expr)
| `module.binders (LIST.reduce binders set reduce_binder)
| `block.{binder_groups expr}
(LIST.reduce binder_groups (reduce_expr set expr)
Func set binders.
(LIST.reduce binders set reduce_binder))
| `app.{func args} (LIST.reduce (func::args) set reduce_expr)
| `func.{self params expr} (reduce_expr set expr)
| `goto.expr (reduce_expr set expr)
| `switch.{expr clauses}
(LIST.reduce clauses (reduce_expr set expr)
Func set {_ body}. (reduce_expr set body))
| `cond.clauses
(LIST.reduce clauses set
Func set {test body}.
(reduce_expr
(reduce_expr set test)
body))
| `if.{test_expr then_expr else_expr}
(reduce_expr
(reduce_expr
(reduce_expr set test_expr)
then_expr)
else_expr)
| `not.expr (reduce_expr set expr)
| `and.{test_expr then_expr}
(reduce_expr
(reduce_expr set test_expr)
then_expr)
| `or.{test_expr else_expr}
(reduce_expr
(reduce_expr set test_expr)
else_expr)
| `list.exprs (LIST.reduce exprs set reduce_expr)
| `labeled.{_ expr} (reduce_expr set expr)
| `match.{expr clauses}
(LIST.reduce clauses (reduce_expr set expr)
Func set clause.
(reduce_expr set clause.1))
;
In
(SET.list (reduce_expr SET.empty tree))
Where
Let scan_token text i.
Let scan.
Switch (STRING.fetch text i)
| '\'' scan_char
| '"' scan_string
| c
If (ASCII.is_letter c)
scan_word
If (ASCII.is_digit c)
scan_number
scan_basic_symbol
;
In
(scan text i)
Let parse_file_block tokens.
Let {expr tokens}. (parse_expr tokens)
In
Begin (parsing [] tokens)
Define parsing binder_groups tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `eof `block.{(LIST.reverse binder_groups) expr}
| `sym.text
Cond
| (STRING.equal text "Where")
Let {group tokens}.
(parse_binder_group parse_block_body parse_expr tokens)
In
Goto (parsing (group::binder_groups) tokens)
| True
(die "Malformed file block.")
;
;
Where
Let scan_whitespace text i.
Let n. (STRING.length text)
In
Define chomp_line i.
If (i = n)
i
If ((STRING.fetch text i) = '\n')
(i + 1)
Goto (chomp_line $ i + 1)
In
Begin (scanning i)
Define scanning i.
If (i = n)
i
Switch (STRING.fetch text i)
| ' ' Goto (scanning $ i + 1)
| '\n' Goto (scanning $ i + 1)
| '\\' Goto (scanning $ chomp_line i)
| _ i
;
Let scan_char text i.
If Not ((STRING.fetch text i) = '\'')
(die "Expected quotation mark to begin character literal.")
Block
Let i. (i + 1)
In
Let {c i}.
Switch (STRING.fetch text i)
| '\\'
Let i. (i + 1)
In
Switch (STRING.fetch text i)
| '\\' {'\\' i}
| 'n' {'\n' i}
| '\'' {'\'' i}
| _ (die "Invalid character escape sequence.")
;
| '\'' (die "Empty character literal.")
| '\n' (die "Character literal contains newline character.")
| c {c i}
;
In
If Not ((STRING.fetch text $ i + 1) = '\'')
(die "Expected quotation mark to end character literal.")
{(i + 2) `num.c}
Let scan_string text i.
Let begin. i
In
If Not ((STRING.fetch text i) = '"')
(die "Expected quotation mark to begin string literal.")
Begin (scanning $ i + 1)
Define scanning i.
Switch (STRING.fetch text i)
| '"'
Let end. (i + 1)
In
Let token. `str.(STRING.clip text begin end)
In
{end token}
| '\\'
Let j. (i + 1)
Let k. (i + 2)
In
Switch (STRING.fetch text j)
| '\\' Goto (scanning k)
| 'n' Goto (scanning k)
| '"' Goto (scanning k)
| _ (die "Invalid character escape sequence.")
;
| '\n' (die "String literal contains newline.")
| _ Goto (scanning $ i + 1)
;
Let scan_number text i.
Begin (scanning i 0)
Define scanning i num.
Let c. (STRING.fetch text i)
In
If Not (ASCII.is_digit c)
{i `num.num}
Goto (scanning (i + 1) $ 10 * num + c + -'0')
Let scan_word text i.
Let begin. i
In
Begin (scanning i False False)
Define scanning i seen_upper seen_lower.
Let c. (STRING.fetch text i)
In
Switch c
| '_' Goto (scanning (i + 1) seen_upper seen_lower)
| '\'' Goto (scanning (i + 1) seen_upper seen_lower)
| _
If (ASCII.is_digit c)
Goto (scanning (i + 1) seen_upper seen_lower)
If (ASCII.is_letter c)
Goto
(scanning (i + 1)
Or seen_upper (ASCII.is_upper c)
Or seen_lower (ASCII.is_lower c))
If And seen_upper seen_lower
{i `sym.(STRING.clip text begin i)}
{i `id.(STRING.clip text begin i)}
;
Let scan_basic_symbol text i.
{(i + 1) `sym.(STRING.clip text i $ i + 1)}
Define parse_expr tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `num.n {`num.n tokens}
| `str.s {`str.s tokens}
| `id.text
Let {chain tokens}. (parse_chain tokens)
In
Match chain
| `nil {`var.text tokens}
| `cons._ {`chain.{`var.text chain} tokens}
;
| `sym.text
Cond
| (STRING.equal text "-")
Let {expr tokens}. (parse_expr tokens)
In
{`app.{`prim."negate" [expr]} tokens}
| (STRING.equal text "&")
Let {expr tokens}. (parse_expr tokens)
In
{`app.{`prim."ref_new" [expr]} tokens}
| (STRING.equal text "?")
Let {expr tokens}. (parse_expr tokens)
In
{`app.{`prim."ref_fetch" [expr]} tokens}
| (STRING.equal text "(")
(parse_applications parse_expr tokens)
| (STRING.equal text "{")
Let {token tokens}. (pop_token tokens)
In
Cond
| Or (is_symbol token "Let") (is_symbol token "Define")
Let {binders tokens}.
(parse_binder_group parse_block_body parse_expr
(token::tokens))
In
Let {token tokens}. (pop_token tokens)
In
If (is_symbol token "}")
{`module.binders tokens}
(die "Malformed module expression.")
| True
Begin (parsing [] (token::tokens))
Define parsing exprs tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "}")
{`tuple.(LIST.reverse exprs) tokens}
| True
Let {expr tokens}. (parse_expr (token::tokens))
In
Goto (parsing (expr::exprs) tokens)
;
;
| (STRING.equal text "[")
Begin (parsing [] tokens)
Define parsing exprs tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "]")
{`list.(LIST.reverse exprs) tokens}
| True
Let {expr tokens}. (parse_expr (token::tokens))
In
Goto (parsing (expr::exprs) tokens)
;
| (STRING.equal text "`")
Let {label tokens}. (parse_id tokens)
In
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token ".")
Let {expr tokens}. (parse_expr tokens)
In
{`labeled.{label expr} tokens}
| True
{`labeled.{label `tuple.[]} (token::tokens)}
;
| (STRING.equal text "Prim")
Let {text tokens}. (parse_id tokens)
In
{`prim.text tokens}
| (STRING.equal text "Package")
Let {token tokens}. (pop_token tokens)
In
Match token
| `str.text {`package.(strip_quotes text) tokens}
;
| (STRING.equal text "Goto")
Let {expr tokens}. (parse_expr tokens)
In
Match expr
| `app._ {`goto.expr tokens}
| _ (die "Goto expression is not an application.")
;
| (STRING.equal text "Cond")
Let {clauses tokens}.
Begin (parsing [] tokens)
Define parsing clauses tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token ";")
{(LIST.reverse clauses) tokens}
| (is_symbol token "|")
Let {test tokens}. (parse_expr tokens)
In
Let {body tokens}.
(parse_block_body parse_expr tokens)
In
Goto (parsing ({test body}::clauses) tokens)
| True
(die "Malformed Cond expression.")
;
In
{`cond.clauses tokens}
| (STRING.equal text "If")
Let {test_expr tokens}. (parse_expr tokens)
In
Let {then_expr tokens}. (parse_expr tokens)
In
Let {else_expr tokens}. (parse_expr tokens)
In
{`if.{test_expr then_expr else_expr} tokens}
| (STRING.equal text "When")
Let {test_expr tokens}. (parse_expr tokens)
In
Let {then_expr tokens}. (parse_block_body parse_expr tokens)
In
{`if.{test_expr then_expr `tuple.[]} tokens}
| (STRING.equal text "True")
{`true tokens}
| (STRING.equal text "False")
{`false tokens}
| (STRING.equal text "Not")
Let {expr tokens}. (parse_expr tokens)
In
{`not.expr tokens}
| (STRING.equal text "And")
Let {test_expr tokens}. (parse_expr tokens)
In
Let {then_expr tokens}. (parse_expr tokens)
In
{`and.{test_expr then_expr} tokens}
| (STRING.equal text "Or")
Let {test_expr tokens}. (parse_expr tokens)
In
Let {else_expr tokens}. (parse_expr tokens)
In
{`or.{test_expr else_expr} tokens}
| (STRING.equal text "Match")
Let {expr tokens}. (parse_expr tokens)
In
Let {clauses tokens}.
Begin (parsing [] tokens)
Define parsing clauses tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token ";")
\ Complain if there is an _ pattern in a clause
\ before the last clause.
Do Match clauses
| `nil {}
| `cons.{_ clauses}
(LIST.for_each clauses
Func {pat _}.
Match pat
| `default
(die "Malformed Match expression.")
| _ {}
;)
;
In
{(LIST.reverse clauses) tokens}
| (is_symbol token "|")
Let {pat tokens}. (parse_match_pattern tokens)
In
Let {body tokens}.
(parse_block_body parse_expr tokens)
In
Goto (parsing ({pat body}::clauses) tokens)
| True
(die "Malformed Match expression.")
;
In
{`match.{expr clauses} tokens}
| (STRING.equal text "Switch")
Let {expr tokens}. (parse_expr tokens)
In
Let {clauses tokens}.
Begin (parsing [] tokens)
Define parsing clauses tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token ";")
\ Complain if there is a catch-all pattern in a
\ clause before the last clause.
Do Match clauses
| `nil {}
| `cons.{_ clauses}
(LIST.for_each clauses
Func {pat _}.
Match pat
| `default._
(die "Malformed Switch expression.")
| _ {}
;)
;
In
{(LIST.reverse clauses) tokens}
| (is_symbol token "|")
Let {pat tokens}. (parse_switch_pattern tokens)
In
Let {body tokens}.
(parse_block_body parse_expr tokens)
In
Goto (parsing ({pat body}::clauses) tokens)
| True
(die "Malformed Switch expression.")
;
In
{`switch.{expr clauses} tokens}
| (STRING.equal text "Func")
Let {param_pats tokens}. (parse_param_patterns tokens)
In
Let {body tokens}. (parse_block_body parse_expr tokens)
In
{`func.{`nothing param_pats body} tokens}
| (STRING.equal text "Begin")
Let {expr tokens}. (parse_expr tokens)
In
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "Define")
Let {binder tokens}.
(parse_define_binder parse_block_body parse_expr tokens)
In
{`block.{[[binder]] expr} tokens}
| True (die "Expected Define form in Begin expression.")
;
| (STRING.equal text "Block")
(parse_block_body parse_expr tokens)
| True
(die "No parse.")
;
;
Where
Define parse_block_body parse_expr tokens.
Begin (parsing [] tokens)
Define parsing binder_groups tokens.
Let {token _}. (pop_token tokens)
In
Let is_binder_group.
Or (is_symbol token "Let")
Or (is_symbol token "Do") (is_symbol token "Define")
In
Cond
| is_binder_group
Let {group tokens}.
(parse_binder_group parse_block_body parse_expr tokens)
In
Let {token tokens}. (pop_token tokens)
In
If (is_symbol token "In")
Goto (parsing (group::binder_groups) tokens)
(die "Malformed block body.")
| True
Let {expr tokens}. (parse_expr tokens)
In
{`block.{binder_groups expr} tokens}
;
Let parse_switch_pattern tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `sym.text
Cond
| (STRING.equal text "_") {`default.`nothing tokens}
| (STRING.equal text "-")
Let {token tokens}. (pop_token tokens)
In
Match token
| `num.n {`value.-n tokens}
| _ (die "Malformed Switch pattern.")
;
| True (die "Malformed Switch pattern.")
;
| `id.name {`default.`just.name tokens}
| `num.n {`value.n tokens}
;
Let parse_match_pattern tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "_") {`default tokens}
| (is_symbol token "`")
Let {label tokens}. (parse_id tokens)
In
Let {vars tokens}.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token ".")
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "{")
Begin (parsing [] tokens)
Define parsing vars tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "}")
{`tuple.(LIST.reverse vars) tokens}
| (is_symbol token "_")
Goto (parsing ("_"::vars) tokens)
| True
Let {var _}. (parse_id (token::tokens))
In
Goto (parsing (var::vars) tokens)
;
| (is_symbol token "_") {`default tokens}
| True
Let {name tokens}. (parse_id (token::tokens))
In
{`var.name tokens}
;
| True {`tuple.[] (token::tokens)}
;
In
{`labeled.{label vars} tokens}
| True (die "Malformed Match pattern.")
;
Where
Let parse_applications parse_expr tokens.
Let combine left_expr right_expr op.
If (STRING.equal op.name "apply")
Match left_expr
| `app.{func args} `app.{func (LIST.append args [right_expr])}
| _ `app.{left_expr [right_expr]}
;
`app.{`prim.op.name [left_expr right_expr]}
In
Define parse_completion parse lower_limit left_expr tokens.
Let saved_tokens. tokens
Let {maybe_op tokens}. (maybe_parse_binary_op tokens)
In
Match maybe_op
| `nothing {left_expr saved_tokens}
| `just.op
Cond
| (op.precedence < lower_limit) {left_expr saved_tokens}
| True
Let {right_expr tokens}.
(parse
Match op.associativity
| `left (op.precedence + 1)
| `right op.precedence
;
tokens)
In
Let expr. (combine left_expr right_expr op)
In
Goto (parse_completion parse lower_limit expr tokens)
;
;
In
Define parse lower_limit tokens.
Let {expr tokens}. (parse_expr tokens)
In
Goto (parse_completion parse lower_limit expr tokens)
In
Let {expr tokens}. (parse 0 tokens)
In
Let {token tokens}. (pop_token tokens)
In
If (is_symbol token ")")
{expr tokens}
(die "Malformed function application expression.")
Let parse_chain tokens.
Begin (parsing [] tokens)
Define parsing chain tokens.
Let {token tokens}. (pop_token tokens)
In
If (is_symbol token ".")
Block
Let {token tokens}. (pop_token tokens)
In
Match token
| `id._ Goto (parsing (token::chain) tokens)
| `num._ Goto (parsing (token::chain) tokens)
;
{(LIST.reverse chain) (token::tokens)}
Let parse_binder_group parse_block_body parse_expr tokens.
Begin (parsing [] tokens)
Define parsing binders tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `sym.text
Cond
| (STRING.equal text "Do")
Let {expr tokens}. (parse_expr tokens)
In
Let binder. `do.expr
In
Goto (parsing (binder::binders) tokens)
| (STRING.equal text "Define")
Let {binder tokens}.
(parse_define_binder parse_block_body parse_expr tokens)
In
Goto (parsing (binder::binders) tokens)
| (STRING.equal text "Let")
Let {binder tokens}.
(parse_let_binder parse_block_body parse_expr tokens)
In
Goto (parsing (binder::binders) tokens)
| True
{binders (token::tokens)}
;
| _ {binders (token::tokens)}
;
Where
Let maybe_parse_binary_op tokens.
Let {token tokens}. (pop_token tokens)
In
Let {maybe_spec tokens}.
Cond
| (is_symbol token ")")
{`nothing (token::tokens)}
| (is_symbol token "$")
{`just.{"apply" 0 `right} tokens}
| (is_symbol token "!")
{`just.{"ref_store" 1 `right} tokens}
| (is_symbol token ":")
Let {token tokens}. (pop_token tokens)
In
If (is_symbol token ":")
{`just.{"cons" 2 `right} tokens}
(die "Unrecognized binary operator \":\".")
| (is_symbol token "=")
{`just.{"equal" 3 `left} tokens}
| (is_symbol token ">")
Let saved_tokens. tokens
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "=")
{`just.{"greater_or_equal" 3 `left} tokens}
| True
{`just.{"greater" 3 `left} saved_tokens}
;
| (is_symbol token "<")
Let saved_tokens. tokens
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "=")
{`just.{"less_or_equal" 3 `left} tokens}
| True
{`just.{"less" 3 `left} saved_tokens}
;
| (is_symbol token "+")
{`just.{"add" 4 `left} tokens}
| (is_symbol token "*")
{`just.{"multiply" 5 `left} tokens}
| True
{`just.{"apply" 6 `left} (token::tokens)}
;
In
Match maybe_spec
| `nothing {`nothing tokens}
| `just.{name precedence associativity}
Let maybe_op.
`just.{
Let name. name
Let precedence. precedence
Let associativity. associativity
}
In
{maybe_op tokens}
;
Let parse_define_binder parse_block_body parse_expr tokens.
Let {var_name tokens}. (parse_id tokens)
In
Let var_pat. `var.var_name
Let {param_pats tokens}. (parse_param_patterns tokens)
In
Let {body tokens}. (parse_block_body parse_expr tokens)
In
Let binder.
Match param_pats
| `nil (die "Malformed Define binder.")
| `cons._
Do (LIST.for_each param_pats
Func pat.
Match pat
| `var._ {}
| _ (die "Malformed Define binder.")
;)
In
`let.{var_pat `func.{`just.var_name param_pats body}}
;
In
{binder tokens}
Let parse_let_binder parse_block_body parse_expr tokens.
Let {var_pat param_pats tokens}.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "{")
Let {var_pat tokens}. (parse_tuple_pattern tokens)
In
Let {token tokens}. (pop_token tokens)
In
If (is_symbol token ".")
{var_pat [] tokens}
(die "Expected . in Let binder.")
| True
Let {name tokens}. (parse_id (token::tokens))
In
Let var_pat. `var.name
Let {param_pats tokens}. (parse_param_patterns tokens)
In
{var_pat param_pats tokens}
;
In
Let {body tokens}. (parse_block_body parse_expr tokens)
In
Let binder.
Match param_pats
| `nil `let.{var_pat body}
| `cons._ `let.{var_pat `func.{`nothing param_pats body}}
;
In
{binder tokens}
Where
Let parse_param_patterns tokens.
Begin (parsing [] tokens)
Define parsing pats tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `id.name Goto (parsing (`var.name::pats) tokens)
| `sym.text
Cond
| (STRING.equal text ".")
{(LIST.reverse pats) tokens}
| (STRING.equal text "_")
Goto (parsing (`ignore::pats) tokens)
| (STRING.equal text "{")
Let {pat tokens}. (parse_tuple_pattern tokens)
In
Goto (parsing (pat::pats) tokens)
| True (die "Malformed parameter list.")
;
;
Where
Let parse_tuple_pattern tokens.
Begin (parsing [] tokens)
Define parsing vars tokens.
Let {token tokens}. (pop_token tokens)
In
Cond
| (is_symbol token "}")
{`tuple.(LIST.reverse vars) tokens}
| (is_symbol token "_")
Goto (parsing ("_"::vars) tokens)
| True
Match token
| `id.var Goto (parsing (var::vars) tokens)
| _ (die "Malformed tuple pattern.")
;
;
Let parse_binder_ids tokens.
Begin (parsing_ids [] tokens)
Define parsing_ids ids tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `id.text Goto (parsing_ids (text::ids) tokens)
| `sym.text
Cond
| (STRING.equal text "_") Goto (parsing_ids (text::ids) tokens)
| (STRING.equal text ".") {(LIST.reverse ids) tokens}
| True (die "Malformed Let binder.")
;
;
Let parse_id tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `id.text {text tokens}
| _ (die "Expected identifier.")
;
Let parse_sym text tokens.
Let {token tokens}. (pop_token tokens)
In
Match token
| `sym.text'
If (STRING.equal text' text)
tokens
(die
(STRING.concat
["Expected " text " token but got " text' "."]))
| _ (die (STRING.concat ["Token is not " text "."]))
;
Where
Let pop_token tokens.
Match tokens
| `cons.pair pair
;
Let is_symbol token text.
Match token
| `sym.text' (STRING.equal text text')
| _ False
;
Let die. Prim die
Let strip_quotes s. (STRING.clip s 1 $ (STRING.length s) + -1)
Where
Let ASCII. Package "ascii"
Let GRAPH. Package "graph"
Let LIST. Package "list"
Let OS. Package "os"
Let SEARCH. Package "search"
Let STDIO. Package "stdio"
Let STRING. Package "string"