From: Fabien Fleutot <fabien@MacFabien.home>
Date: Thu, 25 Dec 2008 18:36:47 +0000 (+0100)
Subject: ... now captures what it matches in patterns, and can be used to render it on the... 
X-Git-Url: https://git.lizzy.rs/?a=commitdiff_plain;h=6f03a859ea1a5e797b4e5acbe30e6357e8327ade;p=metalua.git

... now captures what it matches in patterns, and can be used to render it on the RHS of a case
---

diff --git a/src/lib/metalua/extension/match.mlua b/src/lib/metalua/extension/match.mlua
index fbc032c..72e5f71 100644
--- a/src/lib/metalua/extension/match.mlua
+++ b/src/lib/metalua/extension/match.mlua
@@ -73,6 +73,29 @@
 
 module ('spmatch', package.seeall)
 
+----------------------------------------------------------------------
+-- This would have been best done through library 'metalua.walk',
+-- but walk depends on match, so we have to break the dependency.
+-- It replaces all instances of `...' in `ast' with `term', unless
+-- it appears in a function.
+----------------------------------------------------------------------
+function replace_dots (ast, term)
+   local function rec (x)
+      if type(x) == 'table' then
+         if x.tag=='Dots' then 
+            if term=='ambiguous' then
+               error ("You can't use `...' on the right of a match case when it appears "..
+                      "more than once on the left")
+            else 
+               x <- term
+            end
+         elseif x.tag=='Function' then return
+         else for y in ivalues (x) do rec (y) end end
+      end
+   end
+   return rec (ast)
+end
+
 tmpvar_base = mlp.gensym 'submatch.' [1]
 function next_tmpvar(cfg)
    assert (cfg.ntmp, "No cfg.ntmp imbrication level in the match compiler")
@@ -197,7 +220,7 @@ function table_pattern_element_builder (pattern, term, cfg)
             acc_test (+{ -{sub_pattern} == nil }, cfg)
          end
       elseif sub_pattern.tag == "Dots" then
-         -- Remember to suppress arity checking
+         -- Remember where the capture is, and thatt arity checking shouldn't occur
          seen_dots = true
       else
          -- Business as usual:
@@ -207,7 +230,13 @@ function table_pattern_element_builder (pattern, term, cfg)
          -- TODO: restore ntmp?
       end
    end
-   if not seen_dots then -- Check arity
+   if seen_dots then -- remember how to retrieve `...'
+      -- FIXME: check, but there might be cases where the variable -{term} 
+      -- will be overridden in contrieved tables.
+      -- ==> save it now, and clean the setting statement if unused
+      if cfg.dots_replacement then cfg.dots_replacement = 'ambiguous'
+      else cfg.dots_replacement = +{ select (-{`Number{len}}, unpack(-{term})) } end
+   else -- Check arity
       acc_test (+{ #-{term} ~= -{`Number{len}} }, cfg)
    end
 end
@@ -239,6 +268,7 @@ function case_builder (case, term_seq, cfg)
    for i = 1, #patterns_group do
       local pattern_seq = patterns_group[i]
       cfg.on_failure = mlp.gensym 'match_fail' [1]
+      cfg.dots_replacement = false
       pattern_seq_builder (pattern_seq, term_seq, cfg)
       if i<#patterns_group then
          acc_stat (`Goto{on_success}, cfg)
@@ -247,6 +277,10 @@ function case_builder (case, term_seq, cfg)
    end
    acc_stat (`Label{on_success}, cfg)
    if guard then acc_test (+{not -{guard}}, cfg) end
+   if cfg.dots_replacement then
+      eprintf ("Dots replacement required in a match")
+      replace_dots (block, cfg.dots_replacement)
+   end
    block.tag = 'Do'
    acc_stat (block, cfg)
    acc_stat (`Goto{cfg.after_success}, cfg)
@@ -282,9 +316,10 @@ function match_builder (x)
 
    for i=1, #cases do
       local case_cfg = { 
-         after_success = cfg.after_success,
-         code         = `Do{ },
-         locals       = { } }
+         after_success    = cfg.after_success,
+         code             = `Do{ }
+         -- locals    = { } -- unnecessary, done by pattern_seq_builder
+      }
       case_builder (cases[i], term_seq, case_cfg)
       if next (case_cfg.locals) then
          local case_locals = { }
diff --git a/src/lib/metalua/walk/id.mlua b/src/lib/metalua/walk/id.mlua
index 4de5f18..5e457e8 100644
--- a/src/lib/metalua/walk/id.mlua
+++ b/src/lib/metalua/walk/id.mlua
@@ -85,15 +85,16 @@ local function _walk_id (kind, supercfg, ast, ...)
          local r = supercfg.expr.down(x, ...)
          if r then return r end
       end
+      local parents = {...}
       match x with
       | `Id{ name } ->
          local binder, r = scope.current[name] -- binder :: ast which bound var
          if binder then 
             --$log( 'walk.id found a bound var:', x, binder)
-            r = visit_bound_var(x, binder, ...)
+            r = visit_bound_var(x, binder, unpack(parents))
          else 
             --$log( 'walk.id found a free var:', x, scope.current)
-            r = visit_free_var(x, ...) 
+            r = visit_free_var(x, unpack(parents))
          end
          if r then return r end
       | `Function{ params, _ } -> scope:push (params, x)
@@ -105,7 +106,7 @@ local function _walk_id (kind, supercfg, ast, ...)
          -------------------------------------------------------------
          scope:push()
          for stat in values (block) do walk.stat(cfg, stat, x, ...) end 
-         walk.expr(cfg, expr, x, ...)
+         walk.expr(cfg, expr, x, unpack(parents))
          scope:pop()
          return 'break'
       | _ -> -- pass