rufus-lua-win 5.1.5

data/vendor/lua/lib/lua/metalua/extension/withdo.mlua

@@ -0,0 +1,30 @@
+-- RAII in metalua.
+--
+-- Write:
+-- with var_1, var_2... = val_1, val_2... do
+--    ...
+-- end
+--
+-- will assign val_n to var_n foreach n, and guaranty that var_n:close() will be called,
+-- no matter what, even if the body causes an error, even if it returns, even
+-- if another :close() call causes an error, etc. No. Matter. What.
+
+require 'metalua.extension.trycatch'
+
+function withdo_builder (x)
+   local names, vals, body = unpack(x)
+   for i = #names, 1, -1 do
+      local name, val = names[i], vals[i]
+      body = trycatch_builder{ { `Set{ {name}, {val} }, body }, -- try-block
+                               { }, -- catch-block
+                               { +{ print ("closing "..-{`String{name[1]}}) },
+                                 `Invoke{ name, `String "close" } } }
+   end
+   table.insert(body, 1, `Local{ names })
+   return body
+end
+
+mlp.lexer:add 'with'
+mlp.stat:add{
+   'with', mlp.id_list, '=', mlp.expr_list, 'do', mlp.block, 'end',
+   builder = withdo_builder }

data/vendor/lua/lib/lua/metalua/extension/xglobal-runtime.lua

@@ -0,0 +1,41 @@
+local _G = getfenv()
+local _G_mt = getmetatable(_G)
+
+
+-- Set the __globals metafield in the global environment's metatable,
+-- if not already there.
+if _G_mt then
+   if _G_mt.__globals then return else
+      print( "Warning: _G already has a metatable,"..
+            " which might interfere with xglobals")
+      _G_mt.__globals = { } 
+   end
+else 
+   _G_mt = { __globals = { } }
+   setmetatable(_G, _G_mt)
+end
+
+-- add a series of variable names to the list of declared globals
+function _G_mt.__newglobal(...)
+   local g = _G_mt.__globals
+   for v in ivalues{...} do g[v]=true end
+end
+
+-- Try to set a global that's not in _G:
+-- if it isn't declared, fail
+function _G_mt.__newindex(_G, var, val)
+   if not _G_mt.__globals[var] then
+      error ("Setting undeclared global variable "..var)
+   end
+   rawset(_G, var, val)
+end
+
+-- Try to read a global that's not in _G:
+-- if it isn't declared, fail
+function _G_mt.__index(_G, var)
+   if not _G_mt.__globals[var] then 
+      error ("Reading undeclared global variable "..var) 
+   end
+   return nil
+end
+

data/vendor/lua/lib/lua/metalua/extension/xglobal.mlua

@@ -0,0 +1,20 @@
+-- WARNING, this is undertested, especially in cases where mutliple
+-- modules have their own fenvs. Use at your own risks.
+
+require 'strict'
+
+local function decl_builder(x)
+   local ids, vals = unpack(x)
+   local ids_as_strings = table.imap(|x| `String{x[1]}, ids)
+   local decl = `Call{ +{getmetatable(getfenv()).__newglobal},
+                       unpack(ids_as_strings) }
+   if vals then return { decl, `Set{ ids, vals } }
+   else return decl end
+end
+
+mlp.lexer:add 'global'
+mlp.stat:add{ 
+   'global', mlp.id_list, gg.onkeyword{ '=', mlp.expr_list },
+   builder = decl_builder }
+
+return +{ require (-{ `String{ package.metalua_extension_prefix .. 'xglobal-runtime' } }) }

data/vendor/lua/lib/lua/metalua/extension/xloop.mlua

@@ -0,0 +1,100 @@
+-{ extension 'match' }
+-{ extension 'log' }
+
+require 'metalua.walk'
+
+----------------------------------------------------------------------
+-- Back-end:
+----------------------------------------------------------------------
+
+-- Parse additional elements in a loop
+loop_element = gg.multisequence{
+   { 'while',  mlp.expr, builder = |x| `Until{ `Op{ 'not', x[1] } } },
+   { 'until',  mlp.expr, builder = |x| `Until{ x[1] } },
+   { 'if',     mlp.expr, builder = |x| `If{ x[1] } },
+   { 'unless', mlp.expr, builder = |x| `If{ `Op{ 'not', x[1] } } },
+   { 'for',    mlp.for_header, builder = |x| x[1] } }
+
+-- Recompose the loop
+function xloop_builder(x)
+   local first, elements, body = unpack(x)
+
+   -------------------------------------------------------------------
+   -- If it's a regular loop, don't bloat the code
+   -------------------------------------------------------------------
+   if not next(elements) then
+      table.insert(first, body)
+      return first
+   end
+
+   -------------------------------------------------------------------
+   -- There's no reason to treat the first element in a special way
+   -------------------------------------------------------------------
+   table.insert(elements, 1, first)
+
+   -------------------------------------------------------------------
+   -- if a header or a break must be able to exit the loops, ti will
+   -- set exit_label and use it (a regular break wouldn't be enough,
+   -- as it couldn't escape several nested loops.)
+   -------------------------------------------------------------------
+   local exit_label
+   local function exit()
+      if not exit_label then exit_label = mlp.gensym 'break' [1] end
+      return `Goto{ exit_label }
+   end
+
+   -------------------------------------------------------------------
+   -- Compile all headers elements, from last to first
+   -------------------------------------------------------------------
+   for i = #elements, 1, -1 do
+      local e = elements[i]
+      match e with
+      | `If{ cond }    ->
+         body = `If{ cond, {body} }
+      | `Until{ cond } ->
+         body = +{stat: if -{cond} then -{exit()} else -{body} end }
+      | `Forin{ ... } | `Fornum{ ... } ->
+         table.insert (e, {body}); body=e
+      end
+   end
+
+   -------------------------------------------------------------------
+   -- Change breaks into gotos that escape all loops at once.
+   -------------------------------------------------------------------
+   local cfg = { stat = { }, expr = { } }
+   function cfg.stat.down(x)
+      match x with
+      | `Break -> x <- exit()
+      | `Forin{ ... } | `Fornum{ ... } | `While{ ... } | `Repeat{ ... } ->
+         return 'break'
+      | _ -> -- pass
+      end
+   end
+   function cfg.expr.down(x) if x.tag=='Function' then return 'break' end end
+   walk.stat(cfg, body)
+
+   if exit_label then body = { body, `Label{ exit_label } } end
+   return body
+end
+
+----------------------------------------------------------------------
+-- Front-end:
+----------------------------------------------------------------------
+
+mlp.lexer:add 'unless'
+mlp.stat:del  'for'
+mlp.stat:del  'while'
+
+loop_element_list = gg.list{ loop_element, terminators='do' }
+
+mlp.stat:add{
+   'for', mlp.for_header, loop_element_list, 'do', mlp.block, 'end',
+   builder = xloop_builder }
+
+mlp.stat:add{
+   'while', mlp.expr, loop_element_list, 'do', mlp.block, 'end',
+   builder = |x| xloop_builder{ `While{x[1]}, x[2], x[3] } }
+
+mlp.stat:add{
+   'unless', mlp.expr, 'then', mlp.block, 'end',
+   builder = |x| +{stat: if not -{x[1]} then -{x[2]} end} }

data/vendor/lua/lib/lua/metalua/extension/xmatch.mlua

@@ -0,0 +1,216 @@
+
+require 'metalua.extension.match'
+
+module ('spmatch', package.seeall)
+
+require 'metalua.walk.id'
+
+-{extension 'log'}
+
+----------------------------------------------------------------------
+-- Back-end for statements
+-- "match function ..." and "local match function...".
+-- Tag must be either "Localrec" or "Set".
+----------------------------------------------------------------------
+named_match_function_builder = |tag| function (x)
+   local func_name, _, cases = unpack(x)
+   local arity = #cases[1][1][1]
+   if arity==0 then
+      error "There must be at least 1 case in match function"
+   end
+   local args = { }
+   for i=1, arity do args[i] = mlp.gensym("arg."..i) end
+   local body = match_builder{args, cases}
+   return { tag=tag, {func_name}, { `Function{ args, {body} } } }
+end
+
+-- Get rid of the former parser, it will be blended in a multiseq:
+mlp.stat:del 'match'
+
+----------------------------------------------------------------------
+-- "match function", "match ... with"
+----------------------------------------------------------------------
+mlp.stat:add{ 'match',
+   gg.multisequence{
+
+      ----------------------------------------------------------------
+      -- Shortcut for declaration of functions containing only a match:
+      -- "function f($1) match $1 with $2 end end" can be written:
+      -- "match function f $2 end"
+      ----------------------------------------------------------------
+      { 'function', mlp.expr, gg.optkeyword '|',
+         match_cases_list_parser, 'end',
+         builder = named_match_function_builder 'Set' },
+
+      ----------------------------------------------------------------
+      -- Reintroduce the original match statement:
+      ----------------------------------------------------------------
+      default = gg.sequence{
+         mlp.expr_list, 'with', gg.optkeyword '|',
+         match_cases_list_parser, 'end',
+         builder = |x| match_builder{ x[1], x[3] } } } }
+
+----------------------------------------------------------------------
+-- Shortcut: "local match function f $cases end" translates to:
+-- "local function f($args) match $args with $cases end end"
+----------------------------------------------------------------------
+mlp.stat:get'local'[2]:add{
+   'match', 'function', mlp.expr, gg.optkeyword '|',
+   match_cases_list_parser, 'end',
+   builder = named_match_function_builder 'Localrec' }
+
+----------------------------------------------------------------------
+-- "match...with" expressions and "match function..."
+----------------------------------------------------------------------
+mlp.expr:add{ 'match', builder = |x| x[1], gg.multisequence{
+
+      ----------------------------------------------------------------
+      -- Anonymous match functions:
+      -- "function ($1) match $1 with $2 end end" can be written:
+      -- "match function $2 end"
+      ----------------------------------------------------------------
+      { 'function', gg.optkeyword '|',
+         match_cases_list_parser,
+         'end',
+         builder = function(x)
+            local _, cases = unpack(x)
+            local v        = mlp.gensym()
+            local body     = match_builder{v, cases}
+            return `Function{ {v}, {body} }
+         end },
+
+      ----------------------------------------------------------------
+      -- match expressions: you can put a match where an expression
+      -- is expected. The case bodies are then expected to be
+      -- expressions, not blocks.
+      ----------------------------------------------------------------
+      default = gg.sequence{
+         mlp.expr_list, 'with', gg.optkeyword '|',
+         gg.list{  name = "match cases list",
+            gg.sequence{ name = "match expr case",
+               gg.list{ name  = "match expr case patterns list",
+                  primary     = mlp.expr_list,
+                  separators  = "|",
+                  terminators = { "->", "if" } },
+               gg.onkeyword{ "if", mlp.expr, consume = true },
+               "->",
+               mlp.expr }, -- Notice: expression, not block!
+            separators  = "|" },
+         -- Notice: no "end" keyword!
+         builder = function (x)
+            local tested_term_seq, _, cases = unpack(x)
+            local v = mlp.gensym 'match_expr'
+            -- Replace expressions with blocks
+            for case in ivalues (cases) do
+               local body = case[3]
+               case[3] = { `Set{ {v}, {body} } }
+            end
+            local m = match_builder { tested_term_seq, cases }
+            return `Stat{ { `Local{{v}}; m }, v }
+         end } } }
+
+function bind (x)
+   local patterns, values = unpack(x)
+
+   -------------------------------------------------------------------
+   -- Generate pattern code: "bind vars = vals" translates to:
+   -- do
+   --   pattern matching code, goto 'fail' on mismatch
+   --   goto 'success'
+   --   label 'fail': error "..."
+   --   label success
+   -- end
+   -- vars is the set of variables used by the pattern
+   -------------------------------------------------------------------
+   local code, vars do
+      local match_cfg = {
+         on_failure = mlp.gensym 'mismatch' [1],
+         locals = { },
+         code = { } }
+      pattern_seq_builder(patterns, values, match_cfg)
+      local on_success = mlp.gensym 'on_success' [1]
+      code = {
+         match_cfg.code;
+         `Goto{ on_success };
+         `Label{ match_cfg.on_failure };
+         +{error "bind error"};
+         `Label{ on_success } }
+      vars = match_cfg.locals
+   end
+
+   -------------------------------------------------------------------
+   -- variables that actually appear in the pattern:
+   -------------------------------------------------------------------
+   local vars_in_pattern do
+      vars_in_pattern = { }
+      local walk_cfg = { id = { } }
+      function walk_cfg.id.free(v) vars_in_pattern[v[1]]=true end
+      walk_id.expr_list(walk_cfg, patterns)
+   end
+
+   -------------------------------------------------------------------
+   -- temp variables that are generated for destructuring,
+   -- but aren't explicitly typed by the user. These must be made
+   -- local.
+   -------------------------------------------------------------------
+   local vars_not_in_pattern do
+      vars_not_in_pattern = { }
+      for k in keys(vars) do
+         if not vars_in_pattern[k] then
+            vars_not_in_pattern[k] = true
+         end
+      end
+   end
+
+   -------------------------------------------------------------------
+   -- Declare the temp variables as local to the statement.
+   -------------------------------------------------------------------
+   if next(vars_not_in_pattern) then
+      local loc = { }
+      for k in keys (vars_not_in_pattern) do
+         table.insert (loc, `Id{k})
+      end
+      table.insert (code, 1, `Local{ loc, { } })
+   end
+
+   -------------------------------------------------------------------
+   -- Transform the set of pattern variable names into a list of `Id{}
+   -------------------------------------------------------------------
+   local decl_list do
+      decl_list = { }
+      for k in keys (vars_in_pattern) do
+         table.insert (decl_list, `Id{k})
+      end
+   end
+
+   return code, decl_list
+end
+
+function local_bind(x)
+   local code, vars = bind (x)
+   return { `Local{ vars, { } }; code }
+end
+
+function non_local_bind(x)
+   local code, _ = bind (x)
+   code.tag = 'Do'
+   return code
+end
+
+----------------------------------------------------------------------
+-- Syntax front-end
+----------------------------------------------------------------------
+mlp.lexer:add 'bind'
+
+----------------------------------------------------------------------
+-- bind patterns = vars
+----------------------------------------------------------------------
+mlp.stat:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
+   builder = non_local_bind }
+
+----------------------------------------------------------------------
+-- local bind patterns = vars
+-- Some monkey-patching of "local ..." must take place
+----------------------------------------------------------------------
+mlp.stat:get'local'[2]:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
+   builder = local_bind }

data/vendor/lua/lib/lua/metalua/metaloop.mlua

@@ -0,0 +1,76 @@
+require 'metalua.compiler'
+
+module ('metaloop', package.seeall)
+
+PRINT_AST  = true
+LINE_WIDTH = 60
+PROMPT     = "M> "
+PROMPT2    = ">> "
+
+do -- set readline() to a line reader, either editline otr a default
+   local status, _ = pcall(require, 'editline')
+   if status then
+      local rl_handle = editline.init 'metalua'
+      readline = |p| rl_handle:read(p) 
+   else
+      function readline (p)
+         io.write (p)
+         io.flush ()
+         return io.read '*l'
+      end
+   end
+end
+
+function reached_eof(lx, msg)
+   return lx:peek().tag=='Eof' or msg:find "token `Eof"
+end
+
+printf ("Metalua, interactive REPLoop.\n"..
+        "(c) 2006-2008 <metalua@gmail.com>")
+
+function run()
+   local lines = { }
+   while true do
+      local src, lx, ast, f, results, success
+      repeat
+         local line = readline(next(lines) and PROMPT2 or PROMPT)
+         if not line then print(); os.exit(0) end -- line==nil iff eof on stdin
+         if not next(lines) then
+            line = line:gsub('^%s*=', 'return ')
+         end
+         table.insert(lines, line)
+         src = table.concat (lines, "\n")
+      until #line>0
+      
+      lx  = mlc.lexstream_of_luastring(src) 
+      success, ast = pcall(mlc.ast_of_lexstream, lx)
+      if success then
+         success, f = pcall(mlc.function_of_ast, ast, '=stdin')
+         if success then
+            results = { pcall(f) }
+            success = table.remove (results, 1)
+            if success then
+               -- Success!
+               table.iforeach(|x| table.print(x, LINE_WIDTH), results)
+               lines = { }
+            else
+               print "Evaluation error:"
+               print (results[1])
+               lines = { }
+            end
+         else
+            print "Can't compile into bytecode:"
+            print (f)
+            lines = { }
+         end
+      else
+         -- If lx has been read entirely, try to read another
+         -- line before failing.
+         if not reached_eof(lx, ast) then
+            print "Can't compile source into AST:"
+            print (ast)
+            lines = { } 
+         end
+      end
+   end
+end