src/lib/metalua/extension/xmatch.mlua

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