+++ /dev/null
-require 'extension.match'
-require 'walk.id'
-
-local function destructuring_set (x)
- local patterns, values = unpack(x)
-
- local code, vars do
- local mcfg = {
- on_failure = mlp.gensym 'mismatch' [1],
- locals = { },
- code = { } }
- spmatch.pattern_seq_builder(patterns, values, mcfg)
- local on_success = mlp.gensym 'on_success' [1]
- code = {
- mcfg.code;
- `Goto{ on_success };
- `Label{ mcfg.on_failure };
- +{error "Destructuring bind error"};
- `Label{ on_success } }
- vars = mcfg.locals
- end
-
- local vars_in_pattern do
- vars_in_pattern = { }
- local wcfg = { id = { } }
- function wcfg.id.free(v) printf("%s is free", v[1]); vars_in_pattern[v[1]]=true end
- walk_id.expr_list(wcfg, patterns)
- end
-
- local vars_not_in_pattern do
- vars_not_in_pattern = { }
- for k in keys(vars) do
- if not vars_in_pattern[k] then
- vars_not_in_pattern[k] = true
- end
- end
- end
-
- if next(vars_not_in_pattern) then
- local loc = { }
- for k in keys (vars_not_in_pattern) do
- table.insert (loc, `Id{k})
- end
- table.insert (code, 1, `Local{ loc, { } })
- end
-
- local decl_list do
- decl_list = { }
- for k in keys (vars_in_pattern) do
- table.insert (decl_list, `Id{k})
- end
- end
-
- return code, decl_list
-end
-
-function local_destructuring_set(x)
- local code, vars = destructuring_set (x)
- return { `Local{ vars, { } }; code }
-end
-
-function non_local_destructuring_set(x)
- local code, _ = destructuring_set (x)
- code.tag = 'Do'
- return code
-end
-
-mlp.lexer:add 'bind'
-mlp.stat:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
- builder = non_local_destructuring_set }
-mlp.stat:get'local'[2]:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
- builder = local_destructuring_set }
\ No newline at end of file
--- /dev/null
+require 'extension.match'\r
+module ('spmatch', package.seeall)\r
+-{extension 'log'}\r
+\r
+-- Get rid of the former parser, it will be blended in a multiseq:\r
+mlp.stat:del 'match'\r
+\r
+mlp.stat:add{ 'match', \r
+ gg.multisequence{\r
+\r
+ ----------------------------------------------------------------\r
+ -- Shortcut for declaration of functions containing only a match:\r
+ -- "function f($1) match $1 with $2 end end" can be written:\r
+ -- "match function f $2 end"\r
+ ----------------------------------------------------------------\r
+ { 'function', mlp.expr, gg.optkeyword '|',\r
+ match_cases_list_parser,\r
+ 'end',\r
+ builder = function(x) \r
+ local func_name, _, cases = unpack(x)\r
+ local arity = #cases[1][1][1]\r
+ if arity==0 then \r
+ error "There must be at least 1 case in match function" \r
+ end\r
+ local args = { }\r
+ for i=1, arity do args[i] = mlp.gensym("arg."..i) end\r
+ local body = match_builder{args, cases}\r
+ return `Set{ {func_name}, { `Function{ args, {body} } } }\r
+ end },\r
+\r
+ ----------------------------------------------------------------\r
+ -- Reintroduce the original match statement:\r
+ ----------------------------------------------------------------\r
+ default = gg.sequence{\r
+ mlp.expr_list, 'with', gg.optkeyword '|',\r
+ match_cases_list_parser,\r
+ 'end',\r
+ builder = |x| match_builder{ x[1], x[3] } } } }\r
+\r
+mlp.expr:add{ 'match', builder = |x| x[1], gg.multisequence{\r
+\r
+ ----------------------------------------------------------------\r
+ -- Anonymous match functions:\r
+ -- "function ($1) match $1 with $2 end end" can be written:\r
+ -- "match function $2 end"\r
+ ----------------------------------------------------------------\r
+ { 'function', gg.optkeyword '|',\r
+ match_cases_list_parser,\r
+ 'end',\r
+ builder = function(x)\r
+ local _, cases = unpack(x)\r
+ local v = mlp.gensym()\r
+ local body = match_builder{v, cases}\r
+ return `Function{ {v}, {body} }\r
+ end },\r
+\r
+ ----------------------------------------------------------------\r
+ -- match expressions: you can put a match where an expression\r
+ -- is expected. The case bodies are then expected to be \r
+ -- expressions, not blocks.\r
+ ----------------------------------------------------------------\r
+ default = gg.sequence{\r
+ mlp.expr_list, 'with', gg.optkeyword '|',\r
+ gg.list{ name = "match cases list",\r
+ gg.sequence{ name = "match expr case",\r
+ gg.list{ name = "match expr case patterns list",\r
+ primary = mlp.expr_list,\r
+ separators = "|",\r
+ terminators = { "->", "if" } },\r
+ gg.onkeyword{ "if", mlp.expr, consume = true },\r
+ "->",\r
+ mlp.expr },\r
+ separators = "|",\r
+ terminators = "end" },\r
+ 'end',\r
+ builder = function (x)\r
+ local tested_term_seq, _, cases = unpack(x)\r
+ local v = mlp.gensym 'match_expr'\r
+ -- Replace expressions with blocks\r
+ for case in ivalues (cases) do \r
+ local body = case[3]\r
+ case[3] = { `Set{ {v}, {body} } }\r
+ end\r
+ local m = match_builder { tested_term_seq, cases }\r
+ return `Stat{ { `Local{{v}}; m }, v }\r
+ end } } }\r
+\r
+require 'walk.id'\r
+\r
+function bind (x)\r
+ local patterns, values = unpack(x)\r
+ \r
+ -------------------------------------------------------------------\r
+ -- Generate pattern code: "bind vars = vals" translates to:\r
+ -- do \r
+ -- pattern matching code, goto 'fail' on mismatch\r
+ -- goto 'success'\r
+ -- label 'fail': error "..."\r
+ -- label success\r
+ -- end\r
+ -- vars is the set of variables used by the pattern\r
+ -------------------------------------------------------------------\r
+ local code, vars do\r
+ local match_cfg = {\r
+ on_failure = mlp.gensym 'mismatch' [1],\r
+ locals = { },\r
+ code = { } }\r
+ pattern_seq_builder(patterns, values, match_cfg)\r
+ local on_success = mlp.gensym 'on_success' [1]\r
+ code = { \r
+ match_cfg.code; \r
+ `Goto{ on_success }; \r
+ `Label{ match_cfg.on_failure }; \r
+ +{error "bind error"};\r
+ `Label{ on_success } }\r
+ vars = match_cfg.locals\r
+ end\r
+ \r
+ -------------------------------------------------------------------\r
+ -- variables that actually appear in the pattern:\r
+ -------------------------------------------------------------------\r
+ local vars_in_pattern do\r
+ vars_in_pattern = { }\r
+ local walk_cfg = { id = { } }\r
+ function walk_cfg.id.free(v) vars_in_pattern[v[1]]=true end\r
+ walk_id.expr_list(walk_cfg, patterns)\r
+ end\r
+\r
+ -------------------------------------------------------------------\r
+ -- temp variables that are generated for destructuring,\r
+ -- but aren't explicitly typed by the user. These must be made\r
+ -- local.\r
+ -------------------------------------------------------------------\r
+ local vars_not_in_pattern do\r
+ vars_not_in_pattern = { }\r
+ for k in keys(vars) do\r
+ if not vars_in_pattern[k] then\r
+ vars_not_in_pattern[k] = true\r
+ end\r
+ end\r
+ end\r
+\r
+ -------------------------------------------------------------------\r
+ -- Declare the temp variables as local to the statement.\r
+ -------------------------------------------------------------------\r
+ if next(vars_not_in_pattern) then\r
+ local loc = { }\r
+ for k in keys (vars_not_in_pattern) do \r
+ table.insert (loc, `Id{k})\r
+ end\r
+ table.insert (code, 1, `Local{ loc, { } })\r
+ end\r
+\r
+ -------------------------------------------------------------------\r
+ -- Transform the set of pattern variable names into a list of `Id{}\r
+ -------------------------------------------------------------------\r
+ local decl_list do\r
+ decl_list = { }\r
+ for k in keys (vars_in_pattern) do\r
+ table.insert (decl_list, `Id{k})\r
+ end\r
+ end\r
+\r
+ return code, decl_list\r
+end\r
+\r
+function local_bind(x)\r
+ local code, vars = bind (x)\r
+ return { `Local{ vars, { } }; code }\r
+end\r
+\r
+function non_local_bind(x)\r
+ local code, _ = bind (x)\r
+ code.tag = 'Do'\r
+ return code\r
+end\r
+\r
+----------------------------------------------------------------------\r
+-- Syntax front-end\r
+----------------------------------------------------------------------\r
+mlp.lexer:add 'bind'\r
+\r
+----------------------------------------------------------------------\r
+-- bind patterns = vars\r
+----------------------------------------------------------------------\r
+mlp.stat:add{ 'bind', mlp.expr_list, '=', mlp.expr_list, \r
+ builder = non_local_bind }\r
+\r
+----------------------------------------------------------------------\r
+-- local bind patterns = vars\r
+-- Some monkey-patching of "local ..." must take place\r
+----------------------------------------------------------------------\r
+mlp.stat:get'local'[2]:add{ 'bind', mlp.expr_list, '=', mlp.expr_list, \r
+ builder = local_bind }
\ No newline at end of file
projects / metalua.git / commitdiff