--- /dev/null
+-------------------------------------------------------------------------------
+-- Copyright (c) 2006-2013 Fabien Fleutot and others.
+--
+-- All rights reserved.
+--
+-- This program and the accompanying materials are made available
+-- under the terms of the Eclipse Public License v1.0 which
+-- accompanies this distribution, and is available at
+-- http://www.eclipse.org/legal/epl-v10.html
+--
+-- This program and the accompanying materials are also made available
+-- under the terms of the MIT public license which accompanies this
+-- distribution, and is available at http://www.lua.org/license.html
+--
+-- Contributors:
+-- Fabien Fleutot - API and implementation
+--
+-------------------------------------------------------------------------------
+
+require 'metalua.extension.match'
+
+module ('spmatch', package.seeall)
+
+require 'metalua.walk.id'
+
+----------------------------------------------------------------------
+-- Back-end for statements
+-- "match function ..." and "local match function...".
+-- Tag must be either "Localrec" or "Set".
+----------------------------------------------------------------------
+named_match_function_builder = |tag| function (x)
+ local func_name, _, cases = unpack(x)
+ local arity = #cases[1][1][1]
+ if arity==0 then
+ error "There must be at least 1 case in match function"
+ end
+ local args = { }
+ for i=1, arity do args[i] = mlp.gensym("arg."..i) end
+ local body = match_builder{args, cases}
+ return { tag=tag, {func_name}, { `Function{ args, {body} } } }
+end
+
+-- Get rid of the former parser, it will be blended in a multiseq:
+mlp.stat:del 'match'
+
+----------------------------------------------------------------------
+-- "match function", "match ... with"
+----------------------------------------------------------------------
+mlp.stat:add{ 'match',
+ gg.multisequence{
+
+ ----------------------------------------------------------------
+ -- Shortcut for declaration of functions containing only a match:
+ -- "function f($1) match $1 with $2 end end" can be written:
+ -- "match function f $2 end"
+ ----------------------------------------------------------------
+ { 'function', mlp.expr, gg.optkeyword '|',
+ match_cases_list_parser, 'end',
+ builder = named_match_function_builder 'Set' },
+
+ ----------------------------------------------------------------
+ -- Reintroduce the original match statement:
+ ----------------------------------------------------------------
+ default = gg.sequence{
+ mlp.expr_list, 'with', gg.optkeyword '|',
+ match_cases_list_parser, 'end',
+ builder = |x| match_builder{ x[1], x[3] } } } }
+
+----------------------------------------------------------------------
+-- Shortcut: "local match function f $cases end" translates to:
+-- "local function f($args) match $args with $cases end end"
+----------------------------------------------------------------------
+mlp.stat:get'local'[2]:add{
+ 'match', 'function', mlp.expr, gg.optkeyword '|',
+ match_cases_list_parser, 'end',
+ builder = named_match_function_builder 'Localrec' }
+
+----------------------------------------------------------------------
+-- "match...with" expressions and "match function..."
+----------------------------------------------------------------------
+mlp.expr:add{ 'match', builder = |x| x[1], gg.multisequence{
+
+ ----------------------------------------------------------------
+ -- Anonymous match functions:
+ -- "function ($1) match $1 with $2 end end" can be written:
+ -- "match function $2 end"
+ ----------------------------------------------------------------
+ { 'function', gg.optkeyword '|',
+ match_cases_list_parser,
+ 'end',
+ builder = function(x)
+ local _, cases = unpack(x)
+ local v = mlp.gensym()
+ local body = match_builder{v, cases}
+ return `Function{ {v}, {body} }
+ end },
+
+ ----------------------------------------------------------------
+ -- match expressions: you can put a match where an expression
+ -- is expected. The case bodies are then expected to be
+ -- expressions, not blocks.
+ ----------------------------------------------------------------
+ default = gg.sequence{
+ mlp.expr_list, 'with', gg.optkeyword '|',
+ gg.list{ name = "match cases list",
+ gg.sequence{ name = "match expr case",
+ gg.list{ name = "match expr case patterns list",
+ primary = mlp.expr_list,
+ separators = "|",
+ terminators = { "->", "if" } },
+ gg.onkeyword{ "if", mlp.expr, consume = true },
+ "->",
+ mlp.expr }, -- Notice: expression, not block!
+ separators = "|" },
+ -- Notice: no "end" keyword!
+ builder = function (x)
+ local tested_term_seq, _, cases = unpack(x)
+ local v = mlp.gensym 'match_expr'
+ -- Replace expressions with blocks
+ for _, case in ipairs (cases) do
+ local body = case[3]
+ case[3] = { `Set{ {v}, {body} } }
+ end
+ local m = match_builder { tested_term_seq, cases }
+ return `Stat{ { `Local{{v}}; m }, v }
+ end } } }
+
+function bind (x)
+ local patterns, values = unpack(x)
+
+ -------------------------------------------------------------------
+ -- Generate pattern code: "bind vars = vals" translates to:
+ -- do
+ -- pattern matching code, goto 'fail' on mismatch
+ -- goto 'success'
+ -- label 'fail': error "..."
+ -- label success
+ -- end
+ -- vars is the set of variables used by the pattern
+ -------------------------------------------------------------------
+ local code, vars do
+ local match_cfg = {
+ on_failure = mlp.gensym 'mismatch' [1],
+ locals = { },
+ code = { } }
+ pattern_seq_builder(patterns, values, match_cfg)
+ local on_success = mlp.gensym 'on_success' [1]
+ code = {
+ match_cfg.code;
+ `Goto{ on_success };
+ `Label{ match_cfg.on_failure };
+ +{error "bind error"};
+ `Label{ on_success } }
+ vars = match_cfg.locals
+ end
+
+ -------------------------------------------------------------------
+ -- variables that actually appear in the pattern:
+ -------------------------------------------------------------------
+ local vars_in_pattern do
+ vars_in_pattern = { }
+ local walk_cfg = { id = { } }
+ function walk_cfg.id.free(v) vars_in_pattern[v[1]]=true end
+ walk_id.expr_list(walk_cfg, patterns)
+ end
+
+ -------------------------------------------------------------------
+ -- temp variables that are generated for destructuring,
+ -- but aren't explicitly typed by the user. These must be made
+ -- local.
+ -------------------------------------------------------------------
+ local vars_not_in_pattern do
+ vars_not_in_pattern = { }
+ for k, _ in pairs(vars) do
+ if not vars_in_pattern[k] then
+ vars_not_in_pattern[k] = true
+ end
+ end
+ end
+
+ -------------------------------------------------------------------
+ -- Declare the temp variables as local to the statement.
+ -------------------------------------------------------------------
+ if next(vars_not_in_pattern) then
+ local loc = { }
+ for k, _ in pairs(vars_not_in_pattern) do
+ table.insert (loc, `Id{k})
+ end
+ table.insert (code, 1, `Local{ loc, { } })
+ end
+
+ -------------------------------------------------------------------
+ -- Transform the set of pattern variable names into a list of `Id{}
+ -------------------------------------------------------------------
+ local decl_list do
+ decl_list = { }
+ for k, _ in pairs(vars_in_pattern) do
+ table.insert (decl_list, `Id{k})
+ end
+ end
+
+ return code, decl_list
+end
+
+function local_bind(x)
+ local code, vars = bind (x)
+ return { `Local{ vars, { } }; code }
+end
+
+function non_local_bind(x)
+ local code, _ = bind (x)
+ code.tag = 'Do'
+ return code
+end
+
+----------------------------------------------------------------------
+-- Syntax front-end
+----------------------------------------------------------------------
+mlp.lexer:add 'bind'
+
+----------------------------------------------------------------------
+-- bind patterns = vars
+----------------------------------------------------------------------
+mlp.stat:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
+ builder = non_local_bind }
+
+----------------------------------------------------------------------
+-- local bind patterns = vars
+-- Some monkey-patching of "local ..." must take place
+----------------------------------------------------------------------
+mlp.stat:get'local'[2]:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
+ builder = local_bind }
projects / metalua.git / blobdiff