metalua/extension/xmatch.mlua

   1 -------------------------------------------------------------------------------
   2 -- Copyright (c) 2006-2013 Fabien Fleutot and others.
   3 --
   4 -- All rights reserved.
   5 --
   6 -- This program and the accompanying materials are made available
   7 -- under the terms of the Eclipse Public License v1.0 which
   8 -- accompanies this distribution, and is available at
   9 -- http://www.eclipse.org/legal/epl-v10.html
  10 --
  11 -- This program and the accompanying materials are also made available
  12 -- under the terms of the MIT public license which accompanies this
  13 -- distribution, and is available at http://www.lua.org/license.html
  14 --
  15 -- Contributors:
  16 --     Fabien Fleutot - API and implementation
  17 --
  18 -------------------------------------------------------------------------------
  19
  20 require 'metalua.extension.match'
  21
  22 module ('spmatch', package.seeall)
  23
  24 require 'metalua.walk.id'
  25
  26 ----------------------------------------------------------------------
  27 -- Back-end for statements
  28 -- "match function ..." and "local match function...".
  29 -- Tag must be either "Localrec" or "Set".
  30 ----------------------------------------------------------------------
  31 named_match_function_builder = |tag| function (x)
  32    local func_name, _, cases = unpack(x)
  33    local arity = #cases[1][1][1]
  34    if arity==0 then
  35       error "There must be at least 1 case in match function"
  36    end
  37    local args = { }
  38    for i=1, arity do args[i] = mlp.gensym("arg."..i) end
  39    local body = match_builder{args, cases}
  40    return { tag=tag, {func_name}, { `Function{ args, {body} } } }
  41 end
  42
  43 -- Get rid of the former parser, it will be blended in a multiseq:
  44 mlp.stat:del 'match'
  45
  46 ----------------------------------------------------------------------
  47 -- "match function", "match ... with"
  48 ----------------------------------------------------------------------
  49 mlp.stat:add{ 'match',
  50    gg.multisequence{
  51
  52       ----------------------------------------------------------------
  53       -- Shortcut for declaration of functions containing only a match:
  54       -- "function f($1) match $1 with $2 end end" can be written:
  55       -- "match function f $2 end"
  56       ----------------------------------------------------------------
  57       { 'function', mlp.expr, gg.optkeyword '|',
  58          match_cases_list_parser, 'end',
  59          builder = named_match_function_builder 'Set' },
  60
  61       ----------------------------------------------------------------
  62       -- Reintroduce the original match statement:
  63       ----------------------------------------------------------------
  64       default = gg.sequence{
  65          mlp.expr_list, 'with', gg.optkeyword '|',
  66          match_cases_list_parser, 'end',
  67          builder = |x| match_builder{ x[1], x[3] } } } }
  68
  69 ----------------------------------------------------------------------
  70 -- Shortcut: "local match function f $cases end" translates to:
  71 -- "local function f($args) match $args with $cases end end"
  72 ----------------------------------------------------------------------
  73 mlp.stat:get'local'[2]:add{
  74    'match', 'function', mlp.expr, gg.optkeyword '|',
  75    match_cases_list_parser, 'end',
  76    builder = named_match_function_builder 'Localrec' }
  77
  78 ----------------------------------------------------------------------
  79 -- "match...with" expressions and "match function..."
  80 ----------------------------------------------------------------------
  81 mlp.expr:add{ 'match', builder = |x| x[1], gg.multisequence{
  82
  83       ----------------------------------------------------------------
  84       -- Anonymous match functions:
  85       -- "function ($1) match $1 with $2 end end" can be written:
  86       -- "match function $2 end"
  87       ----------------------------------------------------------------
  88       { 'function', gg.optkeyword '|',
  89          match_cases_list_parser,
  90          'end',
  91          builder = function(x)
  92             local _, cases = unpack(x)
  93             local v        = mlp.gensym()
  94             local body     = match_builder{v, cases}
  95             return `Function{ {v}, {body} }
  96          end },
  97
  98       ----------------------------------------------------------------
  99       -- match expressions: you can put a match where an expression
 100       -- is expected. The case bodies are then expected to be
 101       -- expressions, not blocks.
 102       ----------------------------------------------------------------
 103       default = gg.sequence{
 104          mlp.expr_list, 'with', gg.optkeyword '|',
 105          gg.list{  name = "match cases list",
 106             gg.sequence{ name = "match expr case",
 107                gg.list{ name  = "match expr case patterns list",
 108                   primary     = mlp.expr_list,
 109                   separators  = "|",
 110                   terminators = { "->", "if" } },
 111                gg.onkeyword{ "if", mlp.expr, consume = true },
 112                "->",
 113                mlp.expr }, -- Notice: expression, not block!
 114             separators  = "|" },
 115          -- Notice: no "end" keyword!
 116          builder = function (x)
 117             local tested_term_seq, _, cases = unpack(x)
 118             local v = mlp.gensym 'match_expr'
 119             -- Replace expressions with blocks
 120             for _, case in ipairs (cases) do
 121                local body = case[3]
 122                case[3] = { `Set{ {v}, {body} } }
 123             end
 124             local m = match_builder { tested_term_seq, cases }
 125             return `Stat{ { `Local{{v}}; m }, v }
 126          end } } }
 127
 128 function bind (x)
 129    local patterns, values = unpack(x)
 130
 131    -------------------------------------------------------------------
 132    -- Generate pattern code: "bind vars = vals" translates to:
 133    -- do
 134    --   pattern matching code, goto 'fail' on mismatch
 135    --   goto 'success'
 136    --   label 'fail': error "..."
 137    --   label success
 138    -- end
 139    -- vars is the set of variables used by the pattern
 140    -------------------------------------------------------------------
 141    local code, vars do
 142       local match_cfg = {
 143          on_failure = mlp.gensym 'mismatch' [1],
 144          locals = { },
 145          code = { } }
 146       pattern_seq_builder(patterns, values, match_cfg)
 147       local on_success = mlp.gensym 'on_success' [1]
 148       code = {
 149          match_cfg.code;
 150          `Goto{ on_success };
 151          `Label{ match_cfg.on_failure };
 152          +{error "bind error"};
 153          `Label{ on_success } }
 154       vars = match_cfg.locals
 155    end
 156
 157    -------------------------------------------------------------------
 158    -- variables that actually appear in the pattern:
 159    -------------------------------------------------------------------
 160    local vars_in_pattern do
 161       vars_in_pattern = { }
 162       local walk_cfg = { id = { } }
 163       function walk_cfg.id.free(v) vars_in_pattern[v[1]]=true end
 164       walk_id.expr_list(walk_cfg, patterns)
 165    end
 166
 167    -------------------------------------------------------------------
 168    -- temp variables that are generated for destructuring,
 169    -- but aren't explicitly typed by the user. These must be made
 170    -- local.
 171    -------------------------------------------------------------------
 172    local vars_not_in_pattern do
 173       vars_not_in_pattern = { }
 174       for k, _ in pairs(vars) do
 175          if not vars_in_pattern[k] then
 176             vars_not_in_pattern[k] = true
 177          end
 178       end
 179    end
 180
 181    -------------------------------------------------------------------
 182    -- Declare the temp variables as local to the statement.
 183    -------------------------------------------------------------------
 184    if next(vars_not_in_pattern) then
 185       local loc = { }
 186       for k, _ in pairs(vars_not_in_pattern) do
 187          table.insert (loc, `Id{k})
 188       end
 189       table.insert (code, 1, `Local{ loc, { } })
 190    end
 191
 192    -------------------------------------------------------------------
 193    -- Transform the set of pattern variable names into a list of `Id{}
 194    -------------------------------------------------------------------
 195    local decl_list do
 196       decl_list = { }
 197       for k, _ in pairs(vars_in_pattern) do
 198          table.insert (decl_list, `Id{k})
 199       end
 200    end
 201
 202    return code, decl_list
 203 end
 204
 205 function local_bind(x)
 206    local code, vars = bind (x)
 207    return { `Local{ vars, { } }; code }
 208 end
 209
 210 function non_local_bind(x)
 211    local code, _ = bind (x)
 212    code.tag = 'Do'
 213    return code
 214 end
 215
 216 ----------------------------------------------------------------------
 217 -- Syntax front-end
 218 ----------------------------------------------------------------------
 219 mlp.lexer:add 'bind'
 220
 221 ----------------------------------------------------------------------
 222 -- bind patterns = vars
 223 ----------------------------------------------------------------------
 224 mlp.stat:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
 225    builder = non_local_bind }
 226
 227 ----------------------------------------------------------------------
 228 -- local bind patterns = vars
 229 -- Some monkey-patching of "local ..." must take place
 230 ----------------------------------------------------------------------
 231 mlp.stat:get'local'[2]:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
 232    builder = local_bind }