src/lib/metalua/extension/clist.mlua

   1 ----------------------------------------------------------------------
   2 -- Metalua samples:  $Id$
   3 --
   4 -- Summary: Lists by comprehension
   5 --
   6 ----------------------------------------------------------------------
   7 --
   8 -- Copyright (c) 2006-2007, Fabien Fleutot <metalua@gmail.com>.
   9 --
  10 -- This software is released under the MIT Licence, see licence.txt
  11 -- for details.
  12 --
  13 --------------------------------------------------------------------------------
  14 --
  15 -- This extension implements list comprehensions, similar to Haskell and
  16 -- Python syntax, to easily describe lists.
  17 --
  18 --------------------------------------------------------------------------------
  19
  20 -{ extension "match" }
  21
  22 local function dots_builder (x) return `Dots{ x } end
  23
  24 local function for_builder (x, h)
  25    match x with
  26    | `Comp{ _, acc } -> table.insert (acc, h[1]); return x
  27    | `Pair{ _, _ }   -> error "No explicit key in a for list generator"
  28    |  _              -> return `Comp{ x, {h[1]} }
  29    end
  30 end
  31
  32 local function if_builder (x, p)
  33    match x with
  34    | `Comp{ _, acc } -> table.insert (acc, `If{ p[1] }); return x
  35    | `Pair{ _, _ }   -> error "No explicit key in a list guard"
  36    |  _              -> return `Comp{ x, p[1] }
  37    end
  38 end
  39
  40 local function comp_builder(core, list, no_unpack)
  41    -- [ti] = temp var holding table.insert
  42    -- [v]  = variable holding the table being built
  43    -- [r]  = the core of the list being built
  44    local ti, v, r = mlp.gensym "table_insert", mlp.gensym "table"
  45
  46    -----------------------------------------------------------------------------
  47    -- 1 - Build the loop's core: if it has suffix "...", every elements of the
  48    --     multi-return must be inserted, hence the extra [for] loop.
  49    -----------------------------------------------------------------------------
  50    match core with
  51    | `Dots{ x } ->
  52       local w = mlp.gensym()
  53       r = +{stat: for -{w} in values( -{x} ) do -{ `Call{ ti, v, w } } end }
  54    | `Pair{ k, w } ->
  55       r = `Set{ { `Index{ v, k } }, { w } }
  56    |  _ -> r = `Call{ ti, v, core }
  57    end
  58
  59    -----------------------------------------------------------------------------
  60    -- 2 - Stack the if and for control structures, from outside to inside.
  61    --     This is done in a destructive way for the elements of [list].
  62    -----------------------------------------------------------------------------
  63    for i = #list, 1, -1 do
  64       table.insert (list[i], {r})
  65       r = list[i]
  66    end
  67    if no_unpack then
  68       return `Stat{ { `Local{ {ti, v}, { +{table.insert}, `Table} }, r }, v }
  69    else
  70       return +{ function()
  71                    local -{ti}, -{v} = table.insert, { }
  72                    -{r}; return unpack(-{v})
  73                 end () }
  74    end
  75 end
  76
  77 local function table_content_builder (list)
  78    match list with
  79    | { `Comp{ y, acc } } -> return comp_builder( y, acc, "no unpack")
  80    | _ ->
  81       local tables = { `Table }
  82       local ctable = tables[1]
  83       local function flush() ctable=`Table; table.insert(tables, ctable) end
  84       for x in values(list) do
  85          match x with
  86          | `Comp{ y, acc } -> table.insert(ctable, comp_builder(y, acc)); flush()
  87          | `Dots{ y }      -> table.insert(ctable, y); flush()
  88          |  _              -> table.insert (ctable, x);
  89          end
  90       end
  91       match tables with
  92       | { x } | { x, { } } -> return x
  93       | _ ->
  94          if #tables[#tables]==0 then table.remove(tables) end --suppress empty table
  95          return `Call{ +{table.cat}, unpack(tables) }
  96       end
  97    end
  98 end
  99
 100 mlp.table_field = gg.expr{ name="table cell",
 101    primary = mlp.table_field,
 102    suffix  = { name="table cell suffix",
 103       { "...",                 builder = dots_builder },
 104       { "for", mlp.for_header, builder = for_builder  },
 105       { "if",  mlp.expr,       builder = if_builder   } } }
 106
 107 mlp.table_content.builder = table_content_builder
 108
 109 --[[
 110 mlp.stat:add{ "for", gg.expr {
 111       primary = for_header,
 112       suffix = {
 113          { "for", mlp.for_header, builder = for_builder  },
 114          { "if",  mlp.expr,       builder = if_builder   } } },
 115    "do", mlp.block, "end", builder = for_stat_builder }
 116 --]]
 117
 118 --------------------------------------------------------------------------------
 119 -- Back-end for improved index operator.
 120 --------------------------------------------------------------------------------
 121 local function index_builder(a, suffix)
 122    match suffix[1] with
 123    -- Single index, no range: keep the native semantics
 124    | { { e, false } } -> return `Index{ a, e }
 125    -- Either a range, or multiple indexes, or both
 126    | ranges ->
 127       local r = `Call{ +{table.isub}, a }
 128       local function acc (x,y) table.insert (r,x); table.insert (r,y) end
 129       for seq in ivalues (ranges) do
 130          match seq with
 131          | { e, false } -> acc(e,e)
 132          | { e, f }     -> acc(e,f)
 133          end
 134       end
 135       return r
 136    end
 137 end
 138
 139 --------------------------------------------------------------------------------
 140 -- Improved "[...]" index operator:
 141 --  * support for multi-indexes ("foo[bar, gnat]")
 142 --  * support for ranges ("foo[bar ... gnat]")
 143 --------------------------------------------------------------------------------
 144 mlp.expr.suffix:del '['
 145 mlp.expr.suffix:add{ name="table index/range",
 146    "[", gg.list{
 147       gg.sequence { mlp.expr, gg.onkeyword{ "...", mlp.expr } } ,
 148       separators = { ",", ";" } },
 149    "]", builder = index_builder }