1 require 'extension.match'
\r
2 module ('spmatch', package.seeall)
\r
5 ----------------------------------------------------------------------
\r
6 -- Back-end for "match function ..." and "local match function..."
\r
7 -- Tag must be either "Localrec" or "Set".
\r
8 ----------------------------------------------------------------------
\r
9 named_match_function_builder = |tag| function (x)
\r
10 local func_name, _, cases = unpack(x)
\r
11 local arity = #cases[1][1][1]
\r
13 error "There must be at least 1 case in match function"
\r
16 for i=1, arity do args[i] = mlp.gensym("arg."..i) end
\r
17 local body = match_builder{args, cases}
\r
18 return { tag=tag, {func_name}, { `Function{ args, {body} } } }
\r
21 -- Get rid of the former parser, it will be blended in a multiseq:
\r
22 mlp.stat:del 'match'
\r
24 ----------------------------------------------------------------------
\r
25 -- "match function", "match ... with"
\r
26 ----------------------------------------------------------------------
\r
27 mlp.stat:add{ 'match',
\r
30 ----------------------------------------------------------------
\r
31 -- Shortcut for declaration of functions containing only a match:
\r
32 -- "function f($1) match $1 with $2 end end" can be written:
\r
33 -- "match function f $2 end"
\r
34 ----------------------------------------------------------------
\r
35 { 'function', mlp.expr, gg.optkeyword '|',
\r
36 match_cases_list_parser, 'end',
\r
37 builder = match_function_builder 'Set' },
\r
39 ----------------------------------------------------------------
\r
40 -- Reintroduce the original match statement:
\r
41 ----------------------------------------------------------------
\r
42 default = gg.sequence{
\r
43 mlp.expr_list, 'with', gg.optkeyword '|',
\r
44 match_cases_list_parser, 'end',
\r
45 builder = |x| match_builder{ x[1], x[3] } } } }
\r
47 ----------------------------------------------------------------------
\r
48 -- Shortcut: "local match function f $cases end" translates to:
\r
49 -- "local function f($args) match $args with $cases end end"
\r
50 ----------------------------------------------------------------------
\r
51 mlp.stat:get'local'[2]:add{
\r
52 'match', 'function', mlp.expr, gg.optkeyword '|',
\r
53 match_cases_list_parser, 'end',
\r
54 builder = match_function_builder 'Localrec' }
\r
56 ----------------------------------------------------------------------
\r
57 -- "match...with" expressions and "match function..."
\r
58 ----------------------------------------------------------------------
\r
59 mlp.expr:add{ 'match', builder = |x| x[1], gg.multisequence{
\r
61 ----------------------------------------------------------------
\r
62 -- Anonymous match functions:
\r
63 -- "function ($1) match $1 with $2 end end" can be written:
\r
64 -- "match function $2 end"
\r
65 ----------------------------------------------------------------
\r
66 { 'function', gg.optkeyword '|',
\r
67 match_cases_list_parser,
\r
69 builder = function(x)
\r
70 local _, cases = unpack(x)
\r
71 local v = mlp.gensym()
\r
72 local body = match_builder{v, cases}
\r
73 return `Function{ {v}, {body} }
\r
76 ----------------------------------------------------------------
\r
77 -- match expressions: you can put a match where an expression
\r
78 -- is expected. The case bodies are then expected to be
\r
79 -- expressions, not blocks.
\r
80 ----------------------------------------------------------------
\r
81 default = gg.sequence{
\r
82 mlp.expr_list, 'with', gg.optkeyword '|',
\r
83 gg.list{ name = "match cases list",
\r
84 gg.sequence{ name = "match expr case",
\r
85 gg.list{ name = "match expr case patterns list",
\r
86 primary = mlp.expr_list,
\r
88 terminators = { "->", "if" } },
\r
89 gg.onkeyword{ "if", mlp.expr, consume = true },
\r
91 mlp.expr }, -- Notice: expression, not block!
\r
93 -- Notice: no "end" keyword!
\r
94 builder = function (x)
\r
95 local tested_term_seq, _, cases = unpack(x)
\r
96 local v = mlp.gensym 'match_expr'
\r
97 -- Replace expressions with blocks
\r
98 for case in ivalues (cases) do
\r
99 local body = case[3]
\r
100 case[3] = { `Set{ {v}, {body} } }
\r
102 local m = match_builder { tested_term_seq, cases }
\r
103 return `Stat{ { `Local{{v}}; m }, v }
\r
109 local patterns, values = unpack(x)
\r
111 -------------------------------------------------------------------
\r
112 -- Generate pattern code: "bind vars = vals" translates to:
\r
114 -- pattern matching code, goto 'fail' on mismatch
\r
116 -- label 'fail': error "..."
\r
119 -- vars is the set of variables used by the pattern
\r
120 -------------------------------------------------------------------
\r
121 local code, vars do
\r
122 local match_cfg = {
\r
123 on_failure = mlp.gensym 'mismatch' [1],
\r
126 pattern_seq_builder(patterns, values, match_cfg)
\r
127 local on_success = mlp.gensym 'on_success' [1]
\r
130 `Goto{ on_success };
\r
131 `Label{ match_cfg.on_failure };
\r
132 +{error "bind error"};
\r
133 `Label{ on_success } }
\r
134 vars = match_cfg.locals
\r
137 -------------------------------------------------------------------
\r
138 -- variables that actually appear in the pattern:
\r
139 -------------------------------------------------------------------
\r
140 local vars_in_pattern do
\r
141 vars_in_pattern = { }
\r
142 local walk_cfg = { id = { } }
\r
143 function walk_cfg.id.free(v) vars_in_pattern[v[1]]=true end
\r
144 walk_id.expr_list(walk_cfg, patterns)
\r
147 -------------------------------------------------------------------
\r
148 -- temp variables that are generated for destructuring,
\r
149 -- but aren't explicitly typed by the user. These must be made
\r
151 -------------------------------------------------------------------
\r
152 local vars_not_in_pattern do
\r
153 vars_not_in_pattern = { }
\r
154 for k in keys(vars) do
\r
155 if not vars_in_pattern[k] then
\r
156 vars_not_in_pattern[k] = true
\r
161 -------------------------------------------------------------------
\r
162 -- Declare the temp variables as local to the statement.
\r
163 -------------------------------------------------------------------
\r
164 if next(vars_not_in_pattern) then
\r
166 for k in keys (vars_not_in_pattern) do
\r
167 table.insert (loc, `Id{k})
\r
169 table.insert (code, 1, `Local{ loc, { } })
\r
172 -------------------------------------------------------------------
\r
173 -- Transform the set of pattern variable names into a list of `Id{}
\r
174 -------------------------------------------------------------------
\r
177 for k in keys (vars_in_pattern) do
\r
178 table.insert (decl_list, `Id{k})
\r
182 return code, decl_list
\r
185 function local_bind(x)
\r
186 local code, vars = bind (x)
\r
187 return { `Local{ vars, { } }; code }
\r
190 function non_local_bind(x)
\r
191 local code, _ = bind (x)
\r
196 ----------------------------------------------------------------------
\r
197 -- Syntax front-end
\r
198 ----------------------------------------------------------------------
\r
199 mlp.lexer:add 'bind'
\r
201 ----------------------------------------------------------------------
\r
202 -- bind patterns = vars
\r
203 ----------------------------------------------------------------------
\r
204 mlp.stat:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
\r
205 builder = non_local_bind }
\r
207 ----------------------------------------------------------------------
\r
208 -- local bind patterns = vars
\r
209 -- Some monkey-patching of "local ..." must take place
\r
210 ----------------------------------------------------------------------
\r
211 mlp.stat:get'local'[2]:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
\r
212 builder = local_bind }