2be675106b47291664de42c754cc0036a60d99cd
| blob | 2be675106b47291664de42c754cc0036a60d99cd |
1 require 'extension.match'\r
2 module ('spmatch', package.seeall)\r
3 -{extension 'log'}\r
4 \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
12 if arity==0 then \r
13 error "There must be at least 1 case in match function" \r
14 end\r
15 local args = { }\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
19 end\r
20 \r
21 -- Get rid of the former parser, it will be blended in a multiseq:\r
22 mlp.stat:del 'match'\r
23 \r
24 ----------------------------------------------------------------------\r
25 -- "match function", "match ... with"\r
26 ----------------------------------------------------------------------\r
27 mlp.stat:add{ 'match', \r
28 gg.multisequence{\r
29 \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
38 \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
46 \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
55 \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
60 \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
68 'end',\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
74 end },\r
75 \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
87 separators = "|",\r
88 terminators = { "->", "if" } },\r
89 gg.onkeyword{ "if", mlp.expr, consume = true },\r
90 "->",\r
91 mlp.expr }, -- Notice: expression, not block!\r
92 separators = "|" },\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
101 end\r
102 local m = match_builder { tested_term_seq, cases }\r
103 return `Stat{ { `Local{{v}}; m }, v }\r
104 end } } }\r
105 \r
106 require 'walk.id'\r
107 \r
108 function bind (x)\r
109 local patterns, values = unpack(x)\r
110 \r
111 -------------------------------------------------------------------\r
112 -- Generate pattern code: "bind vars = vals" translates to:\r
113 -- do \r
114 -- pattern matching code, goto 'fail' on mismatch\r
115 -- goto 'success'\r
116 -- label 'fail': error "..."\r
117 -- label success\r
118 -- end\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
124 locals = { },\r
125 code = { } }\r
126 pattern_seq_builder(patterns, values, match_cfg)\r
127 local on_success = mlp.gensym 'on_success' [1]\r
128 code = { \r
129 match_cfg.code; \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
135 end\r
136 \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
145 end\r
146 \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
150 -- local.\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
157 end\r
158 end\r
159 end\r
160 \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
165 local loc = { }\r
166 for k in keys (vars_not_in_pattern) do \r
167 table.insert (loc, `Id{k})\r
168 end\r
169 table.insert (code, 1, `Local{ loc, { } })\r
170 end\r
171 \r
172 -------------------------------------------------------------------\r
173 -- Transform the set of pattern variable names into a list of `Id{}\r
174 -------------------------------------------------------------------\r
175 local decl_list do\r
176 decl_list = { }\r
177 for k in keys (vars_in_pattern) do\r
178 table.insert (decl_list, `Id{k})\r
179 end\r
180 end\r
181 \r
182 return code, decl_list\r
183 end\r
184 \r
185 function local_bind(x)\r
186 local code, vars = bind (x)\r
187 return { `Local{ vars, { } }; code }\r
188 end\r
189 \r
190 function non_local_bind(x)\r
191 local code, _ = bind (x)\r
192 code.tag = 'Do'\r
193 return code\r
194 end\r
195 \r
196 ----------------------------------------------------------------------\r
197 -- Syntax front-end\r
198 ----------------------------------------------------------------------\r
199 mlp.lexer:add 'bind'\r
200 \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
206 \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 }