src/lib/metalua/extension/xmatch.mlua

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