Initial contribution.
diff --git a/compiler/Makefile b/compiler/Makefile new file mode 100644 index 0000000..2d9d88c --- /dev/null +++ b/compiler/Makefile
@@ -0,0 +1,67 @@ +include ../config + +all: $(LIBRARIES) install metalua + +$(PLATFORM): all + +LUA_RUN = ../$(LUA_VM_DIR)/$(RUN) +LUA_COMPILE = ../$(LUA_VM_DIR)/$(COMPILE) + +LIBRARIES = \ + bytecode.luac \ + mlp.luac \ + mlc.luac + +# Library which compiles an AST into a bytecode string. +BYTECODE_LUA = \ + lopcodes.lua \ + lcode.lua \ + ldump.lua \ + compile.lua + +# Library which compiles source strings into AST +MLP_LUA = \ + lexer.lua \ + gg.lua \ + mlp_lexer.lua \ + mlp_misc.lua \ + mlp_table.lua \ + mlp_meta.lua \ + mlp_expr.lua \ + mlp_stat.lua \ + mlp_ext.lua + +metalua.luac: mlc.luac + +bytecode.luac: $(BYTECODE_LUA) + $(LUA_COMPILE) -o $@ $^ + +mlp.luac: $(MLP_LUA) + $(LUA_COMPILE) -o $@ $^ + +# Plain lua files compilation +%.luac: %.mlua bootstrap.lua mlp.luac bytecode.luac + $(LUA_RUN) bootstrap.lua $< + +# FIXME what's this?! some old stuff from when metalua files hadn't their own +# extensions? +# Metalua files compilation through the bootstrap compiler +%.luac: %.lua + $(LUA_COMPILE) -o $@ bootstrap $< + +# Compiler/interpreter +metalua: metalua.luac install-lib + $(LUA_RUN) metalua.luac --verbose --sharpbang '#!$(TARGET_BIN_PATH)/lua' --output metalua --file metalua.mlua + +install-lib: $(LIBRARIES) + mkdir -p $(TARGET_LUA_PATH)/metalua + cp $(LIBRARIES) $(TARGET_LUA_PATH)/metalua/ + +install: install-lib metalua + mkdir -p $(TARGET_BIN_PATH) + cp metalua $(TARGET_BIN_PATH)/ + +.PHONY: all install + +clean: + -rm *.luac metalua
diff --git a/compiler/compile.lua b/compiler/compile.lua new file mode 100644 index 0000000..fc12ea5 --- /dev/null +++ b/compiler/compile.lua
@@ -0,0 +1,1265 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Kein-Hong Man, Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Kein-Hong Man - Initial implementation for Lua 5.0, part of Yueliang +-- Fabien Fleutot - Port to Lua 5.1, integration with Metalua +-- +------------------------------------------------------------------------------- +---------------------------------------------------------------------- +-- Metalua. +-- +-- Summary: Compile ASTs to Lua 5.1 VM function prototype. +-- Largely based on: +-- +-- * Yueliang (http://luaforge.net/projects/yueliang), +-- yueliang-0.1.2/orig-5.0.2/lparser.lua +-- +-- * Lua 5.1 sources (http://www.lua.org), src/lparser.c +-- +---------------------------------------------------------------------- + +module ("bytecode", package.seeall) + +local debugf = function() end +--local debugf=printf + +local stat = { } +local expr = { } + +MAX_INT = 2147483645 -- INT_MAX-2 for 32-bit systems (llimits.h) +MAXVARS = 200 -- (llimits.h) +MAXUPVALUES = 32 -- (llimits.h) +MAXPARAMS = 100 -- (llimits.h) +LUA_MAXPARSERLEVEL = 200 -- (llimits.h) + +-- from lobject.h +VARARG_HASARG = 1 +VARARG_ISVARARG = 2 +VARARG_NEEDSARG = 4 + +local function hasmultret (k) + return k=="VCALL" or k=="VVARARG" +end + +----------------------------------------------------------------------- +-- Some ASTs take expression lists as children; it should be +-- acceptible to give an expression instead, and to automatically +-- interpret it as a single element list. That's what does this +-- function, adding a surrounding list iff needed. +-- +-- WARNING: "Do" is the tag for chunks, which are essentially lists. +-- Therefore, we don't listify stuffs with a "Do" tag. +----------------------------------------------------------------------- +local function ensure_list (ast) + return ast.tag and ast.tag ~= "Do" and {ast} or ast end + +----------------------------------------------------------------------- +-- Get a localvar structure { varname, startpc, endpc } from a +-- (zero-based) index of active variable. The catch is: don't get +-- confused between local index and active index. +-- +-- locvars[x] contains { varname, startpc, endpc }; +-- actvar[i] contains the index of the variable in locvars +----------------------------------------------------------------------- +local function getlocvar (fs, i) + return fs.f.locvars[fs.actvar[i]] +end + +local function removevars (fs, tolevel) + while fs.nactvar > tolevel do + fs.nactvar = fs.nactvar - 1 + -- There may be dummy locvars due to expr.Stat + -- FIXME: strange that they didn't disappear?! + local locvar = getlocvar (fs, fs.nactvar) + --printf("[REMOVEVARS] removing var #%i = %s", fs.nactvar, + -- locvar and tostringv(locvar) or "<nil>") + if locvar then locvar.endpc = fs.pc end + end +end + +----------------------------------------------------------------------- +-- [f] has a list of all its local variables, active and inactive. +-- Some local vars can correspond to the same register, if they exist +-- in different scopes. +-- [fs.nlocvars] is the total number of local variables, not to be +-- confused with [fs.nactvar] the numebr of variables active at the +-- current PC. +-- At this stage, the existence of the variable is not yet aknowledged, +-- since [fs.nactvar] and [fs.freereg] aren't updated. +----------------------------------------------------------------------- +local function registerlocalvar (fs, varname) + debugf("[locvar: %s = reg %i]", varname, fs.nlocvars) + local f = fs.f + f.locvars[fs.nlocvars] = { } -- LocVar + f.locvars[fs.nlocvars].varname = varname + local nlocvars = fs.nlocvars + fs.nlocvars = fs.nlocvars + 1 + return nlocvars +end + +----------------------------------------------------------------------- +-- update the active vars counter in [fs] by adding [nvars] of them, +-- and sets those variables' [startpc] to the current [fs.pc]. +-- These variables were allready created, but not yet counted, by +-- new_localvar. +----------------------------------------------------------------------- +local function adjustlocalvars (fs, nvars) + --debugf("adjustlocalvars, nvars=%i, previous fs.nactvar=%i,".. + -- " #locvars=%i, #actvar=%i", + -- nvars, fs.nactvar, #fs.f.locvars, #fs.actvar) + + fs.nactvar = fs.nactvar + nvars + for i = nvars, 1, -1 do + --printf ("adjusting actvar #%i", fs.nactvar - i) + getlocvar (fs, fs.nactvar - i).startpc = fs.pc + end +end + +------------------------------------------------------------------------ +-- check whether, in an assignment to a local variable, the local variable +-- is needed in a previous assignment (to a table). If so, save original +-- local value in a safe place and use this safe copy in the previous +-- assignment. +------------------------------------------------------------------------ +local function check_conflict (fs, lh, v) + local extra = fs.freereg -- eventual position to save local variable + local conflict = false + while lh do + if lh.v.k == "VINDEXED" then + if lh.v.info == v.info then -- conflict? + conflict = true + lh.v.info = extra -- previous assignment will use safe copy + end + if lh.v.aux == v.info then -- conflict? + conflict = true + lh.v.aux = extra -- previous assignment will use safe copy + end + end + lh = lh.prev + end + if conflict then + luaK:codeABC (fs, "OP_MOVE", fs.freereg, v.info, 0) -- make copy + luaK:reserveregs (fs, 1) + end +end + +----------------------------------------------------------------------- +-- Create an expdesc. To be updated when expdesc is lua-ified. +----------------------------------------------------------------------- +local function init_exp (e, k, i) + e.f, e.t, e.k, e.info = luaK.NO_JUMP, luaK.NO_JUMP, k, i end + +----------------------------------------------------------------------- +-- Reserve the string in tthe constant pool, and return an expdesc +-- referring to it. +----------------------------------------------------------------------- +local function codestring (fs, e, str) + --printf( "codestring(%s)", disp.ast(str)) + init_exp (e, "VK", luaK:stringK (fs, str)) +end + +----------------------------------------------------------------------- +-- search for a local variable named [name] in the function being +-- built by [fs]. Doesn't try to visit upvalues. +----------------------------------------------------------------------- +local function searchvar (fs, name) + for i = fs.nactvar - 1, 0, -1 do + -- Because of expr.Stat, there can be some actvars which don't + -- correspond to any locvar. Hence the checking for locvar's + -- nonnilness before getting the varname. + local locvar = getlocvar(fs, i) + if locvar and name == locvar.varname then + --printf("Found local var: %s; i = %i", tostringv(locvar), i) + return i + end + end + return -1 -- not found +end + +----------------------------------------------------------------------- +-- create and return a new proto [f] +----------------------------------------------------------------------- +local function newproto () + local f = {} + f.k = {} + f.sizek = 0 + f.p = {} + f.sizep = 0 + f.code = {} + f.sizecode = 0 + f.sizelineinfo = 0 + f.sizeupvalues = 0 + f.nups = 0 + f.upvalues = {} + f.numparams = 0 + f.is_vararg = 0 + f.maxstacksize = 0 + f.lineinfo = {} + f.sizelocvars = 0 + f.locvars = {} + f.lineDefined = 0 + f.source = nil + return f +end + +------------------------------------------------------------------------ +-- create and return a function state [new_fs] as a sub-funcstate of [fs]. +------------------------------------------------------------------------ +local function open_func (old_fs) + local new_fs = { } + new_fs.upvalues = { } + new_fs.actvar = { } + local f = newproto () + new_fs.f = f + new_fs.prev = old_fs -- linked list of funcstates + new_fs.pc = 0 + new_fs.lasttarget = -1 + new_fs.jpc = luaK.NO_JUMP + new_fs.freereg = 0 + new_fs.nk = 0 + new_fs.h = {} -- constant table; was luaH_new call + new_fs.np = 0 + new_fs.nlocvars = 0 + new_fs.nactvar = 0 + new_fs.bl = nil + new_fs.nestlevel = old_fs and old_fs.nestlevel or 0 + f.maxstacksize = 2 -- registers 0/1 are always valid + new_fs.lastline = 0 + new_fs.forward_gotos = { } + new_fs.labels = { } + return new_fs +end + +------------------------------------------------------------------------ +-- Finish to set up [f] according to final state of [fs] +------------------------------------------------------------------------ +local function close_func (fs) + local f = fs.f + --printf("[CLOSE_FUNC] remove any remaining var") + removevars (fs, 0) + luaK:ret (fs, 0, 0) + f.sizecode = fs.pc + f.sizelineinfo = fs.pc + f.sizek = fs.nk + f.sizep = fs.np + f.sizelocvars = fs.nlocvars + f.sizeupvalues = f.nups + assert (fs.bl == nil) + if next(fs.forward_gotos) then + local x = table.tostring(fs.forward_gotos) + error ("Unresolved goto: "..x) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function pushclosure(fs, func, v) + local f = fs.f + f.p [fs.np] = func.f + fs.np = fs.np + 1 + init_exp (v, "VRELOCABLE", luaK:codeABx (fs, "OP_CLOSURE", 0, fs.np - 1)) + for i = 0, func.f.nups - 1 do + local o = (func.upvalues[i].k == "VLOCAL") and "OP_MOVE" or "OP_GETUPVAL" + luaK:codeABC (fs, o, 0, func.upvalues[i].info, 0) + end +end + +------------------------------------------------------------------------ +-- FIXME: is there a need for f=fs.f? if yes, why not always using it? +------------------------------------------------------------------------ +function indexupvalue(fs, name, v) + local f = fs.f + for i = 0, f.nups - 1 do + if fs.upvalues[i].k == v.k and fs.upvalues[i].info == v.info then + assert(fs.f.upvalues[i] == name) + return i + end + end + -- new one + f.upvalues[f.nups] = name + assert (v.k == "VLOCAL" or v.k == "VUPVAL") + fs.upvalues[f.nups] = { k = v.k; info = v.info } + local nups = f.nups + f.nups = f.nups + 1 + return nups +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function markupval(fs, level) + local bl = fs.bl + while bl and bl.nactvar > level do bl = bl.previous end + if bl then bl.upval = true end +end + + +--for debug only +--[[ +local function bldepth(fs) + local i, x= 1, fs.bl + while x do i=i+1; x=x.previous end + return i +end +--]] + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function enterblock (fs, bl, isbreakable) + bl.breaklist = luaK.NO_JUMP + bl.isbreakable = isbreakable + bl.nactvar = fs.nactvar + bl.upval = false + bl.previous = fs.bl + fs.bl = bl + assert (fs.freereg == fs.nactvar) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function leaveblock (fs) + local bl = fs.bl + fs.bl = bl.previous + --printf("[LEAVEBLOCK] Removing vars...") + removevars (fs, bl.nactvar) + --printf("[LEAVEBLOCK] ...Vars removed") + if bl.upval then + luaK:codeABC (fs, "OP_CLOSE", bl.nactvar, 0, 0) + end + -- a block either controls scope or breaks (never both) + assert (not bl.isbreakable or not bl.upval) + assert (bl.nactvar == fs.nactvar) + fs.freereg = fs.nactvar -- free registers + luaK:patchtohere (fs, bl.breaklist) +end + + +------------------------------------------------------------------------ +-- read a list of expressions from a list of ast [astlist] +-- starts at the [offset]th element of the list (defaults to 1) +------------------------------------------------------------------------ +local function explist(fs, astlist, v, offset) + offset = offset or 1 + if #astlist < offset then error "I don't handle empty expr lists yet" end + --printf("[EXPLIST] about to precompile 1st element %s", disp.ast(astlist[offset])) + expr.expr (fs, astlist[offset], v) + --printf("[EXPLIST] precompiled first element v=%s", tostringv(v)) + for i = offset+1, #astlist do + luaK:exp2nextreg (fs, v) + --printf("[EXPLIST] flushed v=%s", tostringv(v)) + expr.expr (fs, astlist[i], v) + --printf("[EXPLIST] precompiled element v=%s", tostringv(v)) + end + return #astlist - offset + 1 +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function funcargs (fs, ast, v, idx_from) + local args = { } -- expdesc + local nparams + if #ast < idx_from then args.k = "VVOID" else + explist(fs, ast, args, idx_from) + luaK:setmultret(fs, args) + end + assert(v.k == "VNONRELOC") + local base = v.info -- base register for call + if hasmultret(args.k) then nparams = luaK.LUA_MULTRET else -- open call + if args.k ~= "VVOID" then + luaK:exp2nextreg(fs, args) end -- close last argument + nparams = fs.freereg - (base + 1) + end + init_exp(v, "VCALL", luaK:codeABC(fs, "OP_CALL", base, nparams + 1, 2)) + if ast.lineinfo then + luaK:fixline(fs, ast.lineinfo.first.line) + else + luaK:fixline(fs, ast.line) + end + fs.freereg = base + 1 -- call remove function and arguments and leaves + -- (unless changed) one result +end + +------------------------------------------------------------------------ +-- calculates log value for encoding the hash portion's size +------------------------------------------------------------------------ +local function log2(x) + -- math result is always one more than lua0_log2() + local mn, ex = math.frexp(x) + return ex - 1 +end + +------------------------------------------------------------------------ +-- converts an integer to a "floating point byte", represented as +-- (mmmmmxxx), where the real value is (xxx) * 2^(mmmmm) +------------------------------------------------------------------------ + +-- local function int2fb(x) +-- local m = 0 -- mantissa +-- while x >= 8 do x = math.floor((x + 1) / 2); m = m + 1 end +-- return m * 8 + x +-- end + +local function int2fb(x) + local e = 0 + while x >= 16 do + x = math.floor ( (x+1) / 2) + e = e+1 + end + if x<8 then return x + else return (e+1) * 8 + x - 8 end +end + + +------------------------------------------------------------------------ +-- FIXME: to be unified with singlevar +------------------------------------------------------------------------ +local function singlevaraux(fs, n, var, base) +--[[ +print("\n\nsinglevaraux: fs, n, var, base") +printv(fs) +printv(n) +printv(var) +printv(base) +print("\n") +--]] + if fs == nil then -- no more levels? + init_exp(var, "VGLOBAL", luaP.NO_REG) -- default is global variable + return "VGLOBAL" + else + local v = searchvar(fs, n) -- look up at current level + if v >= 0 then + init_exp(var, "VLOCAL", v) + if not base then + markupval(fs, v) -- local will be used as an upval + end + else -- not found at current level; try upper one + if singlevaraux(fs.prev, n, var, false) == "VGLOBAL" then + return "VGLOBAL" end + var.info = indexupvalue (fs, n, var) + var.k = "VUPVAL" + return "VUPVAL" + end + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function singlevar(fs, varname, var) + if singlevaraux(fs, varname, var, true) == "VGLOBAL" then + var.info = luaK:stringK (fs, varname) end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function new_localvar (fs, name, n) + assert (type (name) == "string") + if fs.nactvar + n > MAXVARS then error ("too many local vars") end + fs.actvar[fs.nactvar + n] = registerlocalvar (fs, name) + --printf("[NEW_LOCVAR] %i = %s", fs.nactvar+n, name) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function parlist (fs, ast_params) + local dots = (#ast_params > 0 and ast_params[#ast_params].tag == "Dots") + local nparams = dots and #ast_params - 1 or #ast_params + for i = 1, nparams do + assert (ast_params[i].tag == "Id", "Function parameters must be Ids") + new_localvar (fs, ast_params[i][1], i-1) + end + -- from [code_param]: + --checklimit (fs, fs.nactvar, self.MAXPARAMS, "parameters") + fs.f.numparams = fs.nactvar + fs.f.is_vararg = dots and VARARG_ISVARARG or 0 + adjustlocalvars (fs, nparams) + fs.f.numparams = fs.nactvar --FIXME vararg must be taken in account + luaK:reserveregs (fs, fs.nactvar) -- reserve register for parameters +end + +------------------------------------------------------------------------ +-- if there's more variables than expressions in an assignment, +-- some assignations to nil are made for extraneous vars. +-- Also handles multiret functions +------------------------------------------------------------------------ +local function adjust_assign (fs, nvars, nexps, e) + local extra = nvars - nexps + if hasmultret (e.k) then + extra = extra+1 -- includes call itself + if extra <= 0 then extra = 0 end + luaK:setreturns(fs, e, extra) -- call provides the difference + if extra > 1 then luaK:reserveregs(fs, extra-1) end + else + if e.k ~= "VVOID" then + luaK:exp2nextreg(fs, e) end -- close last expression + if extra > 0 then + local reg = fs.freereg + luaK:reserveregs(fs, extra) + luaK:_nil(fs, reg, extra) + end + end +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function enterlevel (fs) + fs.nestlevel = fs.nestlevel + 1 + assert (fs.nestlevel <= LUA_MAXPARSERLEVEL, "too many syntax levels") +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function leavelevel (fs) + fs.nestlevel = fs.nestlevel - 1 +end + +------------------------------------------------------------------------ +-- Parse conditions in if/then/else, while, repeat +------------------------------------------------------------------------ +local function cond (fs, ast) + local v = { } + expr.expr(fs, ast, v) -- read condition + if v.k == "VNIL" then v.k = "VFALSE" end -- 'falses' are all equal here + luaK:goiftrue (fs, v) + return v.f +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function chunk (fs, ast) + enterlevel (fs) + assert (not ast.tag) + for i=1, #ast do + stat.stat (fs, ast[i]); + fs.freereg = fs.nactvar + end + leavelevel (fs) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function block (fs, ast) + local bl = {} + enterblock (fs, bl, false) + for i=1, #ast do + stat.stat (fs, ast[i]) + fs.freereg = fs.nactvar + end + assert (bl.breaklist == luaK.NO_JUMP) + leaveblock (fs) +end + +------------------------------------------------------------------------ +-- Forin / Fornum body parser +-- [fs] +-- [body] +-- [base] +-- [nvars] +-- [isnum] +------------------------------------------------------------------------ +local function forbody (fs, ast_body, base, nvars, isnum) + local bl = {} -- BlockCnt + adjustlocalvars (fs, 3) -- control variables + local prep = + isnum and luaK:codeAsBx (fs, "OP_FORPREP", base, luaK.NO_JUMP) + or luaK:jump (fs) + enterblock (fs, bl, false) -- loop block + adjustlocalvars (fs, nvars) -- scope for declared variables + luaK:reserveregs (fs, nvars) + block (fs, ast_body) + leaveblock (fs) + --luaK:patchtohere (fs, prep-1) + luaK:patchtohere (fs, prep) + local endfor = + isnum and luaK:codeAsBx (fs, "OP_FORLOOP", base, luaK.NO_JUMP) + or luaK:codeABC (fs, "OP_TFORLOOP", base, 0, nvars) + luaK:fixline (fs, ast_body.line) -- pretend that 'OP_FOR' starts the loop + luaK:patchlist (fs, isnum and endfor or luaK:jump(fs), prep + 1) +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function recfield (fs, ast, cc) + local reg = fs.freereg + local key, val = {}, {} -- expdesc + --FIXME: expr + exp2val = index --> + -- check reduncancy between exp2val and exp2rk + cc.nh = cc.nh + 1 + expr.expr(fs, ast[1], key); + luaK:exp2val (fs, key) + local keyreg = luaK:exp2RK (fs, key) + expr.expr(fs, ast[2], val) + local valreg = luaK:exp2RK (fs, val) + luaK:codeABC(fs, "OP_SETTABLE", cc.t.info, keyreg, valreg) + fs.freereg = reg -- free registers +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function listfield(fs, ast, cc) + expr.expr(fs, ast, cc.v) + assert (cc.na <= luaP.MAXARG_Bx) -- FIXME check <= or < + cc.na = cc.na + 1 + cc.tostore = cc.tostore + 1 +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function closelistfield(fs, cc) + if cc.v.k == "VVOID" then return end -- there is no list item + luaK:exp2nextreg(fs, cc.v) + cc.v.k = "VVOID" + if cc.tostore == luaP.LFIELDS_PER_FLUSH then + luaK:setlist (fs, cc.t.info, cc.na, cc.tostore) + cc.tostore = 0 + end +end + +------------------------------------------------------------------------ +-- The last field might be a call to a multireturn function. In that +-- case, we must unfold all of its results into the list. +------------------------------------------------------------------------ +local function lastlistfield(fs, cc) + if cc.tostore == 0 then return end + if hasmultret (cc.v.k) then + luaK:setmultret(fs, cc.v) + luaK:setlist (fs, cc.t.info, cc.na, luaK.LUA_MULTRET) + cc.na = cc.na - 1 + else + if cc.v.k ~= "VVOID" then luaK:exp2nextreg(fs, cc.v) end + luaK:setlist (fs, cc.t.info, cc.na, cc.tostore) + end +end +------------------------------------------------------------------------ +------------------------------------------------------------------------ +-- +-- Statement parsers table +-- +------------------------------------------------------------------------ +------------------------------------------------------------------------ + +function stat.stat (fs, ast) + if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end + -- debugf (" - Statement %s", disp.ast (ast) ) + + if not ast.tag then chunk (fs, ast) else + + local parser = stat [ast.tag] + if not parser then + error ("A statement cannot have tag `"..ast.tag) end + parser (fs, ast) + end + --debugf (" - /Statement `%s", ast.tag or "<nil>") + debugf (" - /Statement `%s", ast.tag) +end + +------------------------------------------------------------------------ + +stat.Do = block + +------------------------------------------------------------------------ + +function stat.Break (fs, ast) + -- if ast.lineinfo then fs.lastline = ast.lineinfo.last.line + local bl, upval = fs.bl, false + while bl and not bl.isbreakable do + if bl.upval then upval = true end + bl = bl.previous + end + assert (bl, "no loop to break") + if upval then luaK:codeABC(fs, "OP_CLOSE", bl.nactvar, 0, 0) end + bl.breaklist = luaK:concat(fs, bl.breaklist, luaK:jump(fs)) +end + +------------------------------------------------------------------------ + +function stat.Return (fs, ast) + local e = {} -- expdesc + local first -- registers with returned values + local nret = #ast + + if nret == 0 then first = 0 + else + --printf("[RETURN] compiling explist") + explist (fs, ast, e) + --printf("[RETURN] explist e=%s", tostringv(e)) + if hasmultret (e.k) then + luaK:setmultret(fs, e) + if e.k == "VCALL" and nret == 1 then + luaP:SET_OPCODE(luaK:getcode(fs, e), "OP_TAILCALL") + assert(luaP:GETARG_A(luaK:getcode(fs, e)) == fs.nactvar) + end + first = fs.nactvar + nret = luaK.LUA_MULTRET -- return all values + elseif nret == 1 then + --printf("[RETURN] 1 val: e=%s", tostringv(e)) + first = luaK:exp2anyreg(fs, e) + --printf("[RETURN] 1 val in reg %i", first) + else + --printf("* Return multiple vals in nextreg %i", fs.freereg) + luaK:exp2nextreg(fs, e) -- values must go to the 'stack' + first = fs.nactvar -- return all 'active' values + assert(nret == fs.freereg - first) + end + end + luaK:ret(fs, first, nret) +end +------------------------------------------------------------------------ + +function stat.Local (fs, ast) + local names, values = ast[1], ast[2] or { } + for i = 1, #names do new_localvar (fs, names[i][1], i-1) end + local e = { } + if #values == 0 then e.k = "VVOID" else explist (fs, values, e) end + adjust_assign (fs, #names, #values, e) + adjustlocalvars (fs, #names) +end + +------------------------------------------------------------------------ + +function stat.Localrec (fs, ast) + assert(#ast[1]==1 and #ast[2]==1, "Multiple letrecs not implemented yet") + local ast_var, ast_val, e_var, e_val = ast[1][1], ast[2][1], { }, { } + new_localvar (fs, ast_var[1], 0) + init_exp (e_var, "VLOCAL", fs.freereg) + luaK:reserveregs (fs, 1) + adjustlocalvars (fs, 1) + expr.expr (fs, ast_val, e_val) + luaK:storevar (fs, e_var, e_val) + getlocvar (fs, fs.nactvar-1).startpc = fs.pc +end + +------------------------------------------------------------------------ + +function stat.If (fs, ast) + local astlen = #ast + -- Degenerate case #1: no statement + if astlen==0 then return block(fs, { }) end + -- Degenerate case #2: only an else statement + if astlen==1 then return block(fs, ast[1]) end + + local function test_then_block (fs, test, body) + local condexit = cond (fs, test); + block (fs, body) + return condexit + end + + local escapelist = luaK.NO_JUMP + + local flist = test_then_block (fs, ast[1], ast[2]) -- 'then' statement + for i = 3, #ast - 1, 2 do -- 'elseif' statement + escapelist = luaK:concat( fs, escapelist, luaK:jump(fs)) + luaK:patchtohere (fs, flist) + flist = test_then_block (fs, ast[i], ast[i+1]) + end + if #ast % 2 == 1 then -- 'else' statement + escapelist = luaK:concat(fs, escapelist, luaK:jump(fs)) + luaK:patchtohere(fs, flist) + block (fs, ast[#ast]) + else + escapelist = luaK:concat(fs, escapelist, flist) + end + luaK:patchtohere(fs, escapelist) +end + +------------------------------------------------------------------------ + +function stat.Forin (fs, ast) + local vars, vals, body = ast[1], ast[2], ast[3] + -- imitating forstat: + local bl = { } + enterblock (fs, bl, true) + -- imitating forlist: + local e, base = { }, fs.freereg + new_localvar (fs, "(for generator)", 0) + new_localvar (fs, "(for state)", 1) + new_localvar (fs, "(for control)", 2) + for i = 1, #vars do new_localvar (fs, vars[i][1], i+2) end + explist (fs, vals, e) + adjust_assign (fs, 3, #vals, e) + luaK:checkstack (fs, 3) + forbody (fs, body, base, #vars, false) + -- back to forstat: + leaveblock (fs) +end + +------------------------------------------------------------------------ + +function stat.Fornum (fs, ast) + + local function exp1 (ast_e) + local e = { } + expr.expr (fs, ast_e, e) + luaK:exp2nextreg (fs, e) + end + -- imitating forstat: + local bl = { } + enterblock (fs, bl, true) + -- imitating fornum: + local base = fs.freereg + new_localvar (fs, "(for index)", 0) + new_localvar (fs, "(for limit)", 1) + new_localvar (fs, "(for step)", 2) + new_localvar (fs, ast[1][1], 3) + exp1 (ast[2]) -- initial value + exp1 (ast[3]) -- limit + if #ast == 5 then exp1 (ast[4]) else -- default step = 1 + luaK:codeABx(fs, "OP_LOADK", fs.freereg, luaK:numberK(fs, 1)) + luaK:reserveregs(fs, 1) + end + forbody (fs, ast[#ast], base, 1, true) + -- back to forstat: + leaveblock (fs) +end + +------------------------------------------------------------------------ +function stat.Repeat (fs, ast) + local repeat_init = luaK:getlabel (fs) + local bl1, bl2 = { }, { } + enterblock (fs, bl1, true) + enterblock (fs, bl2, false) + chunk (fs, ast[1]) + local condexit = cond (fs, ast[2]) + if not bl2.upval then + leaveblock (fs) + luaK:patchlist (fs, condexit, repeat_init) + else + stat.Break (fs) + luaK:patchtohere (fs, condexit) + leaveblock (fs) + luaK:patchlist (fs, luaK:jump (fs), repeat_init) + end + leaveblock (fs) +end + +------------------------------------------------------------------------ + +function stat.While (fs, ast) + local whileinit = luaK:getlabel (fs) + local condexit = cond (fs, ast[1]) + local bl = { } + enterblock (fs, bl, true) + block (fs, ast[2]) + luaK:patchlist (fs, luaK:jump (fs), whileinit) + leaveblock (fs) + luaK:patchtohere (fs, condexit); +end + +------------------------------------------------------------------------ + +-- FIXME: it's cumbersome to write this in this semi-recursive way. +function stat.Set (fs, ast) + local ast_lhs, ast_vals, e = ast[1], ast[2], { } + + --print "\n\nSet ast_lhs ast_vals:" + --print(disp.ast(ast_lhs)) + --print(disp.ast(ast_vals)) + + local function let_aux (lhs, nvars) + local legal = { VLOCAL=1, VUPVAL=1, VGLOBAL=1, VINDEXED=1 } + --printv(lhs) + if not legal [lhs.v.k] then + error ("Bad lhs expr: "..table.tostring(ast_lhs)) + end + if nvars < #ast_lhs then -- this is not the last lhs + local nv = { v = { }, prev = lhs } + expr.expr (fs, ast_lhs [nvars+1], nv.v) + if nv.v.k == "VLOCAL" then check_conflict (fs, lhs, nv.v) end + let_aux (nv, nvars+1) + else -- this IS the last lhs + explist (fs, ast_vals, e) + if #ast_vals < nvars then + adjust_assign (fs, nvars, #ast_vals, e) + elseif #ast_vals > nvars then + adjust_assign (fs, nvars, #ast_vals, e) + fs.freereg = fs.freereg - #ast_vals + nvars + else -- #ast_vals == nvars (and we're at last lhs) + luaK:setoneret (fs, e) -- close last expression + luaK:storevar (fs, lhs.v, e) + return -- avoid default + end + end + init_exp (e, "VNONRELOC", fs.freereg - 1) -- default assignment + luaK:storevar (fs, lhs.v, e) + end + + local lhs = { v = { }, prev = nil } + expr.expr (fs, ast_lhs[1], lhs.v) + let_aux( lhs, 1) +end + +------------------------------------------------------------------------ + +function stat.Call (fs, ast) + local v = { } + expr.Call (fs, ast, v) + luaP:SETARG_C (luaK:getcode(fs, v), 1) +end + +------------------------------------------------------------------------ + +function stat.Invoke (fs, ast) + local v = { } + expr.Invoke (fs, ast, v) + --FIXME: didn't check that, just copied from stat.Call + luaP:SETARG_C (luaK:getcode(fs, v), 1) +end + + +local function patch_goto (fs, src, dst) + +end + + +------------------------------------------------------------------------ +-- Goto/Label data: +-- fs.labels :: string => { nactvar :: int; pc :: int } +-- fs.forward_gotos :: string => list(int) +-- +-- fs.labels goes from label ids to the number of active variables at +-- the label's PC, and that PC +-- +-- fs.forward_gotos goes from label ids to the list of the PC where +-- some goto wants to jump to this label. Since gotos are actually made +-- up of two instructions OP_CLOSE and OP_JMP, it's the first instruction's +-- PC that's stored in fs.forward_gotos +-- +-- Note that backward gotos aren't stored: since their destination is knowns +-- when they're compiled, their target is directly set. +------------------------------------------------------------------------ + +------------------------------------------------------------------------ +-- Set a Label to jump to with Goto +------------------------------------------------------------------------ +function stat.Label (fs, ast) + local label_id = ast[1] + if type(label_id)=='table' then label_id=label_id[1] end + -- printf("Label %s at PC %i", label_id, fs.pc) + ------------------------------------------------------------------- + -- Register the label, so that future gotos can use it. + ------------------------------------------------------------------- + if fs.labels [label_id] then error "Duplicate label in function" + else fs.labels [label_id] = { pc = fs.pc; nactvar = fs.nactvar } end + local gotos = fs.forward_gotos [label_id] + if gotos then + ---------------------------------------------------------------- + -- Patch forward gotos which were targetting this label. + ---------------------------------------------------------------- + for _, goto_pc in ipairs(gotos) do + local close_instr = fs.f.code[goto_pc] + local jmp_instr = fs.f.code[goto_pc+1] + local goto_nactvar = luaP:GETARG_A (close_instr) + if fs.nactvar < goto_nactvar then + luaP:SETARG_A (close_instr, fs.nactvar) end + luaP:SETARG_sBx (jmp_instr, fs.pc - goto_pc - 2) + end + ---------------------------------------------------------------- + -- Gotos are patched, they can be forgotten about (when the + -- function will be finished, it will be checked that all gotos + -- have been patched, by checking that forward_goto is empty). + ---------------------------------------------------------------- + fs.forward_gotos[label_id] = nil + end +end + +------------------------------------------------------------------------ +-- jumps to a label set with stat.Label. +-- Argument must be a String or an Id +-- FIXME/optim: get rid of useless OP_CLOSE when nactvar doesn't change. +-- Thsi must be done both here for backward gotos, and in +-- stat.Label for forward gotos. +------------------------------------------------------------------------ +function stat.Goto (fs, ast) + local label_id = ast[1] + if type(label_id)=='table' then label_id=label_id[1] end + -- printf("Goto %s at PC %i", label_id, fs.pc) + local label = fs.labels[label_id] + if label then + ---------------------------------------------------------------- + -- Backward goto: the label already exists, so I can get its + -- nactvar and address directly. nactvar is used to close + -- upvalues if we get out of scoping blocks by jumping. + ---------------------------------------------------------------- + if fs.nactvar > label.nactvar then + luaK:codeABC (fs, "OP_CLOSE", label.nactvar, 0, 0) end + local offset = label.pc - fs.pc - 1 + luaK:codeAsBx (fs, "OP_JMP", 0, offset) + else + ---------------------------------------------------------------- + -- Forward goto: will be patched when the matching label is + -- found, forward_gotos[label_id] keeps the PC of the CLOSE + -- instruction just before the JMP. [stat.Label] will use it to + -- patch the OP_CLOSE and the OP_JMP. + ---------------------------------------------------------------- + if not fs.forward_gotos[label_id] then + fs.forward_gotos[label_id] = { } end + table.insert (fs.forward_gotos[label_id], fs.pc) + luaK:codeABC (fs, "OP_CLOSE", fs.nactvar, 0, 0) + luaK:codeAsBx (fs, "OP_JMP", 0, luaK.NO_JUMP) + end +end + +------------------------------------------------------------------------ +------------------------------------------------------------------------ +-- +-- Expression parsers table +-- +------------------------------------------------------------------------ +------------------------------------------------------------------------ + +function expr.expr (fs, ast, v) + if type(ast) ~= "table" then + error ("Expr AST expected, got "..table.tostring(ast)) end + + if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end + + --debugf (" - Expression %s", tostringv (ast)) + local parser = expr[ast.tag] + if parser then parser (fs, ast, v) + elseif not ast.tag then + error ("No tag in expression "..table.tostring(ast, 'nohash', 80)) + else + error ("No parser for node `"..ast.tag) end + debugf (" - /`%s", ast.tag) +end + +------------------------------------------------------------------------ + +function expr.Nil (fs, ast, v) init_exp (v, "VNIL", 0) end +function expr.True (fs, ast, v) init_exp (v, "VTRUE", 0) end +function expr.False (fs, ast, v) init_exp (v, "VFALSE", 0) end +function expr.String (fs, ast, v) codestring (fs, v, ast[1]) end +function expr.Number (fs, ast, v) + init_exp (v, "VKNUM", 0) + v.nval = ast[1] +end + +function expr.Paren (fs, ast, v) + expr.expr (fs, ast[1], v) + luaK:setoneret (fs, v) +end + +function expr.Dots (fs, ast, v) + assert (fs.f.is_vararg ~= 0, "No vararg in this function") + -- NEEDSARG flag is set if and only if the function is a vararg, + -- but no vararg has been used yet in its code. + if fs.f.is_vararg < VARARG_NEEDSARG then + fs.f.is_varag = fs.f.is_vararg - VARARG_NEEDSARG end + init_exp (v, "VVARARG", luaK:codeABC (fs, "OP_VARARG", 0, 1, 0)) +end + +------------------------------------------------------------------------ + +function expr.Table (fs, ast, v) + local pc = luaK:codeABC(fs, "OP_NEWTABLE", 0, 0, 0) + local cc = { v = { } , na = 0, nh = 0, tostore = 0, t = v } -- ConsControl + init_exp (v, "VRELOCABLE", pc) + init_exp (cc.v, "VVOID", 0) -- no value (yet) + luaK:exp2nextreg (fs, v) -- fix it at stack top (for gc) + for i = 1, #ast do + assert(cc.v.k == "VVOID" or cc.tostore > 0) + closelistfield(fs, cc); + (ast[i].tag == "Pair" and recfield or listfield) (fs, ast[i], cc) + end + lastlistfield(fs, cc) + + -- Configure [OP_NEWTABLE] dimensions + luaP:SETARG_B(fs.f.code[pc], int2fb(cc.na)) -- set initial array size + luaP:SETARG_C(fs.f.code[pc], int2fb(cc.nh)) -- set initial table size + --printv(fs.f.code[pc]) +end + + +------------------------------------------------------------------------ + +function expr.Function (fs, ast, v) + if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end + + local new_fs = open_func(fs) + if ast.lineinfo then + new_fs.f.lineDefined, new_fs.f.lastLineDefined = + ast.lineinfo.first.line, ast.lineinfo.last.line + end + parlist (new_fs, ast[1]) + chunk (new_fs, ast[2]) + close_func (new_fs) + pushclosure(fs, new_fs, v) +end + +------------------------------------------------------------------------ + +function expr.Op (fs, ast, v) + if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end + local op = ast[1] + + if #ast == 2 then + expr.expr (fs, ast[2], v) + luaK:prefix (fs, op, v) + elseif #ast == 3 then + local v2 = { } + expr.expr (fs, ast[2], v) + luaK:infix (fs, op, v) + expr.expr (fs, ast[3], v2) + luaK:posfix (fs, op, v, v2) + else + error "Wrong arg number" + end +end + +------------------------------------------------------------------------ + +function expr.Call (fs, ast, v) + expr.expr (fs, ast[1], v) + luaK:exp2nextreg (fs, v) + funcargs(fs, ast, v, 2) + --debugf("after expr.Call: %s, %s", v.k, luaP.opnames[luaK:getcode(fs, v).OP]) +end + +------------------------------------------------------------------------ +-- `Invoke{ table key args } +function expr.Invoke (fs, ast, v) + expr.expr (fs, ast[1], v) + luaK:dischargevars (fs, v) + local key = { } + codestring (fs, key, ast[2][1]) + luaK:_self (fs, v, key) + funcargs (fs, ast, v, 3) +end + +------------------------------------------------------------------------ + +function expr.Index (fs, ast, v) + if #ast ~= 2 then + print"\n\nBAD INDEX AST:" + table.print(ast) + error "generalized indexes not implemented" end + + if ast.lineinfo then fs.lastline = ast.lineinfo.last.line end + + --assert(fs.lastline ~= 0, ast.tag) + + expr.expr (fs, ast[1], v) + luaK:exp2anyreg (fs, v) + + local k = { } + expr.expr (fs, ast[2], k) + luaK:exp2val (fs, k) + luaK:indexed (fs, v, k) +end + +------------------------------------------------------------------------ + +function expr.Id (fs, ast, v) + assert (ast.tag == "Id") + singlevar (fs, ast[1], v) +end + +------------------------------------------------------------------------ + +function expr.Stat (fs, ast, v) + --printf(" * Stat: %i actvars, first freereg is %i", fs.nactvar, fs.freereg) + --printf(" actvars: %s", table.tostring(fs.actvar)) + + -- Protect temporary stack values by pretending they are local + -- variables. Local vars are in registers 0 ... fs.nactvar-1, + -- and temporary unnamed variables in fs.nactvar ... fs.freereg-1 + local save_nactvar = fs.nactvar + + -- Eventually, the result should go on top of stack *after all + -- `Stat{ } related computation and string usage is over. The index + -- of this destination register is kept here: + local dest_reg = fs.freereg + + -- There might be variables in actvar whose register is > nactvar, + -- and therefore will not be protected by the "nactvar := freereg" + -- trick. Indeed, `Local only increases nactvar after the variable + -- content has been computed. Therefore, in + -- "local foo = -{`Stat{...}}", variable foo will be messed up by + -- the compilation of `Stat. + -- FIX: save the active variables at indices >= nactvar in + -- save_actvar, and restore them after `Stat has been computer. + -- + -- I use a while rather than for loops and length operators because + -- fs.actvar is a 0-based array... + local save_actvar = { } do + local i = fs.nactvar + while true do + local v = fs.actvar[i] + if not v then break end + --printf("save hald-baked actvar %s at index %i", table.tostring(v), i) + save_actvar[i] = v + i=i+1 + end + end + + fs.nactvar = fs.freereg -- Now temp unnamed registers are protected + enterblock (fs, { }, false) + chunk (fs, ast[1]) + expr.expr (fs, ast[2], v) + luaK:exp2nextreg (fs, v) + leaveblock (fs) + luaK:exp2reg (fs, v, dest_reg) + + -- Reserve the newly allocated stack level + -- Puzzled note: here was written "fs.freereg = fs.freereg+1". + -- I'm pretty sure it should rather be dest_reg+1, but maybe + -- both are equivalent? + fs.freereg = dest_reg+1 + + -- Restore nactvar, so that intermediate stacked value stop + -- being protected. + --printf(" nactvar back from %i to %i", fs.nactvar, save_nactvar) + fs.nactvar = save_nactvar + + -- restore messed-up unregistered local vars + for i, j in pairs(save_actvar) do + --printf(" Restoring actvar %i", i) + fs.actvar[i] = j + end + --printf(" * End of Stat") +end + + + +------------------------------------------------------------------------ +-- Main function: ast --> proto +------------------------------------------------------------------------ +function metalua_compile (ast, source) + local fs = open_func (nil) + fs.f.is_vararg = VARARG_ISVARARG + chunk (fs, ast) + close_func (fs) + assert (fs.prev == nil) + assert (fs.f.nups == 0) + assert (fs.nestlevel == 0) + if source then fs.f.source = source end + return fs.f +end
diff --git a/compiler/gg.lua b/compiler/gg.lua new file mode 100644 index 0000000..c4c6019 --- /dev/null +++ b/compiler/gg.lua
@@ -0,0 +1,821 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +--------------------------------------------------------------------- +-- +-- Summary: parser generator. Collection of higher order functors, +-- which allow to build and combine parsers. Relies on a lexer +-- that supports the same API as the one exposed in mll.lua. +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- +-- Parser generators: +-- * [gg.sequence()] +-- * [gg.multisequence()] +-- * [gg.expr()] +-- * [gg.list()] +-- * [gg.onkeyword()] +-- * [gg.optkeyword()] +-- +-- Other functions: +-- * [gg.parse_error()] +-- * [gg.make_parser()] +-- * [gg.is_parser()] +-- +-------------------------------------------------------------------------------- + +module("gg", package.seeall) + +------------------------------------------------------------------------------- +-- parser metatable, which maps __call to method parse, and adds some +-- error tracing boilerplate. +-- +-- TODO: parsers don't throw errors anymore, they return `Error{ } nodes instead. +-- Therefore the accumulation of error positions won't work anymore. +-- Instead, the mlc.check_ast() function should retrace the whole path to +-- the actual error position. +-- +------------------------------------------------------------------------------- +local parser_metatable = { } + +function parser_metatable :__call (...) + local r = self :parse(...) + return r + --return self :parse(...) +end + +------------------------------------------------------------------------------- +-- Turn a table into a parser, mainly by setting the metatable. +------------------------------------------------------------------------------- +function make_parser(kind, p) + p.kind = kind + if not p.transformers then p.transformers = { } end + function p.transformers:add (x) + table.insert (self, x) + end + setmetatable (p, parser_metatable) + return p +end + +------------------------------------------------------------------------------- +-- Return true iff [x] is a parser. +-- If it's a gg-generated parser, return the name of its kind. +------------------------------------------------------------------------------- +function is_parser (x) + return type(x)=="function" or getmetatable(x)==parser_metatable and x.kind +end + +------------------------------------------------------------------------------- +-- Parse a sequence, without applying builder nor transformers. +-- Won't fail: if the parsing can't be completed, the missing results +-- will be filled with Error nodes. +-- +-- TODO: This introduces a new assumption in gg that it must produce +-- AST as results. This should be decoupled by passing an error handler +-- from outside. +------------------------------------------------------------------------------- +local function raw_parse_sequence (lx, p) + local r = { } + local failed = false + for i=1, #p do + e=p[i] + if failed then + if type(e)=="string" then table.insert(r, earlier_error(lx)) end + elseif type(e) == "string" then + if not lx :is_keyword (lx :next(), e) then + table.insert(r, {tag='Error', "A keyword was expected, probably `"..e.."'."}) + failed=true + end + elseif is_parser (e) then + local x = e(lx) + if type(x)=='table' and x.tag=='Error' then failed=true end + table.insert (r, x) + else -- Invalid parser definition, this is not a parsing error, it must fail. + return gg.parse_error (lx,"Sequence `%s': element #%i is neither a string ".. + "nor a parser: %s", p.name, i, table.tostring(e)) + end + end + return r +end + +------------------------------------------------------------------------------- +-- Parse a multisequence, without applying multisequence transformers. +-- The sequences are completely parsed. +------------------------------------------------------------------------------- +local function raw_parse_multisequence (lx, sequence_table, default) + local seq_parser = sequence_table[lx:is_keyword(lx:peek())] + if seq_parser then return seq_parser (lx) + elseif default then return default (lx) + else return false end +end + +------------------------------------------------------------------------------- +-- Applies all transformers listed in parser on ast. +------------------------------------------------------------------------------- +local function transform (ast, parser, fli, lli) + if parser.transformers then + for _, t in ipairs (parser.transformers) do ast = t(ast) or ast end + end + if type(ast) == 'table'then + local ali = ast.lineinfo + if not ali or ali.first~=fli or ali.last~=lli then + ast.lineinfo = lexer.new_lineinfo(fli, lli) + end + end + return ast +end + +------------------------------------------------------------------------------- +-- Generate a tracable parsing error +------------------------------------------------------------------------------- +function parse_error(lx, fmt, ...) + local li = lx:lineinfo_left() + local line, column, offset + if li then line, column, offset = li.line, li.column, li.offset + else line, column, offset, src_name = -1, -1, -1 end + + local msg = string.format("line %i, char %i: "..fmt, line, column, ...) + local src = lx.src + if offset>0 and src then + local i, j = offset, offset + while src:sub(i,i) ~= '\n' and i>=0 do i=i-1 end + while src:sub(j,j) ~= '\n' and j<=#src do j=j+1 end + local srcline = src:sub (i+1, j-1) + local idx = string.rep (" ", column).."^" + msg = string.format("%s\n>>> %s\n>>> %s", msg, srcline, idx) + end + lx :kill() + assert (lx :peek().tag=='Eof') + --printf ("gg.parse_error(%q)", msg) + return { tag='Error', msg, error=true } +end + +function wrap_error(lx, nchildren, tag, ...) + local li = lx :peek() .lineinfo + local r = { tag=tag or 'Error', lineinfo=li, error=true } + local children = {...} + for i=1, nchildren do + r[i] = children[i] or earlier_error(lx) + end + return r +end + +function earlier_error(lx) + local li = lx and lx :peek().lineinfo + return { tag='Error', "earlier error", lineinfo=li, error=true, stuffing = true } +end + +------------------------------------------------------------------------------- +-- +-- Sequence parser generator +-- +------------------------------------------------------------------------------- +-- Input fields: +-- +-- * [builder]: how to build an AST out of sequence parts. let [x] be the list +-- of subparser results (keywords are simply omitted). [builder] can be: +-- - [nil], in which case the result of parsing is simply [x] +-- - a string, which is then put as a tag on [x] +-- - a function, which takes [x] as a parameter and returns an AST. +-- +-- * [name]: the name of the parser. Used for debug messages +-- +-- * [transformers]: a list of AST->AST functions, applied in order on ASTs +-- returned by the parser. +-- +-- * Table-part entries corresponds to keywords (strings) and subparsers +-- (function and callable objects). +-- +-- After creation, the following fields are added: +-- * [parse] the parsing function lexer->AST +-- * [kind] == "sequence" +-- * [name] is set, if it wasn't in the input. +-- +------------------------------------------------------------------------------- +function sequence (p) + make_parser ("sequence", p) + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse (lx) + + -- Raw parsing: + local fli = lx:lineinfo_right() + local seq = raw_parse_sequence (lx, self) + local lli = lx:lineinfo_left() + + -- Builder application: + local builder, tb = self.builder, type (self.builder) + if tb == "string" then seq.tag = builder + elseif tb == "function" or builder and builder.__call then seq = builder(seq) + elseif builder == nil then -- nothing + else error ("Invalid builder of type "..tb.." in sequence") end + seq = transform (seq, self, fli, lli) + assert (not seq or seq.lineinfo) + return seq + end + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + -- Try to build a proper name + if p.name then + -- don't touch existing name + elseif type(p[1])=="string" then -- find name based on 1st keyword + if #p==1 then p.name=p[1] + elseif type(p[#p])=="string" then + p.name = p[1] .. " ... " .. p[#p] + else p.name = p[1] .. " ..." end + else -- can't find a decent name + p.name = "unnamed_sequence" + end + + return p +end --</sequence> + + +------------------------------------------------------------------------------- +-- +-- Multiple, keyword-driven, sequence parser generator +-- +------------------------------------------------------------------------------- +-- in [p], useful fields are: +-- +-- * [transformers]: as usual +-- +-- * [name]: as usual +-- +-- * Table-part entries must be sequence parsers, or tables which can +-- be turned into a sequence parser by [gg.sequence]. These +-- sequences must start with a keyword, and this initial keyword +-- must be different for each sequence. The table-part entries will +-- be removed after [gg.multisequence] returns. +-- +-- * [default]: the parser to run if the next keyword in the lexer is +-- none of the registered initial keywords. If there's no default +-- parser and no suitable initial keyword, the multisequence parser +-- simply returns [false]. +-- +-- After creation, the following fields are added: +-- +-- * [parse] the parsing function lexer->AST +-- +-- * [sequences] the table of sequences, indexed by initial keywords. +-- +-- * [add] method takes a sequence parser or a config table for +-- [gg.sequence], and adds/replaces the corresponding sequence +-- parser. If the keyword was already used, the former sequence is +-- removed and a warning is issued. +-- +-- * [get] method returns a sequence by its initial keyword +-- +-- * [kind] == "multisequence" +-- +------------------------------------------------------------------------------- +function multisequence (p) + make_parser ("multisequence", p) + + ------------------------------------------------------------------- + -- Add a sequence (might be just a config table for [gg.sequence]) + ------------------------------------------------------------------- + function p:add (s) + -- compile if necessary: + local keyword = type(s)=='table' and s[1] + if type(s)=='table' and not is_parser(s) then sequence(s) end + if is_parser(s)~='sequence' or type(keyword)~='string' then + if self.default then -- two defaults + error ("In a multisequence parser, all but one sequences ".. + "must start with a keyword") + else self.default = s end -- first default + elseif self.sequences[keyword] then -- duplicate keyword + eprintf (" *** Warning: keyword %q overloaded in multisequence ***", + keyword) + self.sequences[keyword] = s + else -- newly caught keyword + self.sequences[keyword] = s + end + end -- </multisequence.add> + + ------------------------------------------------------------------- + -- Get the sequence starting with this keyword. [kw :: string] + ------------------------------------------------------------------- + function p:get (kw) return self.sequences [kw] end + + ------------------------------------------------------------------- + -- Remove the sequence starting with keyword [kw :: string] + ------------------------------------------------------------------- + function p:del (kw) + if not self.sequences[kw] then + eprintf("*** Warning: trying to delete sequence starting ".. + "with %q from a multisequence having no such ".. + "entry ***", kw) end + local removed = self.sequences[kw] + self.sequences[kw] = nil + return removed + end + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse (lx) + local fli = lx:lineinfo_right() + local x = raw_parse_multisequence (lx, self.sequences, self.default) + local lli = lx:lineinfo_left() + return transform (x, self, fli, lli) + end + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + -- Register the sequences passed to the constructor. They're going + -- from the array part of the parser to the hash part of field + -- [sequences] + p.sequences = { } + for i=1, #p do p:add (p[i]); p[i] = nil end + + -- FIXME: why is this commented out? + --if p.default and not is_parser(p.default) then sequence(p.default) end + return p +end --</multisequence> + + +------------------------------------------------------------------------------- +-- +-- Expression parser generator +-- +------------------------------------------------------------------------------- +-- +-- Expression configuration relies on three tables: [prefix], [infix] +-- and [suffix]. Moreover, the primary parser can be replaced by a +-- table: in this case the [primary] table will be passed to +-- [gg.multisequence] to create a parser. +-- +-- Each of these tables is a modified multisequence parser: the +-- differences with respect to regular multisequence config tables are: +-- +-- * the builder takes specific parameters: +-- - for [prefix], it takes the result of the prefix sequence parser, +-- and the prefixed expression +-- - for [infix], it takes the left-hand-side expression, the results +-- of the infix sequence parser, and the right-hand-side expression. +-- - for [suffix], it takes the suffixed expression, and theresult +-- of the suffix sequence parser. +-- +-- * the default field is a list, with parameters: +-- - [parser] the raw parsing function +-- - [transformers], as usual +-- - [prec], the operator's precedence +-- - [assoc] for [infix] table, the operator's associativity, which +-- can be "left", "right" or "flat" (default to left) +-- +-- In [p], useful fields are: +-- * [transformers]: as usual +-- * [name]: as usual +-- * [primary]: the atomic expression parser, or a multisequence config +-- table (mandatory) +-- * [prefix]: prefix operators config table, see above. +-- * [infix]: infix operators config table, see above. +-- * [suffix]: suffix operators config table, see above. +-- +-- After creation, these fields are added: +-- * [kind] == "expr" +-- * [parse] as usual +-- * each table is turned into a multisequence, and therefore has an +-- [add] method +-- +------------------------------------------------------------------------------- +function expr (p) + make_parser ("expr", p) + + ------------------------------------------------------------------- + -- parser method. + -- In addition to the lexer, it takes an optional precedence: + -- it won't read expressions whose precedence is lower or equal + -- to [prec]. + ------------------------------------------------------------------- + function p:parse (lx, prec) + prec = prec or 0 + + ------------------------------------------------------ + -- Extract the right parser and the corresponding + -- options table, for (pre|in|suff)fix operators. + -- Options include prec, assoc, transformers. + ------------------------------------------------------ + local function get_parser_info (tab) + local p2 = tab:get (lx:is_keyword (lx:peek())) + if p2 then -- keyword-based sequence found + local function parser(lx) return raw_parse_sequence(lx, p2) end + return parser, p2 + else -- Got to use the default parser + local d = tab.default + if d then return d.parse or d.parser, d + else return false, false end + end + end + + ------------------------------------------------------ + -- Look for a prefix sequence. Multiple prefixes are + -- handled through the recursive [p.parse] call. + -- Notice the double-transform: one for the primary + -- expr, and one for the one with the prefix op. + ------------------------------------------------------ + local function handle_prefix () + local fli = lx:lineinfo_right() + local p2_func, p2 = get_parser_info (self.prefix) + local op = p2_func and p2_func (lx) + if op then -- Keyword-based sequence found + local ili = lx:lineinfo_right() -- Intermediate LineInfo + local e = p2.builder (op, self:parse (lx, p2.prec)) + local lli = lx:lineinfo_left() + return transform (transform (e, p2, ili, lli), self, fli, lli) + else -- No prefix found, get a primary expression + local e = self.primary(lx) + local lli = lx:lineinfo_left() + return transform (e, self, fli, lli) + end + end --</expr.parse.handle_prefix> + + ------------------------------------------------------ + -- Look for an infix sequence+right-hand-side operand. + -- Return the whole binary expression result, + -- or false if no operator was found. + ------------------------------------------------------ + local function handle_infix (e) + local p2_func, p2 = get_parser_info (self.infix) + if not p2 then return false end + + ----------------------------------------- + -- Handle flattening operators: gather all operands + -- of the series in [list]; when a different operator + -- is found, stop, build from [list], [transform] and + -- return. + ----------------------------------------- + if (not p2.prec or p2.prec>prec) and p2.assoc=="flat" then + local fli = lx:lineinfo_right() + local pflat, list = p2, { e } + repeat + local op = p2_func(lx) + if not op then break end + table.insert (list, self:parse (lx, p2.prec)) + local _ -- We only care about checking that p2==pflat + _, p2 = get_parser_info (self.infix) + until p2 ~= pflat + local e2 = pflat.builder (list) + local lli = lx:lineinfo_left() + return transform (transform (e2, pflat, fli, lli), self, fli, lli) + + ----------------------------------------- + -- Handle regular infix operators: [e] the LHS is known, + -- just gather the operator and [e2] the RHS. + -- Result goes in [e3]. + ----------------------------------------- + elseif p2.prec and p2.prec>prec or + p2.prec==prec and p2.assoc=="right" then + local fli = e.lineinfo.first -- lx:lineinfo_right() + local op = p2_func(lx) + if not op then return false end + local e2 = self:parse (lx, p2.prec) + local e3 = p2.builder (e, op, e2) + local lli = lx:lineinfo_left() + return transform (transform (e3, p2, fli, lli), self, fli, lli) + + ----------------------------------------- + -- Check for non-associative operators, and complain if applicable. + ----------------------------------------- + elseif p2.assoc=="none" and p2.prec==prec then + return parse_error (lx, "non-associative operator!") + + ----------------------------------------- + -- No infix operator suitable at that precedence + ----------------------------------------- + else return false end + + end --</expr.parse.handle_infix> + + ------------------------------------------------------ + -- Look for a suffix sequence. + -- Return the result of suffix operator on [e], + -- or false if no operator was found. + ------------------------------------------------------ + local function handle_suffix (e) + -- FIXME bad fli, must take e.lineinfo.first + local p2_func, p2 = get_parser_info (self.suffix) + if not p2 then return false end + if not p2.prec or p2.prec>=prec then + --local fli = lx:lineinfo_right() + local fli = e.lineinfo.first + local op = p2_func(lx) + if not op then return false end + local lli = lx:lineinfo_left() + e = p2.builder (e, op) + e = transform (transform (e, p2, fli, lli), self, fli, lli) + return e + end + return false + end --</expr.parse.handle_suffix> + + ------------------------------------------------------ + -- Parser body: read suffix and (infix+operand) + -- extensions as long as we're able to fetch more at + -- this precedence level. + ------------------------------------------------------ + local e = handle_prefix() + repeat + local x = handle_suffix (e); e = x or e + local y = handle_infix (e); e = y or e + until not (x or y) + + -- No transform: it already happened in operators handling + return e + end --</expr.parse> + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + if not p.primary then p.primary=p[1]; p[1]=nil end + for _, t in ipairs{ "primary", "prefix", "infix", "suffix" } do + if not p[t] then p[t] = { } end + if not is_parser(p[t]) then multisequence(p[t]) end + end + function p:add(...) return self.primary:add(...) end + return p +end --</expr> + + +------------------------------------------------------------------------------- +-- +-- List parser generator +-- +------------------------------------------------------------------------------- +-- In [p], the following fields can be provided in input: +-- +-- * [builder]: takes list of subparser results, returns AST +-- * [transformers]: as usual +-- * [name]: as usual +-- +-- * [terminators]: list of strings representing the keywords which +-- might mark the end of the list. When non-empty, the list is +-- allowed to be empty. A string is treated as a single-element +-- table, whose element is that string, e.g. ["do"] is the same as +-- [{"do"}]. +-- +-- * [separators]: list of strings representing the keywords which can +-- separate elements of the list. When non-empty, one of these +-- keyword has to be found between each element. Lack of a separator +-- indicates the end of the list. A string is treated as a +-- single-element table, whose element is that string, e.g. ["do"] +-- is the same as [{"do"}]. If [terminators] is empty/nil, then +-- [separators] has to be non-empty. +-- +-- * [nonempty]: if true, empty lists are rejected by the parser whatever +-- the [terminators] and [separators] values are. +-- +-- After creation, the following fields are added: +-- * [parse] the parsing function lexer->AST +-- * [kind] == "list" +-- +------------------------------------------------------------------------------- +function list (p) + make_parser ("list", p) + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse (lx) + + ------------------------------------------------------ + -- Used to quickly check whether there's a terminator + -- or a separator immediately ahead + ------------------------------------------------------ + local function peek_is_in (keywords) + return keywords and lx:is_keyword(lx:peek(), unpack(keywords)) end + + local x = { } + local fli = lx:lineinfo_right() + + -- if there's a terminator to start with, don't bother trying + if not peek_is_in (self.terminators) then + + while true do + + local item = self.primary(lx) + table.insert(x, item) + + -- loop exit conditions + if type(item)=='table' and item.tag=='Error' then break -- error in last item + elseif self.separators then -- either a separator is consumed or an error is raised + if peek_is_in (self.separators) then lx :next() else break end + elseif peek_is_in (self.terminators) then break -- end on terminator detection + elseif lx :peek().tag == 'Eof' then break end -- Eof is always a terminator + end + end + if self.nonempty and not next(x) then + return gg.parse_error (lx,"List `%s' must not be empty", p.name) + end + + local lli = lx:lineinfo_left() + + -- Apply the builder. It can be a string, or a callable value, + -- or simply nothing. + local b = self.builder + if b then + if type(b)=="string" then x.tag = b -- b is a string, use it as a tag + elseif type(b)=="function" then x=b(x) + else + local bmt = getmetatable(b) + if bmt and bmt.__call then x=b(x) end + end + end + return transform (x, self, fli, lli) + end --</list.parse> + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + if not p.primary then p.primary, p[1] = p[1], nil end + + if type(p.terminators) == "string" then p.terminators = { p.terminators } + elseif p.terminators and #p.terminators == 0 then p.terminators = nil end + + if type(p.separators) == "string" then p.separators = { p.separators } + elseif p.separators and #p.separators == 0 then p.separators = nil end + + return p +end --</list> + + +------------------------------------------------------------------------------- +-- +-- Keyword-conditionned parser generator +-- +------------------------------------------------------------------------------- +-- +-- Only apply a parser if a given keyword is found. The result of +-- [gg.onkeyword] parser is the result of the subparser (modulo +-- [transformers] applications). +-- +-- lineinfo: the keyword is *not* included in the boundaries of the +-- resulting lineinfo. A review of all usages of gg.onkeyword() in the +-- implementation of metalua has shown that it was the appropriate choice +-- in every case. +-- +-- Input fields: +-- +-- * [name]: as usual +-- +-- * [transformers]: as usual +-- +-- * [peek]: if non-nil, the conditionning keyword is left in the lexeme +-- stream instead of being consumed. +-- +-- * [primary]: the subparser. +-- +-- * [keywords]: list of strings representing triggering keywords. +-- +-- * Table-part entries can contain strings, and/or exactly one parser. +-- Strings are put in [keywords], and the parser is put in [primary]. +-- +-- After the call, the following fields will be set: +-- +-- * [parse] the parsing method +-- * [kind] == "onkeyword" +-- * [primary] +-- * [keywords] +-- +------------------------------------------------------------------------------- +function onkeyword (p) + make_parser ("onkeyword", p) + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse(lx) + if lx:is_keyword (lx:peek(), unpack(self.keywords)) then + local fli = lx:lineinfo_right() + if not self.peek then lx:next() end + local content = self.primary (lx) + local lli = lx:lineinfo_left() + local li = content.lineinfo or { } + fli, lli = li.first or fli, li.last or lli + return transform (content, p, fli, lli) + else return false end + end + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + if not p.keywords then p.keywords = { } end + for _, x in ipairs(p) do + if type(x)=="string" then table.insert (p.keywords, x) + else assert (not p.primary and is_parser (x)); p.primary = x end + end + if not next (p.keywords) then + eprintf("Warning, no keyword to trigger gg.onkeyword") end + assert (p.primary, 'no primary parser in gg.onkeyword') + return p +end --</onkeyword> + + +------------------------------------------------------------------------------- +-- +-- Optional keyword consummer pseudo-parser generator +-- +------------------------------------------------------------------------------- +-- +-- This doesn't return a real parser, just a function. That function parses +-- one of the keywords passed as parameters, and returns it. It returns +-- [false] if no matching keyword is found. +-- +-- Notice that tokens returned by lexer already carry lineinfo, therefore +-- there's no need to add them, as done usually through transform() calls. +------------------------------------------------------------------------------- +function optkeyword (...) + local args = {...} + if type (args[1]) == "table" then + assert (#args == 1) + args = args[1] + end + for _, v in ipairs(args) do assert (type(v)=="string") end + return function (lx) + local x = lx:is_keyword (lx:peek(), unpack (args)) + if x then lx:next(); return x + else return false end + end +end + + +------------------------------------------------------------------------------- +-- +-- Run a parser with a special lexer +-- +------------------------------------------------------------------------------- +-- +-- This doesn't return a real parser, just a function. +-- First argument is the lexer class to be used with the parser, +-- 2nd is the parser itself. +-- The resulting parser returns whatever the argument parser does. +-- +------------------------------------------------------------------------------- +function with_lexer(new_lexer, parser) + + ------------------------------------------------------------------- + -- Most gg functions take their parameters in a table, so it's + -- better to silently accept when with_lexer{ } is called with + -- its arguments in a list: + ------------------------------------------------------------------- + if not parser and #new_lexer==2 and type(new_lexer[1])=='table' then + return with_lexer(unpack(new_lexer)) + end + + ------------------------------------------------------------------- + -- Save the current lexer, switch it for the new one, run the parser, + -- restore the previous lexer, even if the parser caused an error. + ------------------------------------------------------------------- + return function (lx) + local old_lexer = getmetatable(lx) + lx:sync() + setmetatable(lx, new_lexer) + local status, result = pcall(parser, lx) + lx:sync() + setmetatable(lx, old_lexer) + if status then return result else error(result) end + end +end + +function nonempty(primary) + local p = make_parser('non-empty list', { primary = primary, name=primary.name }) + function p :parse (lx) + local fli = lx:lineinfo_right() + local content = self.primary (lx) + local lli = lx:lineinfo_left() + local li = content.lineinfo or { } + fli, lli = li.first or fli, li.last or lli + if #content == 0 then + return gg.parse_error (lx, "`%s' must not be empty", self.name or "list") + else + return transform (content, self, fli, lli) + end + end + return p +end
diff --git a/compiler/lcode.lua b/compiler/lcode.lua new file mode 100644 index 0000000..d6de77e --- /dev/null +++ b/compiler/lcode.lua
@@ -0,0 +1,1034 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2005-2013 Kein-Hong Man, Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Kein-Hong Man - Initial implementation for Lua 5.0, part of Yueliang +-- Fabien Fleutot - Port to Lua 5.1, integration with Metalua +-- +------------------------------------------------------------------------------- + +--[[-------------------------------------------------------------------- + + lcode.lua + Lua 5 code generator in Lua + This file is part of Yueliang. + + Copyright (c) 2005 Kein-Hong Man <khman@users.sf.net> + The COPYRIGHT file describes the conditions + under which this software may be distributed. + + See the ChangeLog for more information. + +------------------------------------------------------------------------ + + [FF] Slightly modified, mainly to produce Lua 5.1 bytecode. + +----------------------------------------------------------------------]] + +--[[-------------------------------------------------------------------- +-- Notes: +-- * one function manipulate a pointer argument with a simple data type +-- (can't be emulated by a table, ambiguous), now returns that value: +-- luaK:concat(fs, l1, l2) +-- * some function parameters changed to boolean, additional code +-- translates boolean back to 1/0 for instruction fields +-- * Added: +-- luaK:ttisnumber(o) (from lobject.h) +-- luaK:nvalue(o) (from lobject.h) +-- luaK:setnilvalue(o) (from lobject.h) +-- luaK:setsvalue(o) (from lobject.h) +-- luaK:setnvalue(o) (from lobject.h) +-- luaK:sethvalue(o) (from lobject.h) +----------------------------------------------------------------------]] + +module("bytecode", package.seeall) + +local function debugf() end + +luaK = {} + +luaK.MAXSTACK = 250 -- (llimits.h, used in lcode.lua) +luaK.LUA_MULTRET = -1 -- (lua.h) + +------------------------------------------------------------------------ +-- Marks the end of a patch list. It is an invalid value both as an absolute +-- address, and as a list link (would link an element to itself). +------------------------------------------------------------------------ +luaK.NO_JUMP = -1 + +--FF 5.1 +function luaK:isnumeral(e) + return e.k=="VKNUM" and e.t==self.NO_JUMP and e.t==self.NO_JUMP +end + +------------------------------------------------------------------------ +-- emulation of TObject macros (these are from lobject.h) +-- * TObject is a table since lcode passes references around +-- * tt member field removed, using Lua's type() instead +------------------------------------------------------------------------ +function luaK:ttisnumber(o) + if o then return type(o.value) == "number" else return false end +end +function luaK:nvalue(o) return o.value end +function luaK:setnilvalue(o) o.value = nil end +function luaK:setsvalue(o, s) o.value = s end +luaK.setnvalue = luaK.setsvalue +luaK.sethvalue = luaK.setsvalue + +------------------------------------------------------------------------ +-- returns the instruction object for given e (expdesc) +------------------------------------------------------------------------ +function luaK:getcode(fs, e) + return fs.f.code[e.info] +end + +------------------------------------------------------------------------ +-- codes an instruction with a signed Bx (sBx) field +------------------------------------------------------------------------ +function luaK:codeAsBx(fs, o, A, sBx) + return self:codeABx(fs, o, A, sBx + luaP.MAXARG_sBx) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:hasjumps(e) + return e.t ~= e.f +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:_nil(fs, from, n) + if fs.pc > fs.lasttarget then -- no jumps to current position? + if fs.pc == 0 then return end --function start, positions are already clean + local previous = fs.f.code[fs.pc - 1] + if luaP:GET_OPCODE(previous) == "OP_LOADNIL" then + local pfrom = luaP:GETARG_A(previous) + local pto = luaP:GETARG_B(previous) + if pfrom <= from and from <= pto + 1 then -- can connect both? + if from + n - 1 > pto then + luaP:SETARG_B(previous, from + n - 1) + end + return + end + end + end + self:codeABC(fs, "OP_LOADNIL", from, from + n - 1, 0) -- else no optimization +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:jump(fs) + local jpc = fs.jpc -- save list of jumps to here + fs.jpc = self.NO_JUMP + local j = self:codeAsBx(fs, "OP_JMP", 0, self.NO_JUMP) + return self:concat(fs, j, jpc) -- keep them on hold +end + +--FF 5.1 +function luaK:ret (fs, first, nret) + luaK:codeABC (fs, "OP_RETURN", first, nret+1, 0) +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:condjump(fs, op, A, B, C) + self:codeABC(fs, op, A, B, C) + return self:jump(fs) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:fixjump(fs, pc, dest) + local jmp = fs.f.code[pc] + local offset = dest - (pc + 1) + assert(dest ~= self.NO_JUMP) + if math.abs(offset) > luaP.MAXARG_sBx then + luaX:syntaxerror(fs.ls, "control structure too long") + end + luaP:SETARG_sBx(jmp, offset) +end + +------------------------------------------------------------------------ +-- returns current 'pc' and marks it as a jump target (to avoid wrong +-- optimizations with consecutive instructions not in the same basic block). +------------------------------------------------------------------------ +function luaK:getlabel(fs) + fs.lasttarget = fs.pc + return fs.pc +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:getjump(fs, pc) + local offset = luaP:GETARG_sBx(fs.f.code[pc]) + if offset == self.NO_JUMP then -- point to itself represents end of list + return self.NO_JUMP -- end of list + else + return (pc + 1) + offset -- turn offset into absolute position + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:getjumpcontrol(fs, pc) + local pi = fs.f.code[pc] + local ppi = fs.f.code[pc - 1] + if pc >= 1 and luaP:testOpMode(luaP:GET_OPCODE(ppi), "OpModeT") then + return ppi + else + return pi + end +end + +------------------------------------------------------------------------ +-- check whether list has any jump that do not produce a value +-- (or produce an inverted value) +------------------------------------------------------------------------ +--FF updated 5.1 +function luaK:need_value(fs, list, cond) + while list ~= self.NO_JUMP do + local i = self:getjumpcontrol(fs, list) + if luaP:GET_OPCODE(i) ~= "OP_TESTSET" or + luaP:GETARG_A(i) ~= luaP.NO_REG or + luaP:GETARG_C(i) ~= cond then + return true + end + list = self:getjump(fs, list) + end + return false -- not found +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +--FF updated 5.1 +function luaK:patchtestreg(fs, node, reg) + assert(reg) -- pour assurer, vu que j'ai ajoute un parametre p/r a 5.0 + local i = self:getjumpcontrol(fs, node) + if luaP:GET_OPCODE(i) ~= "OP_TESTSET" then + return false end -- cannot patch other instructions + if reg ~= luaP.NO_REG and reg ~= luaP:GETARG_B(i) then + luaP:SETARG_A(i, reg) + else + -- no register to put value or register already has the value + luaP:SET_OPCODE(i, "OP_TEST") + luaP:SETARG_A(i, luaP:GETARG_B(i)) + luaP:SETARG_B(i, 0) + luaP:SETARG_C(i, luaP:GETARG_C(i)) + end + return true +end + +--FF added 5.1 +function luaK:removevalues (fs, list) + while list ~= self.NO_JUMP do + self:patchtestreg (fs, list, luaP.NO_REG) + list = self:getjump (fs, list) + end +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:patchlistaux(fs, list, vtarget, reg, dtarget) + while list ~= self.NO_JUMP do + local _next = self:getjump(fs, list) + if self:patchtestreg (fs, list, reg) then + self:fixjump(fs, list, vtarget) + else + self:fixjump (fs, list, dtarget) + end + list = _next + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:dischargejpc(fs) + self:patchlistaux(fs, fs.jpc, fs.pc, luaP.NO_REG, fs.pc) + fs.jpc = self.NO_JUMP +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:patchlist(fs, list, target) + if target == fs.pc then + self:patchtohere(fs, list) + else + assert(target < fs.pc) + self:patchlistaux(fs, list, target, luaP.NO_REG, target) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:patchtohere(fs, list) + self:getlabel(fs) + fs.jpc = self:concat(fs, fs.jpc, list) +end + +------------------------------------------------------------------------ +-- * l1 was a pointer, now l1 is returned and callee assigns the value +------------------------------------------------------------------------ +function luaK:concat(fs, l1, l2) + if l2 == self.NO_JUMP then return l1 -- unchanged + elseif l1 == self.NO_JUMP then + return l2 -- changed + else + local list = l1 + local _next = self:getjump(fs, list) + while _next ~= self.NO_JUMP do -- find last element + list = _next + _next = self:getjump(fs, list) + end + self:fixjump(fs, list, l2) + end + return l1 -- unchanged +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:checkstack(fs, n) + local newstack = fs.freereg + n + if newstack > fs.f.maxstacksize then + if newstack >= luaK.MAXSTACK then + luaX:syntaxerror(fs.ls, "function or expression too complex") + end + fs.f.maxstacksize = newstack + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:reserveregs(fs, n) + self:checkstack(fs, n) + fs.freereg = fs.freereg + n +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:freereg(fs, reg) + if not luaP:ISK (reg) and reg >= fs.nactvar then + fs.freereg = fs.freereg - 1 + assert(reg == fs.freereg, + string.format("reg=%i, fs.freereg=%i", reg, fs.freereg)) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:freeexp(fs, e) + if e.k == "VNONRELOC" then + self:freereg(fs, e.info) + end +end + +------------------------------------------------------------------------ +-- k is a constant, v is... what? +-- fs.h is a hash value --> index in f.k +------------------------------------------------------------------------ +-- * luaH_get, luaH_set deleted; direct table access used instead +-- * luaO_rawequalObj deleted in first assert +-- * setobj2n deleted in assignment of v to f.k table +------------------------------------------------------------------------ +--FF radically updated, not completely understood +function luaK:addk(fs, k, v) + local idx = fs.h[k.value] + local f = fs.f +-- local oldsize = f.sizek + if self:ttisnumber (idx) then + --TODO this assert currently FAILS + --assert(fs.f.k[self:nvalue(idx)] == v) + return self:nvalue(idx) + else -- constant not found; create a new entry + do + local t = type (v.value) + assert(t=="nil" or t=="string" or t=="number" or t=="boolean") + end + --debugf("[const: k[%i] = %s ]", fs.nk, tostringv(v.value)) + fs.f.k[fs.nk] = v + fs.h[k.value] = { } + self:setnvalue(fs.h[k.value], fs.nk) + local nk = fs.nk + fs.nk = fs.nk+1 + return nk + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:stringK(fs, s) + assert (type(s)=="string") + local o = {} -- TObject + self:setsvalue(o, s) + return self:addk(fs, o, o) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:numberK(fs, r) + assert (type(r)=="number") + local o = {} -- TObject + self:setnvalue(o, r) + return self:addk(fs, o, o) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:boolK(fs, r) + assert (type(r)=="boolean") + local o = {} -- TObject + self:setnvalue(o, r) + return self:addk(fs, o, o) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:nilK(fs) + local k, v = {}, {} -- TObject + self:setnilvalue(v) + self:sethvalue(k, fs.h) -- cannot use nil as key; instead use table itself + return self:addk(fs, k, v) +end + + +--FF 5.1 +function luaK:setreturns (fs, e, nresults) + if e.k == "VCALL" then -- expression is an open function call? + luaP:SETARG_C(self:getcode(fs, e), nresults + 1) + elseif e.k == "VVARARG" then + luaP:SETARG_B (self:getcode (fs, e), nresults + 1) + luaP:SETARG_A (self:getcode (fs, e), fs.freereg) + self:reserveregs (fs, 1) + end +end + +--FF 5.1 +function luaK:setmultret (fs, e) + self:setreturns (fs, e, self.LUA_MULTRET) +end + +--FF 5.1 +function luaK:setoneret (fs, e) + if e.k == "VCALL" then -- expression is an open function call? + e.k = "VNONRELOC" + e.info = luaP:GETARG_A(self:getcode(fs, e)) + elseif e.k == "VVARARG" then + luaP:SETARG_B (self:getcode (fs, e), 2) + e.k = "VRELOCABLE" + end +end + + +------------------------------------------------------------------------ +--FF deprecated in 5.1 +------------------------------------------------------------------------ +function luaK:setcallreturns(fs, e, nresults) + assert (false, "setcallreturns deprecated") + --print "SCR:" + --printv(e) + --printv(self:getcode(fs, e)) + if e.k == "VCALL" then -- expression is an open function call? + luaP:SETARG_C(self:getcode(fs, e), nresults + 1) + if nresults == 1 then -- 'regular' expression? + e.k = "VNONRELOC" + e.info = luaP:GETARG_A(self:getcode(fs, e)) + end + elseif e.k == "VVARARG" then + --printf("Handle vararg return on expr %s, whose code is %s", + -- tostringv(e), tostringv(self:getcode(fs, e))) + if nresults == 1 then + luaP:SETARG_B (self:getcode (fs, e), 2) + e.k = "VRELOCABLE" +--FIXME: why no SETARG_A??? + else + luaP:SETARG_B (self:getcode (fs, e), nresults + 1) + luaP:SETARG_A (self:getcode (fs, e), fs.freereg) + self:reserveregs (fs, 1) + --printf("Now code is %s", tostringv(self:getcode(fs, e))) + end + end +end + +------------------------------------------------------------------------ +-- Ajoute le code pour effectuer l'extraction de la locvar/upval/globvar +-- /idx, sachant +------------------------------------------------------------------------ +function luaK:dischargevars(fs, e) +--printf("\ndischargevars\n") + local k = e.k + if k == "VLOCAL" then + e.k = "VNONRELOC" + elseif k == "VUPVAL" then + e.info = self:codeABC(fs, "OP_GETUPVAL", 0, e.info, 0) + e.k = "VRELOCABLE" + elseif k == "VGLOBAL" then + e.info = self:codeABx(fs, "OP_GETGLOBAL", 0, e.info) + e.k = "VRELOCABLE" + elseif k == "VINDEXED" then + self:freereg(fs, e.aux) + self:freereg(fs, e.info) + e.info = self:codeABC(fs, "OP_GETTABLE", 0, e.info, e.aux) + e.k = "VRELOCABLE" + elseif k == "VCALL" or k == "VVARARG" then + self:setoneret(fs, e) + else + -- there is one value available (somewhere) + end +--printf("\n/dischargevars\n") +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:code_label(fs, A, b, jump) + self:getlabel(fs) -- those instructions may be jump targets + return self:codeABC(fs, "OP_LOADBOOL", A, b, jump) +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:discharge2reg(fs, e, reg) + self:dischargevars(fs, e) + local k = e.k + if k == "VNIL" then + self:_nil(fs, reg, 1) + elseif k == "VFALSE" or k == "VTRUE" then + self:codeABC(fs, "OP_LOADBOOL", reg, (e.k == "VTRUE") and 1 or 0, 0) + elseif k == "VKNUM" then + self:codeABx (fs, "OP_LOADK", reg, self:numberK(fs, e.nval)) + elseif k == "VK" then + self:codeABx(fs, "OP_LOADK", reg, e.info) + elseif k == "VRELOCABLE" then + local pc = self:getcode(fs, e) + luaP:SETARG_A(pc, reg) + elseif k == "VNONRELOC" then + if reg ~= e.info then + self:codeABC(fs, "OP_MOVE", reg, e.info, 0) + end + else + assert(e.k == "VVOID" or e.k == "VJMP") + return -- nothing to do... + end + e.info = reg + e.k = "VNONRELOC" +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:discharge2anyreg(fs, e) + if e.k ~= "VNONRELOC" then + self:reserveregs(fs, 1) + self:discharge2reg(fs, e, fs.freereg - 1) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2reg(fs, e, reg) + self:discharge2reg(fs, e, reg) + if e.k == "VJMP" then + e.t = self:concat(fs, e.t, e.info) -- put this jump in 't' list + end + if self:hasjumps(e) then + local final -- position after whole expression + local p_f = self.NO_JUMP -- position of an eventual LOAD false + local p_t = self.NO_JUMP -- position of an eventual LOAD true + if self:need_value(fs, e.t, 1) or self:need_value(fs, e.f, 0) then + local fj = self.NO_JUMP -- first jump (over LOAD ops.) + if e.k ~= "VJMP" then fj = self:jump(fs) end + p_f = self:code_label(fs, reg, 0, 1) + p_t = self:code_label(fs, reg, 1, 0) + self:patchtohere(fs, fj) + end + final = self:getlabel(fs) + self:patchlistaux(fs, e.f, final, reg, p_f) + self:patchlistaux(fs, e.t, final, reg, p_t) + end + e.f, e.t = self.NO_JUMP, self.NO_JUMP + e.info = reg + e.k = "VNONRELOC" +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2nextreg(fs, e) + self:dischargevars(fs, e) + --[FF] Allready in place (added for expr.Stat) + if e.k == "VNONRELOC" and e.info == fs.freereg then + --printf("Expression already in next reg %i: %s", fs.freereg, tostringv(e)) + return end + self:freeexp(fs, e) + self:reserveregs(fs, 1) + self:exp2reg(fs, e, fs.freereg - 1) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2anyreg(fs, e) + --printf("exp2anyregs(e=%s)", tostringv(e)) + self:dischargevars(fs, e) + if e.k == "VNONRELOC" then + if not self:hasjumps(e) then -- exp is already in a register + return e.info + end + if e.info >= fs.nactvar then -- reg. is not a local? + self:exp2reg(fs, e, e.info) -- put value on it + return e.info + end + end + self:exp2nextreg(fs, e) -- default + return e.info +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2val(fs, e) + if self:hasjumps(e) then + self:exp2anyreg(fs, e) + else + self:dischargevars(fs, e) + end +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:exp2RK(fs, e) + self:exp2val(fs, e) + local k = e.k + if k=="VNIL" or k=="VTRUE" or k=="VFALSE" or k=="VKNUM" then + if fs.nk <= luaP.MAXINDEXRK then + if k=="VNIL" then e.info = self:nilK(fs) + elseif k=="VKNUM" then e.info = self:numberK (fs, e.nval) + else e.info = self:boolK(fs, e.k=="VTRUE") end + e.k = "VK" + return luaP:RKASK(e.info) + end + elseif k == "VK" then + if e.info <= luaP.MAXINDEXRK then -- constant fit in argC? + return luaP:RKASK (e.info) + end + end + -- not a constant in the right range: put it in a register + return self:exp2anyreg(fs, e) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:storevar(fs, var, exp) + --print("STOREVAR") + --printf("var=%s", tostringv(var)) + --printf("exp=%s", tostringv(exp)) + + local k = var.k + if k == "VLOCAL" then + self:freeexp(fs, exp) + self:exp2reg(fs, exp, var.info) + return + elseif k == "VUPVAL" then + local e = self:exp2anyreg(fs, exp) + self:codeABC(fs, "OP_SETUPVAL", e, var.info, 0) + elseif k == "VGLOBAL" then + --printf("store global, exp=%s", tostringv(exp)) + local e = self:exp2anyreg(fs, exp) + self:codeABx(fs, "OP_SETGLOBAL", e, var.info) + elseif k == "VINDEXED" then + local e = self:exp2RK(fs, exp) + self:codeABC(fs, "OP_SETTABLE", var.info, var.aux, e) + else + assert(0) -- invalid var kind to store + end + self:freeexp(fs, exp) + --print("/STOREVAR") +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:_self(fs, e, key) + self:exp2anyreg(fs, e) + self:freeexp(fs, e) + local func = fs.freereg + self:reserveregs(fs, 2) + self:codeABC(fs, "OP_SELF", func, e.info, self:exp2RK(fs, key)) + self:freeexp(fs, key) + e.info = func + e.k = "VNONRELOC" +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:invertjump(fs, e) + --printf("invertjump on jump instruction #%i", e.info) + --printv(self:getcode(fs, e)) + local pc = self:getjumpcontrol(fs, e.info) + assert(luaP:testOpMode(luaP:GET_OPCODE(pc), "OpModeT") and + luaP:GET_OPCODE(pc) ~= "OP_TESTSET" and + luaP:GET_OPCODE(pc) ~= "OP_TEST") + --printf("Before invert:") + --printv(pc) + luaP:SETARG_A(pc, (luaP:GETARG_A(pc) == 0) and 1 or 0) + --printf("After invert:") + --printv(pc) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:jumponcond(fs, e, cond) + if e.k == "VRELOCABLE" then + local ie = self:getcode(fs, e) + if luaP:GET_OPCODE(ie) == "OP_NOT" then + fs.pc = fs.pc - 1 -- remove previous OP_NOT + return self:condjump(fs, "OP_TEST", luaP:GETARG_B(ie), 0, + cond and 0 or 1) + end + -- else go through + end + self:discharge2anyreg(fs, e) + self:freeexp(fs, e) + return self:condjump(fs, "OP_TESTSET", luaP.NO_REG, e.info, cond and 1 or 0) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:goiftrue(fs, e) + local pc -- pc of last jump + self:dischargevars(fs, e) + local k = e.k + if k == "VK" or k == "VTRUE" or k == "VKNUM" then + pc = self.NO_JUMP -- always true; do nothing + elseif k == "VFALSE" then + pc = self:jump(fs) -- always jump + elseif k == "VJMP" then + self:invertjump(fs, e) + pc = e.info + else + pc = self:jumponcond(fs, e, false) + end + e.f = self:concat(fs, e.f, pc) -- insert last jump in 'f' list + self:patchtohere(fs, e.t) + e.t = self.NO_JUMP +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:goiffalse(fs, e) + local pc -- pc of last jump + self:dischargevars(fs, e) + local k = e.k + if k == "VNIL" or k == "VFALSE"then + pc = self.NO_JUMP -- always false; do nothing + elseif k == "VTRUE" then + pc = self:jump(fs) -- always jump + elseif k == "VJMP" then + pc = e.info + else + pc = self:jumponcond(fs, e, true) + end + e.t = self:concat(fs, e.t, pc) -- insert last jump in 't' list + self:patchtohere(fs, e.f) + e.f = self.NO_JUMP +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:codenot(fs, e) + self:dischargevars(fs, e) + local k = e.k + if k == "VNIL" or k == "VFALSE" then + e.k = "VTRUE" + elseif k == "VK" or k == "VKNUM" or k == "VTRUE" then + e.k = "VFALSE" + elseif k == "VJMP" then + self:invertjump(fs, e) + elseif k == "VRELOCABLE" or k == "VNONRELOC" then + self:discharge2anyreg(fs, e) + self:freeexp(fs, e) + e.info = self:codeABC(fs, "OP_NOT", 0, e.info, 0) + e.k = "VRELOCABLE" + else + assert(0) -- cannot happen + end + -- interchange true and false lists + e.f, e.t = e.t, e.f + self:removevalues(fs, e.f) + self:removevalues(fs, e.t) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:indexed(fs, t, k) + t.aux = self:exp2RK(fs, k) + t.k = "VINDEXED" +end + +--FF 5.1 +function luaK:constfolding (op, e1, e2) + if not self:isnumeral(e1) or not self:isnumeral(e2) then return false end + local v1, v2, e, r = e1.nval, e2 and e2.nval, nil + if op == "OP_ADD" then r = v1+v2 + elseif op == "OP_SUB" then r = v1-v2 + elseif op == "OP_MUL" then r = v1*v2 + elseif op == "OP_DIV" then if v2==0 then return false end r = v1/v2 + elseif op == "OP_MOD" then if v2==0 then return false end r = v1%v2 + elseif op == "OP_POW" then r = v1^v2 + elseif op == "OP_UNM" then r = -v1 + elseif op == "OP_LEN" then return false + else assert (false, "Unknown numeric value") end + e1.nval = r + return true +end + +--FF 5.1 +function luaK:codearith (fs, op, e1, e2) + if self:constfolding (op, e1, e2) then return else + local o1 = self:exp2RK (fs, e1) + local o2 = 0 + if op ~= "OP_UNM" and op ~= "OP_LEN" then + o2 = self:exp2RK (fs, e2) end + self:freeexp(fs, e2) + self:freeexp(fs, e1) + e1.info = self:codeABC (fs, op, 0, o1, o2) + e1.k = "VRELOCABLE" + end +end + +--FF 5.1 +function luaK:codecomp (fs, op, cond, e1, e2) + assert (type (cond) == "boolean") + local o1 = self:exp2RK (fs, e1) + local o2 = self:exp2RK (fs, e2) + self:freeexp (fs, e2) + self:freeexp (fs, e1) + if not cond and op ~= "OP_EQ" then + local temp = o1; o1=o2; o2=temp cond = true end + e1.info = self:condjump (fs, op, cond and 1 or 0, o1, o2) + e1.k = "VJMP" +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:prefix (fs, op, e) + local e2 = { t = self.NO_JUMP; f = self.NO_JUMP; + k = "VKNUM"; nval = 0 } + if op == "unm" then + if e.k == "VK" then + self:exp2anyreg (fs, e) end + self:codearith (fs, "OP_UNM", e, e2) + elseif op == "not" then + self:codenot (fs, e) + elseif op == "len" then + self:exp2anyreg (fs, e) + self:codearith (fs, "OP_LEN", e, e2) + else + assert (false, "Unknown unary operator") + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:infix (fs, op, v) + if op == "and" then + self:goiftrue(fs, v) + elseif op == "or" then + self:goiffalse(fs, v) + elseif op == "concat" then + self:exp2nextreg(fs, v) -- operand must be on the 'stack' + else + if not self:isnumeral (v) then self:exp2RK(fs, v) end + end +end + +------------------------------------------------------------------------ +-- +-- grep "ORDER OPR" if you change these enums +------------------------------------------------------------------------ +luaK.arith_opc = { -- done as a table lookup instead of a calc + add = "OP_ADD", + sub = "OP_SUB", + mul = "OP_MUL", + mod = "OP_MOD", + div = "OP_DIV", + pow = "OP_POW", + len = "OP_LEN", + ["not"] = "OP_NOT" +} +luaK.test_opc = { -- was ops[] in the codebinop function + eq = {opc="OP_EQ", cond=true}, + lt = {opc="OP_LT", cond=true}, + le = {opc="OP_LE", cond=true}, + + -- Pseudo-ops, with no metatable equivalent: + ne = {opc="OP_EQ", cond=false}, + gt = {opc="OP_LT", cond=false}, + ge = {opc="OP_LE", cond=false} +} + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:posfix(fs, op, e1, e2) + if op == "and" then + assert(e1.t == self.NO_JUMP) -- list must be closed + self:dischargevars(fs, e2) + e2.f = self:concat(fs, e2.f, e1.f) + for k,v in pairs(e2) do e1[k]=v end -- *e1 = *e2 + elseif op == "or" then + assert(e1.f == self.NO_JUMP) -- list must be closed + self:dischargevars(fs, e2) + e2.t = self:concat(fs, e2.t, e1.t) + for k,v in pairs(e2) do e1[k]=v end -- *e1 = *e2 + elseif op == "concat" then + self:exp2val(fs, e2) + if e2.k == "VRELOCABLE" + and luaP:GET_OPCODE(self:getcode(fs, e2)) == "OP_CONCAT" then + assert(e1.info == luaP:GETARG_B(self:getcode(fs, e2)) - 1) + self:freeexp(fs, e1) + luaP:SETARG_B(self:getcode(fs, e2), e1.info) + e1.k = "VRELOCABLE"; e1.info = e2.info + else + self:exp2nextreg(fs, e2) + self:codearith (fs, "OP_CONCAT", e1, e2) + end + else + local opc = self.arith_opc[op] + if opc then self:codearith (fs, opc, e1, e2) else + opc = self.test_opc[op] or error ("Unknown operator "..op) + self:codecomp (fs, opc.opc, opc.cond, e1, e2) + end + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:fixline(fs, line) + --assert (line) + if not line then + --print(debug.traceback "fixline (line == nil)") + end + fs.f.lineinfo[fs.pc - 1] = line or 0 +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:code(fs, i, line) + if not line then + line = 0 + --print(debug.traceback "line == nil") + end + local f = fs.f + + do -- print it + local params = { } + for _,x in ipairs{"A","B","Bx", "sBx", "C"} do + if i[x] then table.insert (params, string.format ("%s=%i", x, i[x])) end + end + debugf ("[code:\t%s\t%s]", luaP.opnames[i.OP], table.concat (params, ", ")) + end + + self:dischargejpc(fs) -- 'pc' will change + + f.code[fs.pc] = i + f.lineinfo[fs.pc] = line + + if line == 0 then + f.lineinfo[fs.pc] = fs.lastline + if fs.lastline == 0 then + --print(debug.traceback()) + end + end + + if f.lineinfo[fs.pc] == 0 then + f.lineinfo[fs.pc] = 42 + end + + local pc = fs.pc + fs.pc = fs.pc + 1 + return pc +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:codeABC(fs, o, a, b, c) + assert(luaP:getOpMode(o) == "iABC", o.." is not an ABC operation") + --assert getbmode(o) ~= opargn or b == 0 + --assert getcmode(o) ~= opargn or c == 0 + --FF + --return self:code(fs, luaP:CREATE_ABC(o, a, b, c), fs.ls.lastline) + return self:code(fs, luaP:CREATE_ABC(o, a, b, c), fs.lastline) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:codeABx(fs, o, a, bc) + assert(luaP:getOpMode(o) == "iABx" or luaP:getOpMode(o) == "iAsBx") + --assert getcmode(o) == opargn + --FF + --return self:code(fs, luaP:CREATE_ABx(o, a, bc), fs.ls.lastline) + return self:code(fs, luaP:CREATE_ABx(o, a, bc), fs.lastline) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:setlist (fs, base, nelems, tostore) + local c = math.floor ((nelems-1) / luaP.LFIELDS_PER_FLUSH + 1) + local b = tostore == self.LUA_MULTRET and 0 or tostore + assert (tostore ~= 0) + if c <= luaP.MAXARG_C then self:codeABC (fs, "OP_SETLIST", base, b, c) + else + self:codeABC (fs, "OP_SETLIST", base, b, 0) + self:code (fs, c, fs.lastline)--FIXME + end + fs.freereg = base + 1 +end
diff --git a/compiler/ldump.lua b/compiler/ldump.lua new file mode 100644 index 0000000..05ace5c --- /dev/null +++ b/compiler/ldump.lua
@@ -0,0 +1,441 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2005-2013 Kein-Hong Man, Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Kein-Hong Man - Initial implementation for Lua 5.0, part of Yueliang +-- Fabien Fleutot - Port to Lua 5.1, integration with Metalua +-- +------------------------------------------------------------------------------- + +--[[-------------------------------------------------------------------- + + ldump.lua + Save bytecodes in Lua + This file is part of Yueliang. + + Copyright (c) 2005 Kein-Hong Man <khman@users.sf.net> + The COPYRIGHT file describes the conditions + under which this software may be distributed. + +------------------------------------------------------------------------ + + [FF] Slightly modified, mainly to produce Lua 5.1 bytecode. + +----------------------------------------------------------------------]] + +--[[-------------------------------------------------------------------- +-- Notes: +-- * LUA_NUMBER (double), byte order (little endian) and some other +-- header values hard-coded; see other notes below... +-- * One significant difference is that instructions are still in table +-- form (with OP/A/B/C/Bx fields) and luaP:Instruction() is needed to +-- convert them into 4-char strings +-- * Deleted: +-- luaU:DumpVector: folded into DumpLines, DumpCode +-- * Added: +-- luaU:endianness() (from lundump.c) +-- luaU:make_setS: create a chunk writer that writes to a string +-- luaU:make_setF: create a chunk writer that writes to a file +-- (lua.h contains a typedef for a Chunkwriter pointer, and +-- a Lua-based implementation exists, writer() in lstrlib.c) +-- luaU:from_double(x): encode double value for writing +-- luaU:from_int(x): encode integer value for writing +-- (error checking is limited for these conversion functions) +-- (double conversion does not support denormals or NaNs) +-- luaU:ttype(o) (from lobject.h) +----------------------------------------------------------------------]] + +module("bytecode", package.seeall) + +format = { } +format.header = string.dump(function()end):sub(1, 12) +format.little_endian, format.int_size, +format.size_t_size, format.instr_size, +format.number_size, format.integral = format.header:byte(7, 12) +format.little_endian = format.little_endian~=0 +format.integral = format.integral ~=0 + +assert(format.integral or format.number_size==8, "Number format not supported by dumper") +assert(format.little_endian, "Big endian architectures not supported by dumper") + +--requires luaP +luaU = {} + +-- constants used by dumper +luaU.LUA_TNIL = 0 +luaU.LUA_TBOOLEAN = 1 +luaU.LUA_TNUMBER = 3 -- (all in lua.h) +luaU.LUA_TSTRING = 4 +luaU.LUA_TNONE = -1 + +-- definitions for headers of binary files +--luaU.LUA_SIGNATURE = "\27Lua" -- binary files start with "<esc>Lua" +--luaU.VERSION = 81 -- 0x50; last format change was in 5.0 +--luaU.FORMAT_VERSION = 0 -- 0 is official version. yeah I know I'm a liar. + +-- a multiple of PI for testing native format +-- multiplying by 1E7 gives non-trivial integer values +--luaU.TEST_NUMBER = 3.14159265358979323846E7 + +--[[-------------------------------------------------------------------- +-- Additional functions to handle chunk writing +-- * to use make_setS and make_setF, see test_ldump.lua elsewhere +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- works like the lobject.h version except that TObject used in these +-- scripts only has a 'value' field, no 'tt' field (native types used) +------------------------------------------------------------------------ +function luaU:ttype(o) + local tt = type(o.value) + if tt == "number" then return self.LUA_TNUMBER + elseif tt == "string" then return self.LUA_TSTRING + elseif tt == "nil" then return self.LUA_TNIL + elseif tt == "boolean" then return self.LUA_TBOOLEAN + else + return self.LUA_TNONE -- the rest should not appear + end +end + +------------------------------------------------------------------------ +-- create a chunk writer that writes to a string +-- * returns the writer function and a table containing the string +-- * to get the final result, look in buff.data +------------------------------------------------------------------------ +function luaU:make_setS() + local buff = {} + buff.data = "" + local writer = + function(s, buff) -- chunk writer + if not s then return end + buff.data = buff.data..s + end + return writer, buff +end + +------------------------------------------------------------------------ +-- create a chunk writer that writes to a file +-- * returns the writer function and a table containing the file handle +-- * if a nil is passed, then writer should close the open file +------------------------------------------------------------------------ +function luaU:make_setF(filename) + local buff = {} + buff.h = io.open(filename, "wb") + if not buff.h then return nil end + local writer = + function(s, buff) -- chunk writer + if not buff.h then return end + if not s then buff.h:close(); return end + buff.h:write(s) + end + return writer, buff +end + +----------------------------------------------------------------------- +-- converts a IEEE754 double number to an 8-byte little-endian string +-- * luaU:from_double() and luaU:from_int() are from ChunkBake project +-- * supports +/- Infinity, but not denormals or NaNs +----------------------------------------------------------------------- +function luaU:from_double(x) + local function grab_byte(v) + return math.floor(v / 256), + string.char(math.mod(math.floor(v), 256)) + end + local sign = 0 + if x < 0 then sign = 1; x = -x end + local mantissa, exponent = math.frexp(x) + if x == 0 then -- zero + mantissa, exponent = 0, 0 + elseif x == 1/0 then + mantissa, exponent = 0, 2047 + else + mantissa = (mantissa * 2 - 1) * math.ldexp(0.5, 53) + exponent = exponent + 1022 + end + local v, byte = "" -- convert to bytes + x = mantissa + for i = 1,6 do + x, byte = grab_byte(x); v = v..byte -- 47:0 + end + x, byte = grab_byte(exponent * 16 + x); v = v..byte -- 55:48 + x, byte = grab_byte(sign * 128 + x); v = v..byte -- 63:56 + return v +end + +----------------------------------------------------------------------- +-- converts a number to a little-endian 32-bit integer string +-- * input value assumed to not overflow, can be signed/unsigned +----------------------------------------------------------------------- +function luaU:from_int(x, size) + local v = "" + x = math.floor(x) + if x >= 0 then + for i = 1, size do + v = v..string.char(math.mod(x, 256)); x = math.floor(x / 256) + end + else -- x < 0 + x = -x + local carry = 1 + for i = 1, size do + local c = 255 - math.mod(x, 256) + carry + if c == 256 then c = 0; carry = 1 else carry = 0 end + v = v..string.char(c); x = math.floor(x / 256) + end + end + return v +end + +--[[-------------------------------------------------------------------- +-- Functions to make a binary chunk +-- * many functions have the size parameter removed, since output is +-- in the form of a string and some sizes are implicit or hard-coded +-- * luaU:DumpVector has been deleted (used in DumpCode & DumpLines) +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- dump a block of literal bytes +------------------------------------------------------------------------ +function luaU:DumpLiteral(s, D) self:DumpBlock(s, D) end + +--[[-------------------------------------------------------------------- +-- struct DumpState: +-- L -- lua_State (not used in this script) +-- write -- lua_Chunkwriter (chunk writer function) +-- data -- void* (chunk writer context or data already written) +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- dumps a block of bytes +-- * lua_unlock(D.L), lua_lock(D.L) deleted +------------------------------------------------------------------------ +function luaU:DumpBlock(b, D) D.write(b, D.data) end + +------------------------------------------------------------------------ +-- dumps a single byte +------------------------------------------------------------------------ +function luaU:DumpByte(y, D) + self:DumpBlock(string.char(y), D) +end + +------------------------------------------------------------------------ +-- dumps a 32-bit signed integer (for int) +------------------------------------------------------------------------ +function luaU:DumpInt(x, D) + self:DumpBlock(self:from_int(x, format.int_size), D) +end + +------------------------------------------------------------------------ +-- dumps a 32-bit unsigned integer (for size_t) +------------------------------------------------------------------------ +function luaU:DumpSize(x, D) + self:DumpBlock(self:from_int(x, format.size_t_size), D) +end + +------------------------------------------------------------------------ +-- dumps a LUA_NUMBER (hard-coded as a double) +------------------------------------------------------------------------ +function luaU:DumpNumber(x, D) + if format.integral then + self:DumpBlock(self:from_int(x, format.number_size), D) + else + self:DumpBlock(self:from_double(x), D) + end +end + +------------------------------------------------------------------------ +-- dumps a Lua string +------------------------------------------------------------------------ +function luaU:DumpString(s, D) + if s == nil then + self:DumpSize(0, D) + else + s = s.."\0" -- include trailing '\0' + self:DumpSize(string.len(s), D) + self:DumpBlock(s, D) + end +end + +------------------------------------------------------------------------ +-- dumps instruction block from function prototype +------------------------------------------------------------------------ +function luaU:DumpCode(f, D) + local n = f.sizecode + self:DumpInt(n, D) + --was DumpVector + for i = 0, n - 1 do + self:DumpBlock(luaP:Instruction(f.code[i]), D) + end +end + +------------------------------------------------------------------------ +-- dumps local variable names from function prototype +------------------------------------------------------------------------ +function luaU:DumpLocals(f, D) + local n = f.sizelocvars + self:DumpInt(n, D) + for i = 0, n - 1 do + -- Dirty temporary fix: + -- `Stat{ } keeps properly count of the number of local vars, + -- but fails to keep score of their debug info (names). + -- It therefore might happen that #f.localvars < f.sizelocvars, or + -- that a variable's startpc and endpc fields are left unset. + -- FIXME: This might not be needed anymore, check the bug report + -- by J. Belmonte. + local var = f.locvars[i] + if not var then break end + -- printf("[DUMPLOCALS] dumping local var #%i = %s", i, table.tostring(var)) + self:DumpString(var.varname, D) + self:DumpInt(var.startpc or 0, D) + self:DumpInt(var.endpc or 0, D) + end +end + +------------------------------------------------------------------------ +-- dumps line information from function prototype +------------------------------------------------------------------------ +function luaU:DumpLines(f, D) + local n = f.sizelineinfo + self:DumpInt(n, D) + --was DumpVector + for i = 0, n - 1 do + self:DumpInt(f.lineinfo[i], D) -- was DumpBlock + --print(i, f.lineinfo[i]) + end +end + +------------------------------------------------------------------------ +-- dump upvalue names from function prototype +------------------------------------------------------------------------ +function luaU:DumpUpvalues(f, D) + local n = f.sizeupvalues + self:DumpInt(n, D) + for i = 0, n - 1 do + self:DumpString(f.upvalues[i], D) + end +end + +------------------------------------------------------------------------ +-- dump constant pool from function prototype +-- * nvalue(o) and tsvalue(o) macros removed +------------------------------------------------------------------------ +function luaU:DumpConstants(f, D) + local n = f.sizek + self:DumpInt(n, D) + for i = 0, n - 1 do + local o = f.k[i] -- TObject + local tt = self:ttype(o) + assert (tt >= 0) + self:DumpByte(tt, D) + if tt == self.LUA_TNUMBER then + self:DumpNumber(o.value, D) + elseif tt == self.LUA_TSTRING then + self:DumpString(o.value, D) + elseif tt == self.LUA_TBOOLEAN then + self:DumpByte (o.value and 1 or 0, D) + elseif tt == self.LUA_TNIL then + else + assert(false) -- cannot happen + end + end +end + + +function luaU:DumpProtos (f, D) + local n = f.sizep + assert (n) + self:DumpInt(n, D) + for i = 0, n - 1 do + self:DumpFunction(f.p[i], f.source, D) + end +end + +function luaU:DumpDebug(f, D) + self:DumpLines(f, D) + self:DumpLocals(f, D) + self:DumpUpvalues(f, D) +end + + +------------------------------------------------------------------------ +-- dump child function prototypes from function prototype +--FF completely reworked for 5.1 format +------------------------------------------------------------------------ +function luaU:DumpFunction(f, p, D) + -- print "Dumping function:" + -- table.print(f, 60) + + local source = f.source + if source == p then source = nil end + self:DumpString(source, D) + self:DumpInt(f.lineDefined, D) + self:DumpInt(f.lastLineDefined or 42, D) + self:DumpByte(f.nups, D) + self:DumpByte(f.numparams, D) + self:DumpByte(f.is_vararg, D) + self:DumpByte(f.maxstacksize, D) + self:DumpCode(f, D) + self:DumpConstants(f, D) + self:DumpProtos( f, D) + self:DumpDebug(f, D) +end + +------------------------------------------------------------------------ +-- dump Lua header section (some sizes hard-coded) +--FF: updated for version 5.1 +------------------------------------------------------------------------ +function luaU:DumpHeader(D) + self:DumpLiteral(format.header, D) +end + +------------------------------------------------------------------------ +-- dump function as precompiled chunk +-- * w, data are created from make_setS, make_setF +--FF: suppressed extraneous [L] param +------------------------------------------------------------------------ +function luaU:dump (Main, w, data) + local D = {} -- DumpState + D.write = w + D.data = data + self:DumpHeader(D) + self:DumpFunction(Main, nil, D) + -- added: for a chunk writer writing to a file, this final call with + -- nil data is to indicate to the writer to close the file + D.write(nil, D.data) +end + +------------------------------------------------------------------------ +-- find byte order (from lundump.c) +-- * hard-coded to little-endian +------------------------------------------------------------------------ +function luaU:endianness() + return 1 +end + +-- FIXME: ugly concat-base generation in [make_setS], bufferize properly! +function dump_string (proto) + local writer, buff = luaU:make_setS() + luaU:dump (proto, writer, buff) + return buff.data +end + +-- FIXME: [make_setS] sucks, perform synchronous file writing +-- Now unused +function dump_file (proto, filename) + local writer, buff = luaU:make_setS() + luaU:dump (proto, writer, buff) + local file = io.open (filename, "wb") + file:write (buff.data) + io.close(file) + if UNIX_SHARPBANG then os.execute ("chmod a+x "..filename) end +end \ No newline at end of file
diff --git a/compiler/lexer.lua b/compiler/lexer.lua new file mode 100644 index 0000000..15c1ad8 --- /dev/null +++ b/compiler/lexer.lua
@@ -0,0 +1,673 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +module ("lexer", package.seeall) + + +lexer = { alpha={ }, sym={ } } +lexer.__index=lexer + +local debugf = function() end +-- local debugf=printf + +---------------------------------------------------------------------- +-- Some locale settings produce bad results, e.g. French locale +-- expect float numbers to use commas instead of periods. +---------------------------------------------------------------------- +os.setlocale('C') + + + +---------------------------------------------------------------------- +-- Some locale settings produce bad results, e.g. French locale +-- expects float numbers to use commas instead of periods. +---------------------------------------------------------------------- +os.setlocale('C') + +---------------------------------------------------------------------- +-- Create a new metatable, for a new class of objects. +---------------------------------------------------------------------- +local function new_metatable(name) + local mt = { __type = 'metalua::lexer::'..name }; + mt.__index = mt; return mt +end + + + +---------------------------------------------------------------------- +-- Position: represent a point in a source file. +---------------------------------------------------------------------- +position_metatable = new_metatable 'position' + +local position_idx=1 + +function new_position(line, column, offset, source) + -- assert(type(line)=='number') + -- assert(type(column)=='number') + -- assert(type(offset)=='number') + -- assert(type(source)=='string') + local id = position_idx; position_idx = position_idx+1 + return setmetatable({line=line, column=column, offset=offset, source=source, id=id}, position_metatable) +end + +function position_metatable :__tostring() + return string.format("<%s%s|L%d|C%d|K%d>", + self.comments and "C|" or "", + self.source, self.line, self.column, self.offset) +end + + + +---------------------------------------------------------------------- +-- Position factory: convert offsets into line/column/offset positions. +---------------------------------------------------------------------- +position_factory_metatable = new_metatable 'position_factory' + +function new_position_factory(src, src_name) + -- assert(type(src)=='string') + -- assert(type(src_name)=='string') + local lines = { 1 } + for offset in src :gmatch '\n()' do table.insert(lines, offset) end + local max = #src+1 + table.insert(lines, max+1) -- +1 includes Eof + return setmetatable({ src_name=src_name, line2offset=lines, max=max }, + position_factory_metatable) +end + +function position_factory_metatable :get_position (offset) + -- assert(type(offset)=='number') + assert(offset<=self.max) + local line2offset = self.line2offset + local left = self.last_left or 1 + if offset<line2offset[left] then left=1 end + local right = left+1 + if line2offset[right]<=offset then right = right+1 end + if line2offset[right]<=offset then right = #line2offset end + while true do + -- print (" trying lines "..left.."/"..right..", offsets "..line2offset[left].. + -- "/"..line2offset[right].." for offset "..offset) + -- assert(line2offset[left]<=offset) + -- assert(offset<line2offset[right]) + -- assert(left<right) + if left+1==right then break end + local middle = math.floor((left+right)/2) + if line2offset[middle]<=offset then left=middle else right=middle end + end + -- assert(left+1==right) + -- printf("found that offset %d is between %d and %d, hence on line %d", + -- offset, line2offset[left], line2offset[right], left) + local line = left + local column = offset - line2offset[line] + 1 + self.last_left = left + return new_position(line, column, offset, self.src_name) +end + + + +---------------------------------------------------------------------- +-- Lineinfo: represent a node's range in a source file; +-- embed information about prefix and suffix comments. +---------------------------------------------------------------------- +lineinfo_metatable = new_metatable 'lineinfo' + +function new_lineinfo(first, last) + assert(first.__type=='metalua::lexer::position') + assert(last.__type=='metalua::lexer::position') + return setmetatable({first=first, last=last}, lineinfo_metatable) +end + +function lineinfo_metatable :__tostring() + local fli, lli = self.first, self.last + local line = fli.line; if line~=lli.line then line =line ..'-'..lli.line end + local column = fli.column; if column~=lli.column then column=column..'-'..lli.column end + local offset = fli.offset; if offset~=lli.offset then offset=offset..'-'..lli.offset end + return string.format("<%s%s|L%s|C%s|K%s%s>", + fli.comments and "C|" or "", + fli.source, line, column, offset, + lli.comments and "|C" or "") +end + + + +---------------------------------------------------------------------- +-- Token: atomic Lua language element, with a category, a content, +-- and some lineinfo relating it to its original source. +---------------------------------------------------------------------- +token_metatable = new_metatable 'token' + +function new_token(tag, content, lineinfo) + --printf("TOKEN `%s{ %q, lineinfo = %s} boundaries %d, %d", + -- tag, content, tostring(lineinfo), lineinfo.first.id, lineinfo.last.id) + return setmetatable({tag=tag, lineinfo=lineinfo, content}, token_metatable) +end + +function token_metatable :__tostring() + --return string.format("`%s{ %q, %s }", self.tag, self[1], tostring(self.lineinfo)) + return string.format("`%s %q", self.tag, self[1]) +end + + +---------------------------------------------------------------------- +-- Comment: series of comment blocks with associated lineinfo. +-- To be attached to the tokens just before and just after them. +---------------------------------------------------------------------- +comment_metatable = new_metatable 'comment' + +function new_comment(lines) + local first = lines[1].lineinfo.first + local last = lines[#lines].lineinfo.last + local lineinfo = new_lineinfo(first, last) + return setmetatable({lineinfo=lineinfo, unpack(lines)}, comment_metatable) +end + +function comment_metatable :text() + local last_line = self[1].lineinfo.last.line + local acc = { } + for i, line in ipairs(self) do + local nreturns = line.lineinfo.first.line - last_line + table.insert(acc, ("\n"):rep(nreturns)) + table.insert(acc, line[1]) + end + return table.concat(acc) +end + +function new_comment_line(text, lineinfo, nequals) + assert(type(text)=='string') + assert(lineinfo.__type=='metalua::lexer::lineinfo') + assert(nequals==nil or type(nequals)=='number') + return { lineinfo = lineinfo, text, nequals } +end + + + +---------------------------------------------------------------------- +-- Patterns used by [lexer :extract] to decompose the raw string into +-- correctly tagged tokens. +---------------------------------------------------------------------- +lexer.patterns = { + spaces = "^[ \r\n\t]*()", + short_comment = "^%-%-([^\n]*)\n?()", + --final_short_comment = "^%-%-([^\n]*)()$", + long_comment = "^%-%-%[(=*)%[\n?(.-)%]%1%]()", + long_string = "^%[(=*)%[\n?(.-)%]%1%]()", + number_mantissa = { "^%d+%.?%d*()", "^%d*%.%d+()" }, + number_mantissa_hex = { "^%x+%.?%x*()", "^%x*%.%x+()" }, --Lua5.1 and Lua5.2 + number_exponant = "^[eE][%+%-]?%d+()", + number_exponant_hex = "^[pP][%+%-]?%d+()", --Lua5.2 + number_hex = "^0[xX]()", + word = "^([%a_][%w_]*)()" +} + +---------------------------------------------------------------------- +-- unescape a whole string, applying [unesc_digits] and +-- [unesc_letter] as many times as required. +---------------------------------------------------------------------- +local function unescape_string (s) + + -- Turn the digits of an escape sequence into the corresponding + -- character, e.g. [unesc_digits("123") == string.char(123)]. + local function unesc_digits (backslashes, digits) + if #backslashes%2==0 then + -- Even number of backslashes, they escape each other, not the digits. + -- Return them so that unesc_letter() can treat them + return backslashes..digits + else + -- Remove the odd backslash, which escapes the number sequence. + -- The rest will be returned and parsed by unesc_letter() + backslashes = backslashes :sub (1,-2) + end + local k, j, i = digits :reverse() :byte(1, 3) + local z = _G.string.byte "0" + local code = (k or z) + 10*(j or z) + 100*(i or z) - 111*z + if code > 255 then + error ("Illegal escape sequence '\\"..digits.. + "' in string: ASCII codes must be in [0..255]") + end + local c = string.char (code) + if c == '\\' then c = '\\\\' end -- parsed by unesc_letter (test: "\092b" --> "\\b") + return backslashes..c + end + + -- Turn hex digits of escape sequence into char. + local function unesc_hex(backslashes, digits) + if #backslashes%2==0 then + return backslashes..'x'..digits + else + backslashes = backslashes :sub (1,-2) + end + local c = string.char(tonumber(digits,16)) + if c == '\\' then c = '\\\\' end -- parsed by unesc_letter (test: "\x5cb" --> "\\b") + return backslashes..c + end + + -- Handle Lua 5.2 \z sequences + local function unesc_z(backslashes, more) + if #backslashes%2==0 then + return backslashes..more + else + return backslashes :sub (1,-2) + end + end + + -- Take a letter [x], and returns the character represented by the + -- sequence ['\\'..x], e.g. [unesc_letter "n" == "\n"]. + local function unesc_letter(x) + local t = { + a = "\a", b = "\b", f = "\f", + n = "\n", r = "\r", t = "\t", v = "\v", + ["\\"] = "\\", ["'"] = "'", ['"'] = '"', ["\n"] = "\n" } + return t[x] or error([[Unknown escape sequence '\]]..x..[[']]) + end + + s = s: gsub ("(\\+)(z%s*)", unesc_z) -- Lua 5.2 + s = s: gsub ("(\\+)([0-9][0-9]?[0-9]?)", unesc_digits) + s = s: gsub ("(\\+)x([0-9a-fA-F][0-9a-fA-F])", unesc_hex) -- Lua 5.2 + s = s: gsub ("\\(%D)",unesc_letter) + return s +end + +lexer.extractors = { + "extract_long_comment", "extract_short_comment", + "extract_short_string", "extract_word", "extract_number", + "extract_long_string", "extract_symbol" } + + + +---------------------------------------------------------------------- +-- Really extract next token from the raw string +-- (and update the index). +-- loc: offset of the position just after spaces and comments +-- previous_i: offset in src before extraction began +---------------------------------------------------------------------- +function lexer :extract () + local attached_comments = { } + -- generate a non-comment token, attach comments to its lineinfo. + local function gen_token(...) + local token = new_token(...) + if #attached_comments>0 then -- attach previous comments to token + local comments = new_comment(attached_comments) + token.lineinfo.first.comments = comments + if self.lineinfo_last_extracted then + self.lineinfo_last_extracted.comments = comments + end + attached_comments = { } + end + token.lineinfo.first.facing = self.lineinfo_last_extracted + self.lineinfo_last_extracted.facing = assert(token.lineinfo.first) + self.lineinfo_last_extracted = assert(token.lineinfo.last) + return token + end + while true do -- loop until a non-comment token is found + + -- skip whitespaces + self.i = self.src:match (self.patterns.spaces, self.i) + if self.i>#self.src then -- handle EOF + local fli = self.posfact :get_position (#self.src+1) + local lli = self.posfact :get_position (#self.src+1) -- ok? + local tok = gen_token("Eof", "eof", new_lineinfo(fli, lli)) + tok.lineinfo.last.facing = lli + return tok + end + local i_first = self.i -- loc = position after whitespaces + + -- try every extractor until a token is found + for _, extractor in ipairs(self.extractors) do + local tag, content, xtra = self [extractor] (self) + if tag then + local fli = self.posfact :get_position (i_first) + local lli = self.posfact :get_position (self.i-1) + local lineinfo = new_lineinfo(fli, lli) + if tag=='Comment' then + local prev_comment = attached_comments[#attached_comments] + if not xtra -- new comment is short + and prev_comment and not prev_comment[2] -- prev comment is short + and prev_comment.lineinfo.last.line+1==fli.line then -- adjascent lines + -- concat with previous comment + prev_comment[1] = prev_comment[1].."\n"..content -- TODO quadratic, BAD! + prev_comment.lineinfo.last = lli + else -- accumulate comment + local comment = new_comment_line(content, lineinfo, xtra) + table.insert(attached_comments, comment) + end + break -- back to skipping spaces + else -- not a comment: real token, then + return gen_token(tag, content, lineinfo) + end -- if token is a comment + end -- if token found + end -- for each extractor + end -- while token is a comment +end -- :extract() + + + + +---------------------------------------------------------------------- +-- Extract a short comment. +---------------------------------------------------------------------- +function lexer :extract_short_comment() + -- TODO: handle final_short_comment + local content, j = self.src :match (self.patterns.short_comment, self.i) + if content then self.i=j; return 'Comment', content, nil end +end + +---------------------------------------------------------------------- +-- Extract a long comment. +---------------------------------------------------------------------- +function lexer :extract_long_comment() + local equals, content, j = self.src:match (self.patterns.long_comment, self.i) + if j then self.i = j; return "Comment", content, #equals end +end + +---------------------------------------------------------------------- +-- Extract a '...' or "..." short string. +---------------------------------------------------------------------- +function lexer :extract_short_string() + local k = self.src :sub (self.i,self.i) -- first char + if k~=[[']] and k~=[["]] then return end -- no match ' + local i = self.i + 1 + local j = i + while true do + local x,y; x, j, y = self.src :match ("([\\\r\n"..k.."])()(.?)", j) -- next interesting char + if x == '\\' then + if y == 'z' then -- Lua 5.2 \z + j = self.src :match ("^%s*()", j+1) + else + j=j+1 -- escaped char + end + elseif x == k then break -- end of string + else + assert (not x or x=='\r' or x=='\n') + error "Unterminated string" + end + end + self.i = j + + return 'String', unescape_string (self.src :sub (i,j-2)) +end + +---------------------------------------------------------------------- +-- Extract Id or Keyword. +---------------------------------------------------------------------- +function lexer :extract_word() + local word, j = self.src:match (self.patterns.word, self.i) + if word then + self.i = j + return (self.alpha [word] and 'Keyword' or 'Id'), word + end +end + +---------------------------------------------------------------------- +-- Extract Number. +---------------------------------------------------------------------- +function lexer :extract_number() + local j = self.src:match(self.patterns.number_hex, self.i) + if j then + j = self.src:match (self.patterns.number_mantissa_hex[1], j) or + self.src:match (self.patterns.number_mantissa_hex[2], j) + if j then + j = self.src:match (self.patterns.number_exponant_hex, j) or j + end + else + j = self.src:match (self.patterns.number_mantissa[1], self.i) or + self.src:match (self.patterns.number_mantissa[2], self.i) + if j then + j = self.src:match (self.patterns.number_exponant, j) or j + end + end + if not j then return end + -- Number found, interpret with tonumber() and return it + local str = self.src:sub (self.i, j-1) + -- :TODO: tonumber on Lua5.2 floating hex may or may not work on Lua5.1 + local n = tonumber (str) + if not n then error(str.." is not a valid number according to tonumber()") end + self.i = j + return 'Number', n +end + +---------------------------------------------------------------------- +-- Extract long string. +---------------------------------------------------------------------- +function lexer :extract_long_string() + local _, content, j = self.src :match (self.patterns.long_string, self.i) + if j then self.i = j; return 'String', content end +end + +---------------------------------------------------------------------- +-- Extract symbol. +---------------------------------------------------------------------- +function lexer :extract_symbol() + local k = self.src:sub (self.i,self.i) + local symk = self.sym [k] -- symbols starting with `k` + if not symk then + self.i = self.i + 1 + return 'Keyword', k + end + for _, sym in pairs (symk) do + if sym == self.src:sub (self.i, self.i + #sym - 1) then + self.i = self.i + #sym + return 'Keyword', sym + end + end + self.i = self.i+1 + return 'Keyword', k +end + +---------------------------------------------------------------------- +-- Add a keyword to the list of keywords recognized by the lexer. +---------------------------------------------------------------------- +function lexer :add (w, ...) + assert(not ..., "lexer :add() takes only one arg, although possibly a table") + if type (w) == "table" then + for _, x in ipairs (w) do self :add (x) end + else + if w:match (self.patterns.word .. "$") then self.alpha [w] = true + elseif w:match "^%p%p+$" then + local k = w:sub(1,1) + local list = self.sym [k] + if not list then list = { }; self.sym [k] = list end + _G.table.insert (list, w) + elseif w:match "^%p$" then return + else error "Invalid keyword" end + end +end + +---------------------------------------------------------------------- +-- Return the [n]th next token, without consumming it. +-- [n] defaults to 1. If it goes pass the end of the stream, an EOF +-- token is returned. +---------------------------------------------------------------------- +function lexer :peek (n) + if not n then n=1 end + if n > #self.peeked then + for i = #self.peeked+1, n do + self.peeked [i] = self :extract() + end + end + return self.peeked [n] +end + +---------------------------------------------------------------------- +-- Return the [n]th next token, removing it as well as the 0..n-1 +-- previous tokens. [n] defaults to 1. If it goes pass the end of the +-- stream, an EOF token is returned. +---------------------------------------------------------------------- +function lexer :next (n) + n = n or 1 + self :peek (n) + local a + for i=1,n do + a = _G.table.remove (self.peeked, 1) + -- TODO: is this used anywhere? I think not. a.lineinfo.last may be nil. + --self.lastline = a.lineinfo.last.line + end + self.lineinfo_last = a.lineinfo.last + return a +end + +---------------------------------------------------------------------- +-- Returns an object which saves the stream's current state. +---------------------------------------------------------------------- +-- FIXME there are more fields than that to save +function lexer :save () return { self.i; _G.table.cat(self.peeked) } end + +---------------------------------------------------------------------- +-- Restore the stream's state, as saved by method [save]. +---------------------------------------------------------------------- +-- FIXME there are more fields than that to restore +function lexer :restore (s) self.i=s[1]; self.peeked=s[2] end + +---------------------------------------------------------------------- +-- Resynchronize: cancel any token in self.peeked, by emptying the +-- list and resetting the indexes +---------------------------------------------------------------------- +function lexer :sync() + local p1 = self.peeked[1] + if p1 then + local li_first = p1.lineinfo.first + if li_first.comments then li_first=li_first.comments.lineinfo.first end + self.i = li_first.offset + self.column_offset = self.i - li_first.column + self.peeked = { } + self.attached_comments = p1.lineinfo.first.comments or { } + end +end + +---------------------------------------------------------------------- +-- Take the source and offset of an old lexer. +---------------------------------------------------------------------- +function lexer :takeover(old) + self :sync(); old :sync() + for _, field in ipairs{ 'i', 'src', 'attached_comments', 'posfact' } do + self[field] = old[field] + end + return self +end + +---------------------------------------------------------------------- +-- Return the current position in the sources. This position is between +-- two tokens, and can be within a space / comment area, and therefore +-- have a non-null width. :lineinfo_left() returns the beginning of the +-- separation area, :lineinfo_right() returns the end of that area. +-- +-- ____ last consummed token ____ first unconsummed token +-- / / +-- XXXXX <spaces and comments> YYYYY +-- \____ \____ +-- :lineinfo_left() :lineinfo_right() +---------------------------------------------------------------------- +function lexer :lineinfo_right() + return self :peek(1).lineinfo.first +end + +function lexer :lineinfo_left() + return self.lineinfo_last +end + +---------------------------------------------------------------------- +-- Create a new lexstream. +---------------------------------------------------------------------- +function lexer :newstream (src_or_stream, name) + name = name or "?" + if type(src_or_stream)=='table' then -- it's a stream + return setmetatable ({ }, self) :takeover (src_or_stream) + elseif type(src_or_stream)=='string' then -- it's a source string + local src = src_or_stream + local first_position = new_position(1, 1, 1, name) + local stream = { + src_name = name; -- Name of the file + src = src; -- The source, as a single string + peeked = { }; -- Already peeked, but not discarded yet, tokens + i = 1; -- Character offset in src + attached_comments = { },-- comments accumulator + lineinfo_last = first_position, -- right boundary of last consummed token + lineinfo_last_extracted = first_position, -- right boundary of last extracted token + posfact = new_position_factory (src_or_stream, name) + } + setmetatable (stream, self) + + -- skip initial sharp-bang for unix scripts + -- FIXME: redundant with mlp.chunk() + if src and src :match "^#" then stream.i = src :find "\n" + 1 end + return stream + else + assert(false, ":newstream() takes a source string or a stream, not a ".. + type(src_or_stream)) + end +end + +---------------------------------------------------------------------- +-- if there's no ... args, return the token a (whose truth value is +-- true) if it's a `Keyword{ }, or nil. If there are ... args, they +-- have to be strings. if the token a is a keyword, and it's content +-- is one of the ... args, then returns it (it's truth value is +-- true). If no a keyword or not in ..., return nil. +---------------------------------------------------------------------- +function lexer :is_keyword (a, ...) + if not a or a.tag ~= "Keyword" then return false end + local words = {...} + if #words == 0 then return a[1] end + for _, w in ipairs (words) do + if w == a[1] then return w end + end + return false +end + +---------------------------------------------------------------------- +-- Cause an error if the next token isn't a keyword whose content +-- is listed among ... args (which have to be strings). +---------------------------------------------------------------------- +function lexer :check (...) + local words = {...} + local a = self :next() + local function err () + error ("Got " .. tostring (a) .. + ", expected one of these keywords : '" .. + _G.table.concat (words,"', '") .. "'") end + + if not a or a.tag ~= "Keyword" then err () end + if #words == 0 then return a[1] end + for _, w in ipairs (words) do + if w == a[1] then return w end + end + err () +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function lexer :clone() + require 'metalua.runtime' + local clone = { + alpha = table.deep_copy(self.alpha), + sym = table.deep_copy(self.sym) } + setmetatable(clone, self) + clone.__index = clone + return clone +end + +---------------------------------------------------------------------- +-- Cancel everything left in a lexer, all subsequent attempts at +-- `:peek()` or `:next()` will return `Eof`. +---------------------------------------------------------------------- +function lexer :kill() + self.i = #self.src+1 + self.peeked = { } + self.attached_comments = { } + self.lineinfo_last = self.posfact :get_position (#self.src+1) +end
diff --git a/compiler/lopcodes.lua b/compiler/lopcodes.lua new file mode 100644 index 0000000..15d97f7 --- /dev/null +++ b/compiler/lopcodes.lua
@@ -0,0 +1,440 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2005-2013 Kein-Hong Man, Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Kein-Hong Man - Initial implementation for Lua 5.0, part of Yueliang +-- Fabien Fleutot - Port to Lua 5.1, integration with Metalua +-- +------------------------------------------------------------------------------- + +--[[-------------------------------------------------------------------- + + lopcodes.lua + Lua 5 virtual machine opcodes in Lua + This file is part of Yueliang. + + Copyright (c) 2005 Kein-Hong Man <khman@users.sf.net> + The COPYRIGHT file describes the conditions + under which this software may be distributed. + + See the ChangeLog for more information. + +------------------------------------------------------------------------ + + [FF] Slightly modified, mainly to produce Lua 5.1 bytecode. + +----------------------------------------------------------------------]] + +--[[-------------------------------------------------------------------- +-- Notes: +-- * an Instruction is a table with OP, A, B, C, Bx elements; this +-- should allow instruction handling to work with doubles and ints +-- * Added: +-- luaP:Instruction(i): convert field elements to a 4-char string +-- luaP:DecodeInst(x): convert 4-char string into field elements +-- * WARNING luaP:Instruction outputs instructions encoded in little- +-- endian form and field size and positions are hard-coded +----------------------------------------------------------------------]] + +module("bytecode", package.seeall) + +local function debugf() end + +luaP = { } + +--[[ +=========================================================================== + We assume that instructions are unsigned numbers. + All instructions have an opcode in the first 6 bits. + Instructions can have the following fields: + 'A' : 8 bits + 'B' : 9 bits + 'C' : 9 bits + 'Bx' : 18 bits ('B' and 'C' together) + 'sBx' : signed Bx + + A signed argument is represented in excess K; that is, the number + value is the unsigned value minus K. K is exactly the maximum value + for that argument (so that -max is represented by 0, and +max is + represented by 2*max), which is half the maximum for the corresponding + unsigned argument. +=========================================================================== +--]] + +luaP.OpMode = {"iABC", "iABx", "iAsBx"} -- basic instruction format + +------------------------------------------------------------------------ +-- size and position of opcode arguments. +-- * WARNING size and position is hard-coded elsewhere in this script +------------------------------------------------------------------------ +luaP.SIZE_C = 9 +luaP.SIZE_B = 9 +luaP.SIZE_Bx = luaP.SIZE_C + luaP.SIZE_B +luaP.SIZE_A = 8 + +luaP.SIZE_OP = 6 + +luaP.POS_C = luaP.SIZE_OP +luaP.POS_B = luaP.POS_C + luaP.SIZE_C +luaP.POS_Bx = luaP.POS_C +luaP.POS_A = luaP.POS_B + luaP.SIZE_B + +--FF from 5.1 +luaP.BITRK = 2^(luaP.SIZE_B - 1) +function luaP:ISK(x) return x >= self.BITRK end +luaP.MAXINDEXRK = luaP.BITRK - 1 +function luaP:RKASK(x) + if x < self.BITRK then return x+self.BITRK else return x end +end + + + +------------------------------------------------------------------------ +-- limits for opcode arguments. +-- we use (signed) int to manipulate most arguments, +-- so they must fit in BITS_INT-1 bits (-1 for sign) +------------------------------------------------------------------------ +-- removed "#if SIZE_Bx < BITS_INT-1" test, assume this script is +-- running on a Lua VM with double or int as LUA_NUMBER + +luaP.MAXARG_Bx = math.ldexp(1, luaP.SIZE_Bx) - 1 +luaP.MAXARG_sBx = math.floor(luaP.MAXARG_Bx / 2) -- 'sBx' is signed + +luaP.MAXARG_A = math.ldexp(1, luaP.SIZE_A) - 1 +luaP.MAXARG_B = math.ldexp(1, luaP.SIZE_B) - 1 +luaP.MAXARG_C = math.ldexp(1, luaP.SIZE_C) - 1 + +-- creates a mask with 'n' 1 bits at position 'p' +-- MASK1(n,p) deleted +-- creates a mask with 'n' 0 bits at position 'p' +-- MASK0(n,p) deleted + +--[[-------------------------------------------------------------------- + Visual representation for reference: + + 31 | | | 0 bit position + +-----+-----+-----+----------+ + | B | C | A | Opcode | iABC format + +-----+-----+-----+----------+ + - 9 - 9 - 8 - 6 - field sizes + +-----+-----+-----+----------+ + | [s]Bx | A | Opcode | iABx | iAsBx format + +-----+-----+-----+----------+ +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- the following macros help to manipulate instructions +-- * changed to a table object representation, very clean compared to +-- the [nightmare] alternatives of using a number or a string +------------------------------------------------------------------------ + +-- these accept or return opcodes in the form of string names +function luaP:GET_OPCODE(i) return self.ROpCode[i.OP] end +function luaP:SET_OPCODE(i, o) i.OP = self.OpCode[o] end + +function luaP:GETARG_A(i) return i.A end +function luaP:SETARG_A(i, u) i.A = u end + +function luaP:GETARG_B(i) return i.B end +function luaP:SETARG_B(i, b) i.B = b end + +function luaP:GETARG_C(i) return i.C end +function luaP:SETARG_C(i, b) i.C = b end + +function luaP:GETARG_Bx(i) return i.Bx end +function luaP:SETARG_Bx(i, b) i.Bx = b end + +function luaP:GETARG_sBx(i) return i.Bx - self.MAXARG_sBx end +function luaP:SETARG_sBx(i, b) i.Bx = b + self.MAXARG_sBx end + +function luaP:CREATE_ABC(o,a,b,c) + return {OP = self.OpCode[o], A = a, B = b, C = c} +end + +function luaP:CREATE_ABx(o,a,bc) + return {OP = self.OpCode[o], A = a, Bx = bc} +end + +------------------------------------------------------------------------ +-- Bit shuffling stuffs +------------------------------------------------------------------------ + +if false and pcall (require, 'bit') then + ------------------------------------------------------------------------ + -- Return a 4-char string little-endian encoded form of an instruction + ------------------------------------------------------------------------ + function luaP:Instruction(i) + --FIXME + end +else + ------------------------------------------------------------------------ + -- Version without bit manipulation library. + ------------------------------------------------------------------------ + local p2 = {1,2,4,8,16,32,64,128,256, 512, 1024, 2048, 4096} + -- keeps [n] bits from [x] + local function keep (x, n) return x % p2[n+1] end + -- shifts bits of [x] [n] places to the right + local function srb (x,n) return math.floor (x / p2[n+1]) end + -- shifts bits of [x] [n] places to the left + local function slb (x,n) return x * p2[n+1] end + + ------------------------------------------------------------------------ + -- Return a 4-char string little-endian encoded form of an instruction + ------------------------------------------------------------------------ + function luaP:Instruction(i) + -- printf("Instr->string: %s %s", self.opnames[i.OP], table.tostring(i)) + local c0, c1, c2, c3 + -- change to OP/A/B/C format if needed + if i.Bx then i.C = keep (i.Bx, 9); i.B = srb (i.Bx, 9) end + -- c0 = 6B from opcode + 2LSB from A (flushed to MSB) + c0 = i.OP + slb (keep (i.A, 2), 6) + -- c1 = 6MSB from A + 2LSB from C (flushed to MSB) + c1 = srb (i.A, 2) + slb (keep (i.C, 2), 6) + -- c2 = 7MSB from C + 1LSB from B (flushed to MSB) + c2 = srb (i.C, 2) + slb (keep (i.B, 1), 7) + -- c3 = 8MSB from B + c3 = srb (i.B, 1) + --printf ("Instruction: %s %s", self.opnames[i.OP], tostringv (i)) + --printf ("Bin encoding: %x %x %x %x", c0, c1, c2, c3) + return string.char(c0, c1, c2, c3) + end +end +------------------------------------------------------------------------ +-- decodes a 4-char little-endian string into an instruction struct +------------------------------------------------------------------------ +function luaP:DecodeInst(x) + error "Not implemented" +end + +------------------------------------------------------------------------ +-- invalid register that fits in 8 bits +------------------------------------------------------------------------ +luaP.NO_REG = luaP.MAXARG_A + +------------------------------------------------------------------------ +-- R(x) - register +-- Kst(x) - constant (in constant table) +-- RK(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK) +------------------------------------------------------------------------ + +------------------------------------------------------------------------ +-- grep "ORDER OP" if you change these enums +------------------------------------------------------------------------ + +--[[-------------------------------------------------------------------- +Lua virtual machine opcodes (enum OpCode): +------------------------------------------------------------------------ +name args description +------------------------------------------------------------------------ +OP_MOVE A B R(A) := R(B) +OP_LOADK A Bx R(A) := Kst(Bx) +OP_LOADBOOL A B C R(A) := (Bool)B; if (C) PC++ +OP_LOADNIL A B R(A) := ... := R(B) := nil +OP_GETUPVAL A B R(A) := UpValue[B] +OP_GETGLOBAL A Bx R(A) := Gbl[Kst(Bx)] +OP_GETTABLE A B C R(A) := R(B)[RK(C)] +OP_SETGLOBAL A Bx Gbl[Kst(Bx)] := R(A) +OP_SETUPVAL A B UpValue[B] := R(A) +OP_SETTABLE A B C R(A)[RK(B)] := RK(C) +OP_NEWTABLE A B C R(A) := {} (size = B,C) +OP_SELF A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] +OP_ADD A B C R(A) := RK(B) + RK(C) +OP_SUB A B C R(A) := RK(B) - RK(C) +OP_MUL A B C R(A) := RK(B) * RK(C) +OP_DIV A B C R(A) := RK(B) / RK(C) +OP_POW A B C R(A) := RK(B) ^ RK(C) +OP_UNM A B R(A) := -R(B) +OP_NOT A B R(A) := not R(B) +OP_CONCAT A B C R(A) := R(B).. ... ..R(C) +OP_JMP sBx PC += sBx +OP_EQ A B C if ((RK(B) == RK(C)) ~= A) then pc++ +OP_LT A B C if ((RK(B) < RK(C)) ~= A) then pc++ +OP_LE A B C if ((RK(B) <= RK(C)) ~= A) then pc++ +OP_TEST A B C if (R(B) <=> C) then R(A) := R(B) else pc++ +OP_CALL A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) +OP_TAILCALL A B C return R(A)(R(A+1), ... ,R(A+B-1)) +OP_RETURN A B return R(A), ... ,R(A+B-2) (see note) +OP_FORLOOP A sBx R(A)+=R(A+2); if R(A) <?= R(A+1) then PC+= sBx +OP_TFORLOOP A C R(A+2), ... ,R(A+2+C) := R(A)(R(A+1), R(A+2)); + if R(A+2) ~= nil then pc++ +OP_TFORPREP A sBx if type(R(A)) == table then R(A+1):=R(A), R(A):=next; + PC += sBx +OP_SETLIST A Bx R(A)[Bx-Bx%FPF+i] := R(A+i), 1 <= i <= Bx%FPF+1 +OP_SETLISTO A Bx (see note) +OP_CLOSE A close all variables in the stack up to (>=) R(A) +OP_CLOSURE A Bx R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n)) +----------------------------------------------------------------------]] + +luaP.opnames = {} -- opcode names +luaP.OpCode = {} -- lookup name -> number +luaP.ROpCode = {} -- lookup number -> name + +local i = 0 +for v in string.gfind([[ +MOVE -- 0 +LOADK +LOADBOOL +LOADNIL +GETUPVAL +GETGLOBAL -- 5 +GETTABLE +SETGLOBAL +SETUPVAL +SETTABLE +NEWTABLE -- 10 +SELF +ADD +SUB +MUL +DIV -- 15 +MOD +POW +UNM +NOT +LEN -- 20 +CONCAT +JMP +EQ +LT +LE -- 25 +TEST +TESTSET +CALL +TAILCALL +RETURN -- 30 +FORLOOP +FORPREP +TFORLOOP +SETLIST +CLOSE -- 35 +CLOSURE +VARARG +]], "[%a]+") do + local n = "OP_"..v + luaP.opnames[i] = v + luaP.OpCode[n] = i + luaP.ROpCode[i] = n + i = i + 1 +end +luaP.NUM_OPCODES = i + +--[[ +=========================================================================== + Notes: + (1) In OP_CALL, if (B == 0) then B = top. C is the number of returns - 1, + and can be 0: OP_CALL then sets 'top' to last_result+1, so + next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use 'top'. + + (2) In OP_RETURN, if (B == 0) then return up to 'top' + + (3) For comparisons, B specifies what conditions the test should accept. + + (4) All 'skips' (pc++) assume that next instruction is a jump + + (5) OP_SETLISTO is used when the last item in a table constructor is a + function, so the number of elements set is up to top of stack +=========================================================================== +--]] + +------------------------------------------------------------------------ +-- masks for instruction properties +------------------------------------------------------------------------ +-- was enum OpModeMask: +luaP.OpModeBreg = 2 -- B is a register +luaP.OpModeBrk = 3 -- B is a register/constant +luaP.OpModeCrk = 4 -- C is a register/constant +luaP.OpModesetA = 5 -- instruction set register A +luaP.OpModeK = 6 -- Bx is a constant +luaP.OpModeT = 1 -- operator is a test + +------------------------------------------------------------------------ +-- get opcode mode, e.g. "iABC" +------------------------------------------------------------------------ +function luaP:getOpMode(m) + --printv(m) + --printv(self.OpCode[m]) + --printv(self.opmodes [self.OpCode[m]+1]) + return self.OpMode[tonumber(string.sub(self.opmodes[self.OpCode[m] + 1], 7, 7))] +end + +------------------------------------------------------------------------ +-- test an instruction property flag +-- * b is a string, e.g. "OpModeBreg" +------------------------------------------------------------------------ +function luaP:testOpMode(m, b) + return (string.sub(self.opmodes[self.OpCode[m] + 1], self[b], self[b]) == "1") +end + +-- number of list items to accumulate before a SETLIST instruction +-- (must be a power of 2) +-- * used in lparser, lvm, ldebug, ltests +luaP.LFIELDS_PER_FLUSH = 50 --FF updated to match 5.1 + +-- luaP_opnames[] is set above, as the luaP.opnames table +-- opmode(t,b,bk,ck,sa,k,m) deleted + +--[[-------------------------------------------------------------------- + Legend for luaP:opmodes: + 1 T -> T (is a test?) + 2 B -> B is a register + 3 b -> B is an RK register/constant combination + 4 C -> C is an RK register/constant combination + 5 A -> register A is set by the opcode + 6 K -> Bx is a constant + 7 m -> 1 if iABC layout, + 2 if iABx layout, + 3 if iAsBx layout +----------------------------------------------------------------------]] + +luaP.opmodes = { +-- TBbCAKm opcode + "0100101", -- OP_MOVE 0 + "0000112", -- OP_LOADK + "0000101", -- OP_LOADBOOL + "0100101", -- OP_LOADNIL + "0000101", -- OP_GETUPVAL + "0000112", -- OP_GETGLOBAL 5 + "0101101", -- OP_GETTABLE + "0000012", -- OP_SETGLOBAL + "0000001", -- OP_SETUPVAL + "0011001", -- OP_SETTABLE + "0000101", -- OP_NEWTABLE 10 + "0101101", -- OP_SELF + "0011101", -- OP_ADD + "0011101", -- OP_SUB + "0011101", -- OP_MUL + "0011101", -- OP_DIV 15 + "0011101", -- OP_MOD + "0011101", -- OP_POW + "0100101", -- OP_UNM + "0100101", -- OP_NOT + "0100101", -- OP_LEN 20 + "0101101", -- OP_CONCAT + "0000003", -- OP_JMP + "1011001", -- OP_EQ + "1011001", -- OP_LT + "1011001", -- OP_LE 25 + "1000101", -- OP_TEST + "1100101", -- OP_TESTSET + "0000001", -- OP_CALL + "0000001", -- OP_TAILCALL + "0000001", -- OP_RETURN 30 + "0000003", -- OP_FORLOOP + "0000103", -- OP_FORPREP + "1000101", -- OP_TFORLOOP + "0000001", -- OP_SETLIST + "0000001", -- OP_CLOSE 35 + "0000102", -- OP_CLOSURE + "0000101" -- OP_VARARG +}
diff --git a/compiler/metalua.mlua b/compiler/metalua.mlua new file mode 100644 index 0000000..4526243 --- /dev/null +++ b/compiler/metalua.mlua
@@ -0,0 +1,275 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +--require 'verbose_require' + +require 'metalua.compiler' +require 'metalua.clopts' +require 'metalua.mlc_xcall' + +AST_COMPILE_ERROR_NUMBER = -1 +RUNTIME_ERROR_NUMBER = -3 +BYTECODE_SYNTHESE_ERROR_NUMBER = -100 + +-{ extension 'match' } + +local chunks = { } +local runargs = { } + +local acc_chunk = |kind| |arg| table.insert (chunks, { tag=kind, arg }) + +parser = clopts { + -- Chunk loading + { short = 'f', long = 'file', type = 'string', action = acc_chunk 'File', + usage = 'load a file to compile and/or run' + }, + { short = 'l', long = 'library', type = 'string', action = acc_chunk 'Library', + usage = 'load a libary from the standard paths' + }, + { short = 'e', long = 'literal', type = 'string', action = acc_chunk 'Literal', + usage = 'load a literal piece of source code' + }, + -- What to do with chunks + { short = 'o', long = 'output', type = 'string', + usage = 'set the target name of the next compiled file' + }, + { short = 'x', long = 'run', type = 'boolean', + usage = 'execute the compiled file instead of saving it (unless -o is also used)' + }, + { short = 'i', long = 'interactive', type = 'boolean', + usage = 'run an interactive loop after having run other files' + }, + -- Advanced stuff + { short = 'v', long = 'verbose', type = 'boolean', + usage = 'verbose mode' + }, + { short = 'a', long = 'print-ast', type = 'boolean', + usage = 'print the AST resulting from file compilation' + }, + { short = 'A', long = 'print-ast-lineinfo', type = 'boolean', + usage = 'print the AST resulting from file compilation, including lineinfo data' + }, + { short = 'S', long = 'print-src', type = 'boolean', + usage = 'print the AST resulting from file compilation, as re-gerenerated sources' + }, + { short = 'b', long = 'metabugs', type = 'boolean', + usage = 'show syntax errors as compile-time execution errors' + }, + { short = 's', long = 'sharpbang', type = 'string', + usage = 'set a first line to add to compiled file, typically "#!/bin/env mlr"' + }, + { long = 'no-runtime', type = 'boolean', + usage = "prevent the automatic requirement of metalua runtime" + }, + { long = '', short = 'p', type = '*', + action= function (newargs) runargs=table.icat(runargs, newargs) end, + usage = "pass all remaining arguments to the program" + }, +usage=[[ + +Compile and/or execute metalua programs. Parameters passed to the +compiler should be prefixed with an option flag, hinting what must be +done with them: take tham as file names to compile, as library names +to load, as parameters passed to the running program... When option +flags are absent, metalua tries to adopt a "Do What I Mean" approach: + +- if no code (no library, no literal expression and no file) is + specified, the first flag-less parameter is taken as a file name to + load. + +- if no code and no parameter is passed, an interactive loop is + started. + +- if a target file is specified with --output, the program is not + executed by default, unless a --run flag forces it to. Conversely, + if no --output target is specified, the code is run unless ++run + forbids it. +]]} + +local function main (...) + + local cfg = parser(...) + + ------------------------------------------------------------------- + -- Print messages if in verbose mode + ------------------------------------------------------------------- + local function verb_print (fmt, ...) + if cfg.verbose then + return printf ("[ "..fmt.." ]", ...) + end + end + + if cfg.verbose then + verb_print("raw options: %s", table.tostring(cfg)) + end + + ------------------------------------------------------------------- + -- If there's no chunk but there are params, interpret the first + -- param as a file name. + if #chunks==0 and cfg.params then + local the_file = table.remove(cfg.params, 1) + verb_print("Param %q considered as a source file", the_file) + chunks = { `File{ the_file } } + end + + ------------------------------------------------------------------- + -- If nothing to do, run REPL loop + if #chunks==0 and cfg.interactive==nil then + verb_print "Nothing to compile nor run, force interactive loop" + cfg.interactive=true + end + + + ------------------------------------------------------------------- + -- Run if asked to, or if no --output has been given + -- if cfg.run==false it's been *forced* to false, don't override. + if cfg.run==nil and not cfg.output then + verb_print("No output file specified; I'll run the program") + cfg.run = true + end + + local code = { } + + ------------------------------------------------------------------- + -- Get ASTs from sources + mlc.metabugs = cfg.metabugs + local last_file + for x in values(chunks) do + verb_print("Compiling %s", table.tostring(x)) + local st, ast + match x with + | `Library{ l } -> st, ast = true, `Call{ `Id 'require', `String{ l } } + | `Literal{ e } -> st, ast = mlc_xcall.client_literal (e) + | `File{ f } -> + st, ast = mlc_xcall.client_file (f) + -- Isolate each file in a separate fenv + if st then + ast = +{ function (...) -{ast} end (...) } + ast.source = '@'..f -- TODO [EVE] + code.source = '@'..f -- TODO [EVE] + last_file = ast + end + end + if not st then + printf ("Cannot compile %s:\n%s", table.tostring(x), ast or "no msg") + os.exit (AST_COMPILE_ERROR_NUMBER) + end + ast.origin = x + table.insert(code, ast) + end + -- The last file returns the whole chunk's result + if last_file then + local c = table.shallow_copy(last_file) + last_file <- `Return{ source = c.source, c } + end + + ------------------------------------------------------------------- + -- AST printing + if cfg['print-ast'] or cfg['print-ast-lineinfo'] then + verb_print "Resulting AST:" + for x in ivalues(code) do + printf("--- AST From %s: ---", table.tostring(x.source, 'nohash')) + if x.origin and x.origin.tag=='File' then x=x[1][1][2][1] end + if cfg['print-ast-lineinfo'] then table.print(x, 80, "indent1") + else table.print(x, 80, 'nohash') end + end + end + + ------------------------------------------------------------------- + -- Source printing + if cfg['print-src'] then + verb_print "Resulting sources:" + require 'metalua.ast_to_string' + for x in ivalues(code) do + printf("--- Source From %s: ---", table.tostring(x.source, 'nohash')) + if x.origin and x.origin.tag=='File' then x=x[1][1][2][1] end + print (ast_to_string (x)) + end + end + + -- FIXME: canonize/check AST + + ------------------------------------------------------------------- + -- Insert runtime loader + if cfg['no-runtime'] then + verb_print "Prevent insertion of command \"require 'metalua.runtime'\"" + else + table.insert(code, 1, +{require'metalua.runtime'}) + end + + local bytecode = mlc.ast_to_luacstring (code) + code = nil + + ------------------------------------------------------------------- + -- Insert #!... command + if cfg.sharpbang then + local shbang = cfg.sharpbang + verb_print ("Adding sharp-bang directive %q", shbang) + if not shbang :strmatch'^#!' then shbang = '#!' .. shbang end + if not shbang :strmatch'\n$' then shbang = shbang .. '\n' end + bytecode = shbang .. bytecode + end + + ------------------------------------------------------------------- + -- Save to file + if cfg.output then + -- FIXME: handle '-' + verb_print ("Saving to file %q", cfg.output) + local file, err_msg = io.open(cfg.output, 'wb') + if not file then error("can't open output file: "..err_msg) end + file:write(bytecode) + file:close() + if cfg.sharpbang and os.getenv "OS" ~= "Windows_NT" then + pcall(os.execute, 'chmod a+x "'..cfg.output..'"') + end + end + + ------------------------------------------------------------------- + -- Run compiled code + if cfg.run then + verb_print "Running" + local f = mlc.luacstring_to_function (bytecode) + bytecode = nil + -- FIXME: isolate execution in a ring + -- FIXME: check for failures + + runargs = table.icat(cfg.params or { }, runargs) + local function print_traceback (errmsg) + return errmsg .. '\n' .. debug.traceback ('',2) .. '\n' + end + local st, msg = xpcall(|| f(unpack (runargs)), print_traceback) + if not st then + io.stderr:write(msg) + os.exit(RUNTIME_ERROR_NUMBER) + end + end + + ------------------------------------------------------------------- + -- Run REPL loop + if cfg.interactive then + verb_print "Starting REPL loop" + require 'metalua.metaloop' + metaloop.run() + end + + verb_print "Done" + +end + +main(...)
diff --git a/compiler/mlc.mlua b/compiler/mlc.mlua new file mode 100644 index 0000000..86a64df --- /dev/null +++ b/compiler/mlc.mlua
@@ -0,0 +1,248 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +------------------------------------------------------------------------------- +-- This module is written in a more hackish way than necessary, just +-- because I can. Its core feature is to dynamically generate a +-- function that converts from a source format to a destination +-- format; these formats are the various ways to represent a piece of +-- program, from the source file to the executable function. Legal +-- formats are: +-- +-- * luafile: the name of a file containing sources. +-- * luastring: these sources as a single string. +-- * lexstream: a stream of lexemes. +-- * ast: an abstract syntax tree. +-- * proto: a (Yueliang) struture containing a high level +-- representation of bytecode. Largely based on the +-- Proto structure in Lua's VM. +-- * luacstring: a string dump of the function, as taken by +-- loadstring() and produced by string.dump(). +-- * function: an executable lua function in RAM. +-- +------------------------------------------------------------------------------- + +require 'metalua.bytecode' +require 'metalua.mlp' + +mlc = { } +setmetatable(mlc, mlc) +mlc.metabugs = false + +-------------------------------------------------------------------------------- +-- Order of the transformations. if 'a' is on the left of 'b', then a 'a' can +-- be transformed into a 'b' (but not the other way around). +-- mlc.sequence goes for numbers to format names, mlc.order goes from format +-- names to numbers. +-------------------------------------------------------------------------------- +mlc.sequence = { + 'luafile', 'luastring', 'lexstream', 'ast', 'proto', + 'luacstring', 'function' } +mlc.order = table.transpose(mlc.sequence) + +-- Check whether a structure of nested tables is a valid AST. +-- Currently thows an error if it isn't. +-- @return true When no error is found in given ast +-- @return false, error string +-- @return false, error string, positions Provide position of error in +-- given ast as a table. The position contains the following keys +-- * column: number +-- * line : number +-- * offset: number +-- TODO: build a detailed error location, with the lineinfo of every nested node. +local function check_ast(kind, ast) + if not ast then return check_ast('block', kind) end + assert(type(ast)=='table', "wrong AST type") + local cfg = {} + local function error2ast(error_node, ...) + if not error_node.stuffing then + if error_node.tag=='Error' then + cfg.errorfound = true + cfg.errormsg = error_node[1] + + -- Try to extract error position in source + local li = error_node.lineinfo and error_node.lineinfo.first + + -- Fill positions if undefined or not narrow enough + if li and ( not cfg.positions or cfg.positions.offset < li.offset ) then + cfg.positions = { + column = li.column, + line = li.line, + offset = li.offset + } + end + else + -- This block is for dealing with errors which are not error + -- nodes. It would be soooo nice to get rid of it. + -- TODO: Try to remove this bug when issue #20 is fixed + local li + for _, n in ipairs{ error_node, ... } do + if n.lineinfo then + li = n.lineinfo + cfg.errorfound = true + break + end + end + local posmsg + if li then + local column = li.first.column + local line = li.first.line + local offset = li.first.offset + posmsg = string.format("line %d, char %d, offset %d", + line, column, offset) + cfg.positions = { + column = column, + line = line, + offset = offset + } + else + posmsg = "unknown source position" + end + local msg = "Invalid node ".. + (error_node.tag and "tag "..tostring(error_node.tag) or "without tag").. + (posmsg and " at "..posmsg or "") + cfg.errormsg = msg + end + end + end + local f = require 'metalua.treequery.walk' [kind] + cfg.malformed=error2ast + cfg.unknown= error2ast + cfg.error= error2ast + f(cfg, ast) + return cfg.errorfound == nil, cfg.errormsg, cfg.positions +end + +mlc.check_ast = check_ast + +function mlc.luafile_to_luastring(x, name) + name = name or '@'..x + local f, msg = io.open (x, 'rb') + if not f then return f, msg end + local r = f :read '*a' + f :close() + return r, name +end + +function mlc.luastring_to_lexstream(src, name) + local r = mlp.lexer :newstream (src, name) + return r, name +end + +function mlc.lexstream_to_ast(lx, name) + if PRINT_PARSED_STAT then + print("About to parse a lexstream, starting with "..tostring(lx:peek())) + end + local r = mlp.chunk(lx) + r.source = name + return r, name +end + +function mlc.ast_to_proto(ast, name) + name = name or ast.source + return bytecode.metalua_compile(ast, name), name +end + +function mlc.proto_to_luacstring(proto, name) + return bytecode.dump_string(proto), name +end + +function mlc.luacstring_to_function(bc, name) + return string.undump(bc, name) +end + +-- Create all sensible combinations +for i=1,#mlc.sequence do + for j=i+2, #mlc.sequence do + local dst_name = mlc.sequence[i].."_to_"..mlc.sequence[j] + local functions = { } + --local n = { } + for k=i, j-1 do + local name = mlc.sequence[k].."_to_"..mlc.sequence[k+1] + local f = assert(mlc[name]) + table.insert (functions, f) + --table.insert(n, name) + end + mlc[dst_name] = function(a, b) + for _, f in ipairs(functions) do + a, b = f(a, b) + end + return a, b + end + --printf("Created mlc.%s out of %s", dst_name, table.concat(n, ', ')) + end +end + + +-------------------------------------------------------------------------------- +-- This case isn't handled by the __index method, as it goes "in the wrong direction" +-------------------------------------------------------------------------------- +mlc.function_to_luacstring = string.dump + +-------------------------------------------------------------------------------- +-- These are drop-in replacement for loadfile() and loadstring(). The +-- C functions will call them instead of the original versions if +-- they're referenced in the registry. +-------------------------------------------------------------------------------- + +lua_loadstring = loadstring +local lua_loadstring = loadstring +lua_loadfile = loadfile +local lua_loadfile = loadfile + +function loadstring(str, name) + if type(str) ~= 'string' then error 'string expected' end + if str:match '^\027LuaQ' then return lua_loadstring(str) end + local n = str:match '^#![^\n]*\n()' + if n then str=str:sub(n, -1) end + -- FIXME: handle erroneous returns (return nil + error msg) + local success, f = pcall (mlc.luastring_to_function, str, name) + if success then return f else return nil, f end +end + +function loadfile(filename) + local f, err_msg = io.open(filename, 'rb') + if not f then return nil, err_msg end + local success, src = pcall( f.read, f, '*a') + pcall(f.close, f) + if success then return loadstring (src, '@'..filename) + else return nil, src end +end + +function load(f, name) + while true do + local x = f() + if not x then break end + assert(type(x)=='string', "function passed to load() must return strings") + table.insert(acc, x) + end + return loadstring(table.concat(x)) +end + +function dostring(src) + local f, msg = loadstring(src) + if not f then error(msg) end + return f() +end + +function dofile(name) + local f, msg = loadfile(name) + if not f then error(msg) end + return f() +end
diff --git a/compiler/mlp_expr.lua b/compiler/mlp_expr.lua new file mode 100644 index 0000000..0c7949c --- /dev/null +++ b/compiler/mlp_expr.lua
@@ -0,0 +1,194 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.expr()] +-- * [mlp.expr_list()] +-- * [mlp.func_val()] +-- +-------------------------------------------------------------------------------- + +--require "gg" +--require "mlp_misc" +--require "mlp_table" +--require "mlp_meta" + +-------------------------------------------------------------------------------- +-- These function wrappers (eta-expansions actually) are just here to break +-- some circular dependencies between mlp_xxx.lua files. +-------------------------------------------------------------------------------- +local function _expr (lx) return mlp.expr (lx) end +local function block (lx) return mlp.block (lx) end +local function stat (lx) return mlp.stat (lx) end + +local function _table_content (lx) return mlp.table_content (lx) end + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- Non-empty expression list. Actually, this isn't used here, but that's +-- handy to give to users. +-------------------------------------------------------------------------------- +expr_list = gg.list{ _expr, separators = "," } + +-------------------------------------------------------------------------------- +-- Helpers for function applications / method applications +-------------------------------------------------------------------------------- +func_args_content = gg.list { + name = "function arguments", + _expr, separators = ",", terminators = ")" } + +-- Used to parse methods +method_args = gg.multisequence{ + name = "function argument(s)", + { "{", table_content, "}" }, + { "(", func_args_content, ")", builder = fget(1) }, + { "+{", quote_content, "}" }, + function(lx) local r = opt_string(lx); return r and {r} or { } end } + +-------------------------------------------------------------------------------- +-- [func_val] parses a function, from opening parameters parenthese to +-- "end" keyword included. Used for anonymous functions as well as +-- function declaration statements (both local and global). +-- +-- It's wrapped in a [_func_val] eta expansion, so that when expr +-- parser uses the latter, they will notice updates of [func_val] +-- definitions. +-------------------------------------------------------------------------------- +func_params_content = gg.list{ name="function parameters", + gg.multisequence{ { "...", builder = "Dots" }, id }, + separators = ",", terminators = {")", "|"} } + +local _func_params_content = function (lx) return func_params_content(lx) end + +func_val = gg.sequence { name="function body", + "(", func_params_content, ")", block, "end", builder = "Function" } + +local _func_val = function (lx) return func_val(lx) end + +-------------------------------------------------------------------------------- +-- Default parser for primary expressions +-------------------------------------------------------------------------------- +function id_or_literal (lx) + local a = lx:next() + if a.tag~="Id" and a.tag~="String" and a.tag~="Number" then + local msg + if a.tag=='Eof' then + msg = "End of file reached when an expression was expected" + elseif a.tag=='Keyword' then + msg = "An expression was expected, and `"..a[1].. + "' can't start an expression" + else + msg = "Unexpected expr token " .. _G.table.tostring (a, 'nohash') + end + return gg.parse_error (lx, msg) + end + return a +end + + +-------------------------------------------------------------------------------- +-- Builder generator for operators. Wouldn't be worth it if "|x|" notation +-- were allowed, but then lua 5.1 wouldn't compile it +-------------------------------------------------------------------------------- + +-- opf1 = |op| |_,a| `Op{ op, a } +local function opf1 (op) return + function (_,a) return { tag="Op", op, a } end end + +-- opf2 = |op| |a,_,b| `Op{ op, a, b } +local function opf2 (op) return + function (a,_,b) return { tag="Op", op, a, b } end end + +-- opf2r = |op| |a,_,b| `Op{ op, b, a } -- (args reversed) +local function opf2r (op) return + function (a,_,b) return { tag="Op", op, b, a } end end + +local function op_ne(a, _, b) + -- The first version guarantees to return the same code as Lua, + -- but it relies on the non-standard 'ne' operator, which has been + -- suppressed from the official AST grammar (although still supported + -- in practice by the compiler). + -- return { tag="Op", "ne", a, b } + return { tag="Op", "not", { tag="Op", "eq", a, b, lineinfo= { + first = a.lineinfo.first, last = b.lineinfo.last } } } +end + + +-------------------------------------------------------------------------------- +-- +-- complete expression +-- +-------------------------------------------------------------------------------- + +-- FIXME: set line number. In [expr] transformers probably + +expr = gg.expr { name = "expression", + + primary = gg.multisequence{ name="expr primary", + { "(", _expr, ")", builder = "Paren" }, + { "function", _func_val, builder = fget(1) }, + { "-{", splice_content, "}", builder = fget(1) }, + { "+{", quote_content, "}", builder = fget(1) }, + { "nil", builder = "Nil" }, + { "true", builder = "True" }, + { "false", builder = "False" }, + { "...", builder = "Dots" }, + table, + id_or_literal }, + + infix = { name="expr infix op", + { "+", prec = 60, builder = opf2 "add" }, + { "-", prec = 60, builder = opf2 "sub" }, + { "*", prec = 70, builder = opf2 "mul" }, + { "/", prec = 70, builder = opf2 "div" }, + { "%", prec = 70, builder = opf2 "mod" }, + { "^", prec = 90, builder = opf2 "pow", assoc = "right" }, + { "..", prec = 40, builder = opf2 "concat", assoc = "right" }, + { "==", prec = 30, builder = opf2 "eq" }, + { "~=", prec = 30, builder = op_ne }, + { "<", prec = 30, builder = opf2 "lt" }, + { "<=", prec = 30, builder = opf2 "le" }, + { ">", prec = 30, builder = opf2r "lt" }, + { ">=", prec = 30, builder = opf2r "le" }, + { "and",prec = 20, builder = opf2 "and" }, + { "or", prec = 10, builder = opf2 "or" } }, + + prefix = { name="expr prefix op", + { "not", prec = 80, builder = opf1 "not" }, + { "#", prec = 80, builder = opf1 "len" }, + { "-", prec = 80, builder = opf1 "unm" } }, + + suffix = { name="expr suffix op", + { "[", _expr, "]", builder = function (tab, idx) + return {tag="Index", tab, idx[1]} end}, + { ".", id, builder = function (tab, field) + return {tag="Index", tab, id2string(field[1])} end }, + { "(", func_args_content, ")", builder = function(f, args) + return {tag="Call", f, unpack(args[1])} end }, + { "{", _table_content, "}", builder = function (f, arg) + return {tag="Call", f, arg[1]} end}, + { ":", id, method_args, builder = function (obj, post) + return {tag="Invoke", obj, id2string(post[1]), unpack(post[2])} end}, + { "+{", quote_content, "}", builder = function (f, arg) + return {tag="Call", f, arg[1] } end }, + default = { name="opt_string_arg", parse = mlp.opt_string, builder = function(f, arg) + return {tag="Call", f, arg } end } } }
diff --git a/compiler/mlp_ext.lua b/compiler/mlp_ext.lua new file mode 100644 index 0000000..021a72f --- /dev/null +++ b/compiler/mlp_ext.lua
@@ -0,0 +1,108 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Non-Lua syntax extensions +-- +-------------------------------------------------------------------------------- + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- Alebraic Datatypes +-------------------------------------------------------------------------------- +local function adt (lx) + local tagval = id (lx) [1] + local tagkey = {tag="Pair", {tag="String", "tag"}, {tag="String", tagval} } + if lx:peek().tag == "String" or lx:peek().tag == "Number" then + return { tag="Table", tagkey, lx:next() } + elseif lx:is_keyword (lx:peek(), "{") then + local x = table (lx) + _G.table.insert (x, 1, tagkey) + return x + else return { tag="Table", tagkey } end +end + +expr:add{ "`", adt, builder = fget(1) } + +-------------------------------------------------------------------------------- +-- Anonymous lambda +-------------------------------------------------------------------------------- +local lambda_expr = gg.sequence{ + "|", func_params_content, "|", expr, + builder= function (x) + local li = x[2].lineinfo + return { tag="Function", x[1], + { {tag="Return", x[2], lineinfo=li }, lineinfo=li } } + end } + +-- In an earlier version, lambda_expr took an expr_list rather than an expr +-- after the 2nd bar. However, it happened to be much more of a burden than an +-- help, So finally I disabled it. If you want to return several results, +-- use the long syntax. +-------------------------------------------------------------------------------- +-- local lambda_expr = gg.sequence{ +-- "|", func_params_content, "|", expr_list, +-- builder= function (x) +-- return {tag="Function", x[1], { {tag="Return", unpack(x[2]) } } } end } + +expr:add (lambda_expr) + +-------------------------------------------------------------------------------- +-- Allows to write "a `f` b" instead of "f(a, b)". Taken from Haskell. +-- This is not part of Lua 5.1 syntax, so it's added to the expression +-- afterwards, so that it's easier to disable. +-------------------------------------------------------------------------------- +local function expr_in_backquotes (lx) return expr(lx, 35) end + +expr.infix:add{ name = "infix function", + "`", expr_in_backquotes, "`", prec = 35, assoc="left", + builder = function(a, op, b) return {tag="Call", op[1], a, b} end } + + +-------------------------------------------------------------------------------- +-- table.override assignment +-------------------------------------------------------------------------------- + +mlp.lexer:add "<-" +stat.assignments["<-"] = function (a, b) + assert( #a==1 and #b==1, "No multi-args for '<-'") + return { tag="Call", { tag="Index", { tag="Id", "table" }, + { tag="String", "override" } }, + a[1], b[1]} +end + +-------------------------------------------------------------------------------- +-- C-style op+assignments +-------------------------------------------------------------------------------- +local function op_assign(kw, op) + local function rhs(a, b) + return { tag="Op", op, a, b } + end + local function f(a,b) + return { tag="Set", a, _G.table.imap(rhs, a, b) } + end + mlp.lexer:add (kw) + mlp.stat.assignments[kw] = f +end + +_G.table.iforeach (op_assign, + {"+=", "-=", "*=", "/="}, + {"add", "sub", "mul", "div"}) \ No newline at end of file
diff --git a/compiler/mlp_lexer.lua b/compiler/mlp_lexer.lua new file mode 100644 index 0000000..70ad94c --- /dev/null +++ b/compiler/mlp_lexer.lua
@@ -0,0 +1,46 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +---------------------------------------------------------------------- +-- +-- Summary: Source file lexer. ~~Currently only works on strings. +-- Some API refactoring is needed. +-- +---------------------------------------------------------------------- + +module ("mlp", package.seeall) + +require "lexer" + +local mlp_lexer = lexer.lexer:clone() + +local keywords = { + "and", "break", "do", "else", "elseif", + "end", "false", "for", "function", + "goto", -- Lua5.2 + "if", + "in", "local", "nil", "not", "or", "repeat", + "return", "then", "true", "until", "while", + "...", "..", "==", ">=", "<=", "~=", + "::", -- Lua5,2 + "+{", "-{" } + +for w in values(keywords) do mlp_lexer:add(w) end + +_M.lexer = mlp_lexer
diff --git a/compiler/mlp_meta.lua b/compiler/mlp_meta.lua new file mode 100644 index 0000000..578dfd5 --- /dev/null +++ b/compiler/mlp_meta.lua
@@ -0,0 +1,128 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +---------------------------------------------------------------------- +-- +-- Summary: Meta-operations: AST quasi-quoting and splicing +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.splice_content()] +-- * [mlp.quote_content()] +-- +-------------------------------------------------------------------------------- + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- External splicing: compile an AST into a chunk, load and evaluate +-- that chunk, and replace the chunk by its result (which must also be +-- an AST). +-------------------------------------------------------------------------------- + +function splice (ast) + local f = mlc.ast_to_function(ast, '=splice') + local result=f() + return result +end + +-------------------------------------------------------------------------------- +-- Going from an AST to an AST representing that AST +-- the only key being lifted in this version is ["tag"] +-------------------------------------------------------------------------------- +function quote (t) + --print("QUOTING:", _G.table.tostring(t, 60)) + local cases = { } + function cases.table (t) + local mt = { tag = "Table" } + --_G.table.insert (mt, { tag = "Pair", quote "quote", { tag = "True" } }) + if t.tag == "Splice" then + assert (#t==1, "Invalid splice") + local sp = t[1] + return sp + elseif t.tag then + _G.table.insert (mt, { tag = "Pair", quote "tag", quote (t.tag) }) + end + for _, v in ipairs (t) do + _G.table.insert (mt, quote(v)) + end + return mt + end + function cases.number (t) return { tag = "Number", t, quote = true } end + function cases.string (t) return { tag = "String", t, quote = true } end + return cases [ type (t) ] (t) +end + +-------------------------------------------------------------------------------- +-- when this variable is false, code inside [-{...}] is compiled and +-- avaluated immediately. When it's true (supposedly when we're +-- parsing data inside a quasiquote), [-{foo}] is replaced by +-- [`Splice{foo}], which will be unpacked by [quote()]. +-------------------------------------------------------------------------------- +in_a_quote = false + +-------------------------------------------------------------------------------- +-- Parse the inside of a "-{ ... }" +-------------------------------------------------------------------------------- +function splice_content (lx) + local parser_name = "expr" + if lx:is_keyword (lx:peek(2), ":") then + local a = lx:next() + lx:next() -- skip ":" + assert (a.tag=="Id", "Invalid splice parser name") + parser_name = a[1] + end + local ast = mlp[parser_name](lx) + if in_a_quote then + --printf("SPLICE_IN_QUOTE:\n%s", _G.table.tostring(ast, "nohash", 60)) + return { tag="Splice", ast } + else + if parser_name == "expr" then ast = { { tag="Return", ast } } + elseif parser_name == "stat" then ast = { ast } + elseif parser_name ~= "block" then + error ("splice content must be an expr, stat or block") end + --printf("EXEC THIS SPLICE:\n%s", _G.table.tostring(ast, "nohash", 60)) + return splice (ast) + end +end + +-------------------------------------------------------------------------------- +-- Parse the inside of a "+{ ... }" +-------------------------------------------------------------------------------- +function quote_content (lx) + local parser + if lx:is_keyword (lx:peek(2), ":") then -- +{parser: content } + parser = mlp[id(lx)[1]] + lx:next() + else -- +{ content } + parser = mlp.expr + end + + local prev_iq = in_a_quote + in_a_quote = true + --print("IN_A_QUOTE") + local content = parser (lx) + local q_content = quote (content) + in_a_quote = prev_iq + return q_content +end +
diff --git a/compiler/mlp_misc.lua b/compiler/mlp_misc.lua new file mode 100644 index 0000000..dcde657 --- /dev/null +++ b/compiler/mlp_misc.lua
@@ -0,0 +1,182 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +--------------------------------------------------------------------- +-- +-- Summary: metalua parser, miscellaneous utility functions. +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.fget()] +-- * [mlp.id()] +-- * [mlp.opt_id()] +-- * [mlp.id_list()] +-- * [mlp.gensym()] +-- * [mlp.string()] +-- * [mlp.opt_string()] +-- * [mlp.id2string()] +-- +-------------------------------------------------------------------------------- + +--require "gg" +--require "mll" + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- returns a function that takes the [n]th element of a table. +-- if [tag] is provided, then this element is expected to be a +-- table, and this table receives a "tag" field whose value is +-- set to [tag]. +-- +-- The primary purpose of this is to generate builders for +-- grammar generators. It has little purpose in metalua, as lambda has +-- a lightweight syntax. +-------------------------------------------------------------------------------- + +function fget (n, tag) + assert (type (n) == "number") + if tag then + assert (type (tag) == "string") + return function (x) + assert (type (x[n]) == "table") + return {tag=tag, unpack(x[n])} end + else + return function (x) return x[n] end + end +end + + +-------------------------------------------------------------------------------- +-- Try to read an identifier (possibly as a splice), or return [false] if no +-- id is found. +-------------------------------------------------------------------------------- +function opt_id (lx) + local a = lx:peek(); + if lx:is_keyword (a, "-{") then + local v = gg.sequence{ "-{", splice_content, "}" } (lx) [1] + if v.tag ~= "Id" and v.tag ~= "Splice" then + return gg.parse_error(lx, "Bad id splice") + end + return v + elseif a.tag == "Id" then return lx:next() + else return false end +end + +-------------------------------------------------------------------------------- +-- Mandatory reading of an id: causes an error if it can't read one. +-------------------------------------------------------------------------------- +function id (lx) + return opt_id (lx) or gg.parse_error(lx,"Identifier expected") +end + +-------------------------------------------------------------------------------- +-- Common helper function +-------------------------------------------------------------------------------- +id_list = gg.list { primary = mlp.id, separators = "," } + +-------------------------------------------------------------------------------- +-- Symbol generator: [gensym()] returns a guaranteed-to-be-unique identifier. +-- The main purpose is to avoid variable capture in macros. +-- +-- If a string is passed as an argument, theis string will be part of the +-- id name (helpful for macro debugging) +-------------------------------------------------------------------------------- +local gensymidx = 0 + +function gensym (arg) + gensymidx = gensymidx + 1 + return { tag="Id", _G.string.format(".%i.%s", gensymidx, arg or "")} +end + +-------------------------------------------------------------------------------- +-- Converts an identifier into a string. Hopefully one day it'll handle +-- splices gracefully, but that proves quite tricky. +-------------------------------------------------------------------------------- +function id2string (id) + --print("id2string:", disp.ast(id)) + if id.tag == "Id" then id.tag = "String"; return id + elseif id.tag == "Splice" then + assert (in_a_quote, "can't do id2string on an outermost splice") + error ("id2string on splice not implemented") + -- Evaluating id[1] will produce `Id{ xxx }, + -- and we want it to produce `String{ xxx } + -- Morally, this is what I want: + -- return `String{ `Index{ `Splice{ id[1] }, `Number 1 } } + -- That is, without sugar: + return {tag="String", {tag="Index", {tag="Splice", id[1] }, + {tag="Number", 1 } } } + elseif id.tag == 'Error' then return id + else error ("Identifier expected: ".._G.table.tostring(id, 'nohash')) end +end + +-------------------------------------------------------------------------------- +-- Read a string, possibly spliced, or return an error if it can't +-------------------------------------------------------------------------------- +function string (lx) + local a = lx:peek() + if lx:is_keyword (a, "-{") then + local v = gg.sequence{ "-{", splice_content, "}" } (lx) [1] + if v.tag ~= "" and v.tag ~= "Splice" then + return gg.parse_error(lx,"Bad string splice") + end + return v + elseif a.tag == "String" then return lx:next() + else error "String expected" end +end + +-------------------------------------------------------------------------------- +-- Try to read a string, or return false if it can't. No splice allowed. +-------------------------------------------------------------------------------- +function opt_string (lx) + return lx:peek().tag == "String" and lx:next() +end + +-------------------------------------------------------------------------------- +-- Chunk reader: block + Eof +-------------------------------------------------------------------------------- +function skip_initial_sharp_comment (lx) + -- Dirty hack: I'm happily fondling lexer's private parts + -- FIXME: redundant with lexer:newstream() + lx :sync() + local i = lx.src:match ("^#.-\n()", lx.i) + if i then lx.i, lx.column_offset, lx.line = i, i, lx.line+1 end +end + +local function _chunk (lx) + if PRINT_PARSED_STAT then print "HI"; printf("about to chunk on %s", tostring(lx:peek())) end + if lx:peek().tag == 'Eof' then + if PRINT_PARSED_STAT then print "at EOF" end + return { } -- handle empty files + else + skip_initial_sharp_comment (lx) + if PRINT_PARSED_STAT then printf("after skipping, at %s", tostring(lx:peek())) end + local chunk = block (lx) + if lx:peek().tag ~= "Eof" then + _G.table.insert(chunk, gg.parse_error(lx, "End-of-file expected")) + end + return chunk + end +end + +-- chunk is wrapped in a sequence so that it has a "transformer" field. +chunk = gg.sequence { _chunk, builder = unpack }
diff --git a/compiler/mlp_stat.lua b/compiler/mlp_stat.lua new file mode 100644 index 0000000..c5aa8c1 --- /dev/null +++ b/compiler/mlp_stat.lua
@@ -0,0 +1,244 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +---------------------------------------------------------------------- +-- +-- Summary: metalua parser, statement/block parser. This is part of +-- the definition of module [mlp]. +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exports API: +-- * [mlp.stat()] +-- * [mlp.block()] +-- * [mlp.for_header()] +-- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- eta-expansions to break circular dependency +-------------------------------------------------------------------------------- +local expr = function (lx) return mlp.expr (lx) end +local func_val = function (lx) return mlp.func_val (lx) end +local expr_list = function (lx) return mlp.expr_list(lx) end + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- List of all keywords that indicate the end of a statement block. Users are +-- likely to extend this list when designing extensions. +-------------------------------------------------------------------------------- + + +local block_terminators = { "else", "elseif", "end", "until", ")", "}", "]" } + +-- FIXME: this must be handled from within GG!!! +function block_terminators:add(x) + if type (x) == "table" then for _, y in ipairs(x) do self:add (y) end + else _G.table.insert (self, x) end +end + +-------------------------------------------------------------------------------- +-- list of statements, possibly followed by semicolons +-------------------------------------------------------------------------------- +block = gg.list { + name = "statements block", + terminators = block_terminators, + primary = function (lx) + -- FIXME use gg.optkeyword() + local x = stat (lx) + if lx:is_keyword (lx:peek(), ";") then lx:next() end + return x + end } + +-------------------------------------------------------------------------------- +-- Helper function for "return <expr_list>" parsing. +-- Called when parsing return statements. +-- The specific test for initial ";" is because it's not a block terminator, +-- so without itgg.list would choke on "return ;" statements. +-- We don't make a modified copy of block_terminators because this list +-- is sometimes modified at runtime, and the return parser would get out of +-- sync if it was relying on a copy. +-------------------------------------------------------------------------------- +local return_expr_list_parser = gg.multisequence{ + { ";" , builder = function() return { } end }, + default = gg.list { + expr, separators = ",", terminators = block_terminators } } + +-------------------------------------------------------------------------------- +-- for header, between [for] and [do] (exclusive). +-- Return the `Forxxx{...} AST, without the body element (the last one). +-------------------------------------------------------------------------------- +function for_header (lx) + local vars = mlp.id_list(lx) + if lx :is_keyword (lx:peek(), "=") then + if #vars ~= 1 then + return gg.parse_error (lx, "numeric for only accepts one variable") + end + lx:next() -- skip "=" + local exprs = expr_list (lx) + if #exprs < 2 or #exprs > 3 then + return gg.parse_error (lx, "numeric for requires 2 or 3 boundaries") + end + return { tag="Fornum", vars[1], unpack (exprs) } + else + if not lx :is_keyword (lx :next(), "in") then + return gg.parse_error (lx, '"=" or "in" expected in for loop') + end + local exprs = expr_list (lx) + return { tag="Forin", vars, exprs } + end +end + +-------------------------------------------------------------------------------- +-- Function def parser helper: id ( . id ) * +-------------------------------------------------------------------------------- +local function fn_builder (list) + local r = list[1] + for i = 2, #list do r = { tag="Index", r, id2string(list[i]) } end + return r +end +local func_name = gg.list{ id, separators = ".", builder = fn_builder } + +-------------------------------------------------------------------------------- +-- Function def parser helper: ( : id )? +-------------------------------------------------------------------------------- +local method_name = gg.onkeyword{ name = "method invocation", ":", id, + transformers = { function(x) return x and x.tag=='Id' and id2string(x) end } } + +-------------------------------------------------------------------------------- +-- Function def builder +-------------------------------------------------------------------------------- +local function funcdef_builder(x) + + local name = x[1] or gg.earlier_error() + local method = x[2] + local func = x[3] or gg.earlier_error() + + + if method then + name = { tag="Index", name, method, lineinfo = { + first = name.lineinfo.first, + last = method.lineinfo.last } } + _G.table.insert (func[1], 1, {tag="Id", "self"}) + end + local r = { tag="Set", {name}, {func} } + r[1].lineinfo = name.lineinfo + r[2].lineinfo = func.lineinfo + return r +end + + +-------------------------------------------------------------------------------- +-- if statement builder +-------------------------------------------------------------------------------- +local function if_builder (x) + local cb_pairs, else_block, r = x[1], x[2], {tag="If"} + if cb_pairs.tag=='Error' then return cb_pairs end -- propagate errors + local n_pairs = #cb_pairs + for i = 1, n_pairs do + local cond, block = unpack(cb_pairs[i]) + r[2*i-1], r[2*i] = cond, block + end + if else_block then r[#r+1] = else_block end + return r +end + +-------------------------------------------------------------------------------- +-- produce a list of (expr,block) pairs +-------------------------------------------------------------------------------- +local elseifs_parser = gg.list { + gg.sequence { expr, "then", block, name='if/then block' }, + separators = "elseif", + terminators = { "else", "end" } } + +-------------------------------------------------------------------------------- +-- assignments and calls: statements that don't start with a keyword +-------------------------------------------------------------------------------- +local function assign_or_call_stat_parser (lx) + local e = expr_list (lx) + local a = lx:is_keyword(lx:peek()) + local op = a and stat.assignments[a] + if op then + --FIXME: check that [e] is a LHS + lx:next() + local v = expr_list (lx) + if type(op)=="string" then return { tag=op, e, v } + else return op (e, v) end + else + assert (#e > 0) + if #e > 1 then + return gg.parse_error (lx, + "comma is not a valid statement separator; statement can be ".. + "separated by semicolons, or not separated at all") end + if e[1].tag ~= "Call" and e[1].tag ~= "Invoke" then + local typename + if e[1].tag == 'Id' then + typename = '("'..e[1][1]..'") is an identifier' + elseif e[1].tag == 'Op' then + typename = "is an arithmetic operation" + else typename = "is of type '"..(e[1].tag or "<list>").."'" end + + return gg.parse_error (lx, "This expression " .. typename .. + "; a statement was expected, and only function and method call ".. + "expressions can be used as statements"); + end + return e[1] + end +end + +local_stat_parser = gg.multisequence{ + -- local function <name> <func_val> + { "function", id, func_val, builder = + function(x) + local vars = { x[1], lineinfo = x[1].lineinfo } + local vals = { x[2], lineinfo = x[2].lineinfo } + return { tag="Localrec", vars, vals } + end }, + -- local <id_list> ( = <expr_list> )? + default = gg.sequence{ id_list, gg.onkeyword{ "=", expr_list }, + builder = function(x) return {tag="Local", x[1], x[2] or { } } end } } + +-------------------------------------------------------------------------------- +-- statement +-------------------------------------------------------------------------------- +stat = gg.multisequence { + name="statement", + { "do", block, "end", builder = + function (x) return { tag="Do", unpack (x[1]) } end }, + { "for", for_header, "do", block, "end", builder = + function (x) x[1][#x[1]+1] = x[2]; return x[1] end }, + { "function", func_name, method_name, func_val, builder=funcdef_builder }, + { "while", expr, "do", block, "end", builder = "While" }, + { "repeat", block, "until", expr, builder = "Repeat" }, + { "local", local_stat_parser, builder = fget (1) }, + { "return", return_expr_list_parser, builder = fget (1, "Return") }, + { "break", builder = function() return { tag="Break" } end }, + { "-{", splice_content, "}", builder = fget(1) }, + { "if", gg.nonempty(elseifs_parser), gg.onkeyword{ "else", block }, "end", + builder = if_builder }, + default = assign_or_call_stat_parser } + +stat.assignments = { + ["="] = "Set" } + +stat.dontfail = true +function stat.assignments:add(k, v) self[k] = v end
diff --git a/compiler/mlp_table.lua b/compiler/mlp_table.lua new file mode 100644 index 0000000..cfc26a2 --- /dev/null +++ b/compiler/mlp_table.lua
@@ -0,0 +1,103 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +---------------------------------------------------------------------- +-- +-- Summary: metalua parser, table constructor parser. This is part +-- of thedefinition of module [mlp]. +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.table_field()] +-- * [mlp.table_content()] +-- * [mlp.table()] +-- +-- KNOWN BUG: doesn't handle final ";" or "," before final "}" +-- +-------------------------------------------------------------------------------- + +--require "gg" +--require "mll" +--require "mlp_misc" +local tableinsert = table.insert + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- eta expansion to break circular dependencies: +-------------------------------------------------------------------------------- +local function _expr (lx) return expr(lx) end + +-------------------------------------------------------------------------------- +-- [[key] = value] table field definition +-------------------------------------------------------------------------------- +local bracket_field = gg.sequence{ "[", _expr, "]", "=", _expr, builder = "Pair" } + +-------------------------------------------------------------------------------- +-- [id = value] or [value] table field definition; +-- [[key]=val] are delegated to [bracket_field()] +-------------------------------------------------------------------------------- +function table_field (lx) + if lx:is_keyword (lx:peek(), "[") then return bracket_field (lx) end + local e = _expr (lx) + if lx:is_keyword (lx:peek(), "=") then + lx:next(); -- skip the "=" + local key = id2string(e) + local val = _expr(lx) + local r = { tag="Pair", key, val } + r.lineinfo = { first = key.lineinfo.first, last = val.lineinfo.last } + return r + else return e end +end + +local function _table_field(lx) return table_field(lx) end + +-------------------------------------------------------------------------------- +-- table constructor, without enclosing braces; returns a full table object +-------------------------------------------------------------------------------- +function table_content(lx) + local items = {tag = "Table"} + while not lx:is_keyword(lx:peek(), '}') do + -- Seek for table values + local tablevalue = _table_field (lx) + if tablevalue then + tableinsert(items, tablevalue) + else + return gg.parse_error(lx, '`Pair of value expected.') + end + + -- Seek for values separators + if lx:is_keyword(lx:peek(), ',', ';') then + lx:next() + elseif not lx:is_keyword(lx:peek(), '}') then + return gg.parse_error(lx, '} expected.') + end + end + return items +end + +local function _table_content(lx) return table_content(lx) end + +-------------------------------------------------------------------------------- +-- complete table constructor including [{...}] +-------------------------------------------------------------------------------- +table = gg.sequence{ "{", _table_content, "}", builder = fget(1) }
diff --git a/lib/errnode.lua b/lib/errnode.lua new file mode 100644 index 0000000..1680c48 --- /dev/null +++ b/lib/errnode.lua
@@ -0,0 +1,38 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Sierra Wireless and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Kevin Kin-Foo - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.compiler' +-- +-- Ecapsulates funcion mlc.luastring_to_ast in order to protect call and parse +-- error string when an error occurs. +-- +-- @param src string containg Lua code to evaluate +-- @return AST of table type, as returned by mlc.luastring_to_ast. Contains an +-- error when AST generation fails +-- +function getast(src) + local status, result = pcall(mlc.luastring_to_ast, src) + if status then return result else + local line, column, offset = result:match '%(l.(%d+), c.(%d+), k.(%d+)%)' + local filename = result :match '^([^:]+)' + local msg = result :match 'line %d+, char %d+: (.-)\n' + local li = {line, column, offset, filename} + return {tag='Error', lineinfo={first=li, last=li}, msg} + end +end
diff --git a/lib/metalua/ast_to_string.mlua b/lib/metalua/ast_to_string.mlua new file mode 100644 index 0000000..33091c6 --- /dev/null +++ b/lib/metalua/ast_to_string.mlua
@@ -0,0 +1,572 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'match' } + +local M = { } +M.__index = M + +ast_to_string = |x| M.run(x) + +-------------------------------------------------------------------------------- +-- Instanciate a new AST->source synthetizer +-------------------------------------------------------------------------------- +function M.new () + local self = { + _acc = { }, -- Accumulates pieces of source as strings + current_indent = 0, -- Current level of line indentation + indent_step = " " -- Indentation symbol, normally spaces or '\t' + } + return setmetatable (self, M) +end + +-------------------------------------------------------------------------------- +-- Run a synthetizer on the `ast' arg and return the source as a string. +-- Can also be used as a static method `M.run (ast)'; in this case, +-- a temporary Metizer is instanciated on the fly. +-------------------------------------------------------------------------------- +function M:run (ast) + if not ast then + self, ast = M.new(), self + end + self._acc = { } + self:node (ast) + return table.concat (self._acc) +end + +-------------------------------------------------------------------------------- +-- Accumulate a piece of source file in the synthetizer. +-------------------------------------------------------------------------------- +function M:acc (x) + if x then table.insert (self._acc, x) end +end + +-------------------------------------------------------------------------------- +-- Accumulate an indented newline. +-- Jumps an extra line if indentation is 0, so that +-- toplevel definitions are separated by an extra empty line. +-------------------------------------------------------------------------------- +function M:nl () + if self.current_indent == 0 then self:acc "\n" end + self:acc ("\n" .. self.indent_step:rep (self.current_indent)) +end + +-------------------------------------------------------------------------------- +-- Increase indentation and accumulate a new line. +-------------------------------------------------------------------------------- +function M:nlindent () + self.current_indent = self.current_indent + 1 + self:nl () +end + +-------------------------------------------------------------------------------- +-- Decrease indentation and accumulate a new line. +-------------------------------------------------------------------------------- +function M:nldedent () + self.current_indent = self.current_indent - 1 + self:acc ("\n" .. self.indent_step:rep (self.current_indent)) +end + +-------------------------------------------------------------------------------- +-- Keywords, which are illegal as identifiers. +-------------------------------------------------------------------------------- +local keywords = table.transpose { + "and", "break", "do", "else", "elseif", + "end", "false", "for", "function", "if", + "in", "local", "nil", "not", "or", + "repeat", "return", "then", "true", "until", + "while" } + +-------------------------------------------------------------------------------- +-- Return true iff string `id' is a legal identifier name. +-------------------------------------------------------------------------------- +local function is_ident (id) + return id:strmatch "^[%a_][%w_]*$" and not keywords[id] +end + +-------------------------------------------------------------------------------- +-- Return true iff ast represents a legal function name for +-- syntax sugar ``function foo.bar.gnat() ... end'': +-- a series of nested string indexes, with an identifier as +-- the innermost node. +-------------------------------------------------------------------------------- +local function is_idx_stack (ast) + match ast with + | `Id{ _ } -> return true + | `Index{ left, `String{ _ } } -> return is_idx_stack (left) + | _ -> return false + end +end + +-------------------------------------------------------------------------------- +-- Operator precedences, in increasing order. +-- This is not directly used, it's used to generate op_prec below. +-------------------------------------------------------------------------------- +local op_preprec = { + { "or", "and" }, + { "lt", "le", "eq", "ne" }, + { "concat" }, + { "add", "sub" }, + { "mul", "div", "mod" }, + { "unary", "not", "len" }, + { "pow" }, + { "index" } } + +-------------------------------------------------------------------------------- +-- operator --> precedence table, generated from op_preprec. +-------------------------------------------------------------------------------- +local op_prec = { } + +for prec, ops in ipairs (op_preprec) do + for op in ivalues (ops) do + op_prec[op] = prec + end +end + +-------------------------------------------------------------------------------- +-- operator --> source representation. +-------------------------------------------------------------------------------- +local op_symbol = { + add = " + ", sub = " - ", mul = " * ", + div = " / ", mod = " % ", pow = " ^ ", + concat = " .. ", eq = " == ", ne = " ~= ", + lt = " < ", le = " <= ", ["and"] = " and ", + ["or"] = " or ", ["not"] = "not ", len = "# " } + +-------------------------------------------------------------------------------- +-- Accumulate the source representation of AST `node' in +-- the synthetizer. Most of the work is done by delegating to +-- the method having the name of the AST tag. +-- If something can't be converted to normal sources, it's +-- instead dumped as a `-{ ... }' splice in the source accumulator. +-------------------------------------------------------------------------------- +function M:node (node) + assert (self~=M and self._acc) + if not node.tag then -- tagless block. + self:list (node, self.nl) + else + local f = M[node.tag] + if type (f) == "function" then -- Delegate to tag method. + f (self, node, unpack (node)) + elseif type (f) == "string" then -- tag string. + self:acc (f) + else -- No appropriate method, fall back to splice dumping. + -- This cannot happen in a plain Lua AST. + self:acc " -{ " + self:acc (table.tostring (node, "nohash"), 80) + self:acc " }" + end + end +end + +-------------------------------------------------------------------------------- +-- Convert every node in the AST list `list' passed as 1st arg. +-- `sep' is an optional separator to be accumulated between each list element, +-- it can be a string or a synth method. +-- `start' is an optional number (default == 1), indicating which is the +-- first element of list to be converted, so that we can skip the begining +-- of a list. +-------------------------------------------------------------------------------- +function M:list (list, sep, start) + for i = start or 1, # list do + self:node (list[i]) + if list[i + 1] then + if not sep then + elseif type (sep) == "function" then sep (self) + elseif type (sep) == "string" then self:acc (sep) + else error "Invalid list separator" end + end + end +end + +-------------------------------------------------------------------------------- +-- +-- Tag methods. +-- ------------ +-- +-- Specific AST node dumping methods, associated to their node kinds +-- by their name, which is the corresponding AST tag. +-- synth:node() is in charge of delegating a node's treatment to the +-- appropriate tag method. +-- +-- Such tag methods are called with the AST node as 1st arg. +-- As a convenience, the n node's children are passed as args #2 ... n+1. +-- +-- There are several things that could be refactored into common subroutines +-- here: statement blocks dumping, function dumping... +-- However, given their small size and linear execution +-- (they basically perform series of :acc(), :node(), :list(), +-- :nl(), :nlindent() and :nldedent() calls), it seems more readable +-- to avoid multiplication of such tiny functions. +-- +-- To make sense out of these, you need to know metalua's AST syntax, as +-- found in the reference manual or in metalua/doc/ast.txt. +-- +-------------------------------------------------------------------------------- + +function M:Do (node) + self:acc "do" + self:nlindent () + self:list (node, self.nl) + self:nldedent () + self:acc "end" +end + +function M:Set (node) + match node with + | `Set{ { `Index{ lhs, `String{ method } } }, + { `Function{ { `Id "self", ... } == params, body } } } + if is_idx_stack (lhs) and is_ident (method) -> + -- ``function foo:bar(...) ... end'' -- + self:acc "function " + self:node (lhs) + self:acc ":" + self:acc (method) + self:acc " (" + self:list (params, ", ", 2) + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" + + | `Set{ { lhs }, { `Function{ params, body } } } if is_idx_stack (lhs) -> + -- ``function foo(...) ... end'' -- + self:acc "function " + self:node (lhs) + self:acc " (" + self:list (params, ", ") + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" + + | `Set{ { `Id{ lhs1name } == lhs1, ... } == lhs, rhs } + if not is_ident (lhs1name) -> + -- ``foo, ... = ...'' when foo is *not* a valid identifier. + -- In that case, the spliced 1st variable must get parentheses, + -- to be distinguished from a statement splice. + -- This cannot happen in a plain Lua AST. + self:acc "(" + self:node (lhs1) + self:acc ")" + if lhs[2] then -- more than one lhs variable + self:acc ", " + self:list (lhs, ", ", 2) + end + self:acc " = " + self:list (rhs, ", ") + + | `Set{ lhs, rhs } -> + -- ``... = ...'', no syntax sugar -- + self:list (lhs, ", ") + self:acc " = " + self:list (rhs, ", ") + end +end + +function M:While (node, cond, body) + self:acc "while " + self:node (cond) + self:acc " do" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function M:Repeat (node, body, cond) + self:acc "repeat" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "until " + self:node (cond) +end + +function M:If (node) + for i = 1, #node-1, 2 do + -- for each ``if/then'' and ``elseif/then'' pair -- + local cond, body = node[i], node[i+1] + self:acc (i==1 and "if " or "elseif ") + self:node (cond) + self:acc " then" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + end + -- odd number of children --> last one is an `else' clause -- + if #node%2 == 1 then + self:acc "else" + self:nlindent () + self:list (node[#node], self.nl) + self:nldedent () + end + self:acc "end" +end + +function M:Fornum (node, var, first, last) + local body = node[#node] + self:acc "for " + self:node (var) + self:acc " = " + self:node (first) + self:acc ", " + self:node (last) + if #node==5 then -- 5 children --> child #4 is a step increment. + self:acc ", " + self:node (node[4]) + end + self:acc " do" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function M:Forin (node, vars, generators, body) + self:acc "for " + self:list (vars, ", ") + self:acc " in " + self:list (generators, ", ") + self:acc " do" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function M:Local (node, lhs, rhs) + if next (lhs) then + self:acc "local " + self:list (lhs, ", ") + if rhs[1] then + self:acc " = " + self:list (rhs, ", ") + end + else -- Can't create a local statement with 0 variables in plain Lua + self:acc (table.tostring (node, 'nohash', 80)) + end +end + +function M:Localrec (node, lhs, rhs) + match node with + | `Localrec{ { `Id{name} }, { `Function{ params, body } } } + if is_ident (name) -> + -- ``local function name() ... end'' -- + self:acc "local function " + self:acc (name) + self:acc " (" + self:list (params, ", ") + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" + + | _ -> + -- Other localrec are unprintable ==> splice them -- + -- This cannot happen in a plain Lua AST. -- + self:acc "-{ " + self:acc (table.tostring (node, 'nohash', 80)) + self:acc " }" + end +end + +function M:Call (node, f) + -- single string or table literal arg ==> no need for parentheses. -- + local parens + match node with + | `Call{ _, `String{_} } + | `Call{ _, `Table{...}} -> parens = false + | _ -> parens = true + end + self:node (f) + self:acc (parens and " (" or " ") + self:list (node, ", ", 2) -- skip `f'. + self:acc (parens and ")") +end + +function M:Invoke (node, f, method) + -- single string or table literal arg ==> no need for parentheses. -- + local parens + match node with + | `Invoke{ _, _, `String{_} } + | `Invoke{ _, _, `Table{...}} -> parens = false + | _ -> parens = true + end + self:node (f) + self:acc ":" + self:acc (method[1]) + self:acc (parens and " (" or " ") + self:list (node, ", ", 3) -- Skip args #1 and #2, object and method name. + self:acc (parens and ")") +end + +function M:Return (node) + self:acc "return " + self:list (node, ", ") +end + +M.Break = "break" +M.Nil = "nil" +M.False = "false" +M.True = "true" +M.Dots = "..." + +function M:Number (node, n) + self:acc (tostring (n)) +end + +function M:String (node, str) + -- format "%q" prints '\n' in an umpractical way IMO, + -- so this is fixed with the :gsub( ) call. + self:acc (string.format ("%q", str):gsub ("\\\n", "\\n")) +end + +function M:Function (node, params, body) + self:acc "function (" + self:list (params, ", ") + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function M:Table (node) + if not node[1] then self:acc "{ }" else + self:acc "{" + if #node > 1 then self:nlindent () else self:acc " " end + for i, elem in ipairs (node) do + match elem with + | `Pair{ `String{ key }, value } if is_ident (key) -> + -- ``key = value''. -- + self:acc (key) + self:acc " = " + self:node (value) + + | `Pair{ key, value } -> + -- ``[key] = value''. -- + self:acc "[" + self:node (key) + self:acc "] = " + self:node (value) + + | _ -> + -- ``value''. -- + self:node (elem) + end + if node [i+1] then + self:acc "," + self:nl () + end + end + if #node > 1 then self:nldedent () else self:acc " " end + self:acc "}" + end +end + +function M:Op (node, op, a, b) + -- Transform ``not (a == b)'' into ``a ~= b''. -- + match node with + | `Op{ "not", `Op{ "eq", _a, _b } } + | `Op{ "not", `Paren{ `Op{ "eq", _a, _b } } } -> + op, a, b = "ne", _a, _b + | _ -> + end + + if b then -- binary operator. + local left_paren, right_paren + match a with + | `Op{ op_a, ...} if op_prec[op] >= op_prec[op_a] -> left_paren = true + | _ -> left_paren = false + end + + match b with -- FIXME: might not work with right assoc operators ^ and .. + | `Op{ op_b, ...} if op_prec[op] >= op_prec[op_b] -> right_paren = true + | _ -> right_paren = false + end + + self:acc (left_paren and "(") + self:node (a) + self:acc (left_paren and ")") + + self:acc (op_symbol [op]) + + self:acc (right_paren and "(") + self:node (b) + self:acc (right_paren and ")") + + else -- unary operator. + local paren + match a with + | `Op{ op_a, ... } if op_prec[op] >= op_prec[op_a] -> paren = true + | _ -> paren = false + end + self:acc (op_symbol[op]) + self:acc (paren and "(") + self:node (a) + self:acc (paren and ")") + end +end + +function M:Paren (node, content) + self:acc "(" + self:node (content) + self:acc ")" +end + +function M:Index (node, table, key) + local paren_table + -- Check precedence, see if parens are needed around the table -- + match table with + | `Op{ op, ... } if op_prec[op] < op_prec.index -> paren_table = true + | _ -> paren_table = false + end + + self:acc (paren_table and "(") + self:node (table) + self:acc (paren_table and ")") + + match key with + | `String{ field } if is_ident (field) -> + -- ``table.key''. -- + self:acc "." + self:acc (field) + | _ -> + -- ``table [key]''. -- + self:acc "[" + self:node (key) + self:acc "]" + end +end + +function M:Id (node, name) + if is_ident (name) then + self:acc (name) + else -- Unprintable identifier, fall back to splice representation. + -- This cannot happen in a plain Lua AST. + self:acc "-{`Id " + self:String (node, name) + self:acc "}" + end +end +
diff --git a/lib/metalua/base.lua b/lib/metalua/base.lua new file mode 100644 index 0000000..08be242 --- /dev/null +++ b/lib/metalua/base.lua
@@ -0,0 +1,123 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +---------------------------------------------------------------------- +---------------------------------------------------------------------- +-- +-- Base library extension +-- +---------------------------------------------------------------------- +---------------------------------------------------------------------- + +if not metalua then rawset(getfenv(), 'metalua', { }) end +metalua.version = "v-0.5" + +if not rawpairs then + rawpairs, rawipairs, rawtype = pairs, ipairs, type +end + +function pairs(x) + assert(type(x)=='table', 'pairs() expects a table') + local mt = getmetatable(x) + if mt then + local mtp = mt.__pairs + if mtp then return mtp(x) end + end + return rawpairs(x) +end + +function ipairs(x) + assert(type(x)=='table', 'ipairs() expects a table') + local mt = getmetatable(x) + if mt then + local mti = mt.__ipairs + if mti then return mti(x) end + end + return rawipairs(x) +end + +--[[ +function type(x) + local mt = getmetatable(x) + if mt then + local mtt = mt.__type + if mtt then return mtt end + end + return rawtype(x) +end +]] + +function min (a, ...) + for n in values{...} do if n<a then a=n end end + return a +end + +function max (a, ...) + for n in values{...} do if n>a then a=n end end + return a +end + +function o (...) + local args = {...} + local function g (...) + local result = {...} + for i=#args, 1, -1 do result = {args[i](unpack(result))} end + return unpack (result) + end + return g +end + +function id (...) return ... end +function const (k) return function () return k end end + +function printf(...) return print(string.format(...)) end +function eprintf(...) + io.stderr:write(string.format(...).."\n") +end + +function ivalues (x) + assert(type(x)=='table', 'ivalues() expects a table') + local i = 1 + local function iterator () + local r = x[i]; i=i+1; return r + end + return iterator +end + + +function values (x) + assert(type(x)=='table', 'values() expects a table') + local function iterator (state) + local it + state.content, it = next(state.list, state.content) + return it + end + return iterator, { list = x } +end + +function keys (x) + assert(type(x)=='table', 'keys() expects a table') + local function iterator (state) + local it = next(state.list, state.content) + state.content = it + return it + end + return iterator, { list = x } +end +
diff --git a/lib/metalua/clopts.mlua b/lib/metalua/clopts.mlua new file mode 100644 index 0000000..28d19c3 --- /dev/null +++ b/lib/metalua/clopts.mlua
@@ -0,0 +1,223 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- Command Line OPTionS handler +-- ============================ +-- +-- This lib generates parsers for command-line options. It encourages +-- the following of some common idioms: I'm pissed off by Unix tools +-- which sometimes will let you concatenate single letters options, +-- sometimes won't, will prefix long name options with simple dashes +-- instead of doubles, etc. +-- +-------------------------------------------------------------------------------- + +-- TODO: +-- * add a generic way to unparse options ('grab everything') +-- * doc +-- * when a short options that takes a param isn't the last element of a series +-- of shorts, take the remaining of the sequence as that param, e.g. -Ifoo +-- * let unset strings/numbers with + +-- * add a ++ long counterpart to + +-- + +-{ extension 'match' } + +function clopts(cfg) + local short, long, param_func = { }, { } + local legal_types = table.transpose{ + 'boolean','string','number','string*','number*','nil', '*' } + + ----------------------------------------------------------------------------- + -- Fill short and long name indexes, and check its validity + ----------------------------------------------------------------------------- + for x in ivalues(cfg) do + local xtype = type(x) + if xtype=='table' then + if not x.type then x.type='nil' end + if not legal_types[x.type] then error ("Invalid type name "..x.type) end + if x.short then + if short[x.short] then error ("multiple definitions for option "..x.short) + else short[x.short] = x end + end + if x.long then + if long[x.long] then error ("multiple definitions for option "..x.long) + else long[x.long] = x end + end + elseif xtype=='function' then + if param_func then error "multiple parameters handler in clopts" + else param_func=x end + end + end + + ----------------------------------------------------------------------------- + -- Print a help message, summarizing how to use the command line + ----------------------------------------------------------------------------- + local function print_usage(msg) + if msg then print(msg,'\n') end + print(cfg.usage or "Options:\n") + for x in values(cfg) do + if type(x) == 'table' then + local opts = { } + if x.type=='boolean' then + if x.short then opts = { '-'..x.short..'/+'..x.short } end + if x.long then table.insert (opts, '--'..x.long..'/++'..x.long) end + else + if x.short then opts = { '-'..x.short..' <'..x.type..'>' } end + if x.long then table.insert (opts, '--'..x.long..' <'..x.type..'>' ) end + end + printf(" %s: %s", table.concat(opts,', '), x.usage or '<undocumented>') + end + end + print'' + end + + -- Unless overridden, -h and --help display the help msg + local default_help = { action = | | print_usage() or os.exit(0); + long='help';short='h';type='nil'} + if not short.h then short.h = default_help end + if not long.help then long.help = default_help end + + ----------------------------------------------------------------------------- + -- Helper function for options parsing. Execute the attached action and/or + -- register the config in cfg. + -- + -- * cfg is the table which registers the options + -- * dict the name->config entry hash table that describes options + -- * flag is the prefix '-', '--' or '+' + -- * opt is the option name + -- * i the current index in the arguments list + -- * args is the arguments list + ----------------------------------------------------------------------------- + local function actionate(cfg, dict, flag, opt, i, args) + local entry = dict[opt] + if not entry then print_usage ("invalid option "..flag..opt); return false; end + local etype, name = entry.type, entry.name or entry.long or entry.short + match etype with + | 'string' | 'number' | 'string*' | 'number*' -> + if flag=='+' or flag=='++' then + print_usage ("flag "..flag.." is reserved for boolean options, not for "..opt) + return false + end + local arg = args[i+1] + if not arg then + print_usage ("missing parameter for option "..flag..opt) + return false + end + if etype:strmatch '^number' then + arg = tonumber(arg) + if not arg then + print_usage ("option "..flag..opt.." expects a number argument") + end + end + if etype:strmatch '%*$' then + if not cfg[name] then cfg[name]={ } end + table.insert(cfg[name], arg) + else cfg[name] = arg end + if entry.action then entry.action(arg) end + return i+2 + | 'boolean' -> + local arg = flag=='-' or flag=='--' + cfg[name] = arg + if entry.action then entry.action(arg) end + return i+1 + | 'nil' -> + cfg[name] = true; + if entry.action then entry.action() end + return i+1 + | '*' -> + local arg = table.isub(args, i+1, #args) + cfg[name] = arg + if entry.action then entry.action(arg) end + return #args+1 + | _ -> assert( false, 'undetected bad type for clopts action') + end + end + + ----------------------------------------------------------------------------- + -- Parse a list of commands: the resulting function + ----------------------------------------------------------------------------- + local function parse(...) + local cfg = { } + if not ... then return cfg end + local args = type(...)=='table' and ... or {...} + local i, i_max = 1, #args + while i <= i_max do + local arg, flag, opt, opts = args[i] + --printf('beginning of loop: i=%i/%i, arg=%q', i, i_max, arg) + if arg=='-' then + i=actionate (cfg, short, '-', '', i, args) + -{ `Goto 'continue' } + end + + ----------------------------------------------------------------------- + -- double dash option + ----------------------------------------------------------------------- + flag, opt = arg:strmatch "^(%-%-)(.*)" + if opt then + i=actionate (cfg, long, flag, opt, i, args) + -{ `Goto 'continue' } + end + + ----------------------------------------------------------------------- + -- double plus option + ----------------------------------------------------------------------- + flag, opt = arg:strmatch "^(%+%+)(.*)" + if opt then + i=actionate (cfg, long, flag, opt, i, args) + -{ `Goto 'continue' } + end + + ----------------------------------------------------------------------- + -- single plus or single dash series of short options + ----------------------------------------------------------------------- + flag, opts = arg:strmatch "^([+-])(.+)" + if opts then + local j_max, i2 = opts:len() + for j = 1, j_max do + opt = opts:sub(j,j) + --printf ('parsing short opt %q', opt) + i2 = actionate (cfg, short, flag, opt, i, args) + if i2 ~= i+1 and j < j_max then + error ('short option '..opt..' needs a param of type '..short[opt]) + end + end + i=i2 + -{ `Goto 'continue' } + end + + ----------------------------------------------------------------------- + -- handler for non-option parameter + ----------------------------------------------------------------------- + if param_func then param_func(args[i]) end + if cfg.params then table.insert(cfg.params, args[i]) + else cfg.params = { args[i] } end + i=i+1 + + -{ `Label 'continue' } + if not i then return false end + end -- </while> + return cfg + end + + return parse +end + +
diff --git a/lib/metalua/compiler.lua b/lib/metalua/compiler.lua new file mode 100644 index 0000000..030b79b --- /dev/null +++ b/lib/metalua/compiler.lua
@@ -0,0 +1,22 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.runtime' +require 'metalua.mlc' +require 'metalua.package2'
diff --git a/lib/metalua/dollar.mlua b/lib/metalua/dollar.mlua new file mode 100644 index 0000000..c4f324e --- /dev/null +++ b/lib/metalua/dollar.mlua
@@ -0,0 +1,43 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- TODO: support modules as macros? +-- does it make sense to store a constant AST as a macro? + +-{ extension 'match' } + +dollar = rawget(getfenv(), 'dollar') or { } + +local function dollar_builder(call) + match call with + | `Call{ `Id{name}, ... } -> return dollar[name](select(2, unpack(call))) + | `Id{name} -> + local m = dollar[name] + match type(m) with + | 'function' -> return m() + | 'table' -> return m + | 'nil' -> error "No such macro registered" + | t -> error ("Invalid macro type "..t) + end + | _ -> error "Invalid $macro, '$' should be followed by an identifier or function call" + end +end + +mlp.expr.prefix:add{ '$', prec = 100, builder = |_, x| dollar_builder(x) } +mlp.stat:add{ '$', mlp.expr, builder = |x| dollar_builder(x[1]) }
diff --git a/lib/metalua/extension/H-runtime.mlua b/lib/metalua/extension/H-runtime.mlua new file mode 100644 index 0000000..63ac784 --- /dev/null +++ b/lib/metalua/extension/H-runtime.mlua
@@ -0,0 +1,235 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.walk.id' +-{ extension 'log' } + +-------------------------------------------------------------------------------- +-- +-- H params: +-- * H.alpha is the `Local{ } (or `Set{ }) statement which will +-- receive the alpha-conversions required to restore the free +-- variables of the transformed term. For instance, +-- H+{print(1)} will be transformed into +{.1.X.print(1)}, +-- and alpha will contain +{local -{`Id '.1.X.print} = print }. +-- alpha is reused and augmented by successive calls to H(). +-- +-- * H.side contains 'inside', 'outside', 'both' or nil (equivalent to +-- 'both'). It indicates the kind of hygienization that's to be +-- performed. +-- +-- * H.keep contain a set of free variable names which must not be +-- renamed. +-- +-- * H.kind is the kind of walker that must be used ('expr', 'stat', +-- 'block'...) and defaults to 'guess'. +-- +-- * H:set (field, val) sets a field in H and returns H, so that calls +-- can be chained, e.g.: +-- > H:set(keep, {'print'}):set('side', outside)+{print(x)} +-- +-- * H:reset(field) sets a field to nil, and returns the value of that +-- field prior to nilification. +-------------------------------------------------------------------------------- + +H = { } --setmetatable(H, H) +H.__index=H +H.template = { alpha = { } } + +-------------------------------------------------------------------------------- +-- +-------------------------------------------------------------------------------- +function H:new(x) + local instance = table.deep_copy(self.template) + if x then instance <- x end + setmetatable(instance, self) + return instance +end + +-------------------------------------------------------------------------------- +-- +-------------------------------------------------------------------------------- +function H:__call (ast) + assert (type(ast)=='table', "H expects an AST") + + local local_renames -- only set if inside hygienization's required + + ----------------------------------------------------------------------------- + -- kind of hygienization(s) to perform: h_inseide and/or h_outside + ----------------------------------------------------------------------------- + local h_inside, h_outside do + local side = self.side or 'both' + h_inside = side=='inside' or side=='both' + h_outside = side=='outside' or side=='both' + end + + ----------------------------------------------------------------------------- + -- Initialize self.keep: + -- self.keep is a dictionary of free var names to be protected from capture + ----------------------------------------------------------------------------- + do + local k = self.keep + -- If there's no self.keep, that's an empty dictionary + if not k then k = { }; self.keep = k + -- If it's a string, consider it as a single-element dictionary + elseif type(k)=='string' then k = { [k] = true }; self.keep=k + -- If there's a list-part in self.keep, transpose it: + else for i, v in ipairs(k) do k[v], k[i] = true, nil end end + end + + ----------------------------------------------------------------------------- + -- Config skeleton for the id walker + ----------------------------------------------------------------------------- + local cfg = { expr = { }, stat = { }, id = { } } + + ----------------------------------------------------------------------------- + -- Outside hygienization: all free variables are renamed to fresh ones, + -- and self.alpha is updated to contain the assignments required to keep + -- the AST's semantics. + ----------------------------------------------------------------------------- + if h_outside then + local alpha = self.alpha + + -- free_vars is an old_name -> new_name dictionary computed from alpha: + -- self.alpha is not an efficient representation for searching. + if not alpha then alpha = { }; self.alpha = alpha end + -- FIXME: alpha should only be overridden when there actually are some + -- globals renamed. + if #alpha==0 then alpha <- `Local{ { }, { } } end + local new, old = unpack(alpha) + local free_vars = { } + + assert (#new==#old, "Invalid alpha list") + for i = 1, #new do + assert (old[i].tag=='Id' and #old[i]==1, "Invalid lhs in alpha list") + assert (new[i].tag=='Id' and #new[i]==1, "Invalid rhs in alpha list") + free_vars[old[i][1]] = new[i][1] + end + + -- Rename free variables that are not supposed to be captured. + function cfg.id.free (id) + local old_name = id[1] + if self.keep[old_name] then return end + local new_name = free_vars[old_name] + if not new_name then + new_name = mlp.gensym('X.'..old_name)[1] + free_vars[old_name] = new_name + table.insert(alpha[1], `Id{new_name}) + table.insert(alpha[2], `Id{old_name}) + end + id[1] = new_name + end + end + + ----------------------------------------------------------------------------- + -- Inside hygienization: rename all local variables and their ocurrences. + ----------------------------------------------------------------------------- + if h_inside then + + ---------------------------------------------------------------- + -- Renamings can't performed on-the-spot, as it would + -- transiently break the link between binders and bound vars, + -- thus preventing the algo to work. They're therefore stored + -- in local_renames, and performed after the whole tree has been + -- walked. + ---------------------------------------------------------------- + + local_renames = { } -- `Id{ old_name } -> new_name + local bound_vars = { } -- binding statement -> old_name -> new_name + + ---------------------------------------------------------------- + -- Give a new name to newly created local vars, store it in + -- bound_vars + ---------------------------------------------------------------- + function cfg.binder (id, binder) + if id.h_boundary then return end + local old_name = id[1] + local binder_table = bound_vars[binder] + if not binder_table then + binder_table = { } + bound_vars[binder] = binder_table + end + local new_name = mlp.gensym('L.'..old_name)[1] + binder_table[old_name] = new_name + local_renames[id] = new_name + end + + ---------------------------------------------------------------- + -- List a bound var for renaming. The new name has already been + -- chosen and put in bound_vars by cfg.binder(). + ---------------------------------------------------------------- + function cfg.id.bound (id, binder) + if id.h_boundary then return end + local old_name = id[1] + local new_name = bound_vars[binder][old_name] + --.log(bound_vars[binder]) + assert(new_name, "no alpha conversion for a bound var?!") + local_renames[id] = new_name + end + end + + ----------------------------------------------------------------------------- + -- Don't traverse subtrees marked by '!' + ----------------------------------------------------------------------------- + local cut_boundaries = |x| x.h_boundary and 'break' or nil + cfg.stat.down, cfg.expr.down = cut_boundaries, cut_boundaries + + ----------------------------------------------------------------------------- + -- The walker's config is ready, let's go. + -- After that, ids are renamed in ast, free_vars and bound_vars are set. + ----------------------------------------------------------------------------- + walk_id [self.kind or 'guess'] (cfg, ast) + + if h_inside then -- Apply local name changes + for id, new_name in pairs(local_renames) do id[1] = new_name end + end + + return ast +end + +-------------------------------------------------------------------------------- +-- Return H to allow call chainings +-------------------------------------------------------------------------------- +function H:set(field, val) + local t = type(field) + if t=='string' then self[field]=val + elseif t=='table' then self <- field + else error("Can't set H, field arg can't be of type "..t) end + return self +end + +-------------------------------------------------------------------------------- +-- Return the value before reset +-------------------------------------------------------------------------------- +function H:reset(field) + if type(field) ~= 'string' then error "Can only reset H string fields" end + local r = H[field] + H[field] = nil + return r +end + +-- local function commit_locals_to_chunk(x) +-- local alpha = H:reset 'alpha' +-- --$log ('commit locals', x, alpha, 'nohash') +-- if not alpha or not alpha[1][1] then return end +-- if not x then return alpha end +-- table.insert(x, 1, alpha) +-- end + +-- mlp.chunk.transformers:add (commit_locals_to_chunk)
diff --git a/lib/metalua/extension/H.mlua b/lib/metalua/extension/H.mlua new file mode 100644 index 0000000..0a63f6e --- /dev/null +++ b/lib/metalua/extension/H.mlua
@@ -0,0 +1,41 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.walk.id' +-{ extension 'log' } + +mlp.expr.prefix:add{ '!', prec = 5, + builder = function(_,x) + local v = mlp.gensym() + return `Stat{ +{ block: + local -{v} = -{x}; + (-{v}).h_boundary=true }, + v } + end } + +mlp.stat:add{ '!', mlp.expr, builder = |x| +{stat: (-{x[1]}).h_boundary=true } } + +-- * if there's no boundary in it, is there a need to rename vars? +-- ==> first pass to mark binders which contain boundaries, +-- then 2nd pass only touched those which have a splice +-- in them. + +return +{ require (-{ `String{ package.metalua_extension_prefix .. 'H-runtime' } }) } + +
diff --git a/lib/metalua/extension/anaphoric.mlua b/lib/metalua/extension/anaphoric.mlua new file mode 100644 index 0000000..aacb0d4 --- /dev/null +++ b/lib/metalua/extension/anaphoric.mlua
@@ -0,0 +1,73 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Anaphoric macros. +-- +-- This extension turns 'it' into a special variable, that's bound to +-- an often used value: +-- +-- * in an 'if' statement, 'it' is bound, in a block, to the condition +-- that triggered the block's execution: +-- > if 1234 then y=it end; assert (y == 1234) +-- +-- * in a while loop, it's bound to the test: +-- > while file:read "*a" do table.insert (lines, it) end +-- +-- 'it' is bound the the most closely surrounding structure. If you wanted to +-- use its content at a deeper position in the AST, you would have to save it +-- in a temporary variable. But what you should really do in such a case is +-- avoiding to use anaphoric macros: they're fine for one-liner, but they +-- reduce readability for bigger functions. +-------------------------------------------------------------------------------- + +-- TODO: 'and' operator could, and maybe should, be anaphoric as well +-- TODO: anaphoric functions would be cool for recursive functions, but +-- recursive calls are always in an 'if' statement, so the pronoun +-- used for functions must not be the same as for 'if'. + +require 'freevars' + +local function anaphoric_if(ast) + local it_found = false + for i=2, #ast do + if freevars.block(ast[i])['it'] then + it_found = true + break + end + end + if it_found then + local cond = ast[1] + ast[1] = +{it} + return +{stat: do local it = -{cond}; -{ast} end } + end +end + +local function anaphoric_while(ast) + local it_found = false + if freevars.block(ast[2])['it'] then + local cond = ast[1] + ast[1] = +{it} + return +{stat: do local it = -{cond}; -{ast} end } + end +end + +mlp.stat:get'if'.transformers:add(anaphoric_if) +mlp.stat:get'while'.transformers:add(anaphoric_while) \ No newline at end of file
diff --git a/lib/metalua/extension/clist.mlua b/lib/metalua/extension/clist.mlua new file mode 100644 index 0000000..ae28e84 --- /dev/null +++ b/lib/metalua/extension/clist.mlua
@@ -0,0 +1,156 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- This extension implements list comprehensions, similar to Haskell and +-- Python syntax, to easily describe lists. +-- +-------------------------------------------------------------------------------- + +-{ extension "match" } + +local function dots_builder (x) return `Dots{ x } end + +local function for_builder (x, h) + match x with + | `Comp{ _, acc } -> table.insert (acc, h[1]); return x + | `Pair{ _, _ } -> error "No explicit key in a for list generator" + | _ -> return `Comp{ x, {h[1]} } + end +end + +local function if_builder (x, p) + match x with + | `Comp{ _, acc } -> table.insert (acc, `If{ p[1] }); return x + | `Pair{ _, _ } -> error "No explicit key in a list guard" + | _ -> return `Comp{ x, p[1] } + end +end + +local function comp_builder(core, list, no_unpack) + -- [ti] = temp var holding table.insert + -- [v] = variable holding the table being built + -- [r] = the core of the list being built + local ti, v, r = mlp.gensym "table_insert", mlp.gensym "table" + + ----------------------------------------------------------------------------- + -- 1 - Build the loop's core: if it has suffix "...", every elements of the + -- multi-return must be inserted, hence the extra [for] loop. + ----------------------------------------------------------------------------- + match core with + | `Dots{ x } -> + local w = mlp.gensym() + r = +{stat: for -{w} in values( -{x} ) do -{ `Call{ ti, v, w } } end } + | `Pair{ k, w } -> + r = `Set{ { `Index{ v, k } }, { w } } + | _ -> r = `Call{ ti, v, core } + end + + ----------------------------------------------------------------------------- + -- 2 - Stack the if and for control structures, from outside to inside. + -- This is done in a destructive way for the elements of [list]. + ----------------------------------------------------------------------------- + for i = #list, 1, -1 do + table.insert (list[i], {r}) + r = list[i] + end + if no_unpack then + return `Stat{ { `Local{ {ti, v}, { +{table.insert}, `Table} }, r }, v } + else + return +{ function() + local -{ti}, -{v} = table.insert, { } + -{r}; return unpack(-{v}) + end () } + end +end + +local function table_content_builder (list) + match list with + | { `Comp{ y, acc } } -> return comp_builder( y, acc, "no unpack") + | _ -> + local tables = { `Table } + local ctable = tables[1] + local function flush() ctable=`Table; table.insert(tables, ctable) end + for x in values(list) do + match x with + | `Comp{ y, acc } -> table.insert(ctable, comp_builder(y, acc)); flush() + | `Dots{ y } -> table.insert(ctable, y); flush() + | _ -> table.insert (ctable, x); + end + end + match tables with + | { x } | { x, { } } -> return x + | _ -> + if #tables[#tables]==0 then table.remove(tables) end --suppress empty table + return `Call{ +{table.cat}, unpack(tables) } + end + end +end + +mlp.table_field = gg.expr{ name="table cell", + primary = mlp.table_field, + suffix = { name="table cell suffix", + { "...", builder = dots_builder }, + { "for", mlp.for_header, builder = for_builder }, + { "if", mlp.expr, builder = if_builder } } } + +mlp.table_content.builder = table_content_builder + +--[[ +mlp.stat:add{ "for", gg.expr { + primary = for_header, + suffix = { + { "for", mlp.for_header, builder = for_builder }, + { "if", mlp.expr, builder = if_builder } } }, + "do", mlp.block, "end", builder = for_stat_builder } +--]] + +-------------------------------------------------------------------------------- +-- Back-end for improved index operator. +-------------------------------------------------------------------------------- +local function index_builder(a, suffix) + match suffix[1] with + -- Single index, no range: keep the native semantics + | { { e, false } } -> return `Index{ a, e } + -- Either a range, or multiple indexes, or both + | ranges -> + local r = `Call{ +{table.isub}, a } + local function acc (x,y) table.insert (r,x); table.insert (r,y) end + for seq in ivalues (ranges) do + match seq with + | { e, false } -> acc(e,e) + | { e, f } -> acc(e,f) + end + end + return r + end +end + +-------------------------------------------------------------------------------- +-- Improved "[...]" index operator: +-- * support for multi-indexes ("foo[bar, gnat]") +-- * support for ranges ("foo[bar ... gnat]") +-------------------------------------------------------------------------------- +mlp.expr.suffix:del '[' +mlp.expr.suffix:add{ name="table index/range", + "[", gg.list{ + gg.sequence { mlp.expr, gg.onkeyword{ "...", mlp.expr } } , + separators = { ",", ";" } }, + "]", builder = index_builder }
diff --git a/lib/metalua/extension/continue.mlua b/lib/metalua/extension/continue.mlua new file mode 100644 index 0000000..fbd0f87 --- /dev/null +++ b/lib/metalua/extension/continue.mlua
@@ -0,0 +1,72 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require "metalua.walk" + +---------------------------------------------------------------------- +-- * [loop_tags] are the tags of statements which support continue. +-- * [loop_keywords] are the initial keywords which trigger the parsing +-- of these statements: they're indeed indexed by keyword in [mlp.stat]. +---------------------------------------------------------------------- + +local loop_tags = table.transpose{ "Forin", "Fornum", "While", "Repeat" } +local loop_keywords = { "for", "while", "repeat" } + +---------------------------------------------------------------------- +-- This function takes the AST of a continue-enabled loop, parse +-- its body to find all instances of [`Continue]. If any of them +-- is found ([label~=nil]), they're transformed in [`Goto{...}], and +-- the corresponding label is added at the end of the loop's body. +-- +-- Caveat: if a [continue] appears in the non-body part of a loop +-- (and therefore is relative to some enclosing loop), it isn't +-- handled, and therefore causes a compilation error. This could +-- only happen due in a [`Stat{ }], however, since [`Function{ }] +-- cuts the search for [`Continue]. +---------------------------------------------------------------------- +local function loop_transformer (ast) + local label + local cfg = { stat = { }; expr = { } } + + function cfg.stat.down (x) + if loop_tags[x.tag] then return 'break' + elseif x.tag=='Continue' then + if not label then label = mlp.gensym 'continue' end + x <- `Goto{ label } + end + end + + function cfg.expr.down (x) + return x.tag=='Function' and 'break' + end + + local loop_body = ast.tag=="Repeat" and ast[1] or ast[#ast] + walk.block (cfg, loop_body) + if label then table.insert (loop_body, `Label{ label }) end +end + +---------------------------------------------------------------------- +-- Register the transformer for each kind of loop: +---------------------------------------------------------------------- +for keyword in values (loop_keywords) do + mlp.stat:get(keyword).transformers:add (loop_transformer) +end + +mlp.lexer:add "continue" +mlp.stat:add{ "continue", builder = ||`Continue }
diff --git a/lib/metalua/extension/localin.mlua b/lib/metalua/extension/localin.mlua new file mode 100644 index 0000000..8599a32 --- /dev/null +++ b/lib/metalua/extension/localin.mlua
@@ -0,0 +1,21 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +mlp.expr:add{ "local", mlp.id, "=", mlp.expr, "in", mlp.expr, + builder=|x| `Stat{ { `Local{ { x[1] }, { x[2] } } }, x[3] } } \ No newline at end of file
diff --git a/lib/metalua/extension/log.mlua b/lib/metalua/extension/log.mlua new file mode 100644 index 0000000..5f048c1 --- /dev/null +++ b/lib/metalua/extension/log.mlua
@@ -0,0 +1,58 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.dollar' + +-{ extension 'match' } + +function dollar.log(...) + local args = {...} + local ti = table.insert + local code = { } + local nohash = false + local width = 80 + + local i=1 + if args[i].tag=='String' then + ti(code, +{print(" [LOG] "..-{args[1]})}) + i += 1 + end + + local xtra_args, names, vals = { }, { }, { } + for i=i, #args do + match args[i] with + | +{ 'nohash' } -> nohash = true + | `Number{ w } -> width = w + --| `String{...} | `Number{...} -> ti (xtra_args, args[i]) + | `Id{n} -> ti (names, n); ti (vals, args[i]) + | x -> ti (names, table.tostring(x, 'nohash')); ti (vals, x) + end + end + + for i=1, #names do + local msg = string.format(" [LOG] %s = ", names[i]) + local printer = `Call{ +{table.tostring}, + vals[i], + `Number{ width }, + `Number{ #msg } } + if nohash then ti(printer, +{'nohash'}) end + ti (code, `Call{ +{printf}, +{"%s%s"}, `String{ msg }, printer }) + end + return code +end
diff --git a/lib/metalua/extension/match.mlua b/lib/metalua/extension/match.mlua new file mode 100644 index 0000000..eab9f8f --- /dev/null +++ b/lib/metalua/extension/match.mlua
@@ -0,0 +1,381 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Glossary: +-- +-- * term_seq: the tested stuff, a sequence of terms +-- * pattern_element: might match one term of a term seq. Represented +-- as expression ASTs. +-- * pattern_seq: might match a term_seq +-- * pattern_group: several pattern seqs, one of them might match +-- the term seq. +-- * case: pattern_group * guard option * block +-- * match_statement: tested term_seq * case list +-- +-- Hence a complete match statement is a: +-- +-- { list(expr), list{ list(list(expr)), expr or false, block } } +-- +-- Implementation hints +-- ==================== +-- +-- The implementation is made as modular as possible, so that parts +-- can be reused in other extensions. The priviledged way to share +-- contextual information across functions is through the 'cfg' table +-- argument. Its fields include: +-- +-- * code: code generated from pattern. A pattern_(element|seq|group) +-- is compiled as a sequence of instructions which will jump to +-- label [cfg.on_failure] if the tested term doesn't match. +-- +-- * on_failure: name of the label where the code will jump if the +-- pattern doesn't match +-- +-- * locals: names of local variables used by the pattern. This +-- includes bound variables, and temporary variables used to +-- destructure tables. Names are stored as keys of the table, +-- values are meaningless. +-- +-- * after_success: label where the code must jump after a pattern +-- succeeded to capture a term, and the guard suceeded if there is +-- any, and the conditional block has run. +-- +-- * ntmp: number of temporary variables used to destructurate table +-- in the current case. +-- +-- Code generation is performed by acc_xxx() functions, which accumulate +-- code in cfg.code: +-- +-- * acc_test(test, cfg) will generate a jump to cfg.on_failure +-- *when the test returns TRUE* +-- +-- * acc_stat accumulates a statement +-- +-- * acc_assign accumulate an assignment statement, and makes sure that +-- the LHS variable the registered as local in cfg.locals. +-- +---------------------------------------------------------------------- + +-- TODO: hygiene wrt type() +-- TODO: cfg.ntmp isn't reset as often as it could. I'm not even sure +-- the corresponding locals are declared. + +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") + cfg.ntmp = cfg.ntmp+1 + return `Id{ tmpvar_base .. cfg.ntmp } +end + +-- Code accumulators +acc_stat = |x,cfg| table.insert (cfg.code, x) +acc_test = |x,cfg| acc_stat(+{stat: if -{x} then -{`Goto{cfg.on_failure}} end}, cfg) +-- lhs :: `Id{ string } +-- rhs :: expr +function acc_assign (lhs, rhs, cfg) + assert(lhs.tag=='Id') + cfg.locals[lhs[1]] = true + acc_stat (`Set{ {lhs}, {rhs} }, cfg) +end + +literal_tags = table.transpose{ 'String', 'Number', 'True', 'False', 'Nil' } + +-- pattern :: `Id{ string } +-- term :: expr +function id_pattern_element_builder (pattern, term, cfg) + assert (pattern.tag == "Id") + if pattern[1] == "_" then + -- "_" is used as a dummy var ==> no assignment, no == checking + cfg.locals._ = true + elseif cfg.locals[pattern[1]] then + -- This var is already bound ==> test for equality + acc_test (+{ -{term} ~= -{pattern} }, cfg) + else + -- Free var ==> bind it, and remember it for latter linearity checking + acc_assign (pattern, term, cfg) + cfg.locals[pattern[1]] = true + end +end + +-- Concatenate code in [cfg.code], that will jump to label +-- [cfg.on_failure] if [pattern] doesn't match [term]. [pattern] +-- should be an identifier, or at least cheap to compute and +-- side-effects free. +-- +-- pattern :: pattern_element +-- term :: expr +function pattern_element_builder (pattern, term, cfg) + if literal_tags[pattern.tag] then + acc_test (+{ -{term} ~= -{pattern} }, cfg) + elseif "Id" == pattern.tag then + id_pattern_element_builder (pattern, term, cfg) + elseif "Op" == pattern.tag and "div" == pattern[1] then + regexp_pattern_element_builder (pattern, term, cfg) + elseif "Op" == pattern.tag and "eq" == pattern[1] then + eq_pattern_element_builder (pattern, term, cfg) + elseif "Table" == pattern.tag then + table_pattern_element_builder (pattern, term, cfg) + else + error ("Invalid pattern: "..table.tostring(pattern, "nohash")) + end +end + +function eq_pattern_element_builder (pattern, term, cfg) + local _, pat1, pat2 = unpack (pattern) + local ntmp_save = cfg.ntmp + pattern_element_builder (pat1, term, cfg) + cfg.ntmp = ntmp_save + pattern_element_builder (pat2, term, cfg) +end + +-- pattern :: `Op{ 'div', string, list{`Id string} or `Id{ string }} +-- term :: expr +function regexp_pattern_element_builder (pattern, term, cfg) + local op, regexp, sub_pattern = unpack(pattern) + + -- Sanity checks -- + assert (op=='div', "Don't know what to do with that op in a pattern") + assert (regexp.tag=="String", + "Left hand side operand for '/' in a pattern must be ".. + "a literal string representing a regular expression") + if sub_pattern.tag=="Table" then + for x in ivalues(sub_pattern) do + assert (x.tag=="Id" or x.tag=='Dots', + "Right hand side operand for '/' in a pattern must be ".. + "a list of identifiers") + end + else + assert (sub_pattern.tag=="Id", + "Right hand side operand for '/' in a pattern must be ".. + "an identifier or a list of identifiers") + end + + -- Regexp patterns can only match strings + acc_test (+{ type(-{term}) ~= 'string' }, cfg) + -- put all captures in a list + local capt_list = +{ { string.strmatch(-{term}, -{regexp}) } } + -- save them in a var_n for recursive decomposition + local v2 = next_tmpvar(cfg) + acc_stat (+{stat: local -{v2} = -{capt_list} }, cfg) + -- was capture successful? + acc_test (+{ not next (-{v2}) }, cfg) + pattern_element_builder (sub_pattern, v2, cfg) +end + +-- pattern :: pattern and `Table{ } +-- term :: expr +function table_pattern_element_builder (pattern, term, cfg) + local seen_dots, len = false, 0 + acc_test (+{ type( -{term} ) ~= "table" }, cfg) + for i = 1, #pattern do + local key, sub_pattern + if pattern[i].tag=="Pair" then -- Explicit key/value pair + key, sub_pattern = unpack (pattern[i]) + assert (literal_tags[key.tag], "Invalid key") + else -- Implicit key + len, key, sub_pattern = len+1, `Number{ len+1 }, pattern[i] + end + + -- '...' can only appear in final position + -- Could be fixed actually... + assert (not seen_dots, "Wrongly placed `...' ") + + if sub_pattern.tag == "Id" then + -- Optimization: save a useless [ v(n+1)=v(n).key ] + id_pattern_element_builder (sub_pattern, `Index{ term, key }, cfg) + if sub_pattern[1] ~= "_" then + acc_test (+{ -{sub_pattern} == nil }, cfg) + end + elseif sub_pattern.tag == "Dots" then + -- Remember where the capture is, and thatt arity checking shouldn't occur + seen_dots = true + else + -- Business as usual: + local v2 = next_tmpvar(cfg) + acc_assign (v2, `Index{ term, key }, cfg) + pattern_element_builder (sub_pattern, v2, cfg) + -- TODO: restore ntmp? + end + end + 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 + +-- Jumps to [cfg.on_faliure] if pattern_seq doesn't match +-- term_seq. +function pattern_seq_builder (pattern_seq, term_seq, cfg) + if #pattern_seq ~= #term_seq then error ("Bad seq arity") end + cfg.locals = { } -- reset bound variables between alternatives + for i=1, #pattern_seq do + cfg.ntmp = 1 -- reset the tmp var generator + pattern_element_builder(pattern_seq[i], term_seq[i], cfg) + end +end + +-------------------------------------------------- +-- for each case i: +-- pattern_seq_builder_i: +-- * on failure, go to on_failure_i +-- * on success, go to on_success +-- label on_success: +-- block +-- goto after_success +-- label on_failure_i +-------------------------------------------------- +function case_builder (case, term_seq, cfg) + local patterns_group, guard, block = unpack(case) + local on_success = mlp.gensym 'on_success' [1] + 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) + acc_stat (`Label{cfg.on_failure}, cfg) + end + end + acc_stat (`Label{on_success}, cfg) + if guard then acc_test (+{not -{guard}}, cfg) end + if cfg.dots_replacement then + replace_dots (block, cfg.dots_replacement) + end + block.tag = 'Do' + acc_stat (block, cfg) + acc_stat (`Goto{cfg.after_success}, cfg) + acc_stat (`Label{cfg.on_failure}, cfg) +end + +function match_builder (x) + local term_seq, cases = unpack(x) + local cfg = { + code = `Do{ }, + after_success = mlp.gensym "_after_success" } + + + -- Some sharing issues occur when modifying term_seq, + -- so it's replaced by a copy new_term_seq. + -- TODO: clean that up, and re-suppress the useless copies + -- (cf. remarks about capture bug below). + local new_term_seq = { } + + local match_locals + + -- Make sure that all tested terms are variables or literals + for i=1, #term_seq do + local t = term_seq[i] + -- Capture problem: the following would compile wrongly: + -- `match x with x -> end' + -- Temporary workaround: suppress the condition, so that + -- all external variables are copied into unique names. + --if t.tag ~= 'Id' and not literal_tags[t.tag] then + local v = mlp.gensym 'v' + if not match_locals then match_locals = `Local{ {v}, {t} } else + table.insert(match_locals[1], v) + table.insert(match_locals[2], t) + end + new_term_seq[i] = v + --end + end + term_seq = new_term_seq + + if match_locals then acc_stat(match_locals, cfg) end + + for i=1, #cases do + local case_cfg = { + 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 = { } + table.insert (case_cfg.code, 1, `Local{ case_locals, { } }) + for v in keys (case_cfg.locals) do + table.insert (case_locals, `Id{ v }) + end + end + acc_stat(case_cfg.code, cfg) + end + acc_stat(+{error 'mismatch'}, cfg) + acc_stat(`Label{cfg.after_success}, cfg) + return cfg.code +end + +---------------------------------------------------------------------- +-- Syntactical front-end +---------------------------------------------------------------------- + +mlp.lexer:add{ "match", "with", "->" } +mlp.block.terminators:add "|" + +match_cases_list_parser = gg.list{ name = "match cases list", + gg.sequence{ name = "match case", + gg.list{ name = "match case patterns list", + primary = mlp.expr_list, + separators = "|", + terminators = { "->", "if" } }, + gg.onkeyword{ "if", mlp.expr, consume = true }, + "->", + mlp.block }, + separators = "|", + terminators = "end" } + +mlp.stat:add{ name = "match statement", + "match", + mlp.expr_list, + "with", gg.optkeyword "|", + match_cases_list_parser, + "end", + builder = |x| match_builder{ x[1], x[3] } } +
diff --git a/lib/metalua/extension/ternary.mlua b/lib/metalua/extension/ternary.mlua new file mode 100644 index 0000000..42cf767 --- /dev/null +++ b/lib/metalua/extension/ternary.mlua
@@ -0,0 +1,29 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +local function b(x, suffix) + local v, ontrue, onfalse = mlp.gensym "test", unpack (suffix) + return `Stat{ + +{ block: + local -{v} + if -{x} then (-{v}) = -{ontrue} else (-{v}) = -{onfalse or `Nil} end }, + v } +end + +mlp.expr.suffix:add{ "?", mlp.expr, gg.onkeyword{ ",", mlp.expr }, prec=5, builder=b }
diff --git a/lib/metalua/extension/trycatch.mlua b/lib/metalua/extension/trycatch.mlua new file mode 100644 index 0000000..3f190d5 --- /dev/null +++ b/lib/metalua/extension/trycatch.mlua
@@ -0,0 +1,208 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'match' } + +-------------------------------------------------------------------------------- +-- +-- TODO: +-- +-- * Hygienize calls to pcall() +-- +-------------------------------------------------------------------------------- + +-{ extension 'H' } +-{ extension 'log' } + +-- Get match parsers and builder, for catch cases handling: +local match_alpha = require 'metalua.extension.match' +local H = H:new{side='inside', alpha = match_alpha } + +-- We'll need to track rogue return statements: +require 'metalua.walk' + +-- Put a block AST into a pcall(): +local mkpcall = |block| +{pcall(function() -{block} end)} + +-- The statement builder: +function trycatch_builder(x) + --$log ("trycatch_builder", x, 'nohash', 60) + local try_code, catch_cases, finally_code = unpack(x) + local insert_return_catcher = false + + -- Can't be hygienize automatically by the current version of H, as + -- it must bridge from inside user code (hacjed return statements) + -- to outside macro code. + local caught_return = !mlp.gensym 'caught_return' + local saved_args + + !try_code; !(finally_code or { }) + -- FIXME: Am I sure there's no need to hygienize inside? + --[[if catch_cases then + for case in ivalues(catch_cases) do + --$log(case,'nohash') + local patterns, guard, block = unpack(case) + ! block + end + end]] + + + ---------------------------------------------------------------- + -- Returns in the try-block must be transformed: + -- from the user's PoV, the code in the try-block isn't + -- a function, therefore a return in it must not merely + -- end the execution of the try block, but: + -- * not cause any error to be caught; + -- * let the finally-block be executed; + -- * only then, let the enclosing function return with the + -- appropraite values. + -- The way to handle that is that any returned value is stored + -- into the runtime variable caught_return, then a return with + -- no value is sent, to stop the execution of the try-code. + -- + -- Similarly, a return in a catch case code must not prevent + -- the finally-code from being run. + -- + -- This walker catches return statements and perform the relevant + -- transformation into caught_return setting + empty return. + -- + -- There is an insert_return_catcher compile-time flag, which + -- allows to avoid inserting return-handling code in the result + -- when not needed. + ---------------------------------------------------------------- + local replace_returns_and_dots do + local function f(x) + match x with + | `Return{...} -> + insert_return_catcher = true + -- Setvar's 'caught_return' code can't be hygienize by H currently. + local setvar = `Set{ {caught_return}, { `Table{ unpack(x) } } } + x <- { setvar; `Return }; x.tag = nil; + --$log('transformed return stat:', x, 60) + return 'break' + | `Function{...} -> return 'break' + -- inside this, returns would be the nested function's, not ours. + | `Dots -> + if not saved_args then saved_args = mlp.gensym 'args' end + x <- `Call{ `Id 'unpack', saved_args } + | _ -> -- pass + end + end + local cfg = { stat = {down=f}, expr = {down=f} } + replace_returns_and_dots = |x| walk.block(cfg, x) + end + + -- parse returns in the try-block: + replace_returns_and_dots (try_code) + + -- code handling the error catching process: + local catch_result do + if catch_cases and #catch_cases>0 then + ---------------------------------------------------------- + -- Protect catch code against failures: they run in a pcall(), and + -- the result is kept in catch_* vars so that it can be used to + -- relaunch the error after the finally code has been executed. + ---------------------------------------------------------- + for x in ivalues (catch_cases) do + local case_code = x[3] + -- handle rogue returns: + replace_returns_and_dots (case_code) + -- in case of error in the catch, we still need to run "finally": + x[3] = +{block: catch_success, catch_error = -{mkpcall(case_code)}} + end + ---------------------------------------------------------- + -- Uncaught exceptions must not cause a mismatch, + -- so we introduce a catch-all do-nothing last case: + ---------------------------------------------------------- + table.insert (catch_cases, { { { `Id '_' } }, false, { } }) + catch_result = spmatch.match_builder{ {+{user_error}}, catch_cases } + else + catch_result = { } + end + end + + ---------------------------------------------------------------- + -- Build the bits of code that will handle return statements + -- in the user code (try-block and catch-blocks). + ---------------------------------------------------------------- + local caught_return_init, caught_return_rethrow do + if insert_return_catcher then + caught_return_init = `Local{{caught_return}} + caught_return_rethrow = + +{stat: if -{caught_return} then return unpack(-{caught_return}) end} + else + caught_return_init, caught_return_rethrow = { }, { } + end + end + + local saved_args_init = + saved_args and `Local{ {saved_args}, { `Table{`Dots} } } or { } + + -- The finally code, to execute no matter what: + local finally_result = finally_code or { } + + -- And the whole statement, gluing all taht together: + local result = +{stat: + do + -{ saved_args_init } + -{ caught_return_init } + local user_success, user_error = -{mkpcall(try_code)} + local catch_success, catch_error = false, user_error + if not user_success then -{catch_result} end + -{finally_result} + if not user_success and not catch_success then error(catch_error) end + -{ caught_return_rethrow } + end } + + H(result) + + return result +end + +function catch_case_builder(x) + --$log ("catch_case_builder", x, 'nohash', 60) + local patterns, guard, _, code = unpack(x) + -- patterns ought to be a pattern_group, but each expression must + -- be converted into a single-element pattern_seq. + for i = 1, #patterns do patterns[i] = {patterns[i]} end + return { patterns, guard, code } +end + +mlp.lexer:add{ 'try', 'catch', 'finally', '->' } +mlp.block.terminators:add{ 'catch', 'finally' } + +mlp.stat:add{ + 'try', + mlp.block, + gg.onkeyword{ 'catch', + gg.list{ + gg.sequence{ + mlp.expr_list, + gg.onkeyword{ 'if', mlp.expr }, + gg.optkeyword 'then', + mlp.block, + builder = catch_case_builder }, + separators = 'catch' } }, + gg.onkeyword{ 'finally', mlp.block }, + 'end', + builder = trycatch_builder } + +return H.alpha + +
diff --git a/lib/metalua/extension/types-runtime.mlua b/lib/metalua/extension/types-runtime.mlua new file mode 100644 index 0000000..1f3e582 --- /dev/null +++ b/lib/metalua/extension/types-runtime.mlua
@@ -0,0 +1,178 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- Initialize the types table. It has an __index metatable entry, +-- so that if a symbol is not found in it, it is looked for in the current +-- environment. It allows to write things like [ n=3; x :: vector(n) ]. +-------------------------------------------------------------------------------- +types = { } +setmetatable (types, { __index = getfenv(0)}) + +function types.error (fmt, ...) + error(string.format("Runtime type-checking failure: "..fmt, ...)) +end + +-------------------------------------------------------------------------------- +-- Add a prefix to an error message, if an error occurs. +-- Useful for type checkers that call sub-type-checkers. +-------------------------------------------------------------------------------- +local function nest_error (prefix, ...) + local status, msg = pcall(...) + if not status then types.error("%s:\n%s", prefix, msg) end +end + +-------------------------------------------------------------------------------- +-- Built-in types +-------------------------------------------------------------------------------- +for typename in values{ "number", "string", "boolean", "function", "thread" } do + types[typename] = + function (val) + if type(val) ~= typename then types.error ("%s expected", typename) end + end +end + +function types.integer(val) + if type(val)~='number' or val%1~=0 then types.error 'integer expected' end +end + +-------------------------------------------------------------------------------- +-- table(foo) checks +-- table(foo, bar) checks +-- table(i) where i is an integer checks +-- table(i, j) where i and j are integers checks +-- Integers and key/value types can be combined +-------------------------------------------------------------------------------- +function types.table (...) + + local key_type, val_type, range_from, range_to + -- arguments parsing + for x in values{...} do + if type(x) == "number" then + if range2 then types.error "Invalid type: too many numbers in table type" + elseif range1 then range2 = x + else range1 = x end + else + if type_key then types.error "Invalid type: too many types" + elseif type_val then type_key, type_val = type_val, x + else type_val = x end + end + end + if not range2 then range2=range1 end + if not type_key then type_key = types.integer end + return function (val) + if type(val) ~= "table" then types.error "table expected" end + local s = #val + if range2 and range2 > s then types.error "Not enough table elements" end + if range1 and range1 < s then types.error "Too many elements table elements" end + for k,v in pairs(val) do + nest_error ("in table key", type_key, k) + nest_error ("in table value", type_val, v) + end + end +end + +-------------------------------------------------------------------------------- +-- [list (subtype)] checks that the term is a table, and all of its +-- integer-indexed elements are of type [subtype]. +-------------------------------------------------------------------------------- +types.list = |...| types.table (types.integer, ...) + +-------------------------------------------------------------------------------- +-- Check that [x] is an integral number +-------------------------------------------------------------------------------- +function types.int (x) + if type(x)~="number" or x%1~=0 then types.error "Integer number expected" end +end + +-------------------------------------------------------------------------------- +-- [range(a,b)] checks that number [val] is between [a] and [b]. [a] and [b] +-- can be omitted. +-------------------------------------------------------------------------------- +function types.range (a,b) + return function (val) + if type(val)~="number" or a and val<a or b and val>b then + types.error ("Number between %s and %s expected", + a and tostring(a) or "-infty", + b and tostring(b) or "+infty") + end + end +end + +-------------------------------------------------------------------------------- +-- [inter (x, y)] checks that the term has both types [x] and [y]. +-------------------------------------------------------------------------------- +function types.inter (...) + local args={...} + return function(val) + for t in values(args) do nest_error ("in inter type", t, args) end + end +end + +-------------------------------------------------------------------------------- +-- [inter (x, y)] checks that the term has type either [x] or [y]. +-------------------------------------------------------------------------------- +function types.union (...) + local args={...} + return function(val) + for t in values(args) do if pcall(t, val) then return end end + types.error "None of the types in the union fits" + end +end + +-------------------------------------------------------------------------------- +-- [optional(t)] accepts values of types [t] or [nil]. +-------------------------------------------------------------------------------- +function types.optional(t) + return function(val) + if val~=nil then nest_error("In optional type", t, val) end + end +end + +-------------------------------------------------------------------------------- +-- A call to this is done on litteral tables passed as types, i.e. +-- type {1,2,3} is transformed into types.__table{1,2,3}. +-------------------------------------------------------------------------------- +function types.__table(s_type) + return function (s_val) + if type(s_val) ~= "table" then types.error "Struct table expected" end + for k, field_type in pairs (s_type) do + nest_error ("in struct field "..k, field_type, s_val[k]) + end + end +end + +-------------------------------------------------------------------------------- +-- Same as __table, except that it's called on literal strings. +-------------------------------------------------------------------------------- +function types.__string(s_type) + return function (s_val) + if s_val ~= s_type then + types.error("String %q expected", s_type) + end + end +end + +-------------------------------------------------------------------------------- +-- Top and Bottom: +-------------------------------------------------------------------------------- +function types.any() end +function types.none() types.error "Empty type" end +types.__or = types.union +types.__and = types.inter \ No newline at end of file
diff --git a/lib/metalua/extension/types.mlua b/lib/metalua/extension/types.mlua new file mode 100644 index 0000000..a8e30c8 --- /dev/null +++ b/lib/metalua/extension/types.mlua
@@ -0,0 +1,371 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- This extension inserts type-checking code at approriate place in the code, +-- thanks to annotations based on "::" keyword: +-- +-- * function declarations can be annotated with a returned type. When they +-- are, type-checking code is inserted in each of their return statements, +-- to make sure they return the expected type. +-- +-- * function parameters can also be annotated. If they are, type-checking +-- code is inserted in the function body, which checks the arguments' types +-- and cause an explicit error upon incorrect calls. Moreover, if a new value +-- is assigned to the parameter in the function's body, the new value's type +-- is checked before the assignment is performed. +-- +-- * Local variables can also be annotated. If they are, type-checking +-- code is inserted before any value assignment or re-assignment is +-- performed on them. +-- +-- Type checking can be disabled with: +-- +-- -{stat: types.enabled = false } +-- +-- Code transformation is performed at the chunk level, i.e. file by +-- file. Therefore, it the value of compile-time variable +-- [types.enabled] changes in the file, the only value that counts is +-- its value once the file is entirely parsed. +-- +-- Syntax +-- ====== +-- +-- Syntax annotations consist of "::" followed by a type +-- specifier. They can appear after a function parameter name, after +-- the closing parameter parenthese of a function, or after a local +-- variable name in the declaration. See example in samples. +-- +-- Type specifiers are expressions, in which identifiers are taken +-- from table types. For instance, [number] is transformed into +-- [types.number]. These [types.xxx] fields must contain functions, +-- which generate an error when they receive an argument which doesn't +-- belong to the type they represent. It is perfectly acceptible for a +-- type-checking function to return another type-checking function, +-- thus defining parametric/generic types. Parameters can be +-- identifiers (they're then considered as indexes in table [types]) +-- or literals. +-- +-- Design hints +-- ============ +-- +-- This extension uses the code walking library [walk] to globally +-- transform the chunk AST. See [chunk_transformer()] for details +-- about the walker. +-- +-- During parsing, type informations are stored in string-indexed +-- fields, in the AST nodes of tags `Local and `Function. They are +-- used by the walker to generate code only if [types.enabled] is +-- true. +-- +-- TODO +-- ==== +-- +-- It's easy to add global vars type-checking, by declaring :: as an +-- assignment operator. It's easy to add arbitrary expr +-- type-checking, by declaring :: as an infix operator. How to make +-- both cohabit? + +-------------------------------------------------------------------------------- +-- +-- Function chunk_transformer() +-- +-------------------------------------------------------------------------------- +-- +-- Takes a block annotated with extra fields, describing typing +-- constraints, and returns a normal AST where these constraints have +-- been turned into type-checking instructions. +-- +-- It relies on the following annotations: +-- +-- * [`Local{ }] statements may have a [types] field, which contains a +-- id name ==> type name map. +-- +-- * [Function{ }] expressions may have an [param_types] field, also a +-- id name ==> type name map. They may also have a [ret_type] field +-- containing the type of the returned value. +-- +-- Design hints: +-- ============= +-- +-- It relies on the code walking library, and two states: +-- +-- * [return_types] is a stack of the expected return values types for +-- the functions currently in scope, the most deeply nested one +-- having the biggest index. +-- +-- * [scopes] is a stack of id name ==> type name scopes, one per +-- currently active variables scope. +-- +-- What's performed by the walker: +-- +-- * Assignments to a typed variable involve a type checking of the +-- new value; +-- +-- * Local declarations are checked for additional type declarations. +-- +-- * Blocks create and destroy variable scopes in [scopes] +-- +-- * Functions create an additional scope (around its body block's scope) +-- which retains its argument type associations, and stacks another +-- return type (or [false] if no type constraint is given) +-- +-- * Return statements get the additional type checking statement if +-- applicable. +-- +-------------------------------------------------------------------------------- + +-- TODO: unify scopes handling with free variables detector +-- FIXME: scopes are currently incorrect anyway, only functions currently define a scope. + +require "metalua.walk" + +-{ extension 'match' } + +module("types", package.seeall) + +enabled = true + +local function chunk_transformer (block) + if not enabled then return end + local return_types, scopes = { }, { } + local cfg = { block = { }; stat = { }; expr = { } } + + function cfg.stat.down (x) + match x with + | `Local{ lhs, rhs, types = x_types } -> + -- Add new types declared by lhs in current scope. + local myscope = scopes [#scopes] + for var, type in pairs (x_types) do + myscope [var] = process_type (type) + end + -- Type-check each rhs value with the type of the + -- corresponding lhs declaration, if any. Check backward, in + -- case a local var name is used more than once. + for i = 1, max (#lhs, #rhs) do + local type, new_val = myscope[lhs[i][1]], rhs[i] + if type and new_val then + rhs[i] = checktype_builder (type, new_val, 'expr') + end + end + | `Set{ lhs, rhs } -> + for i=1, #lhs do + match lhs[i] with + | `Id{ v } -> + -- Retrieve the type associated with the variable, if any: + local j, type = #scopes, nil + repeat j, type = j-1, scopes[j][v] until type or j==0 + -- If a type constraint is found, apply it: + if type then rhs[i] = checktype_builder(type, rhs[i] or `Nil, 'expr') end + | _ -> -- assignment to a non-variable, pass + end + end + | `Return{ r_val } -> + local r_type = return_types[#return_types] + if r_type then + x <- `Return{ checktype_builder (r_type, r_val, 'expr') } + end + | _ -> -- pass + end + end + + function cfg.expr.down (x) + if x.tag ~= 'Function' then return end + local new_scope = { } + table.insert (scopes, new_scope) + for var, type in pairs (x.param_types or { }) do + new_scope[var] = process_type (type) + end + local r_type = x.ret_type and process_type (x.ret_type) or false + table.insert (return_types, r_type) + end + + ------------------------------------------------------------------- + -- Unregister the returned type and the variable scope in which + -- arguments are registered; + -- then, adds the parameters type checking instructions at the + -- beginning of the function, if applicable. + ------------------------------------------------------------------- + function cfg.expr.up (x) + if x.tag ~= 'Function' then return end + -- Unregister stuff going out of scope: + table.remove (return_types) + table.remove (scopes) + -- Add initial type checking: + for v, t in pairs(x.param_types or { }) do + table.insert(x[2], 1, checktype_builder(t, `Id{v}, 'stat')) + end + end + + cfg.block.down = || table.insert (scopes, { }) + cfg.block.up = || table.remove (scopes) + + walk.block(cfg, block) +end + +-------------------------------------------------------------------------- +-- Perform required transformations to change a raw type expression into +-- a callable function: +-- +-- * identifiers are changed into indexes in [types], unless they're +-- allready indexed, or into parentheses; +-- +-- * literal tables are embedded into a call to types.__table +-- +-- This transformation is not performed when type checking is disabled: +-- types are stored under their raw form in the AST; the transformation is +-- only performed when they're put in the stacks (scopes and return_types) +-- of the main walker. +-------------------------------------------------------------------------- +function process_type (type_term) + -- Transform the type: + cfg = { expr = { } } + + function cfg.expr.down(x) + match x with + | `Index{...} | `Paren{...} -> return 'break' + | _ -> -- pass + end + end + function cfg.expr.up (x) + match x with + | `Id{i} -> x <- `Index{ `Id "types", `String{ i } } + | `Table{...} | `String{...} | `Op{...} -> + local xcopy, name = table.shallow_copy(x) + match x.tag with + | 'Table' -> name = '__table' + | 'String' -> name = '__string' + | 'Op' -> name = '__'..x[1] + end + x <- `Call{ `Index{ `Id "types", `String{ name } }, xcopy } + | `Function{ params, { results } } if results.tag=='Return' -> + results.tag = nil + x <- `Call{ +{types.__function}, params, results } + | `Function{...} -> error "malformed function type" + | _ -> -- pass + end + end + walk.expr(cfg, type_term) + return type_term +end + +-------------------------------------------------------------------------- +-- Insert a type-checking function call on [term] before returning +-- [term]'s value. Only legal in an expression context. +-------------------------------------------------------------------------- +local non_const_tags = table.transpose + { 'Dots', 'Op', 'Index', 'Call', 'Invoke', 'Table' } +function checktype_builder(type, term, kind) + -- Shove type-checking code into the term to check: + match kind with + | 'expr' if non_const_tags [term.tag] -> + local v = mlp.gensym() + return `Stat{ { `Local{ {v}, {term} }; `Call{ type, v } }, v } + | 'expr' -> + return `Stat{ { `Call{ type, term } }, term } + | 'stat' -> + return `Call{ type, term } + end +end + +-------------------------------------------------------------------------- +-- Parse the typechecking tests in a function definition, and adds the +-- corresponding tests at the beginning of the function's body. +-------------------------------------------------------------------------- +local function func_val_builder (x) + local typed_params, ret_type, body = unpack(x) + local e = `Function{ { }, body; param_types = { }; ret_type = ret_type } + + -- Build [untyped_params] list, and [e.param_types] dictionary. + for i, y in ipairs (typed_params) do + if y.tag=="Dots" then + assert(i==#typed_params, "`...' must be the last parameter") + break + end + local param, type = unpack(y) + e[1][i] = param + if type then e.param_types[param[1]] = type end + end + return e +end + +-------------------------------------------------------------------------- +-- Parse ":: type" annotation if next token is "::", or return false. +-- Called by function parameters parser +-------------------------------------------------------------------------- +local opt_type = gg.onkeyword{ "::", mlp.expr } + +-------------------------------------------------------------------------- +-- Updated function definition parser, which accepts typed vars as +-- parameters. +-------------------------------------------------------------------------- + +-- Parameters parsing: +local id_or_dots = gg.multisequence{ { "...", builder = "Dots" }, default = mlp.id } + +-- Function parsing: +mlp.func_val = gg.sequence{ + "(", gg.list{ + gg.sequence{ id_or_dots, opt_type }, terminators = ")", separators = "," }, + ")", opt_type, mlp.block, "end", + builder = func_val_builder } + +mlp.lexer:add { "::", "newtype" } +mlp.chunk.transformers:add (chunk_transformer) + +-- Local declarations parsing: +local local_decl_parser = mlp.stat:get "local" [2].default + +local_decl_parser[1].primary = gg.sequence{ mlp.id, opt_type } + +function local_decl_parser.builder(x) + local lhs, rhs = unpack(x) + local s, stypes = `Local{ { }, rhs or { } }, { } + for i = 1, #lhs do + local id, type = unpack(lhs[i]) + s[1][i] = id + if type then stypes[id[1]]=type end + end + if next(stypes) then s.types = stypes end + return s +end + +function newtype_builder(x) + local lhs, rhs = unpack(x) + match lhs with + | `Id{ x } -> t = process_type (rhs) + | `Call{ `Id{ x }, ... } -> + t = `Function{ { }, rhs } + for i = 2, #lhs do + if lhs[i].tag ~= "Id" then error "Invalid newtype parameter" end + t[1][i-1] = lhs[i] + end + | _ -> error "Invalid newtype definition" + end + return `Let{ { `Index{ `Id "types", `String{ x } } }, { t } } +end + +mlp.stat:add{ "newtype", mlp.expr, "=", mlp.expr, builder = newtype_builder } + + +-------------------------------------------------------------------------- +-- Register as an operator +-------------------------------------------------------------------------- +--mlp.expr.infix:add{ "::", prec=100, builder = |a, _, b| insert_test(a,b) } + +return +{ require (-{ `String{ package.metalua_extension_prefix .. 'types-runtime' } }) }
diff --git a/lib/metalua/extension/withdo.mlua b/lib/metalua/extension/withdo.mlua new file mode 100644 index 0000000..b361482 --- /dev/null +++ b/lib/metalua/extension/withdo.mlua
@@ -0,0 +1,49 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- 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 }
diff --git a/lib/metalua/extension/xglobal-runtime.lua b/lib/metalua/extension/xglobal-runtime.lua new file mode 100644 index 0000000..b863fed --- /dev/null +++ b/lib/metalua/extension/xglobal-runtime.lua
@@ -0,0 +1,60 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +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 +
diff --git a/lib/metalua/extension/xglobal.mlua b/lib/metalua/extension/xglobal.mlua new file mode 100644 index 0000000..3859e98 --- /dev/null +++ b/lib/metalua/extension/xglobal.mlua
@@ -0,0 +1,39 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- 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' } }) }
diff --git a/lib/metalua/extension/xloop.mlua b/lib/metalua/extension/xloop.mlua new file mode 100644 index 0000000..f4b365f --- /dev/null +++ b/lib/metalua/extension/xloop.mlua
@@ -0,0 +1,119 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ 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} }
diff --git a/lib/metalua/extension/xmatch.mlua b/lib/metalua/extension/xmatch.mlua new file mode 100644 index 0000000..1936bda --- /dev/null +++ b/lib/metalua/extension/xmatch.mlua
@@ -0,0 +1,234 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +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 }
diff --git a/lib/metalua/metaloop.mlua b/lib/metalua/metaloop.mlua new file mode 100644 index 0000000..5e42f30 --- /dev/null +++ b/lib/metalua/metaloop.mlua
@@ -0,0 +1,102 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +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-2011 <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.luastring_to_lexstream(src) + success, ast = pcall(mlc.lexstream_to_ast, lx) + if success then + local check_status, check_msg = pcall(mlc.check_ast, ast) + if not check_status then + print "Invalid AST:" + print (check_msg) + lines = { } + else + success, f = pcall(mlc.ast_to_function, ast, '=stdin') + if success then + results = { xpcall(f, debug.traceback) } + 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 + 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 \ No newline at end of file
diff --git a/lib/metalua/mlc_xcall.lua b/lib/metalua/mlc_xcall.lua new file mode 100644 index 0000000..7875874 --- /dev/null +++ b/lib/metalua/mlc_xcall.lua
@@ -0,0 +1,142 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- Execute an `mlc.*_to_ast()' in a separate lua process. +-- Communication between processes goes through temporary files, +-- for the sake of portability. +-------------------------------------------------------------------------------- + +mlc_xcall = { } + +-------------------------------------------------------------------------------- +-- Number of lines to remove at the end of a traceback, should it be +-- dumped due to a compilation error in metabugs mode. +-------------------------------------------------------------------------------- +local STACK_LINES_TO_CUT = 7 + +-------------------------------------------------------------------------------- +-- (Not intended to be called directly by users) +-- +-- This is the back-end function, called in a separate lua process +-- by `mlc_xcall.client_*()' through `os.execute()'. +-- * inputs: +-- * the name of a lua source file to compile in a separate process +-- * the name of a writable file where the resulting ast is dumped +-- with `serialize()'. +-- * metabugs: if true and an error occurs during compilation, +-- the compiler's stacktrace is printed, allowing meta-programs +-- debugging. +-- * results: +-- * an exit status of 0 or -1, depending on whethet compilation +-- succeeded; +-- * the ast file filled will either the serialized ast, or the +-- error message. +-------------------------------------------------------------------------------- +function mlc_xcall.server (luafilename, astfilename, metabugs) + + -- We don't want these to be loaded when people only do client-side business + require 'metalua.compiler' + require 'serialize' + + mlc.metabugs = metabugs + + -- compile the content of luafile name in an AST, serialized in astfilename + --local status, ast = pcall (mlc.luafile_to_ast, luafilename) + local status, ast + local function compile() return mlc.luafile_to_ast (luafilename) end + if mlc.metabugs then + --print 'mlc_xcall.server/metabugs' + --status, ast = xpcall (compile, debug.traceback) + --status, ast = xpcall (compile, debug.traceback) + local function tb(msg) + local r = debug.traceback(msg) + + -- Cut superfluous end lines + local line_re = '\n[^\n]*' + local re = "^(.-)" .. (line_re) :rep (STACK_LINES_TO_CUT) .. "$" + return r :strmatch (re) or r + end + --status, ast = xpcall (compile, debug.traceback) + status, ast = xpcall (compile, tb) + else status, ast = pcall (compile) end + if status then + local check_status, check_msg = pcall (mlc.check_ast, 'block', ast) + if not check_status then status, ast = false, check_msg end + end + local out = io.open (astfilename, 'w') + if status then -- success + out:write (serialize (ast)) + out:close () + os.exit (0) + else -- failure, `ast' is actually the error message + out:write (ast) + out:close () + os.exit (-1) + end +end + +-------------------------------------------------------------------------------- +-- Compile the file whose name is passed as argument, in a separate process, +-- communicating through a temporary file. +-- returns: +-- * true or false, indicating whether the compilation succeeded +-- * the ast, or the error message. +-------------------------------------------------------------------------------- +function mlc_xcall.client_file (luafile) + + -- printf("\n\nmlc_xcall.client_file(%q)\n\n", luafile) + + local tmpfilename = os.tmpname() + local cmd = string.format ( + [=[lua -l metalua.mlc_xcall -e "mlc_xcall.server([[%s]], [[%s]], %s)"]=], + luafile, tmpfilename, mlc.metabugs and "true" or "false") + + -- printf("os.execute [[%s]]\n\n", cmd) + + local status = (0 == os.execute (cmd)) + local result -- ast or error msg + if status then + result = (lua_loadfile or loadfile) (tmpfilename) () + else + local f = io.open (tmpfilename) + result = f :read '*a' + f :close() + end + os.remove(tmpfilename) + return status, result +end + +-------------------------------------------------------------------------------- +-- Compile a source string into an ast, by dumping it in a tmp +-- file then calling `mlc_xcall.client_file()'. +-- returns: the same as `mlc_xcall.client_file()'. +-------------------------------------------------------------------------------- +function mlc_xcall.client_literal (luasrc) + local srcfilename = os.tmpname() + local srcfile, msg = io.open (srcfilename, 'w') + if not srcfile then print(msg) end + srcfile :write (luasrc) + srcfile :close () + local status, ast = mlc_xcall.client_file (srcfilename) + os.remove(srcfilename) + return status, ast +end + +return mlc_xcall \ No newline at end of file
diff --git a/lib/metalua/package2.lua b/lib/metalua/package2.lua new file mode 100644 index 0000000..d39f6c3 --- /dev/null +++ b/lib/metalua/package2.lua
@@ -0,0 +1,125 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +local package = package + +require 'metalua.mlc' + +package.metalua_extension_prefix = 'metalua.extension.' + +package.mpath = os.getenv 'LUA_MPATH' or + './?.mlua;/usr/local/share/lua/5.1/?.mlua;'.. + '/usr/local/share/lua/5.1/?/init.mlua;'.. + '/usr/local/lib/lua/5.1/?.mlua;'.. + '/usr/local/lib/lua/5.1/?/init.mlua' + + +---------------------------------------------------------------------- +-- resc(k) returns "%"..k if it's a special regular expression char, +-- or just k if it's normal. +---------------------------------------------------------------------- +local regexp_magic = table.transpose{ + "^", "$", "(", ")", "%", ".", "[", "]", "*", "+", "-", "?" } +local function resc(k) + return regexp_magic[k] and '%'..k or k +end + +---------------------------------------------------------------------- +-- Take a Lua module name, return the open file and its name, +-- or <false> and an error message. +---------------------------------------------------------------------- +function package.findfile(name, path_string) + local config_regexp = ("([^\n])\n"):rep(5):sub(1, -2) + local dir_sep, path_sep, path_mark, execdir, igmark = + package.config:strmatch (config_regexp) + name = name:gsub ('%.', dir_sep) + local errors = { } + local path_pattern = string.format('[^%s]+', resc(path_sep)) + for path in path_string:gmatch (path_pattern) do + --printf('path = %s, rpath_mark=%s, name=%s', path, resc(path_mark), name) + local filename = path:gsub (resc (path_mark), name) + --printf('filename = %s', filename) + local file = io.open (filename, 'r') + if file then return file, filename end + table.insert(errors, string.format("\tno lua file %q", filename)) + end + return false, table.concat(errors, "\n")..'\n' +end + +---------------------------------------------------------------------- +-- Execute a metalua module sources compilation in a separate process +-- Sending back the bytecode directly is difficult, as some shells +-- (at least MS-Windows') interpret some characters. So rather than +-- base64-encoding the bytecode, AST is returned from the child +-- process, and converted to bytecode then function in the calling +-- process. +---------------------------------------------------------------------- +local function spring_load(filename) + -- FIXME: handle compilation errors + local pattern = + [=[lua -l metalua.compiler -l serialize -e ]=].. + [=["print(serialize(mlc.luafile_to_ast[[%s]]))"]=] + local cmd = string.format (pattern, filename) + --print ("running command: ``" .. cmd .. "''") + local fd = io.popen (cmd) + local ast_src = fd:read '*a' + fd:close() + local ast = lua_loadstring (ast_src) () -- much faster than loadstring() + return mlc.ast_to_function(ast, filename) +end + +---------------------------------------------------------------------- +-- Load a metalua source file. +---------------------------------------------------------------------- +function package.metalua_loader (name) + local file, filename_or_msg = package.findfile (name, package.mpath) + if not file then return filename_or_msg end + if package.metalua_nopopen then + local luastring = file:read '*a' + file:close() + return mlc.luastring_to_function (luastring, name) + else + file:close() + require 'metalua.mlc_xcall' + local status, ast = mlc_xcall.client_file (filename_or_msg) + return mlc.ast_to_function(ast) + end +end + +---------------------------------------------------------------------- +-- Placed after lua/luac loader, so precompiled files have +-- higher precedence. +---------------------------------------------------------------------- +table.insert(package.loaders, package.metalua_loader) + +---------------------------------------------------------------------- +-- Load an extension. +---------------------------------------------------------------------- +function extension (name, noruntime) + local complete_name = package.metalua_extension_prefix..name + local x = require (complete_name) + if x==true then return + elseif type(x) ~= 'table' then + error ("extension returned %s instead of an AST", type(x)) + else + return x + end +end + +return package
diff --git a/lib/metalua/runtime.lua b/lib/metalua/runtime.lua new file mode 100644 index 0000000..cacf3d1 --- /dev/null +++ b/lib/metalua/runtime.lua
@@ -0,0 +1,22 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.base' +require 'metalua.table2' +require 'metalua.string2'
diff --git a/lib/metalua/string2.lua b/lib/metalua/string2.lua new file mode 100644 index 0000000..7a9b1ad --- /dev/null +++ b/lib/metalua/string2.lua
@@ -0,0 +1,62 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +---------------------------------------------------------------------- +---------------------------------------------------------------------- +-- +-- String module extension +-- +---------------------------------------------------------------------- +---------------------------------------------------------------------- + +-- Courtesy of lua-users.org +function string.split(str, pat) + local t = {} + local fpat = "(.-)" .. pat + local last_end = 1 + local s, e, cap = string.find(str, fpat, 1) + while s do + if s ~= 1 or cap ~= "" then + table.insert(t,cap) + end + last_end = e+1 + s, e, cap = string.find(str, fpat, last_end) + end + if last_end <= string.len(str) then + cap = string.sub(str, last_end) + table.insert(t, cap) + end + return t +end + +-- "match" is regularly used as a keyword for pattern matching, +-- so here is an always available substitute. +string.strmatch = string["match"] + +-- change a compiled string into a function +function string.undump(str) + if str:strmatch '^\027LuaQ' or str:strmatch '^#![^\n]+\n\027LuaQ' then + local f = (lua_loadstring or loadstring)(str) + return f + else + error "Not a chunk dump" + end +end + +return string \ No newline at end of file
diff --git a/lib/metalua/table2.lua b/lib/metalua/table2.lua new file mode 100644 index 0000000..653fd68 --- /dev/null +++ b/lib/metalua/table2.lua
@@ -0,0 +1,423 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +--------------------------------------------------------------------- +---------------------------------------------------------------------- +-- +-- Table module extension +-- +---------------------------------------------------------------------- +---------------------------------------------------------------------- + +-- todo: table.scan (scan1?) fold1? flip? + +function table.transpose(t) + local tt = { } + for a, b in pairs(t) do tt[b] = a end + return tt +end + +function table.iforeach(f, ...) + -- assert (type (f) == "function") [wouldn't allow metamethod __call] + local nargs = select("#", ...) + if nargs==1 then -- Quick iforeach (most common case), just one table arg + local t = ... + assert (type (t) == "table") + for i = 1, #t do + local result = f (t[i]) + -- If the function returns non-false, stop iteration + if result then return result end + end + else -- advanced case: boundaries and/or multiple tables + + -- fargs: arguments fot a single call to f + -- first, last: indexes of the first & last elements mapped in each table + -- arg1: index of the first table in args + + -- 1 - find boundaries if any + local args, fargs, first, last, arg1 = {...}, { } + if type(args[1]) ~= "number" then first, arg1 = 1, 1 -- no boundary + elseif type(args[2]) ~= "number" then first, last, arg1 = 1, args[1], 2 + else first, last, arg1 = args[1], args[2], 3 end + assert (nargs >= arg1) -- at least one table + -- 2 - determine upper boundary if not given + if not last then for i = arg1, nargs do + assert (type (args[i]) == "table") + last = max (#args[i], last) + end end + -- 3 - remove non-table arguments from args, adjust nargs + if arg1>1 then args = { select(arg1, unpack(args)) }; nargs = #args end + + -- 4 - perform the iteration + for i = first, last do + for j = 1, nargs do fargs[j] = args[j][i] end -- build args list + local result = f (unpack (fargs)) -- here is the call + -- If the function returns non-false, stop iteration + if result then return result end + end + end +end + +function table.imap (f, ...) + local result, idx = { }, 1 + local function g(...) result[idx] = f(...); idx=idx+1 end + table.iforeach(g, ...) + return result +end + +function table.ifold (f, acc, ...) + local function g(...) acc = f (acc,...) end + table.iforeach (g, ...) + return acc +end + +-- function table.ifold1 (f, ...) +-- return table.ifold (f, acc, 2, false, ...) +-- end + +function table.izip(...) + local function g(...) return {...} end + return table.imap(g, ...) +end + +function table.ifilter(f, t) + local yes, no = { }, { } + for i=1,#t do table.insert (f(t[i]) and yes or no, t[i]) end + return yes, no +end + +function table.icat(...) + local result = { } + for t in values {...} do + for x in values (t) do + table.insert (result, x) + end + end + return result +end + +function table.iflatten (x) return table.icat (unpack (x)) end + +function table.irev (t) + local result, nt = { }, #t + for i=0, nt-1 do result[nt-i] = t[i+1] end + return result +end + +function table.isub (t, ...) + local ti, u = table.insert, { } + local args, nargs = {...}, select("#", ...) + for i=1, nargs/2 do + local a, b = args[2*i-1], args[2*i] + for i=a, b, a<=b and 1 or -1 do ti(u, t[i]) end + end + return u +end + +function table.iall (f, ...) + local result = true + local function g(...) return not f(...) end + return not table.iforeach(g, ...) + --return result +end + +function table.iany (f, ...) + local function g(...) return not f(...) end + return not table.iall(g, ...) +end + +function table.shallow_copy(x) + local y={ } + for k, v in pairs(x) do y[k]=v end + return y +end + +-- Warning, this is implementation dependent: it relies on +-- the fact the [next()] enumerates the array-part before the hash-part. +function table.cat(...) + local y={ } + for x in values{...} do + -- cat array-part + for _, v in ipairs(x) do table.insert(y,v) end + -- cat hash-part + local lx, k = #x + if lx>0 then k=next(x,lx) else k=next(x) end + while k do y[k]=x[k]; k=next(x,k) end + end + return y +end + +function table.deep_copy(x) + local tracker = { } + local function aux (x) + if type(x) == "table" then + local y=tracker[x] + if y then return y end + y = { }; tracker[x] = y + setmetatable (y, getmetatable (x)) + for k,v in pairs(x) do y[aux(k)] = aux(v) end + return y + else return x end + end + return aux(x) +end + +function table.override(dst, src) + for k, v in pairs(src) do dst[k] = v end + for i = #src+1, #dst do dst[i] = nil end + return dst +end + + +function table.range(a,b,c) + if not b then assert(not(c)); b=a; a=1 + elseif not c then c = (b>=a) and 1 or -1 end + local result = { } + for i=a, b, c do table.insert(result, i) end + return result +end + + +-- FIXME: new_indent seems to be always nil?! +-- FIXME: accumulator function should be configurable, +-- so that print() doesn't need to bufferize the whole string +-- before starting to print. +function table.tostring(t, ...) + local PRINT_HASH, HANDLE_TAG, FIX_INDENT, LINE_MAX, INITIAL_INDENT = true, true + for _, x in ipairs {...} do + if type(x) == "number" then + if not LINE_MAX then LINE_MAX = x + else INITIAL_INDENT = x end + elseif x=="nohash" then PRINT_HASH = false + elseif x=="notag" then HANDLE_TAG = false + else + local n = string['match'](x, "^indent%s*(%d*)$") + if n then FIX_INDENT = tonumber(n) or 3 end + end + end + LINE_MAX = LINE_MAX or math.huge + INITIAL_INDENT = INITIAL_INDENT or 1 + + local current_offset = 0 -- indentation level + local xlen_cache = { } -- cached results for xlen() + local acc_list = { } -- Generated bits of string + local function acc(...) -- Accumulate a bit of string + local x = table.concat{...} + current_offset = current_offset + #x + table.insert(acc_list, x) + end + local function valid_id(x) + -- FIXME: we should also reject keywords; but the list of + -- current keywords is not fixed in metalua... + return type(x) == "string" + and string['match'](x, "^[a-zA-Z_][a-zA-Z0-9_]*$") + end + + -- Compute the number of chars it would require to display the table + -- on a single line. Helps to decide whether some carriage returns are + -- required. Since the size of each sub-table is required many times, + -- it's cached in [xlen_cache]. + local xlen_type = { } + local function xlen(x, nested) + nested = nested or { } + if x==nil then return #"nil" end + --if nested[x] then return #tostring(x) end -- already done in table + local len = xlen_cache[x] + if len then return len end + local f = xlen_type[type(x)] + if not f then return #tostring(x) end + len = f (x, nested) + xlen_cache[x] = len + return len + end + + -- optim: no need to compute lengths if I'm not going to use them + -- anyway. + if LINE_MAX == math.huge then xlen = function() return 0 end end + + + local tostring_cache = { } + local function __tostring(x) + local the_string = tostring_cache[x] + if the_string~=nil then return the_string end + local mt = getmetatable(x) + if mt then + local __tostring = mt.__tostring + if __tostring then + the_string = __tostring(x) + tostring_cache[x] = the_string + return the_string + end + end + if x~=nil then tostring_cache[x] = false end -- nil is an illegal key + return false + end + + xlen_type["nil"] = function () return 3 end + function xlen_type.number (x) return #tostring(x) end + function xlen_type.boolean (x) return x and 4 or 5 end + function xlen_type.string (x) return #string.format("%q",x) end + function xlen_type.table (adt, nested) + + local custom_string = __tostring(adt) + if custom_string then return #custom_string end + + -- Circular references detection + if nested [adt] then return #tostring(adt) end + nested [adt] = true + + local has_tag = HANDLE_TAG and valid_id(adt.tag) + local alen = #adt + local has_arr = alen>0 + local has_hash = false + local x = 0 + + if PRINT_HASH then + -- first pass: count hash-part + for k, v in pairs(adt) do + if k=="tag" and has_tag then + -- this is the tag -> do nothing! + elseif type(k)=="number" and k<=alen and math.fmod(k,1)==0 and k>0 then + -- array-part pair -> do nothing! + else + has_hash = true + if valid_id(k) then x=x+#k + else x = x + xlen (k, nested) + 2 end -- count surrounding brackets + x = x + xlen (v, nested) + 5 -- count " = " and ", " + end + end + end + + for i = 1, alen do x = x + xlen (adt[i], nested) + 2 end -- count ", " + + nested[adt] = false -- No more nested calls + + if not (has_tag or has_arr or has_hash) then return 3 end + if has_tag then x=x+#adt.tag+1 end + if not (has_arr or has_hash) then return x end + if not has_hash and alen==1 and type(adt[1])~="table" then + return x-2 -- substract extraneous ", " + end + return x+2 -- count "{ " and " }", substract extraneous ", " + end + + -- Recursively print a (sub) table at given indentation level. + -- [newline] indicates whether newlines should be inserted. + local function rec (adt, nested, indent) + if not FIX_INDENT then indent = current_offset end + local function acc_newline() + acc ("\n"); acc (string.rep (" ", indent)) + current_offset = indent + end + local x = { } + x["nil"] = function() acc "nil" end + function x.number() acc (tostring (adt)) end + function x.string() acc ((string.format ("%q", adt):gsub("\\\n", "\\n"))) end + function x.boolean() acc (adt and "true" or "false") end + function x.table() + if nested[adt] then acc(tostring(adt)); return end + nested[adt] = true + + + local has_tag = HANDLE_TAG and valid_id(adt.tag) + local alen = #adt + local has_arr = alen>0 + local has_hash = false + + if has_tag then acc("`"); acc(adt.tag) end + + -- First pass: handle hash-part + if PRINT_HASH then + for k, v in pairs(adt) do + -- pass if the key belongs to the array-part or is the "tag" field + if not (k=="tag" and HANDLE_TAG) and + not (type(k)=="number" and k<=alen and math.fmod(k,1)==0 and k>0) then + + -- Is it the first time we parse a hash pair? + if not has_hash then + acc "{ " + if not FIX_INDENT then indent = current_offset end + else acc ", " end + + -- Determine whether a newline is required + local is_id, expected_len = valid_id(k) + if is_id then expected_len = #k + xlen (v, nested) + #" = , " + else expected_len = xlen (k, nested) + + xlen (v, nested) + #"[] = , " end + if has_hash and expected_len + current_offset > LINE_MAX + then acc_newline() end + + -- Print the key + if is_id then acc(k); acc " = " + else acc "["; rec (k, nested, indent+(FIX_INDENT or 0)); acc "] = " end + + -- Print the value + rec (v, nested, indent+(FIX_INDENT or 0)) + has_hash = true + end + end + end + + -- Now we know whether there's a hash-part, an array-part, and a tag. + -- Tag and hash-part are already printed if they're present. + if not has_tag and not has_hash and not has_arr then acc "{ }"; + elseif has_tag and not has_hash and not has_arr then -- nothing, tag already in acc + else + assert (has_hash or has_arr) + local no_brace = false + if has_hash and has_arr then acc ", " + elseif has_tag and not has_hash and alen==1 and type(adt[1])~="table" then + -- No brace required; don't print "{", remember not to print "}" + acc (" "); rec (adt[1], nested, indent+(FIX_INDENT or 0)) + no_brace = true + elseif not has_hash then + -- Braces required, but not opened by hash-part handler yet + acc "{ " + if not FIX_INDENT then indent = current_offset end + end + + -- 2nd pass: array-part + if not no_brace and has_arr then + rec (adt[1], nested, indent+(FIX_INDENT or 0)) + for i=2, alen do + acc ", "; + if current_offset + xlen (adt[i], { }) > LINE_MAX + then acc_newline() end + rec (adt[i], nested, indent+(FIX_INDENT or 0)) + end + end + if not no_brace then acc " }" end + end + nested[adt] = false -- No more nested calls + end + local custom_string = __tostring(adt) + if custom_string then acc(custom_string) else + local y = x[type(adt)] + if y then y() else acc(tostring(adt)) end + end + end + --printf("INITIAL_INDENT = %i", INITIAL_INDENT) + current_offset = INITIAL_INDENT or 0 + rec(t, { }, 0) + return table.concat (acc_list) +end + +function table.print(...) return print(table.tostring(...)) end + +return table \ No newline at end of file
diff --git a/lib/metalua/treequery.mlua b/lib/metalua/treequery.mlua new file mode 100644 index 0000000..5925471 --- /dev/null +++ b/lib/metalua/treequery.mlua
@@ -0,0 +1,457 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +local walk = require 'metalua.treequery.walk' + +local M = { } +-- support for old-style modules +treequery = M + +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- +-- +-- multimap helper mmap: associate a key to a set of values +-- +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- + +local function mmap_add (mmap, node, x) + if node==nil then return false end + local set = mmap[node] + if set then set[x] = true + else mmap[node] = {[x]=true} end +end + +-- currently unused, I throw the whole set away +local function mmap_remove (mmap, node, x) + local set = mmap[node] + if not set then return false + elseif not set[x] then return false + elseif next(set) then set[x]=nil + else mmap[node] = nil end + return true +end + +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- +-- +-- TreeQuery object. +-- +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- + +local ACTIVE_SCOPE = setmetatable({ }, {__mode="k"}) + +-- treequery metatable +local Q = { }; Q.__index = Q + +--- treequery constructor +-- the resultingg object will allow to filter ans operate on the AST +-- @param root the AST to visit +-- @return a treequery visitor instance +function M.treequery(root) + return setmetatable({ + root = root, + unsatisfied = 0, + predicates = { }, + until_up = { }, + from_up = { }, + up_f = false, + down_f = false, + filters = { } + }, Q) +end + +-- helper to share the implementations of positional filters +local function add_pos_filter(self, position, inverted, inclusive, f, ...) + if type(f)=='string' then f = M.has_tag(f, ...) end + if not inverted then self.unsatisfied += 1 end + local x = { + pred = f, + position = position, + satisfied = false, + inverted = inverted or false, + inclusive = inclusive or false } + table.insert(self.predicates, x) + return self +end + +-- TODO: offer an API for inclusive pos_filters + +--- select nodes which are after one which satisfies predicate f +Q.after = |self, f, ...| add_pos_filter(self, 'after', false, false, f, ...) +--- select nodes which are not after one which satisfies predicate f +Q.not_after = |self, f, ...| add_pos_filter(self, 'after', true, false, f, ...) +--- select nodes which are under one which satisfies predicate f +Q.under = |self, f, ...| add_pos_filter(self, 'under', false, false, f, ...) +--- select nodes which are not under one which satisfies predicate f +Q.not_under = |self, f, ...| add_pos_filter(self, 'under', true, false, f, ...) + +--- select nodes which satisfy predicate f +function Q :filter(f, ...) + if type(f)=='string' then f = M.has_tag(f, ...) end + table.insert(self.filters, f); + return self +end + +--- select nodes which satisfy predicate f +function Q :filter_not(f, ...) + if type(f)=='string' then f = M.has_tag(f, ...) end + table.insert(self.filters, |...| not f(...)) + return self +end + +-- private helper: apply filters and execute up/down callbacks when applicable +function Q :execute() + local cfg = { } + -- TODO: optimize away not_under & not_after by pruning the tree + function cfg.down(...) + --printf ("[down]\t%s\t%s", self.unsatisfied, table.tostring((...))) + ACTIVE_SCOPE[...] = cfg.scope + local satisfied = self.unsatisfied==0 + for _, x in ipairs(self.predicates) do + if not x.satisfied and x.pred(...) then + x.satisfied = true + local node, parent = ... + local inc = x.inverted and 1 or -1 + if x.position=='under' then + -- satisfied from after we get down this node... + self.unsatisfied += inc + -- ...until before we get up this node + mmap_add(self.until_up, node, x) + elseif x.position=='after' then + -- satisfied from after we get up this node... + mmap_add(self.from_up, node, x) + -- ...until before we get up this node's parent + mmap_add(self.until_up, parent, x) + elseif x.position=='under_or_after' then + -- satisfied from after we get down this node... + self.satisfied += inc + -- ...until before we get up this node's parent... + mmap_add(self.until_up, parent, x) + else + error "position not understood" + end -- position + if x.inclusive then satisfied = self.unsatisfied==0 end + end -- predicate passed + end -- for predicates + + if satisfied then + for _, f in ipairs(self.filters) do + if not f(...) then satisfied=false; break end + end + if satisfied and self.down_f then self.down_f(...) end + end + end + + function cfg.up(...) + --printf ("[up]\t%s", table.tostring((...))) + + -- Remove predicates which are due before we go up this node + local preds = self.until_up[...] + if preds then + for x, _ in pairs(preds) do + local inc = x.inverted and -1 or 1 + self.unsatisfied += inc + x.satisfied = false + end + self.until_up[...] = nil + end + + -- Execute the up callback + -- TODO: cache the filter passing result from the down callback + -- TODO: skip if there's no callback + local satisfied = self.unsatisfied==0 + if satisfied then + for _, f in ipairs(self.filters) do + if not f(self, ...) then satisfied=false; break end + end + if satisfied and self.up_f then self.up_f(...) end + end + + -- Set predicate which are due after we go up this node + local preds = self.from_up[...] + if preds then + for p, _ in pairs(preds) do + local inc = p.inverted and 1 or -1 + self.unsatisfied += inc + end + self.from_up[...] = nil + end + ACTIVE_SCOPE[...] = nil + end + + function cfg.binder(id_node, ...) + --printf(" >>> Binder called on %s, %s", table.tostring(id_node), + -- table.tostring{...}:sub(2,-2)) + cfg.down(id_node, ...) + cfg.up(id_node, ...) + --printf("down/up on binder done") + end + + --function cfg.occurrence (binder, occ) + -- if binder then OCC2BIND[occ] = binder[1] end + --printf(" >>> %s is an occurrence of %s", occ[1], table.tostring(binder and binder[2])) + --end + + --function cfg.binder(...) cfg.down(...); cfg.up(...) end + return walk.guess(cfg, self.root) +end + +--- Execute a function on each selected node +-- @down: function executed when we go down a node, i.e. before its children +-- have been examined. +-- @up: function executed when we go up a node, i.e. after its children +-- have been examined. +function Q :foreach(down, up) + if not up and not down then + error "iterator not implemented" + end + self.up_f = up + self.down_f = down + return self :execute() +end + +--- Return the list of nodes selected by a given treequery. +function Q :list() + local acc = { } + self :foreach(|x| table.insert(acc, x)) + return acc +end + +--- Return the first matching element +-- TODO: dirty hack, to implement properly with a 'break' return. +-- Also, it won't behave correctly if a predicate causes an error, +-- or if coroutines are involved. +function Q :first() + local result = { } + local function f(...) result = {...}; error() end + pcall(|| self :foreach(f)) + return unpack(result) +end + +--- Pretty printer for queries +function Q :__tostring() return "treequery("..table.tostring(self.root, 'nohash')..")" end + +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- +-- +-- Predicates. +-- +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- + +--- Return a predicate which is true if the tested node's tag is among the +-- one listed as arguments +-- @param ... a sequence of tag names +function M.has_tag(...) + local args = {...} + if #args==1 then + local tag = ... + return (|node| node.tag==tag) + else + local tags = { } + for _, tag in ipairs(args) do tags[tag]=true end + return function(node) + local node_tag = node.tag + return node_tag and tags[node_tag] + end + end +end + +--- Predicate to test whether a node represents an expression. +M.is_expr = M.has_tag('Nil', 'Dots', 'True', 'False', 'Number','String', + 'Function', 'Table', 'Op', 'Paren', 'Call', 'Invoke', + 'Id', 'Index') + +-- helper for is_stat +local STAT_TAGS = { Do=1, Set=1, While=1, Repeat=1, If=1, Fornum=1, + Forin=1, Local=1, Localrec=1, Return=1, Break=1 } + +--- Predicate to test whether a node represents a statement. +-- It is context-aware, i.e. it recognizes `Call and `Invoke nodes +-- used in a statement context as such. +function M.is_stat(node, parent) + local tag = node.tag + if not tag then return false + elseif STAT_TAGS[tag] then return true + elseif tag=='Call' or tag=='Invoke' then return parent.tag==nil + else return false end +end + +--- Predicate to test whether a node represents a statements block. +function M.is_block(node) return node.tag==nil end + +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- +-- +-- Variables and scopes. +-- +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- + +local BINDER_GRAND_PARENT_TAG = { + Local=true, Localrec=true, Forin=true, Function=true } + +--- Test whether a node is a binder. This is local predicate, although it +-- might need to inspect the parent node. +function M.is_binder(node, parent) + --printf('is_binder(%s, %s)', table.tostring(node), table.tostring(parent)) + if node.tag ~= 'Id' or not parent then return false end + if parent.tag=='Fornum' then return b[1]==a end + if not BINDER_GRAND_PARENT_TAG[parent.tag] then return false end + for _, binder in ipairs(parent[1]) do + if binder==node then return true end + end + return false +end + +--- Retrieve the binder associated to an occurrence within root. +-- +-- Each call to this function might cause a traversal of the whole +-- `root` tree. For use inside a query method, prefer `treequery.get_binder`. +-- +-- @param occurrence an Id node representing an occurrence in `root`. +-- @param root the tree in which `node` and its binder occur. +-- @return the binder node, and its ancestors up to root if found. +-- @return nil if node is global (or not an occurrence) in `root`. +function M.binder(occurrence, root) + local cfg, id_name, result = { }, occurrence[1], { } + function cfg.occurrence(id) + if id == occurrence then result = cfg.scope :get(id_name) end + -- TODO: break the walker + end + walk.guess(cfg, root) + return unpack(result) +end + + +--- Return a predicate testing whether a node is an occurrence of the +-- given binder. +-- +-- Caveat: only works in a treequery method. +-- +function M.is_occurrence_of(binder) + return function(node, ...) + local b = M.get_binder(node) + return b and b==binder + end +end + +--- Return the binder which captures this occurence of a variable if applicable; +-- return `nil` if the variable is a binder or a free variable +-- +-- Caveat: this only works in arguments of query methods. +-- Out of a query, use `treequery.binder()`. +-- +function M.get_binder(occurrence, ...) + if occurrence.tag ~= 'Id' then return nil end + if M.is_binder(occurrence, ...) then return nil end + local binder_list = ACTIVE_SCOPE[occurrence[1]] + return unpack (binder_list or { }) +end + + + +--- Transform a predicate on a node into a predicate on this node's +-- parent. For instance if p tests whether a node has property P, +-- then parent(p) tests whether this node's parent has property P. +-- The ancestor level is precised with n, with 1 being the node itself, +-- 2 its parent, 3 its grand-parent etc. +-- @param[optional] n the parent to examine, default=2 +-- @param pred the predicate to transform +-- @return a predicate +function M.parent(n, pred, ...) + if type(a)~='number' then n, pred = 2, n end + if type(pred)=='string' then pred = M.has_tag(pred, ...) end + return function(self, ...) + return select(n, ...) and pred(select(n, ...)) + end +end + +--- Transform a predicate on a node into a predicate on this node's +-- n-th child. +-- @param n the child's index number +-- @param pred the predicate to transform +-- @return a predicate +function M.child(n, pred) + return function(node, ...) + local child = node[n] + return child and pred(child, node, ...) + end +end + +--- Predicate to test the position of a node in its parent. +-- The predicate succeeds if the node is the n-th child of its parent, +-- and a <= n <= b. +-- nth(a) is equivalent to nth(a, a). +-- Negative indices are admitted, and count from the last child, +-- as done for instance by string.sub(). +-- +-- TODO: This is wrong, this tests the table relationship rather than the +-- AST node relationship. +-- Must build a getindex helper, based on pattern matching, then build +-- the predicate around it. +-- +-- @param a lower bound +-- @param a upper bound +-- @return a predicate +function M.is_nth(a, b) + b = b or a + return function(node, parent) + if not parent then return false end + local nchildren = #parent + local a = a<=0 and nchildren+a+1 or a + if a>nchildren then return false end + local b = b<=0 and nchildren+b+1 or b>nchildren and nchildren or b + for i=a,b do if parent[i]==node then return true end end + return false + end +end + + +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- +-- +-- Comments parsing. +-- +-- ----------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- + +local comment_extractor = |which_side| function (node) + local x = node.lineinfo + x = x and x[which_side] + x = x and x.comments + if not x then return nil end + local lines = { } + for _, record in ipairs(x) do + table.insert(lines, record[1]) + end + return table.concat(lines, '\n') +end + +M.comment_prefix = comment_extractor 'first' +M.comment_suffix = comment_extractor 'last' + + +--- Shortcut for the query constructor +function M :__call(...) return self.treequery(...) end +setmetatable(M, M) + +return M
diff --git a/lib/metalua/treequery/walk.mlua b/lib/metalua/treequery/walk.mlua new file mode 100644 index 0000000..9d35e46 --- /dev/null +++ b/lib/metalua/treequery/walk.mlua
@@ -0,0 +1,249 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- Low level AST traversal library. +-- This library is a helper for the higher-level treequery library. +-- It walks through every node of an AST, depth-first, and executes +-- some callbacks contained in its cfg config table: +-- +-- * cfg.down(...) is called when it walks down a node, and receive as +-- parameters the node just entered, followed by its parent, grand-parent +-- etc. until the root node. +-- +-- * cfg.up(...) is called when it walks back up a node, and receive as +-- parameters the node just entered, followed by its parent, grand-parent +-- etc. until the root node. +-- +-- * cfg.occurrence(binder, id_node, ...) is called when it visits an `Id{ } +-- node which isn't a local variable creator. binder is a reference to its +-- binder with its context. The binder is the `Id{ } node which created +-- this local variable. By "binder and its context", we mean a list starting +-- with the `Id{ }, and followed by every ancestor of the binder node, up until +-- the common root node. +-- binder is nil if the variable is global. +-- id_node is followed by its ancestor, up until the root node. +-- +-- cfg.scope is maintained during the traversal, associating a +-- variable name to the binder which creates it in the context of the +-- node currently visited. +-- +-- walk.traverse.xxx functions are in charge of the recursive descent into +-- children nodes. They're private helpers. +-- +-- corresponding walk.xxx functions also take care of calling cfg callbacks. + +-{ extension "match" } + +local M = { traverse = { }; tags = { }; debug = false } + +-------------------------------------------------------------------------------- +-- Standard tags: can be used to guess the type of an AST, or to check +-- that the type of an AST is respected. +-------------------------------------------------------------------------------- +M.tags.stat = table.transpose{ + 'Do', 'Set', 'While', 'Repeat', 'Local', 'Localrec', 'Return', + 'Fornum', 'Forin', 'If', 'Break', 'Goto', 'Label', + 'Call', 'Invoke' } +M.tags.expr = table.transpose{ + 'Paren', 'Call', 'Invoke', 'Index', 'Op', 'Function', 'Stat', + 'Table', 'Nil', 'Dots', 'True', 'False', 'Number', 'String', 'Id' } + +-------------------------------------------------------------------------------- +-- These [M.traverse.xxx()] functions are in charge of actually going through +-- ASTs. At each node, they make sure to call the appropriate walker. +-------------------------------------------------------------------------------- +function M.traverse.stat (cfg, x, ...) + if M.debug then printf("traverse stat %s", table.tostring(x)) end + local ancestors = {...} + local B = |y| M.block (cfg, y, x, unpack(ancestors)) -- Block + local S = |y| M.stat (cfg, y, x, unpack(ancestors)) -- Statement + local E = |y| M.expr (cfg, y, x, unpack(ancestors)) -- Expression + local EL = |y| M.expr_list (cfg, y, x, unpack(ancestors)) -- Expression List + local IL = |y| M.binder_list (cfg, y, x, unpack(ancestors)) -- Id binders List + local OS = || cfg.scope :save() -- Open scope + local CS = || cfg.scope :restore() -- Close scope + + match x with + | {...} if x.tag == nil -> for y in ivalues(x) do M.stat(cfg, y, ...) end + -- no tag --> node not inserted in the history ancestors + | `Do{...} -> OS(x); for _, y in ipairs(x) do S(y) end; CS(x) + | `Set{ lhs, rhs } -> EL(lhs); EL(rhs) + | `While{ cond, body } -> E(cond); OS(); B(body); CS() + | `Repeat{ body, cond } -> OS(body); B(body); E(cond); CS(body) + | `Local{ lhs } -> IL(lhs) + | `Local{ lhs, rhs } -> EL(rhs); IL(lhs) + | `Localrec{ lhs, rhs } -> IL(lhs); EL(rhs) + | `Fornum{ i, a, b, body } -> E(a); E(b); OS(); IL{i}; B(body); CS() + | `Fornum{ i, a, b, c, body } -> E(a); E(b); E(c); OS(); IL{i}; B(body); CS() + | `Forin{ i, rhs, body } -> EL(rhs); OS(); IL(i); B(body); CS() + | `If{...} -> + for i=1, #x-1, 2 do + E(x[i]); OS(); B(x[i+1]); CS() + end + if #x%2 == 1 then + OS(); B(x[#x]); CS() + end + | `Call{...}|`Invoke{...}|`Return{...} -> EL(x) + | `Break | `Goto{ _ } | `Label{ _ } -> -- nothing + | { tag=tag, ...} if M.tags.stat[tag]-> + M.malformed (cfg, x, unpack (ancestors)) + | _ -> + M.unknown (cfg, x, unpack (ancestors)) + end +end + +function M.traverse.expr (cfg, x, ...) + if M.debug then printf("traverse expr %s", table.tostring(x)) end + local ancestors = {...} + local B = |y| M.block (cfg, y, x, unpack(ancestors)) -- Block + local S = |y| M.stat (cfg, y, x, unpack(ancestors)) -- Statement + local E = |y| M.expr (cfg, y, x, unpack(ancestors)) -- Expression + local EL = |y| M.expr_list (cfg, y, x, unpack(ancestors)) -- Expression List + local IL = |y| M.binder_list (cfg, y, x, unpack(ancestors)) -- Id binders list + local OS = || cfg.scope :save() -- Open scope + local CS = || cfg.scope :restore() -- Close scope + + match x with + | `Paren{ e } -> E(e) + | `Call{...} | `Invoke{...} -> EL(x) + | `Index{ a, b } -> E(a); E(b) + | `Op{ opid, ... } -> E(x[2]); if #x==3 then E(x[3]) end + | `Function{ params, body } -> OS(body); IL(params); B(body); CS(body) + | `Stat{ b, e } -> OS(body); B(b); E(e); CS(body) + | `Id{ name } -> M.occurrence(cfg, x, unpack(ancestors)) + | `Table{ ... } -> + for i = 1, #x do match x[i] with + | `Pair{ k, v } -> E(k); E(v) + | v -> E(v) + end end + | `Nil|`Dots|`True|`False|`Number{_}|`String{_} -> -- terminal node + | { tag=tag, ...} if M.tags.expr[tag]-> M.malformed (cfg, x, unpack (ancestors)) + | _ -> M.unknown (cfg, x, unpack (ancestors)) + end +end + +function M.traverse.block (cfg, x, ...) + assert(type(x)=='table', "traverse.block() expects a table") + if x.tag then M.malformed(cfg, x, ...) + else for y in ivalues(x) do M.stat(cfg, y, x, ...) end + end +end + +function M.traverse.expr_list (cfg, x, ...) + assert(type(x)=='table', "traverse.expr_list() expects a table") + -- x doesn't appear in the ancestors + for y in ivalues(x) do M.expr(cfg, y, ...) end +end + +function M.malformed(cfg, x, ...) + local f = cfg.malformed or cfg.error + if f then f(x, ...) else + error ("Malformed node of tag "..(x.tag or '(nil)')) + end +end + +function M.unknown(cfg, x, ...) + local f = cfg.unknown or cfg.error + if f then f(x, ...) else + error ("Unknown node tag "..(x.tag or '(nil)')) + end +end + +function M.occurrence(cfg, x, ...) + if cfg.occurrence then cfg.occurrence(cfg.scope :get(x[1]), x, ...) end +end + +-- TODO: Is it useful to call each error handling function +function M.binder_list (cfg, id_list, ...) + local f = cfg.binder + local ferror = cfg.error or cfg.malformed or cfg.unknown + for i, id_node in ipairs(id_list) do + if id_node.tag == 'Id' then + cfg.scope :set (id_node[1], { id_node, ... }) + if f then f(id_node, ...) end + elseif i==#id_list and id_node.tag=='Dots' then + -- Do nothing, those are valid `Dots + elseif ferror then + -- Traverse error handling function + ferror(id_node, ...) + else + error("Invalid binders list") + end + end +end + +---------------------------------------------------------------------- +-- Generic walker generator. +-- * if `cfg' has an entry matching the tree name, use this entry +-- * if not, try to use the entry whose name matched the ast kind +-- * if an entry is a table, look for 'up' and 'down' entries +-- * if it is a function, consider it as a `down' traverser. +---------------------------------------------------------------------- +local walker_builder = function(traverse) + assert(traverse) + return function (cfg, ...) + if not cfg.scope then cfg.scope = M.newscope() end + local down, up = cfg.down, cfg.up + local broken = down and down(...) + if broken ~= 'break' then M.traverse[traverse] (cfg, ...) end + if up then up(...) end + end +end + +---------------------------------------------------------------------- +-- Declare [M.stat], [M.expr], [M.block] and [M.expr_list] +---------------------------------------------------------------------- +for w in values{ "stat", "expr", "block" } do --, "malformed", "unknown" } do + M[w] = walker_builder (w, M.traverse[w]) +end + +-- Don't call up/down callbacks on expr lists +M.expr_list = M.traverse.expr_list + + +---------------------------------------------------------------------- +-- Try to guess the type of the AST then choose the right walkker. +---------------------------------------------------------------------- +function M.guess (cfg, x, ...) + assert(type(x)=='table', "arg #2 in a walker must be an AST") + if M.tags.expr[x.tag] then return M.expr(cfg, x, ...) end + if M.tags.stat[x.tag] then return M.stat(cfg, x, ...) end + if not x.tag then return M.block(cfg, x, ...) end + error ("Can't guess the AST type from tag "..(x.tag or '<none>')) +end + +local S = { }; S.__index = S + +function M.newscope() + local instance = { current = { } } + instance.stack = { instance.current } + setmetatable (instance, S) + return instance +end + +function S :save(...) + table.insert (self.stack, table.shallow_copy (self.current)) + if ... then return self :add(...) end +end + +function S :restore() self.current = table.remove (self.stack) end +function S :get (var_name) return self.current[var_name] end +function S :set (key, val) self.current[key] = val end + +return M
diff --git a/lib/metalua/walk.mlua b/lib/metalua/walk.mlua new file mode 100644 index 0000000..6c13fb9 --- /dev/null +++ b/lib/metalua/walk.mlua
@@ -0,0 +1,336 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- This library offers a generic way to write AST transforming +-- functions. Macros can take bits of AST as parameters and generate a +-- more complex AST with them; but modifying an AST a posteriori is +-- much more difficult; typical tasks requiring code walking are +-- transformation such as lazy evaluation or Continuation Passing +-- Style, but more mundane operations are required in more macros than +-- one would thing, such as "transform all returns which aren't inside +-- a nested function into an error throwing". +-- +-- AST walking is an intrinsically advanced operation, and the +-- interface of this library, although it tries to remain as simple as +-- possible, is not trivial. You'll probably need to write a couple of +-- walkers with it before feeling comfortable. +-- +-- +-- We deal here with 3 important kinds of AST: statements, expressions +-- and blocks. Code walkers for these three kinds for AST are called +-- [walk.stat (cfg, ast)], [walk.expr (cfg, ast)] and [walk.block +-- (cfg, ast)] respectively. the [cfg] parameter describes what shall +-- happen as the AST is traversed by the walker, and [ast] is the tree +-- itself. +-- +-- An aparte to fellow functional programmers: although Lua has +-- got all the features that constitute a functional language, its +-- heart, and in particular it table data, is imperative. It's often +-- asking for trouble to work against the host language's nature, so +-- code walkers are imperative, cope with it. Or use table.deep_copy() +-- if you don't want issues with shared state. +-- +-- Since walkers are imperative (i.e. they transform the tree in +-- place, rather than returning a fresh variant of it), you'll often +-- want to override a node, i.e. keep its "pointer identity", but +-- replace its content with a new one; this is done by +-- table.override(), and is conveniently abbreviated as +-- "target <- new_content". +-- +-- So, [cfg] can contain a series of sub-tables fields 'expr', 'stat', +-- 'block'. each of them can contain a function up() and/or a function +-- down(). +-- +-- * down() is called when the walker starts visiting a node of the +-- matching kind, i.e. before any of its sub-nodes have been +-- visited. down() is allowed to return either the string "break", +-- which means "don't go further down this tree, don't try to walk +-- its children", or nil, i.e. "please process with the children +-- nodes". +-- +-- There are two reasons why you might want down() to return +-- "break": either because you really weren't interested into the +-- children nodes,or because you wanted to walk through them in a +-- special way, and down() already performed this special walking. +-- +-- * up() is called just before the node is left, i.e. after all of +-- its children nodes have been completely parsed, down and up. This +-- is a good place to put treatments which rely on sub-nodes being +-- already treated. Notice that if down() returned 'break', up() is +-- run immediately after. +-- +-- In previous versions of this library, there were plenty of fancy +-- configurable ways to decide whether an up() or down() functions +-- would be triggered or not. Experience suggested that the best way +-- is to keep it simpler, as done by the current design: the functions +-- in sub-table expr are run on each expression node, and ditto for +-- stat and block; the user is expected to use the pattern matching +-- extension to decide whether to act or not on a given node. +-- +-- Advanced features +-- ================= +-- +-- The version above is a strict subset of the truth: there are a +-- couple of other, more advanced features in the library. +-- +-- Paths in visitor functions +-- -------------------------- +-- First, up() and down() don't take only one node as a parameter, but +-- a series thereof: all the nested expr/stat/block nodes on the way +-- up to the ast's root. For instance, when a walker works on +-- +{ foo(bar*2+1) } an is on the node +{2}, up() and down() are called +-- with arguments (+{bar*2}, +{bar*2+1}, +{foo(bar*2+1)}). +-- +-- `Call and `Invoke as statements +-- ------------------------------- +-- `Call and `Invoke are normally expressions, but they can also +-- appear as statements. In this case, the cfg.expr.xxx() visitors +-- aren't called on them. Sometimes you want to consider tham as +-- expressions, sometimes not, and it's much easier to add a special +-- case in cfg.stat.xxx() visitors than to determine whether we're in +-- a statament's context in cfg.expr.xxx(), +-- +-- Extra walkers +-- ------------- +-- There are some second class walkers: walk.expr_list() and walk.guess(). +-- +-- * The first one walks through a list of expressions. Although used +-- internally by the other walkers, it remains a second class +-- citizen: the list it works on won't appear in the path of nested +-- ASTs that's passed to up() and down(). This design choice has +-- been made because there's no clear definition of what is or isn't +-- an expr list in an AST, and anyway such lists are probably not +-- part of metacoders' mental image of an AST, so it's been thought +-- best to let people pretend they don't exist. +-- +-- * walk.guess() tries to guess the type of the AST it receives, +-- according to its tag, and runs the appropriate walker. Node which +-- can be both stats and exprs (`Call and `Invoke) are considered as +-- expr. +-- +-- These three walkers, although used internally by the other walkers, +-- remain second class citizens: the lists they work on won't appear +-- in the path of nested ASTs that's passed to up() and down(). +-- +-- Tag dictionaries +-- ---------------- +-- There are two public dictionaries, walk.tags.stat and +-- walk.tags.expr, which keep the set of all tags that can start a +-- statement or an expression AST. They're used by walk.guess, and +-- users sometimes need them as well, so they've been kept available. +-- +-- Binder visitor +-- -------------- +-- Finally, there's one last field in [cfg]: binder(). This function +-- is called on identifiers in a binder position, i.e. `Id{ } nodes +-- which create a scoped local variable, in `Function, `Fornum, `Local +-- etc. The main use case for that function is to keep track of +-- variables, captures, etc. and perform alpha conversions. In many +-- cases that work is best done through the library 'walk.id', which +-- understands the notions of scope, free variable, bound variable +-- etc. +-- +-- Binder visitors are called just before the variable's scope starts, +-- e.g. they're called after the right-hand-side has been visited in a +-- `Local node, but before in a `Localrec node. +-- +-- TODO: document scopes, relaxed cfg descriptions +-- ----------------------------------------------- +-- +-- Examples of cfg structures: +-- +-- { Id = f1, Local = f2 } +-- f +-- { up = f1, down = f2 } +-- { scope = { up = f1, down = f2 }, up = f1, down = f2 } +-- { stat = f1, expr = { up = f1 } } +-- +-- +-------------------------------------------------------------------------------- + +-{ extension "match" } + +walk = { traverse = { }; tags = { }; debug = false } + +-------------------------------------------------------------------------------- +-- Standard tags: can be used to guess the type of an AST, or to check +-- that the type of an AST is respected. +-------------------------------------------------------------------------------- +walk.tags.stat = table.transpose{ + 'Do', 'Set', 'While', 'Repeat', 'Local', 'Localrec', 'Return', + 'Fornum', 'Forin', 'If', 'Break', 'Goto', 'Label', + 'Call', 'Invoke' } +walk.tags.expr = table.transpose{ + 'Paren', 'Call', 'Invoke', 'Index', 'Op', 'Function', 'Stat', + 'Table', 'Nil', 'Dots', 'True', 'False', 'Number', 'String', 'Id' } + +local function scope (cfg, dir) + local h = cfg.scope and cfg.scope[dir] + if h then h() end +end + +-------------------------------------------------------------------------------- +-- These [walk.traverse.xxx()] functions are in charge of actually going through +-- ASTs. At each node, they make sure to call the appropriate walker. +-------------------------------------------------------------------------------- +function walk.traverse.stat (cfg, x, ...) + if walk.debug then printf("traverse stat %s", table.tostring(x)) end + local log = {...} + local B = |y| walk.block (cfg, y, x, unpack(log)) + local S = |y| walk.stat (cfg, y, x, unpack(log)) + local E = |y| walk.expr (cfg, y, x, unpack(log)) + local EL = |y| walk.expr_list (cfg, y, x, unpack(log)) + local I = |y| walk.binder_list (cfg, y, x, unpack(log)) + local DOWN = || scope(cfg, 'down') + local UP = || scope(cfg, 'up') + local function BS(y) DOWN(); B(y); UP() end + + match x with + | {...} if x.tag == nil -> for y in ivalues(x) do walk.stat(cfg, y, ...) end + -- no tag --> node not inserted in the history log + | `Do{...} -> BS(x) + | `Set{ lhs, rhs } -> EL(lhs); EL(rhs) + | `While{ cond, body } -> E(cond); BS(body) + | `Repeat{ body, cond } -> DOWN(); B(body); E(cond); UP() + | `Local{ lhs } -> I(lhs) + | `Local{ lhs, rhs } -> EL(rhs); I(lhs) + | `Localrec{ lhs, rhs } -> I(lhs); EL(rhs) + | `Fornum{ i, a, b, body } -> E(a); E(b); DOWN(); I{i}; B(body); UP() + | `Fornum{ i, a, b, c, body } -> E(a); E(b); E(c); I{i}; BS(body) + | `Forin{ i, rhs, body } -> EL(rhs); DOWN(); I(i); B(body); UP() + | `If{...} -> for i=1, #x-1, 2 do E(x[i]); BS(x[i+1]) end + if #x%2 == 1 then BS(x[#x]) end + | `Call{...}|`Invoke{...}|`Return{...} -> EL(x) + | `Break | `Goto{ _ } | `Label{ _ } -> -- nothing + | { tag=tag, ...} if walk.tags.stat[tag]-> + walk.malformed (cfg, x, unpack (log)) + | _ -> + walk.unknown (cfg, x, unpack (log)) + end +end + +function walk.traverse.expr (cfg, x, ...) + if walk.debug then printf("traverse expr %s", table.tostring(x)) end + local log = {...} + local B = |y| walk.block (cfg, y, x, unpack(log)) + local S = |y| walk.stat (cfg, y, x, unpack(log)) + local E = |y| walk.expr (cfg, y, x, unpack(log)) + local EL = |y| walk.expr_list (cfg, y, x, unpack(log)) + local I = |y| walk.binder_list (cfg, y, x, unpack(log)) + local DOWN = || scope(cfg, 'down') + local UP = || scope(cfg, 'up') + match x with + | `Paren{ e } -> E(e) + | `Call{...} | `Invoke{...} -> EL(x) + | `Index{ a, b } -> E(a); E(b) + | `Op{ opid, ... } -> E(x[2]); if #x==3 then E(x[3]) end + | `Function{ params, body } -> DOWN(); I(params); B(body); UP() + | `Stat{ b, e } -> DOWN(); B(b); E(e); UP() + | `Table{ ... } -> + for i = 1, #x do match x[i] with + | `Pair{ k, v } -> E(k); E(v) + | v -> E(v) + end end + |`Nil|`Dots|`True|`False|`Number{_}|`String{_}|`Id{_} -> -- nothing + | { tag=tag, ...} if walk.tags.expr[tag]-> + walk.malformed (cfg, x, unpack (log)) + | _ -> + walk.unknown (cfg, x, unpack (log)) + end +end + +function walk.traverse.block (cfg, x, ...) + assert(type(x)=='table', "traverse.block() expects a table") + for y in ivalues(x) do walk.stat(cfg, y, x, ...) end +end + +function walk.traverse.expr_list (cfg, x, ...) + assert(type(x)=='table', "traverse.expr_list() expects a table") + -- x doesn't appear in the log + for y in ivalues(x) do walk.expr(cfg, y, ...) end +end + + +function walk.malformed(cfg, x, ...) + local f = cfg.malformed or cfg.error + if f then f(x, ...) else + error ("Malformed node of tag "..(x.tag or '(nil)')) + end +end + +function walk.unknown(cfg, x, ...) + local f = cfg.unknown or cfg.error + if f then f(x, ...) else + error ("Unknown node tag "..(x.tag or '(nil)')) + end +end + +---------------------------------------------------------------------- +-- Generic walker generator. +-- * if `cfg' has an entry matching the tree name, use this entry +-- * if not, try to use the entry whose name matched the ast kind +-- * if an entry is a table, look for 'up' and 'down' entries +-- * if it is a function, consider it as a `down' traverser. +---------------------------------------------------------------------- +local walker_builder = |cfg_field, traverse| function (cfg, x, ...) + local sub_cfg = type (x)=='table' and x.tag and cfg[x.tag] + or cfg[cfg_field] or cfg + local broken, down, up = false + if type(sub_cfg)=='table' then + down, up = sub_cfg.down, sub_cfg.up + elseif type(sub_cfg)=='function' or sub_cfg=='break' then + down, up = sub_cfg, nil + else error "Invalid walk config" end + + if down then + if down=='break' then broken='break' + else broken = down (x, ...) end + assert(not broken or broken=='break', + "Map functions must return 'break' or nil") + end + if not broken and traverse then traverse (cfg, x, ...) end + if up then up (x, ...) end +end + +---------------------------------------------------------------------- +-- Declare [walk.stat], [walk.expr], [walk.block] and [walk.expr_list] +---------------------------------------------------------------------- +for w in values{ "stat", "expr", "block", "expr_list" } do + walk[w] = walker_builder (w, walk.traverse[w]) +end + +---------------------------------------------------------------------- +-- Walk a list of `Id{...} (mainly a helper function actually). +---------------------------------------------------------------------- +function walk.binder_list (cfg, x, ...) + local f = cfg.binder + if f then for v in ivalues(x) do f(v, ...) end end +end + +---------------------------------------------------------------------- +-- Tries to guess the type of the AST then choose the right walkker. +---------------------------------------------------------------------- +function walk.guess (cfg, x, ...) + assert(type(x)=='table', "arg #2 in a walker must be an AST") + if walk.tags.expr[x.tag] then return walk.expr(cfg, x, ...) end + if walk.tags.stat[x.tag] then return walk.stat(cfg, x, ...) end + if not x.tag then return walk.block(cfg, x, ...) end + error ("Can't guess the AST type from tag "..(x.tag or '<none>')) +end
diff --git a/lib/metalua/walk/bindings.mlua b/lib/metalua/walk/bindings.mlua new file mode 100644 index 0000000..b072f9f --- /dev/null +++ b/lib/metalua/walk/bindings.mlua
@@ -0,0 +1,65 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.walk' +require 'metalua.walk.scope' + +function bindings(ast) + -- binders :: ast => name => occurences + -- unbound :: name => occurences + -- scope :: name => ast + + local binders, unbound, cfg, scope = { }, { }, { scope={ } }, scope:new() + + -- * id: identifier entering in scope + -- * ast: statement or expr carrying this id, on of: + -- Local, Localrec, Forin, Fornum, Function. + function cfg.binder (id, ast) + if id.tag ~= 'Id' then return end + local id_name = id[1] + -- Reference in scope, so that the binding statement can be retrieved: + scope.current[id_name] = ast + -- Init the occurences list for this identifier: + if binders[ast] then binders[ast][id_name] = { } + else binders[ast] = { [id_name] = { } } end + end + + -- identifier occurence, not as a binder: reference this occurence + function cfg.Id (id) + local id_name = id[1] + -- ast which binds this id, might be nil: + local binder_ast = scope.current [id_name] + -- dict id_name => occurences, might be the list of unbound occurences: + local occur_dict = binder_ast and binders[binder_ast] or unbound + -- add an occurence of `id' in the occurences list: + local occurences = occur_dict [id_name] + if occurences then table.insert (occurences, id) + else occur_dict [id_name] = { id } end + end + + --Do not choke on partial ASTs which contain `Error{} nodes + function cfg.error(x) end + + function cfg.scope.down() scope:push() end + function cfg.scope.up() scope:pop() end + + walk.guess (cfg, ast) + return binders, unbound +end +
diff --git a/lib/metalua/walk/id.mlua b/lib/metalua/walk/id.mlua new file mode 100644 index 0000000..9ad40c4 --- /dev/null +++ b/lib/metalua/walk/id.mlua
@@ -0,0 +1,205 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- This library walks AST to gather information about the identifiers +-- in it. It classifies them between free variables and bound +-- variables, and keeps track of which AST node created a given bound +-- variable occurence. +-- +-- walk_id (kind, ast) +-- +-- Input: +-- * an AST kind: 'expr', 'stat', 'block', 'expr_list', 'binder_list', 'guess' +-- * an AST of the corresponding kind. +-- +-- > string, AST +-- +-- Output: a table with two fields, 'bound' and 'free'; +-- * free associates the name of each free variable with the list of +-- all its occurences in the AST. That list is never empty. +-- * bound associates each stat or expr binding a new variable with +-- the occurences of that/those new variable(s). +-- +-- > { free = table (string, AST and `Id{ }); +-- > bound = table (AST, table(AST and `Id{ })) } +-- +-- How it works +-- ============ +-- Walk the tree to: +-- * locate open variables, and keep pointers on them so that they can +-- be alpha converted. +-- * locate variable bindings, so that we can find bound variables +-- * locate bound variables, keep them in association with their +-- binder, again in order to alpha-convert them. +-- +-- Special treatments: +-- * `Function `Local `Localrec `Fornum `Forin have binders; +-- `Local takes effect from the next statement, +-- `Localrec from the current statement, +-- `Function and other statments inside their bodies. +-- * `Repeat has a special scoping rule for its condition. +-- * blocks create temporary scopes +-- * `Splice must stop the walking, so that user code won't be +-- converted +-- +-------------------------------------------------------------------------------- + +-{ extension 'match' } +-{ extension 'log' } + +require 'metalua.walk' +require 'metalua.walk.scope' + +-- variable lists auto-create empty list as values by default. +local varlist_mt = { __index = function (self, key) + local x={ }; self[key] = x; return x + end } + +local function _walk_id (kind, supercfg, ast, ...) + + assert(walk[kind], "Inbalid AST kind selector") + assert(type(supercfg=='table'), "Config table expected") + assert(type(ast)=='table', "AST expected") + + local cfg = { expr = { }; block = { }; stat = { } } + local scope = scope:new() + + local visit_bound_var, visit_free_var + if not supercfg.id then + printf("Warning, you're using the id walker without id visitor. ".. + "If you know what you want do to, then you're probably doing ".. + "something else...") + visit_bound_var = || nil + visit_free_var = || nil + else + visit_free_var = supercfg.id.free or || nil + visit_bound_var = supercfg.id.bound or || nil + end + + ----------------------------------------------------------------------------- + -- Check identifiers; add functions parameters to scope + ----------------------------------------------------------------------------- + function cfg.expr.down(x, ...) + -- Execute the generic expression walker; if it breaks. + -- don't do the id walking. + if supercfg.expr and supercfg.expr.down then + 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, unpack(parents)) + else + --$log( 'walk.id found a free var:', x, scope.current) + r = visit_free_var(x, unpack(parents)) + end + if r then return r end + | `Function{ params, _ } -> scope:push (params, x) + | `Stat{ block, expr } -> + ------------------------------------------------------------- + -- 'expr' is in the scope of 'block': create the scope and + -- walk the block 'manually', then prevent automatic walk + -- by returning 'break'. + ------------------------------------------------------------- + scope:push() + for stat in values (block) do walk.stat(cfg, stat, x, ...) end + walk.expr(cfg, expr, x, unpack(parents)) + scope:pop() + return 'break' + | _ -> -- pass + end + + end + + ----------------------------------------------------------------------------- + -- Close the function scope opened by 'down()' + ----------------------------------------------------------------------------- + function cfg.expr.up(x, ...) + match x with `Function{...} -> scope:pop() | _ -> end + if supercfg.expr and supercfg.expr.up then supercfg.expr.up(x, ...) end + end + + ----------------------------------------------------------------------------- + -- Create a new scope and register loop variable[s] in it + ----------------------------------------------------------------------------- + function cfg.stat.down(x, ...) + -- Execute the generic statement walker; if it breaks. + -- don't do the id walking. + if supercfg.stat and supercfg.stat.down then + local r = supercfg.stat.down(x, ...) + if r then return r end + end + match x with + | `Forin{ vars, ... } -> scope:push (vars, x) + | `Fornum{ var, ... } -> scope:push ({var}, x) + | `Localrec{ vars, ... } -> scope:add (vars, x) + | `Repeat{ block, expr } -> + ------------------------------------------------------------- + -- 'expr' is in the scope of 'block': create the scope and + -- walk the block 'manually', then prevent automatic walk + -- by returning 'break'. + ------------------------------------------------------------- + scope:push() + for stat in values (block) do walk.stat(cfg, stat, x, ...) end + walk.expr(cfg, expr, x, ...) + scope:pop() + return 'break' + | _ -> -- pass + end + end + + ----------------------------------------------------------------------------- + -- Close the scopes opened by 'up()' + ----------------------------------------------------------------------------- + function cfg.stat.up(x, ...) + match x with + | `Forin{ ... } | `Fornum{ ... } -> scope:pop() + | `Local{ vars, ... } -> scope:add(vars, x) + | _ -> -- pass + -- `Repeat has no up(), because it 'break's. + end + if supercfg.stat and supercfg.stat.up then supercfg.stat.up(x, ...) end + end + + ----------------------------------------------------------------------------- + -- Create a separate scope for each block + ----------------------------------------------------------------------------- + function cfg.block.down(x, ...) + if supercfg.block and supercfg.block.down then + local r = supercfg.block.down(x, ...) + if r then return r end + end + scope:push() + end + function cfg.block.up(x, ...) + scope:pop() + if supercfg.block and supercfg.block.up then supercfg.block.up(x, ...) end + end + cfg.binder = supercfg.binder + walk[kind](cfg, ast, ...) +end + +local mt = { __index = |_,k| |...| _walk_id(k, ...) } +walk_id = setmetatable({ }, mt)
diff --git a/lib/metalua/walk/scope.lua b/lib/metalua/walk/scope.lua new file mode 100644 index 0000000..856917b --- /dev/null +++ b/lib/metalua/walk/scope.lua
@@ -0,0 +1,73 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Scopes: this library helps keeping track of identifier scopes, +-- typically in code walkers. +-- +-- * scope:new() returns a new scope instance s +-- +-- * s:push() bookmarks the current set of variables, so the it can be +-- retrieved next time a s:pop() is performed. +-- +-- * s:pop() retrieves the last state saved by s:push(). Calls to +-- :push() and :pop() can be nested as deep as one wants. +-- +-- * s:add(var_list, val) adds new variable names (stirng) into the +-- scope, as keys. val is the (optional) value associated with them: +-- it allows to attach arbitrary information to variables, e.g. the +-- statement or expression that created them. +-- +-- * s:push(var_list, val) is a shortcut for +-- s:push(); s:add(var_list, val). +-- +-- * s.current is the current scope, a table with variable names as +-- keys and their associated value val (or 'true') as value. +-- +-------------------------------------------------------------------------------- + +scope = { } +scope.__index = scope + +function scope:new() + local ret = { current = { } } + ret.stack = { ret.current } + setmetatable (ret, self) + return ret +end + +function scope:push(...) + table.insert (self.stack, table.shallow_copy (self.current)) + if ... then return self:add(...) end +end + +function scope:pop() + self.current = table.remove (self.stack) +end + +function scope:add (vars, val) + val = val or true + for i, id in ipairs (vars) do + assert(id.tag=='Id' or id.tag=='Dots' and i==#vars) + if id.tag=='Id' then self.current[id[1]] = val end + end +end + +return scope \ No newline at end of file
diff --git a/lib/serialize.lua b/lib/serialize.lua new file mode 100644 index 0000000..4e5c8a7 --- /dev/null +++ b/lib/serialize.lua
@@ -0,0 +1,202 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Serialize an object into a source code string. This string, when passed as +-- an argument to loadstring()(), returns an object structurally identical +-- to the original one. +-- +-- The following are supported: +-- +-- * strings, numbers, booleans, nil +-- +-- * functions without upvalues +-- +-- * tables thereof. There is no restriction on keys; recursive and shared +-- sub-tables are handled correctly. +-- +-- Caveat: metatables and environments aren't saved; this might or might not +-- be what you want. +-------------------------------------------------------------------------------- + +local no_identity = { number=1, boolean=1, string=1, ['nil']=1 } + +function serialize (x) + + local gensym_max = 0 -- index of the gensym() symbol generator + local seen_once = { } -- element->true set of elements seen exactly once in the table + local multiple = { } -- element->varname set of elements seen more than once + local nested = { } -- transient, set of elements currently being traversed + local nest_points = { } + local nest_patches = { } + + -- Generate fresh indexes to store new sub-tables: + local function gensym() + gensym_max = gensym_max + 1 ; return gensym_max + end + + ----------------------------------------------------------------------------- + -- `nest_points' are places where a (recursive) table appears within + -- itself, directly or not. for instance, all of these chunks + -- create nest points in table `x': + -- + -- "x = { }; x[x] = 1" + -- "x = { }; x[1] = x" + -- "x = { }; x[1] = { y = { x } }". + -- + -- To handle those, two tables are created by `mark_nest_point()': + -- + -- * `nest_points [parent]' associates all keys and values in table + -- parent which create a nest_point with boolean `true' + -- + -- * `nest_patches' contains a list of `{ parent, key, value }' + -- tuples creating a nest point. They're all dumped after all the + -- other table operations have been performed. + -- + -- `mark_nest_point (p, k, v)' fills tables `nest_points' and + -- `nest_patches' with informations required to remember that + -- key/value `(k,v)' creates a nest point in parent table `p'. It + -- also marks `p' as occuring multiple times, since several + -- references to it will be required in order to patch the nest + -- points. + ----------------------------------------------------------------------------- + local function mark_nest_point (parent, k, v) + local nk, nv = nested[k], nested[v] + assert (not nk or seen_once[k] or multiple[k]) + assert (not nv or seen_once[v] or multiple[v]) + local mode = (nk and nv and "kv") or (nk and "k") or ("v") + local parent_np = nest_points [parent] + local pair = { k, v } + if not parent_np then parent_np = { }; nest_points [parent] = parent_np end + parent_np [k], parent_np [v] = nk, nv + table.insert (nest_patches, { parent, k, v }) + seen_once [parent], multiple [parent] = nil, true + end + + ----------------------------------------------------------------------------- + -- 1st pass, list the tables and functions which appear more than once in `x' + ----------------------------------------------------------------------------- + local function mark_multiple_occurences (x) + if no_identity [type(x)] then return end + if seen_once [x] then seen_once [x], multiple [x] = nil, true + elseif multiple [x] then -- pass + else seen_once [x] = true end + + if type (x) == 'table' then + nested [x] = true + for k, v in pairs (x) do + if nested[k] or nested[v] then mark_nest_point (x, k, v) else + mark_multiple_occurences (k) + mark_multiple_occurences (v) + end + end + nested [x] = nil + end + end + + local dumped = { } -- multiply occuring values already dumped in localdefs + local localdefs = { } -- already dumped local definitions as source code lines + + + -- mutually recursive functions: + local dump_val, dump_or_ref_val + + ------------------------------------------------------------------------------ + -- if `x' occurs multiple times, dump the local var rather than the + -- value. If it's the first time it's dumped, also dump the content + -- in localdefs. + ------------------------------------------------------------------------------ + function dump_or_ref_val (x) + if nested[x] then return 'false' end -- placeholder for recursive reference + if not multiple[x] then return dump_val (x) end + local var = dumped [x] + if var then return "_[" .. var .. "]" end -- already referenced + local val = dump_val(x) -- first occurence, create and register reference + var = gensym() + table.insert(localdefs, "_["..var.."]="..val) + dumped [x] = var + return "_[" .. var .. "]" + end + + ----------------------------------------------------------------------------- + -- 2nd pass, dump the object; subparts occuring multiple times are dumped + -- in local variables, which can then be referenced multiple times; + -- care is taken to dump local vars in an order which repect dependencies. + ----------------------------------------------------------------------------- + function dump_val(x) + local t = type(x) + if x==nil then return 'nil' + elseif t=="number" then return tostring(x) + elseif t=="string" then return string.format("%q", x) + elseif t=="boolean" then return x and "true" or "false" + elseif t=="function" then + return string.format ("loadstring(%q,'@serialized')", string.dump (x)) + elseif t=="table" then + + local acc = { } + local idx_dumped = { } + local np = nest_points [x] + for i, v in ipairs(x) do + if np and np[v] then + table.insert (acc, 'false') -- placeholder + else + table.insert (acc, dump_or_ref_val(v)) + end + idx_dumped[i] = true + end + for k, v in pairs(x) do + if np and (np[k] or np[v]) then + --check_multiple(k); check_multiple(v) -- force dumps in localdefs + elseif not idx_dumped[k] then + table.insert (acc, "[" .. dump_or_ref_val(k) .. "] = " .. dump_or_ref_val(v)) + end + end + return "{ "..table.concat(acc,", ").." }" + else + error ("Can't serialize data of type "..t) + end + end + + -- Patch the recursive table entries: + local function dump_nest_patches() + for _, entry in ipairs(nest_patches) do + local p, k, v = unpack (entry) + assert (multiple[p]) + local set = dump_or_ref_val (p) .. "[" .. dump_or_ref_val (k) .. "] = " .. + dump_or_ref_val (v) .. " -- rec " + table.insert (localdefs, set) + end + end + + mark_multiple_occurences (x) + local toplevel = dump_or_ref_val (x) + dump_nest_patches() + + if next (localdefs) then + -- Dump local vars containing shared or recursive parts, + -- then the main table using them. + return "local _={ }\n" .. + table.concat (localdefs, "\n") .. + "\nreturn " .. toplevel + else + -- No shared part, straightforward dump: + return "return " .. toplevel + end +end
diff --git a/lib/strict.lua b/lib/strict.lua new file mode 100644 index 0000000..e35e22d --- /dev/null +++ b/lib/strict.lua
@@ -0,0 +1,51 @@ +------------------------------------------------------------------------------- +-- Copyright (C) 1994-2008 Lua.org, PUC-Rio. All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +------------------------------------------------------------------------------- + +local getinfo, error, rawset, rawget = debug.getinfo, error, rawset, rawget + +local mt = getmetatable(_G) +if mt == nil then + mt = {} + setmetatable(_G, mt) +end + +__strict = true +mt.__declared = {} + +local function what () + local d = getinfo(3, "S") + return d and d.what or "C" +end + +mt.__newindex = function (t, n, v) + if __strict and not mt.__declared[n] then + local w = what() + if w ~= "main" and w ~= "C" then + error("assign to undeclared variable '"..n.."'", 2) + end + mt.__declared[n] = true + end + rawset(t, n, v) +end + +mt.__index = function (t, n) + if __strict and not mt.__declared[n] and what() ~= "C" then + error("variable '"..n.."' is not declared", 2) + end + return rawget(t, n) +end + +function global(...) + for _, v in ipairs{...} do mt.__declared[v] = true end +end
diff --git a/lib/verbose_require.lua b/lib/verbose_require.lua new file mode 100644 index 0000000..0e07650 --- /dev/null +++ b/lib/verbose_require.lua
@@ -0,0 +1,31 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + + +do + local xrequire, n, ind = require, 0, "| " + function require (x) + print(ind:rep(n).."/ require: "..x) + n=n+1 + local y = xrequire(x) + n=n-1 + print(ind:rep(n).."\\_") + return y + end +end
diff --git a/make.bat b/make.bat new file mode 100644 index 0000000..d4e9ca6 --- /dev/null +++ b/make.bat
@@ -0,0 +1,58 @@ +@CLS + +@REM *** Settings *** + +@REM BASE = root directory of metalua sources +@REM DISTRIB_BIN = metalua executables target directory +@REM DISTRIB_LIB = metalua libraries target directory, can be an existing path referenced in LUA_PATH +@REM LUA, LUAC = Lua executables, provided by metalua by default. + +@REM --- BEGINNING OF USER-EDITABLE PART --- + +@set BASE=%CD% +@set DISTRIB=%BASE%\..\distrib +@set DISTRIB_BIN=%DISTRIB%\bin +@set DISTRIB_LIB=%DISTRIB%\lib +@set LUA=%DISTRIB_BIN%\lua +@set LUAC=%DISTRIB_BIN%\luac + +@REM --- END OF USER-EDITABLE PART --- + + +@REM *** Create the distribution directories, populate them with lib sources *** + +@set LUA_PATH=?.luac;?.lua;%DISTRIB_LIB%\?.luac;%DISTRIB_LIB%\?.lua +@set LUA_MPATH=?.mlua;%DISTRIB_LIB%\?.mlua + +mkdir %DISTRIB% +mkdir %DISTRIB_BIN% +mkdir %DISTRIB_LIB% +xcopy /y /s lib %DISTRIB_LIB% +xcopy /y /s bin %DISTRIB_BIN% + +@REM *** Generate a callable batch metalua.bat script *** + +echo @set LUA_PATH=?.luac;?.lua;%DISTRIB_LIB%\?.luac;%DISTRIB_LIB%\?.lua > %DISTRIB_BIN%\metalua.bat +echo @set LUA_MPATH=?.mlua;%DISTRIB_LIB%\?.mlua >> %DISTRIB_BIN%\metalua.bat +echo @%LUA% %DISTRIB_LIB%\metalua.luac %%* >> %DISTRIB_BIN%\metalua.bat + + +@REM *** Compiling the parts of the compiler written in plain Lua *** + +cd compiler +%LUAC% -o %DISTRIB_LIB%\metalua\bytecode.luac lopcodes.lua lcode.lua ldump.lua compile.lua +%LUAC% -o %DISTRIB_LIB%\metalua\mlp.luac lexer.lua gg.lua mlp_lexer.lua mlp_misc.lua mlp_table.lua mlp_meta.lua mlp_expr.lua mlp_stat.lua mlp_ext.lua +cd .. + +@REM *** Bootstrap the parts of the compiler written in metalua *** + +%LUA% %BASE%\build-utils\bootstrap.lua %BASE%\compiler\mlc.mlua output=%DISTRIB_LIB%\metalua\mlc.luac +%LUA% %BASE%\build-utils\bootstrap.lua %BASE%\compiler\metalua.mlua output=%DISTRIB_LIB%\metalua.luac + +@REM *** Finish the bootstrap: recompile the metalua parts of the compiler with itself *** + +call %DISTRIB_BIN%\metalua -vb -f compiler\mlc.mlua -o %DISTRIB_LIB%\metalua\mlc.luac +call %DISTRIB_BIN%\metalua -vb -f compiler\metalua.mlua -o %DISTRIB_LIB%\metalua.luac + +@REM *** Precompile metalua libraries *** +%LUA% %BASE%\build-utils\precompile.lua directory=%DISTRIB_LIB% command=%DISTRIB_BIN%\metalua
diff --git a/make.sh b/make.sh new file mode 100644 index 0000000..fc890e9 --- /dev/null +++ b/make.sh
@@ -0,0 +1,135 @@ +#! /bin/sh + +# --- BEGINNING OF USER-EDITABLE PART --- + +# Metalua sources +BASE=${PWD} + +# Temporary building location. +# Upon installation, everything will be moved to ${INSTALL_LIB} and ${INSTALL_BIN} + +if [ -z "${BUILD}" ]; then + BUILD=$(mkdir -p ../build; cd ../build; pwd) +fi + +if [ -z "${BUILD_BIN}" ]; then + BUILD_BIN=${BUILD}/bin +fi + +if [ -z "${BUILD_LIB}" ]; then + BUILD_LIB=${BUILD}/lib +fi + +# Where to place the final results +# DESTDIR= +# INSTALL_BIN=/usr/local/bin +# INSTALL_LIB=/usr/local/lib/lua/5.1 +if [ -z "${INSTALL_BIN}" ]; then + INSTALL_BIN=~/local/bin +fi + +if [ -z "${INSTALL_LIB}" ]; then + INSTALL_LIB=~/local/lib/lua +fi + +# Where to find Lua executables. +# On many Debian-based systems, those can be installed with "sudo apt-get install lua5.1" +LUA=$(which lua) +LUAC=$(which luac) + +# --- END OF USER-EDITABLE PART --- + +if [ -z ${LUA} ] ; then echo "Error: no lua interpreter found"; exit 1; fi +if [ -z ${LUAC} ] ; then echo "Error: no lua compiler found"; exit 1; fi + +if [ -f ~/.metaluabuildrc ] ; then . ~/.metaluabuildrc; fi + +if [ -z "$LINEREADER" ] ; then LINEREADER=$(which rlwrap); fi + +if [ -z "$LINEREADER" ] ; then + echo "Warning, rlwrap not found, no line editor support for interactive mode" + echo "Consider performing the equivalent of 'sudo apt-get install rlwrap'." +fi + +echo '*** Lua paths setup ***' + +export LUA_PATH="?.luac;?.lua;${BUILD_LIB}/?.luac;${BUILD_LIB}/?.lua" +export LUA_MPATH="?.mlua;${BUILD_LIB}/?.mlua" + +echo '*** Create the distribution directories, populate them with lib sources ***' + +mkdir -p ${BUILD_BIN} +mkdir -p ${BUILD_LIB} +cp -Rp lib/* ${BUILD_LIB}/ +# cp -Rp bin/* ${BUILD_BIN}/ # No binaries provided for unix (for now) + +echo '*** Generating a callable metalua shell script ***' + +cat > ${BUILD_BIN}/metalua <<EOF +#!/bin/sh +export LUA_PATH='?.luac;?.lua;${BUILD_LIB}/?.luac;${BUILD_LIB}/?.lua' +export LUA_MPATH='?.mlua;${BUILD_LIB}/?.mlua' +exec ${LINEREADER} ${LUA} ${BUILD_LIB}/metalua.luac \$* +EOF +chmod a+x ${BUILD_BIN}/metalua + +echo '*** Compiling the parts of the compiler written in plain Lua ***' + +cd compiler +${LUAC} -o ${BUILD_LIB}/metalua/bytecode.luac lopcodes.lua lcode.lua ldump.lua compile.lua || exit 1 +${LUAC} -o ${BUILD_LIB}/metalua/mlp.luac lexer.lua gg.lua mlp_lexer.lua mlp_misc.lua mlp_table.lua mlp_meta.lua mlp_expr.lua mlp_stat.lua mlp_ext.lua || exit 1 +cd .. + +echo '*** Bootstrap the parts of the compiler written in metalua ***' + +${LUA} ${BASE}/build-utils/bootstrap.lua ${BASE}/compiler/mlc.mlua output=${BUILD_LIB}/metalua/mlc.luac +${LUA} ${BASE}/build-utils/bootstrap.lua ${BASE}/compiler/metalua.mlua output=${BUILD_LIB}/metalua.luac +${LUA} ${BASE}/build-utils/bootstrap.lua ${BASE}/lib/metalua/treequery/walk.mlua output=${BUILD_LIB}/metalua/treequery/walk.luac + +echo '*** Finish the bootstrap: recompile the metalua parts of the compiler with itself ***' + +${BUILD_BIN}/metalua -vb -f compiler/mlc.mlua -o ${BUILD_LIB}/metalua/mlc.luac +${BUILD_BIN}/metalua -vb -f compiler/metalua.mlua -o ${BUILD_LIB}/metalua.luac +${BUILD_BIN}/metalua -vb -f lib/metalua/treequery/walk.mlua -o ${BUILD_LIB}/metalua/treequery/walk.luac + +echo '*** Precompile metalua libraries ***' +for SRC in $(find ${BUILD_LIB} -name '*.mlua'); do + DST=$(dirname $SRC)/$(basename $SRC .mlua).luac + if [ $DST -nt $SRC ]; then + echo "+ $DST already up-to-date" + else + echo "- $DST generated from $SRC" + ${BUILD_BIN}/metalua $SRC -o $DST + fi +done + +echo '*** Generate make-install.sh script ***' + +cat > make-install.sh <<EOF2 +#!/bin/sh +mkdir -p ${INSTALL_BIN} +mkdir -p ${INSTALL_LIB} +if [ -n "${DESTDIR}" ]; then + mkdir -p ${DESTDIR}${INSTALL_BIN} + mkdir -p ${DESTDIR}${INSTALL_LIB} +fi +cat > ${DESTDIR}${INSTALL_BIN}/metalua <<EOF +#!/bin/sh +METALUA_LIB=${INSTALL_LIB} +export LUA_PATH="?.luac;?.lua;\\\${METALUA_LIB}/?.luac;\\\${METALUA_LIB}/?.lua" +export LUA_MPATH="?.mlua;\\\${METALUA_LIB}/?.mlua" +exec ${LINEREADER} ${LUA} \\\${METALUA_LIB}/metalua.luac "\\\$@" +EOF + +chmod a+x ${DESTDIR}${INSTALL_BIN}/metalua + +cp -pR ${BUILD_LIB}/* ${DESTDIR}${INSTALL_LIB}/ + +echo "metalua libs installed in ${INSTALL_LIB};" +echo "metalua executable in ${INSTALL_BIN}." +EOF2 +chmod a+x make-install.sh + +echo +echo "Build completed, proceed to installation with './make-install.sh' or 'sudo ./make-install.sh'" +echo
diff --git a/samples/clist_test.mlua b/samples/clist_test.mlua new file mode 100644 index 0000000..804b786 --- /dev/null +++ b/samples/clist_test.mlua
@@ -0,0 +1,39 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{extension "clist"} + +-- integers from 2 to 50, by steps of 2: +x = { i for i = 2, 50, 2 } + +-- the same, obtained by filtering over all integers <= 50: +y = { i for i = 1, 50 if i%2==0 } + +-- prime numbers, implemented in an inefficient way: +local sieve, n = { i for i=2, 100 }, 1 +while n < #sieve do + sieve = { + i for i in values(sieve[1 ... n]); + i for i in values(sieve[n+1 ... #sieve]) if i%sieve[n] ~= 0 } + n += 1 +end + +print "Prime numbers < 100, computed with lists by comprehension:" +table.print(sieve) +
diff --git a/samples/h_test.mlua b/samples/h_test.mlua new file mode 100644 index 0000000..7923884 --- /dev/null +++ b/samples/h_test.mlua
@@ -0,0 +1,79 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'log' } +-{ extension 'H' } + +require 'metalua.compiler' + +TEST_CASES = { + + { "everything should be renamed", + +{ block: + local x = 3 + print(x) }, + { } }, + + { "don't get confused between global and local x", + +{ block: + print(x) + local x = 3 + print(x) }, + { alpha = { } } }, + + { "don't rename keepme", + +{ block: + keepme() + dont_keep_me() }, + { keep = 'keepme' , alpha = `Local{ { }, { } } } }, + + { "print shouldn't be renamed the 2nd and 3rd time", + +{ block: + print(i) + -{!`Call{`Id 'print', `String 'hi' } } + -{!+{print 'hi'}} }, + { } }, + + { "print shouldn't be renamed at all", + +{ block: + print(i) + -{`Call{`Id 'print', `String 'hi' } } + -{+{print 'hi'}} }, + { keep = 'print' } }, + + { "Rename print with a pre-specified name, rename x freely, not y", + +{ block: + print (x, y) }, + { alpha = +{stat: local RENAMED_PRINT = print}, + keep = {y = true} } } } + +for case in ivalues(TEST_CASES) do + local comment, ast, cfg = unpack(case) + print ('\n'..'-':rep(70)) + print (comment) + local H = H:new(cfg) + print ("\nBEFORE PARSING:") + $log (ast, H, 50) + H(ast) + print ("\nAFTER PARSING:") + $log (ast, H, 50) +end + +print ('\n'..'=':rep(70)) +$log(TEST_CASES,40) \ No newline at end of file
diff --git a/samples/h_test2.mlua b/samples/h_test2.mlua new file mode 100644 index 0000000..ee9f64d --- /dev/null +++ b/samples/h_test2.mlua
@@ -0,0 +1,44 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ block: + -{ extension 'log' } + -{ extension 'H' } + + require 'metalua.dollar' + + local H = H:new() + print("initial H.alpha", H.alpha) + + + function dollar.Q(cond, iftrue, iffalse) + local b = +{ block: + local v + if -{!cond} then v = -{!iftrue} + else v = -{!iffalse} end } + local r = `Stat{ b, +{v} } + H(r) + return r + end + + $log(H) + return H.alpha } + +x=1 ; y=$Q(x==1, 'one', 'two') ; print(y) +x=2 ; y=$Q(x==1, 'one', 'two') ; print(y) \ No newline at end of file
diff --git a/samples/hello_world.mlua b/samples/hello_world.mlua new file mode 100644 index 0000000..48cb7eb --- /dev/null +++ b/samples/hello_world.mlua
@@ -0,0 +1,26 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- The message numbered (1) will display at compilation, i.e. before +-- (2) is displayed (supposing that compilation and execution are +-- both requested) + +print "(2) This is a runtime message: Hello world!" +-{ print "(1) This is a compile-time message: Hello world!" } +
diff --git a/samples/ifexpr.mlua b/samples/ifexpr.mlua new file mode 100644 index 0000000..c6ca15a --- /dev/null +++ b/samples/ifexpr.mlua
@@ -0,0 +1,161 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +---------------------------------------------------------------------------------- +-- This samples walks you through the writing of a simple extension. +-- +-- Lua makes a difference between statements and expressions, and it's sometimes +-- cumbersome to put a statement where an expression is expected. Among others, +-- if-then-else constructs are statements, so you cannot write: +-- +-- > local foo = if bar then 1 else 2 +-- +-- Indeed, an expression is expected at the right of the equal, and "if ..." is +-- a statement, which expects nested statements as "then" and "else" clauses. +-- The example above must therefore be written: +-- +-- > local foo +-- > if bar then foo=1 else foo=2 end +-- +-- +-- Let's allow if-then-[elseif*]-[else] constructs to be used in an expression's +-- context. In such a context, 'then' and 'else' are expected to be followed by +-- expressions, not statement blocks. +-- +-- Stuff you probably need to understand, at least summarily, to follow this +-- code: +-- * Lua syntax +-- * the fact that -{ ... } switches metalua into compile time mode +-- * mlp, the dynamically extensible metalua parser, which will be extended with +-- the new construct at compile time. +-- * gg, the grammar generator that allows to build and extend parsers, and with +-- which mlp is implemented. +-- * the fact that code can be interchangeably represented as abstract syntax +-- trees with `Foo{ bar } notations (easy to manipulate) or as quotes inside a +-- +{ ... } (easy to read). +-- +---------------------------------------------------------------------------------- + + +---------------------------------------------------------------------------------- +-- How to turn this file in a proper syntax extension. +-- =================================================== +-- +-- To turn this example's metalevel 0 code into a regular extension: +-- * Put everything inside the -{block: ... } in a separate .mlua file; +-- * save it in a directory called 'extension', which is itself +-- in your $LUA_MPATH. For instance, if your $LUA_MPATH contains +-- '~/local/metalua/?.mlua', you can save it as +-- '~/local/metalua/extension-compiler/ifexpr.mlua' +-- * Load the extension with "-{ extension 'ifexpr' }", whenever you want to +-- use it. +---------------------------------------------------------------------------------- + +-{ block: -- Enter metalevel 0, where we'll start hacking the parser. + + ------------------------------------------------------------------------------- + -- Most extension implementations are cut in two parts: a front-end which + -- parses the syntax into some custom tree, and a back-end which turns that + -- tree into a compilable AST. Since the front-end calls the back-end, the + -- later has to be declared first. + ------------------------------------------------------------------------------- + + ------------------------------------------------------------------------------- + -- Back-end: + -- ========= + -- This is the builder that turns the parser's result into an expression AST. + -- Local vars: + -- ----------- + -- elseifthen_list : list of { condition, expression_if_true } pairs, + -- opt_else: either the expression in the 'else' final clause if any, + -- or false if there's no else clause. + -- v: the variable in which the result will be stored. + -- ifstat: the if-then-else statement that will be generated from + -- then if-then-else expression, then embedded in a `Stat{} + -- + -- The builder simply turns all expressions into blocks, so that they fit in + -- a regular if-then-else statement. Then the resulting if-then-else is + -- embedded in a `Stat{ } node, so that it can be placed where an expression + -- is expected. + -- + -- The variable in which the result is stored has its name generated by + -- mlp.gensym(). This way we're sure there will be no variable capture. + -- When macro hygiene problems are more complex, it's generally a good + -- idea to give a look at the extension 'H'. + ------------------------------------------------------------------------------- + local function builder (x) + local elseifthen_list, opt_else = unpack (x) + + local v = mlp.gensym 'ife' -- the selected expr will be stored in this var. + local ifstat = `If{ } + for y in ivalues (elseifthen_list) do + local cond, val = unpack (y) + table.insert (ifstat, cond) + table.insert (ifstat, { `Set{ {v}, {val} } }) -- change expr into stat. + end + if opt_else then -- the same for else clause, except that there's no cond. + table.insert (ifstat, { `Set{ {v}, {opt_else} } }) + end + return `Stat{ +{block: local -{v}; -{ifstat}}, v } + end + + ------------------------------------------------------------------------------- + -- Front-end: + -- ========== + -- This is mostly the same as the regular if-then-else parser, except that: + -- * it's added to the expression parser, not the statement parser; + -- * blocks after conditions are replaced by exprs; + -- + -- In Lua, 'end' traditionally terminates a block, not an + -- expression. Should there be a 'end' to respect if-then-else + -- usual syntax, or should there be none, to respect usual implicit + -- expression ending? I chose not to put an 'end' here, but other people + -- might have other tastes... + ------------------------------------------------------------------------------- + mlp.expr:add{ name = 'if-expression', + 'if', + gg.list { gg.sequence{mlp.expr, "then", mlp.expr}, separators="elseif" }, + gg.onkeyword{ 'else', mlp.expr }, + builder = builder } + +} -- Back to metalevel 1, with the new feature enabled + +local foo, bar + +------------------------------------------------------------ +-- The parser will read this as: +-- { { { `Id 'foo', `Number 1 }, +-- { `Id 'bar', `Number 2 } }, +-- `Number 3 }, +-- then feed it to 'builder', which will turn it into an AST +------------------------------------------------------------ + +local x = if false then 1 elseif bar then 2 else 3 + +------------------------------------------------------------ +-- The result after builder will be: +-- `Stat{ +{block: local $v$ +-- if foo then $v$ = 1 +-- elseif bar then $v$ = 2 +-- else $v$ = 3 +-- end }, `Id "$v$" } +------------------------------------------------------------ + +assert (x == 3) +print "It seems to work..." \ No newline at end of file
diff --git a/samples/lex_switch_test.mlua b/samples/lex_switch_test.mlua new file mode 100644 index 0000000..4c79709 --- /dev/null +++ b/samples/lex_switch_test.mlua
@@ -0,0 +1,59 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- This is a simple and somewhat stupid example of how to switch +-- lexers dynamically. Behind a V, X and Y are the only reserved +-- keywords. In normal conditions, X and Y aren't keywords and can be +-- used as variables. + +-{ block: + require 'lexer' + local my_lexer = lexer.lexer:clone() -- no keywords + my_lexer:add{"X", "Y"} + mlp.lexer:add "V" + + function num(lx) + local a = lx:next() + assert(a.tag=='Number') + return a + end + + my_parser = gg.list{ + gg.multisequence{ + { "X", num, builder = |x| `Table{ x[1], +{0} } }, + { "Y", num, builder = |y| `Table{ +{0}, y[1] } }, + default = gg.sequence{ mlp.id, builder = |x| `Pair{ `String{x[1][1]},`True } } }, + separators = { ',', ';' }, + builder = function(l) l.tag='Table'; return l end } + + mlp.expr:add{ "V", gg.with_lexer(my_lexer, my_parser), builder = unpack } } + +-- Use the special lexer: +foo = V X 1, Y 2, X 3, + for, foo, in, tag, function -- check that these aren't keywords in my_lexer + +-- Use X and Y as Id, in the unpolluted lexer: +print "Vector:" +X = table.tostring(foo, 60) +print (X) + +print "Sum:" -- Ready for a functional one-liner? :) +Y = |v| table.ifold (|a,b| table.imap (|c,d| c+d, a, b), {0,0}, v) +table.print (Y(foo)) +
diff --git a/samples/match_test.mlua b/samples/match_test.mlua new file mode 100644 index 0000000..4eff225 --- /dev/null +++ b/samples/match_test.mlua
@@ -0,0 +1,105 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{extension 'match'} + +WIDTH = 50 +function p(msg) + io.write(msg, ' ':rep(WIDTH-#msg)) + io.flush() +end + +p "Basic match" +match 1 with 1 -> print 'ok' end + +p "Sequence match" +match 3, 4 with +| 1, 2 -> print 'KO' +| 3, 4 -> print 'ok' +end + +p "Id binding" +match 3, 4 with +| 1, 2 -> print 'KO' +| x, y -> print 'ok' +end + +p "Table destructuring & non-litteral tested term" +match {1, 2} with +|{a, 2} -> assert(a==1); print 'ok' +end + +p "Pattern group" +match {'?'} with +|1|2|3 -> print 'KO' +|{...} -> print 'ok' +end + +p "Multi-level destructuring" +match {{1000}} with +|{{2000}} -> print 'KO' +|{{3000}} -> print 'KO' +|{{1000}} -> print 'ok' +end + +p "Guard" +match 1 with +| 1 if false -> print 'KO' +| 1 -> print 'ok' +end + +p "Guard with bound var" +match 1 with +| a if a ~= 1 -> print 'KO' +| a if a == 1 -> print 'ok' +end + +p "Non linear var & destructuring" +match {1, {2}} with +| {a, {a}} -> print 'KO' +| {a, {b}} -> print 'ok' +end + +p "Non-linear vars on a sequence" +match 1, 2 with +| a, a -> print 'KO' +| a, b -> print 'ok' +end + +p "Multiple _ wildcards" +match 1, 2 with +| _, _ -> print 'ok' +| a, b -> print 'KO' +end + +p "Regexp & non-linear vars" +match 'toto' with +| 't(.)t(.)' / { a, a } -> print (a..'k') +end + +p "Nested match & ..." +match { { 'o', 'k', '!' } } with +| { t } -> match t with + | { a, b } -> print 'KO' + | { a, b, ... } -> print (a..b) + | _ -> print 'KO' + end +| _ -> print 'KO' +end +
diff --git a/samples/synth.mlua b/samples/synth.mlua new file mode 100644 index 0000000..880fc3a --- /dev/null +++ b/samples/synth.mlua
@@ -0,0 +1,579 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'strict' + +-{ extension 'match' } + +synth = { } +synth.__index = synth + +-------------------------------------------------------------------------------- +-- Instanciate a new AST->source synthetizer +-------------------------------------------------------------------------------- +function synth.new () + local self = { + _acc = { }, -- Accumulates pieces of source as strings + current_indent = 0, -- Current level of line indentation + indent_step = " " -- Indentation symbol, normally spaces or '\t' + } + return setmetatable (self, synth) +end + +-------------------------------------------------------------------------------- +-- Run a synthetizer on the `ast' arg and return the source as a string. +-- Can also be used as a static method `synth.run (ast)'; in this case, +-- a temporary synthetizer is instanciated on the fly. +-------------------------------------------------------------------------------- +function synth:run (ast) + if not ast then + self, ast = synth.new(), self + end + self._acc = { } + self:node (ast) + return table.concat (self._acc) +end + +-------------------------------------------------------------------------------- +-- Accumulate a piece of source file in the synthetizer. +-------------------------------------------------------------------------------- +function synth:acc (x) + if x then table.insert (self._acc, x) end +end + +-------------------------------------------------------------------------------- +-- Accumulate an indented newline. +-- Jumps an extra line if indentation is 0, so that +-- toplevel definitions are separated by an extra empty line. +-------------------------------------------------------------------------------- +function synth:nl () + if self.current_indent == 0 then self:acc "\n" end + self:acc ("\n" .. self.indent_step:rep (self.current_indent)) +end + +-------------------------------------------------------------------------------- +-- Increase indentation and accumulate a new line. +-------------------------------------------------------------------------------- +function synth:nlindent () + self.current_indent = self.current_indent + 1 + self:nl () +end + +-------------------------------------------------------------------------------- +-- Decrease indentation and accumulate a new line. +-------------------------------------------------------------------------------- +function synth:nldedent () + self.current_indent = self.current_indent - 1 + self:acc ("\n" .. self.indent_step:rep (self.current_indent)) +end + +-------------------------------------------------------------------------------- +-- Keywords, which are illegal as identifiers. +-------------------------------------------------------------------------------- +local keywords = table.transpose { + "and", "break", "do", "else", "elseif", + "end", "false", "for", "function", "if", + "in", "local", "nil", "not", "or", + "repeat", "return", "then", "true", "until", + "while" } + +-------------------------------------------------------------------------------- +-- Return true iff string `id' is a legal identifier name. +-------------------------------------------------------------------------------- +local function is_ident (id) + return id:strmatch "^[%a_][%w_]*$" and not keywords[id] +end + +-------------------------------------------------------------------------------- +-- Return true iff ast represents a legal function name for +-- syntax sugar ``function foo.bar.gnat() ... end'': +-- a series of nested string indexes, with an identifier as +-- the innermost node. +-------------------------------------------------------------------------------- +local function is_idx_stack (ast) + match ast with + | `Id{ _ } -> return true + | `Index{ left, `String{ _ } } -> return is_idx_stack (left) + | _ -> return false + end +end + +-------------------------------------------------------------------------------- +-- Operator precedences, in increasing order. +-- This is not directly used, it's used to generate op_prec below. +-------------------------------------------------------------------------------- +local op_preprec = { + { "or", "and" }, + { "lt", "le", "eq", "ne" }, + { "concat" }, + { "add", "sub" }, + { "mul", "div", "mod" }, + { "unary", "not", "len" }, + { "pow" }, + { "index" } } + +-------------------------------------------------------------------------------- +-- operator --> precedence table, generated from op_preprec. +-------------------------------------------------------------------------------- +local op_prec = { } + +for prec, ops in ipairs (op_preprec) do + for op in ivalues (ops) do + op_prec[op] = prec + end +end + +-------------------------------------------------------------------------------- +-- operator --> source representation. +-------------------------------------------------------------------------------- +local op_symbol = { + add = " + ", sub = " - ", mul = " * ", + div = " / ", mod = " % ", pow = " ^ ", + concat = " .. ", eq = " == ", ne = " ~= ", + lt = " < ", le = " <= ", ["and"] = " and ", + ["or"] = " or ", ["not"] = "not ", len = "# " } + +-------------------------------------------------------------------------------- +-- Accumulate the source representation of AST `node' in +-- the synthetizer. Most of the work is done by delegating to +-- the method having the name of the AST tag. +-- If something can't be converted to normal sources, it's +-- instead dumped as a `-{ ... }' splice in the source accumulator. +-------------------------------------------------------------------------------- +function synth:node (node) + assert (self~=synth and self._acc) + if not node.tag then -- tagless block. + self:list (node, self.nl) + else + local f = synth[node.tag] + if type (f) == "function" then -- Delegate to tag method. + f (self, node, unpack (node)) + elseif type (f) == "string" then -- tag string. + self:acc (f) + else -- No appropriate method, fall back to splice dumping. + -- This cannot happen in a plain Lua AST. + self:acc " -{ " + self:acc (table.tostring (node, "nohash"), 80) + self:acc " }" + end + end +end + +-------------------------------------------------------------------------------- +-- Convert every node in the AST list `list' passed as 1st arg. +-- `sep' is an optional separator to be accumulated between each list element, +-- it can be a string or a synth method. +-- `start' is an optional number (default == 1), indicating which is the +-- first element of list to be converted, so that we can skip the begining +-- of a list. +-------------------------------------------------------------------------------- +function synth:list (list, sep, start) + for i = start or 1, # list do + self:node (list[i]) + if list[i + 1] then + if not sep then + elseif type (sep) == "function" then sep (self) + elseif type (sep) == "string" then self:acc (sep) + else error "Invalid list separator" end + end + end +end + +-------------------------------------------------------------------------------- +-- +-- Tag methods. +-- ------------ +-- +-- Specific AST node dumping methods, associated to their node kinds +-- by their name, which is the corresponding AST tag. +-- synth:node() is in charge of delegating a node's treatment to the +-- appropriate tag method. +-- +-- Such tag methods are called with the AST node as 1st arg. +-- As a convenience, the n node's children are passed as args #2 ... n+1. +-- +-- There are several things that could be refactored into common subroutines +-- here: statement blocks dumping, function dumping... +-- However, given their small size and linear execution +-- (they basically perform series of :acc(), :node(), :list(), +-- :nl(), :nlindent() and :nldedent() calls), it seems more readable +-- to avoid multiplication of such tiny functions. +-- +-- To make sense out of these, you need to know metalua's AST syntax, as +-- found in the reference manual or in metalua/doc/ast.txt. +-- +-------------------------------------------------------------------------------- + +function synth:Do (node) + self:acc "do" + self:nlindent () + self:list (node, self.nl) + self:nldedent () + self:acc "end" +end + +function synth:Set (node) + match node with + | `Set{ { `Index{ lhs, `String{ method } } }, + { `Function{ { `Id "self", ... } == params, body } } } + if is_idx_stack (lhs) and is_ident (method) -> + -- ``function foo:bar(...) ... end'' -- + self:acc "function " + self:node (lhs) + self:acc ":" + self:acc (method) + self:acc " (" + self:list (params, ", ", 2) + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" + + | `Set{ { lhs }, { `Function{ params, body } } } if is_idx_stack (lhs) -> + -- ``function foo(...) ... end'' -- + self:acc "function " + self:node (lhs) + self:acc " (" + self:list (params, ", ") + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" + + | `Set{ { `Id{ lhs1name } == lhs1, ... } == lhs, rhs } + if not is_ident (lhs1name) -> + -- ``foo, ... = ...'' when foo is *not* a valid identifier. + -- In that case, the spliced 1st variable must get parentheses, + -- to be distinguished from a statement splice. + -- This cannot happen in a plain Lua AST. + self:acc "(" + self:node (lhs1) + self:acc ")" + if lhs[2] then -- more than one lhs variable + self:acc ", " + self:list (lhs, ", ", 2) + end + self:acc " = " + self:list (rhs, ", ") + + | `Set{ lhs, rhs } -> + -- ``... = ...'', no syntax sugar -- + self:list (lhs, ", ") + self:acc " = " + self:list (rhs, ", ") + end +end + +function synth:While (node, cond, body) + self:acc "while " + self:node (cond) + self:acc " do" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function synth:Repeat (node, body, cond) + self:acc "repeat" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "until " + self:node (cond) +end + +function synth:If (node) + for i = 1, #node-1, 2 do + -- for each ``if/then'' and ``elseif/then'' pair -- + local cond, body = node[i], node[i+1] + self:acc (i==1 and "if " or "elseif ") + self:node (cond) + self:acc " then" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + end + -- odd number of children --> last one is an `else' clause -- + if #node%2 == 1 then + self:acc "else" + self:nlindent () + self:list (node[#node], self.nl) + self:nldedent () + end + self:acc "end" +end + +function synth:Fornum (node, var, first, last) + local body = node[#node] + self:acc "for " + self:node (var) + self:acc " = " + self:node (first) + self:acc ", " + self:node (last) + if #node==5 then -- 5 children --> child #4 is a step increment. + self:acc ", " + self:node (node[4]) + end + self:acc " do" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function synth:Forin (node, vars, generators, body) + self:acc "for " + self:list (vars, ", ") + self:acc " in " + self:list (generators, ", ") + self:acc " do" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function synth:Local (node, lhs, rhs) + self:acc "local " + self:list (lhs, ", ") + if rhs[1] then + self:acc " = " + self:list (rhs, ", ") + end +end + +function synth:Localrec (node, lhs, rhs) + match node with + | `Localrec{ { `Id{name} }, { `Function{ params, body } } } + if is_ident (name) -> + -- ``local function name() ... end'' -- + self:acc "local function " + self:acc (name) + self:acc " (" + self:list (params, ", ") + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" + + | _ -> + -- Other localrec are unprintable ==> splice them -- + -- This cannot happen in a plain Lua AST. -- + self:acc "-{ " + self:acc (table.tostring (node, 'nohash', 80)) + self:acc " }" + end +end + +function synth:Call (node, f) + -- single string or table literal arg ==> no need for parentheses. -- + local parens + match node with + | `Call{ _, `String{_} } + | `Call{ _, `Table{...}} -> parens = false + | _ -> parens = true + end + self:node (f) + self:acc (parens and " (" or " ") + self:list (node, ", ", 2) -- skip `f'. + self:acc (parens and ")") +end + +function synth:Invoke (node, f, method) + -- single string or table literal arg ==> no need for parentheses. -- + local parens + match node with + | `Invoke{ _, _, `String{_} } + | `Invoke{ _, _, `Table{...}} -> parens = false + | _ -> parens = true + end + self:node (f) + self:acc ":" + self:acc (method[1]) + self:acc (parens and " (" or " ") + self:list (node, ", ", 3) -- Skip args #1 and #2, object and method name. + self:acc (parens and ")") +end + +function synth:Return (node) + self:acc "return " + self:list (node, ", ") +end + +synth.Break = "break" +synth.Nil = "nil" +synth.False = "false" +synth.True = "true" +synth.Dots = "..." + +function synth:Number (node, n) + self:acc (tostring (n)) +end + +function synth:String (node, str) + -- format "%q" prints '\n' in an umpractical way IMO, + -- so this is fixed with the :gsub( ) call. + self:acc (string.format ("%q", str):gsub ("\\\n", "\\n")) +end + +function synth:Function (node, params, body) + self:acc "function " + self:acc " (" + self:list (params, ", ") + self:acc ")" + self:nlindent () + self:list (body, self.nl) + self:nldedent () + self:acc "end" +end + +function synth:Table (node) + if not node[1] then self:acc "{ }" else + self:acc "{" + self:nlindent () + for i, elem in ipairs (node) do + match elem with + | `Pair{ `String{ key }, value } if is_ident (key) -> + -- ``key = value''. -- + self:acc (key) + self:acc " = " + self:node (value) + + | `Pair{ key, value } -> + -- ``[key] = value''. -- + self:acc "[" + self:node (key) + self:acc "] = " + self:node (value) + + | _ -> + -- ``value''. -- + self:node (elem) + end + if node [i+1] then + self:acc "," + self:nl () + end + end + self:nldedent () + self:acc "}" + end +end + +function synth:Op (node, op, a, b) + -- Transform ``not (a == b)'' into ``a ~= b''. -- + match node with + | `Op{ "not", `Op{ "eq", _a, _b } } + | `Op{ "not", `Paren{ `Op{ "eq", _a, _b } } } -> + op, a, b = "ne", _a, _b + | _ -> + end + + if b then -- binary operator. + local left_paren, right_paren + match a with + | `Op{ op_a, ...} if op_prec[op] >= op_prec[op_a] -> left_paren = true + | _ -> left_paren = false + end + + match b with -- FIXME: might not work with right assoc operators ^ and .. + | `Op{ op_b, ...} if op_prec[op] >= op_prec[op_b] -> right_paren = true + | _ -> right_paren = false + end + + self:acc (left_paren and "(") + self:node (a) + self:acc (left_paren and ")") + + self:acc (op_symbol [op]) + + self:acc (right_paren and "(") + self:node (b) + self:acc (right_paren and ")") + + else -- unary operator. + local paren + match a with + | `Op{ op_a, ... } if op_prec[op] >= op_prec[op_a] -> paren = true + | _ -> paren = false + end + self:acc (op_symbol[op]) + self:acc (paren and "(") + self:node (a) + self:acc (paren and ")") + end +end + +function synth:Paren (node, content) + self:acc "(" + self:node (content) + self:acc ")" +end + +function synth:Index (node, table, key) + local paren_table + -- Check precedence, see if parens are needed around the table -- + match table with + | `Op{ op, ... } if op_prec[op] < op_prec.index -> paren_table = true + | _ -> paren_table = false + end + + self:acc (paren_table and "(") + self:node (table) + self:acc (paren_table and ")") + + match key with + | `String{ field } if is_ident (field) -> + -- ``table.key''. -- + self:acc "." + self:acc (field) + | _ -> + -- ``table [key]''. -- + self:acc "[" + self:node (key) + self:acc "]" + end +end + +function synth:Id (node, name) + if is_ident (name) then + self:acc (name) + else -- Unprintable identifier, fall back to splice representation. + -- This cannot happen in a plain Lua AST. + self:acc "-{`Id " + self:String (node, name) + self:acc "}" + end +end + + +-------------------------------------------------------------------------------- +-- Read a file, get its AST, use synth to regenerate sources +-- from that AST +-------------------------------------------------------------------------------- +require 'metalua.compiler' +local filename = (arg[2] or arg[1]) or arg[0] +local ast = mlc.luafile_to_ast (filename) + +print(synth.run(ast))
diff --git a/samples/trycatch_test.mlua b/samples/trycatch_test.mlua new file mode 100644 index 0000000..80e4124 --- /dev/null +++ b/samples/trycatch_test.mlua
@@ -0,0 +1,126 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'trycatch' } + + +---------------------------------------------------------------------- +print "1) no error" +try + print(" Hi") +end + + +---------------------------------------------------------------------- +print "2) caught error" +try + error "some_error" +catch x then + printf(" Successfully caught %q", x) +end + + +-- [[ +---------------------------------------------------------------------- +print "3) no error, with a finally" +try + print " Hi" +finally + print " Finally OK" +end + + +---------------------------------------------------------------------- +print "4) error, with a finally" +try + print " Hi" + error "bang" +catch "bang"/{_} then + print " Bang caught" +finally + print " Finally OK" +end + + +---------------------------------------------------------------------- +print "5) nested catchers" +try + try + error "some_error" + catch "some_other_error" then + assert (false, "mismatch, this must not happen") + end + catch "some_error"/{x} then + printf(" Successfully caught %q across a try that didn't catch", x) +catch x then + assert (false, "We shouldn't reach this catch-all") +end + + +---------------------------------------------------------------------- +print "6) nested catchers, with a 'finally in the inner one" +try + try + error "some_error" + catch "some_other_error" then + assert (false, "mismatch, this must not happen") + finally + print " Leaving the inner try-catch" + end +catch "some_error"/{x} then + printf(" Successfully caught %q across a try that didn't catch", x) +catch x then + assert (false, "We shouldn't reach this catch-all") +end + + +---------------------------------------------------------------------- +print "7) 'finally' intercepts a return from a function" +function f() + try + print " into f:" + return "F_RESULT" + assert (false, "I'll never go there") + catch _ then + assert (false, "No exception should be thrown") + finally + print " I do the finally before leaving f()" + end +end +local fr = f() +printf(" f returned %q", fr) + + +---------------------------------------------------------------------- +print "8) don't be fooled by nested functions" +function f() + try + local function g() return "from g" end + printf(" g() returns %q", g()) + return "from f" + catch _ then + assert (false, "No exception should be thrown") + end +end +local fr = f() +printf(" f returned %q", fr) + +---------------------------------------------------------------------- +print "*) done." +
diff --git a/samples/types_test.mlua b/samples/types_test.mlua new file mode 100644 index 0000000..aeb3945 --- /dev/null +++ b/samples/types_test.mlua
@@ -0,0 +1,38 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension "types" } +-{ extension "clist" } + +-- Uncomment this to turn typechecking code generation off: +-- -{stat: types.enabled=false} + +function sum (x :: table(number)) :: number + local acc :: number = 0 + for i=1, #x do + acc = acc + x[i] -- .. 'x' -- converts to string + end + --acc='bug' -- put a string in a number variable + return acc +end + +x = { i for i=1,100 } +--x[23] = 'toto' -- string in a number list, sum() will complain +y = sum (x) +printf ("sum 1 .. %i = %i", #x, y) \ No newline at end of file
diff --git a/samples/walk_id_test.mlua b/samples/walk_id_test.mlua new file mode 100644 index 0000000..5dfff6c --- /dev/null +++ b/samples/walk_id_test.mlua
@@ -0,0 +1,45 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'match' } + +require 'metalua.walk.id' + +ast = +{ block: + y = type(1) + function foo(x) + local type = 'number' + assert(x==type or not x) + end + foo(x) } + +disp = |msg,ast| printf("\n%s:\n%s", msg, table.tostring(ast, 80, 'nohash')) +disp('initial term', ast) + +do -- Make globals explicit: + local ast = table.deep_copy(ast) + local cfg = { id = { } } + function cfg.id.free(i) + i <- `Index{ `Id '_G', `String{i[1]} } + return 'break' + end + walk_id.block(cfg, ast) + disp('Globals made explicit', ast) +end +
diff --git a/samples/weaver.mlua b/samples/weaver.mlua new file mode 100644 index 0000000..3a7507f --- /dev/null +++ b/samples/weaver.mlua
@@ -0,0 +1,139 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +require 'metalua.mlc' +require 'metalua.walk' + +function weave_ast (src, ast, name) + + ------------------------------------------------------------------- + -- translation: associate an AST node to its recomposed source + -- ast_children: associate an AST node to the list of its children + -- ast_parent: associate an AST node to the list of its parent + -- weavable: whether an AST node supports weaving of its children + -- node: common walker config for exprs, stats & blocks + ------------------------------------------------------------------- + local translation, ast_children, ast_parent, weaveable, node = + { }, { }, { }, { }, { } + + ------------------------------------------------------------------- + -- Build up the parent/children relationships. This is not the same + -- as inclusion between tables: the relation we're building only + -- relates blocks, expressions and statements; in the AST, some + -- tables don't represent any of these node kinds. + -- For instance in `Local{ { `Id "x" }, { } }, `Id"x" is a child of + -- the `Local{ } node, although it's not directly included in it. + ------------------------------------------------------------------- + function node.down(ast, parent) + ---------------------------------------------------- + -- `Do{ } blocks are processed twice: + -- * once as a statement + -- * once as a block, child of itself + -- This prevents them from becoming their own child. + ---------------------------------------------------- + if ast==parent then return end + + if not ast.lineinfo then + weaveable [ast] = false, false + if parent then weaveable [parent] = false end + else + weaveable [ast] = true + + -- normalize lineinfo + -- TODO: FIXME + if ast.lineinfo.first[3] > ast.lineinfo.last[3] then + ast.lineinfo.first, ast.lineinfo.last = ast.lineinfo.last, ast.lineinfo.first + end + end + ast_children [ast] = { } + ast_parent [ast] = parent + if parent then table.insert (ast_children [parent], ast) end + end + + ------------------------------------------------------------------- + -- Visit up, from leaves to upper-level nodes, and weave leaves + -- back into the text of their parent node, recursively. Since the + -- visitor is imperative, we can't easily make it return a value + -- (the resulting recomposed source, here). Therefore we + -- imperatively store results in the association table + -- `translation'. + ------------------------------------------------------------------- + function node.up(ast) + local _acc = { } + local function acc(x) table.insert (_acc, x) end + + if not next(ast) then -- shadow node, remove from ast_children + local x = ast_children[ast_parent[ast]] + for i,a in ipairs (x) do if a==ast then table.remove (x, i); break end end + return "" -- no need to continue, we know that the node is empty! + end + + -- ast Can't be weaved normally, try something else -- + local function synthetize (ast) + acc "-{expr: " + acc (table.tostring (ast, 'nohash', 80, 8)) + acc " }" + end + + -- regular weaving of chidren in the parent's sources -- + local function weave (ast) + -- sort children in appearence order + local comp = |a,b| a.lineinfo.first[3] < b.lineinfo.first[3] + table.sort (ast_children [ast], comp) + + local li = ast.lineinfo + if not li then return synthetize (ast) end + local a, d = li.first[3], li.last[3] + for child in ivalues (ast_children [ast]) do + local li = child.lineinfo + local b, c = li.first[3], li.last[3] + acc (src:sub (a, b - 1)) + acc (translation [child]) + a = c + 1 + end + acc (src:sub (a, d)) + end + + -- compute the translation from the children's ones -- + if not translation [ast] then + if weaveable [ast] then weave (ast) else synthetize (ast) end + translation [ast] = table.concat (_acc) + end + end + + local cfg = { expr=node; stat=node; block=node } + walk.block (cfg, ast) + + return translation [ast] +end + +-- Get the source. If none is given, use itself as an example. -- +local filename = arg[2] or arg[1] or arg[0] +local f = assert (io.open (filename, 'r')) +local src = f:read '*a' +f:close() + +local ast = mlc.luastring_to_ast (src, name) +if not next(ast) then + io.write (src) -- Empty ast, probably empty file, or comments only +else + local before = src:sub (1, ast.lineinfo.first[3]-1) + local after = src:sub (ast.lineinfo.last[3]+1, -1) + io.write (before .. weave_ast (src, ast) .. after) +end
diff --git a/samples/withdo_test.mlua b/samples/withdo_test.mlua new file mode 100644 index 0000000..9feb487 --- /dev/null +++ b/samples/withdo_test.mlua
@@ -0,0 +1,32 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'withdo' } + +local original_close = io.close + +function x() + with f1, f2 = io.open 'withdo_test.mlua', io.open 'trycatch_test.mlua' do + local t1 = f1:read '*a' + local t2 = f2:read '*a' + return #t1, #t2 + end +end + +print(x()) \ No newline at end of file
diff --git a/samples/xglobals_test.mlua b/samples/xglobals_test.mlua new file mode 100644 index 0000000..7a46488 --- /dev/null +++ b/samples/xglobals_test.mlua
@@ -0,0 +1,59 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'xglobal' } + +---------------------------------------------------------------------- +print "1) declare unassigned globals" +global a, b + +---------------------------------------------------------------------- +print "2) declare-and-assign global" +global c = 3 + +---------------------------------------------------------------------- +print "3) assign to pre-declared globals" +a, b = 1, 2 + +---------------------------------------------------------------------- +print "4) fail when setting an undeclared global" +local st1, msg1 = pcall(function() + a = 4 + d = 5 -- failure, assignment to undeclared global +end) +assert(not st1) +printf (" -> This error was expected: %s", msg1) + +---------------------------------------------------------------------- +print "5) fail when reading an undeclared global" +local st2, msg2 = pcall(function() + b = c -- OK + local _ = d -- failure, try to read undeclared global +end) +assert(not st2) +printf (" -> This error was expected: %s", msg2) + +---------------------------------------------------------------------- +print "6) check the globals' values" +assert(a==4) +assert(b==3) +assert(c==3) + +---------------------------------------------------------------------- +print "*) done."
diff --git a/samples/xloop_test.mlua b/samples/xloop_test.mlua new file mode 100644 index 0000000..e87993a --- /dev/null +++ b/samples/xloop_test.mlua
@@ -0,0 +1,23 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'xloop' } +for i=1,9 for j=10,90,10 if i~=3 while i<8 do + io.write(i+j, ' ') +end \ No newline at end of file
diff --git a/samples/xmatch_test.mlua b/samples/xmatch_test.mlua new file mode 100644 index 0000000..f651db4 --- /dev/null +++ b/samples/xmatch_test.mlua
@@ -0,0 +1,73 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-{ extension 'xmatch' } + +WIDTH=60 +function p(msg) io.write(msg..' ':rep(WIDTH-#msg)) end + +---------------------------------------------------------------------- +p "match as an expression" +print(match 1 with 1 -> 'ok' | 2 -> 'KO') + +---------------------------------------------------------------------- +p "global match function" +match function g +| x if x<10 -> return 'o' +| _ -> return 'k' +end +print(g(1)..g(11)) + +---------------------------------------------------------------------- +p "global match function, multi-args" +match function cmp +| x, y if x<y -> return 'increasing' +| _, _ -> return 'decreasing' + end + +if cmp(1,2)=='increasing' and cmp(2,1)=='decreasing' then + print "ok" else print "KO" +end + +---------------------------------------------------------------------- +p "local match function" +do + local match function x + | 1 -> print 'ok' + end + x(1) +end +assert(not x) + +---------------------------------------------------------------------- +p "global bind assignment" +bind {a, b} = {'o', 'k'} +print(a..b) + +---------------------------------------------------------------------- +p "local bind assignment" +c, d = 'k', 'o' +do + local bind {c, {d}} = {'o', {'k'}} + print(c..d) +end + +---------------------------------------------------------------------- +p "local bind assignment scope" +print(d..c)
diff --git a/tests/lexer.lua b/tests/lexer.lua new file mode 100644 index 0000000..6eb430a --- /dev/null +++ b/tests/lexer.lua
@@ -0,0 +1,149 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 David Manura and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- David Manura - API and implementation +-- +------------------------------------------------------------------------------- + +-- tests of lexer (preliminary) +-- +-- D.Manura. Copyright (c) 2011, Fabien Fleutot <metalua@gmail.com>. +-- +-- This software is released under the MIT Licence, see Metalua licence.txt +-- for details. + + +package.path = 'src/compiler/?.lua;src/lib/?.lua' + +require 'mlp_lexer' +local LX = mlp.lexer + +-- equality check. +local function checkeq(a, b) + if a ~= b then + error('not equal:\n' .. tostring(a) .. '\n' .. tostring(b), 2) + end +end + +local function checkmatch(a, b) + if not a:match(b) then + error('not match:\n' .. tostring(a) .. '\n' .. tostring(b), 2) + end +end + +-- reads file to string (with limited error handling) +local function readfile(filename) + local fh = assert(io.open(filename, 'rb')) + local text = fh:read'*a' + fh:close() + return text +end + +-- formats token succinctly. +local function tokfmt(tok) + local function fmt(o) + return (type(o) == 'string') and ("%q"):format(o):sub(2,-2) or tostring(o) + end + return [[`]] .. tok.tag .. tostring(tok.lineinfo):gsub('%|L[^%|]*%|C[^%|]*', '') .. '{' .. fmt(tok[1]) .. '}' +end + +-- utility function to lex code +local function lex(code) + local sm = LX:newstream(code) + local toks = {} + while 1 do + local tok = sm:next() + toks[#toks+1] = tokfmt(tok) + if tok.tag == 'Eof' then + break + end + end + return table.concat(toks) +end +local function tlex(code) + local sm = LX:newstream(code) + local toks = {} + while 1 do + local tok = sm:next() + toks[#toks+1] = tok + if tok.tag == 'Eof' then break end + end +return toks +end +local function plex(code) + return pcall(lex, code) +end + +--FIX checkeq(nil, plex '====') + +-- trivial tests +checkeq(lex[[]], [[`Eof<?|K1>{eof}]]) +checkeq(lex'\t', [[`Eof<?|K2>{eof}]]) +checkeq(lex'\n', [[`Eof<?|K2>{eof}]]) +checkeq(lex'--', [[`Eof<C|?|K3>{eof}]]) +checkeq(lex'\n -- \n--\n ', [[`Eof<C|?|K11>{eof}]]) +checkeq(lex[[return]], [[`Keyword<?|K1-6>{return}`Eof<?|K7>{eof}]]) + +-- string tests +checkeq(lex[["\092b"]], [[`String<?|K1-7>{\\b}`Eof<?|K8>{eof}]]) -- was bug +checkeq(lex[["\x5Cb"]], [[`String<?|K1-7>{\\b}`Eof<?|K8>{eof}]]) -- [5.2] +checkeq(lex[["\0\t\090\100\\\1004"]], [[`String<?|K1-21>{\000 Zd\\d4}`Eof<?|K22>{eof}]]) -- decimal/escape + +-- number tests, hex (including Lua 5.2) +local t = tlex[[0xa 0xB 0xfF -0xFf 0x1.8 0x1.8P1 0x1.8p+01 0x.8p-1]] +checkeq(t[1][1], 0xa) +checkeq(t[2][1], 0xB) +checkeq(t[3][1], 0xfF) +checkeq(t[4][1], '-') +checkeq(t[5][1], 0xFf) +-- 5.2 hex floats +checkeq(t[6][1], 1.5) -- 0x1.8 +checkeq(t[7][1], 3) -- 0x1.8P1 +checkeq(t[8][1], 3) -- 0x1.8p+01 +checkeq(t[9][1], 0.25) -- 0x0.8p-1 +checkeq(t[10][1], 'eof') + + +-- Lua 5.2 +checkeq(lex'"a\\z \n ."', [[`String<?|K1-9>{a.}`Eof<?|K10>{eof}]]) -- \z +checkeq(lex'"\\z"', [[`String<?|K1-4>{}`Eof<?|K5>{eof}]]) -- \z +checkeq(lex[["\x00\\\xfF\\xAB"]], [[`String<?|K1-17>{\000\\]]..'\255'..[[\\xAB}`Eof<?|K18>{eof}]]) + +-- Lua 5.2 goto and :: +checkeq(lex'goto a1 ::a1 ::', [[`Keyword<?|K1-4>{goto}`Id<?|K6-7>{a1}]].. + [[`Keyword<?|K9-10>{::}`Id<?|K11-12>{a1}`Keyword<?|K14-15>{::}`Eof<?|K16>{eof}]]) + + +assert(lex(readfile(arg[0]))) -- lex self + +-- checks of unescape_string +local p = function(s) local ok, o = pcall(tlex, s); return ok and o[1][1] or o end +checkmatch(p[['\']], 'Unterminated') +checkeq(p[['\\a\\\t']], [[\a\]]..'\t') +checkeq(p[['\\116']], [[\116]]) +checkeq(p[['\\\116']], [[\t]]) +checkeq(p[['\092\116']], [[\t]]) -- was bug +checkeq(p[['\x5c\x74']], [[\t]]) -- 5.2 hex +-- Lua 5.2 +checkeq(p[['\z\z \ +a\z ']], [[ + +a]]) +checkeq(p[['\\z']], [[\z]]) -- was bug +checkmatch(p[['\xaz']], 'Unknown escape') +checkmatch(p[['\999']], 'must be in.*255') +checkeq(p[['\z\32']], ' ') -- was bug + +print 'DONE'
diff --git a/tests/locals-and-stats.mlua b/tests/locals-and-stats.mlua new file mode 100644 index 0000000..6e24fa5 --- /dev/null +++ b/tests/locals-and-stats.mlua
@@ -0,0 +1,34 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +local foo + +x = -{ `Stat{ { `Local{ { `Id "B" }, + { `Stat{ { `Local{ { `Id "A" }, + { `Number 4 } }, + `Set{ { `Id "y" }, + { `Id "A" } } }, + `Id "A" } } }, + `Set{ { `Id "x" }, + { `Id "B" } } }, + `Id "B" } } + +assert(x==4) +print "Test passed." +
diff --git a/tests/reweave.mlua b/tests/reweave.mlua new file mode 100644 index 0000000..3a891a4 --- /dev/null +++ b/tests/reweave.mlua
@@ -0,0 +1,43 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- +-{ extension 'xloop' } + +ls = io.popen ( (os.getenv("OS") or "") :match "^Windows" and "dir /b reweave" or "ls reweave") +this_script = arg[1] + +local errors = {} + +for filename in ls :lines() if filename :strmatch "%.m?lua$" do + printf ("--- weaver check %s ---", filename) + local ret = os.execute ("metalua ../samples/weaver.mlua reweave/"..filename.." | diff -q reweave/"..filename.." -") + if ret ~= 0 then + print("================================================================================") + print("Reweaved source does not match original:") + print("================================================================================") + os.execute ("metalua ../samples/weaver.mlua reweave/"..filename.." | diff reweave/"..filename.." -") + errors[#errors + 1] = "Reweaving of "..filename.." failed, returned "..ret + end +end + +ls :close() + +if #errors > 0 then + print("================================================================================") + error("REWEAVING ERRORS DETECTED:\n * " .. table.concat(errors, "\n * ")) +end
diff --git a/tests/reweave/comment.lua b/tests/reweave/comment.lua new file mode 100644 index 0000000..587d620 --- /dev/null +++ b/tests/reweave/comment.lua
@@ -0,0 +1,3 @@ +--[[ +comment +--]]
diff --git a/tests/reweave/comment2.lua b/tests/reweave/comment2.lua new file mode 100644 index 0000000..6222fb6 --- /dev/null +++ b/tests/reweave/comment2.lua
@@ -0,0 +1,2 @@ +--[[comment]] +local code = 5
diff --git a/tests/reweave/comment_dup.lua b/tests/reweave/comment_dup.lua new file mode 100644 index 0000000..17afdfd --- /dev/null +++ b/tests/reweave/comment_dup.lua
@@ -0,0 +1,8 @@ +if true then + -- comment +end + +if true then + -- comment + print("something else after") +end
diff --git a/tests/reweave/comments.lua b/tests/reweave/comments.lua new file mode 100644 index 0000000..05e8762 --- /dev/null +++ b/tests/reweave/comments.lua
@@ -0,0 +1,8 @@ +# it eats +--[[ all ]] +--[===[ my ]===] +comments() -- foo +--[[ bar +baz ]] qqq() +-- even +one() -- liners
diff --git a/tests/reweave/dup.lua b/tests/reweave/dup.lua new file mode 100644 index 0000000..e6428ab --- /dev/null +++ b/tests/reweave/dup.lua
@@ -0,0 +1,2 @@ +f(a > b) +f(c >= d)
diff --git a/tests/reweave/empty.lua b/tests/reweave/empty.lua new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/tests/reweave/empty.lua
diff --git a/tests/reweave/extra_whitespace.lua b/tests/reweave/extra_whitespace.lua new file mode 100644 index 0000000..7358189 --- /dev/null +++ b/tests/reweave/extra_whitespace.lua
@@ -0,0 +1,16 @@ +t = {} + +t = { } + +t {} + +t { } + +assert(count(function () end) == 1) + +for k,v,w in a do end + +repeat until 1; repeat until true; +while false do end; while nil do end; + +foo(1) { };
diff --git a/tests/reweave/function-index-decl.lua b/tests/reweave/function-index-decl.lua new file mode 100644 index 0000000..a7c77ac --- /dev/null +++ b/tests/reweave/function-index-decl.lua
@@ -0,0 +1,2 @@ +function a.b.c.f1 (x) return x+1 end +function a.b.c:f2 (x,y) self[x] = y end
diff --git a/tests/reweave/if.lua b/tests/reweave/if.lua new file mode 100644 index 0000000..32ddd19 --- /dev/null +++ b/tests/reweave/if.lua
@@ -0,0 +1 @@ +f(5 > 7)
diff --git a/tests/reweave/index_index.lua b/tests/reweave/index_index.lua new file mode 100644 index 0000000..6aa0028 --- /dev/null +++ b/tests/reweave/index_index.lua
@@ -0,0 +1 @@ +function a.b.c (x) end
diff --git a/tests/reweave/schema.lua b/tests/reweave/schema.lua new file mode 100644 index 0000000..c5275ba --- /dev/null +++ b/tests/reweave/schema.lua
@@ -0,0 +1,1286 @@ +local print, verb, dbg, errr, print_table, printt = make_module_loggers("schema", "SCM") + +local CT, GMF, + game_const + = import 'game/const.lua' + { + 'chipTypes', + 'gameModeFlags' + } + +local MTF, + cast_type + = import (game_const.abilities) + { + 'manualTargetFlags', + 'castType' + } + +local AP, abiprob_mapping = import (game_const.abilities.property) + { + 'mappingInv', -- Note order (inverted goes first) + 'mapping' + } + +local PO, CM, CST, SO, + abie_const + = import 'abie/const.lua' + { + 'propObjects', + 'customMessages', + 'clientStat', + 'storeObjects' + } + +local non_empty_list, + no_check, + not_implemented, + get_children, + get_children_concat_newline, + get_children_concat_str, + get_children_concat_table, + get_value, + get_value_quoted, + get_value_tonumber, + check_mapping_tonumber, + get_value_mapped_tonumber_quoted, + node_children_placeholders_filler, + check_tonumber + = import 'jsle/schema/util.lua' + { + 'non_empty_list', + 'no_check', + 'not_implemented', + 'get_children', + 'get_children_concat_newline', + 'get_children_concat_str', + 'get_children_concat_table', + 'get_value', + 'get_value_quoted', + 'get_value_tonumber', + 'check_mapping_tonumber', + 'get_value_mapped_tonumber_quoted', + 'node_children_placeholders_filler', + 'check_tonumber' + } + +local declare_common = import 'jsle/schema/common.lua' { 'declare_common' } + +-- Optional TODOs: + +-- TODO: Must be able to fetch back data from lang file to this schema. +-- TODO: Write effect validation with human readable answers. Make it available via jobman's job. +-- TODO: Write auto-conversion function for old abilities (v.1.01->current) +-- TODO: Embed limitations on number of simultanious identical active OT effects +-- TODO: Write checkers for numeric fields +-- TODO: Adapt game/ctrl.lua to abie + +local define_schema = function(jsle) + assert_is_table(jsle) + +-- WARNING: Return nil on error from handlers, do not return false -- it is a legitimate value. +-- WARNING: Reordering of schema elements would result in INCOMPATIBLE format change! + + local propwrite_values = + { + { ["health"] = [[жизнь]] }; + { ["health_max"] = [[здоровье]] }; + { ["mana1"] = [[красную ману]] }; + { ["mana2"] = [[зелёную ману]] }; + { ["mana3"] = [[синюю ману]] }; + -- Note mana4 is reserved for health + { ["mana5"] = [[ману 5]] }; + { ["mana6"] = [[ману 6]] }; + { ["mana7"] = [[ману 7]] }; + { ["mana8"] = [[ману 8]] }; + { ["armor"] = [[броню]] }; + { ["fury"] = [[ярость]] }; + { ["block"] = [[блок]] }; + { ["fortune"] = [[удачу]] }; + { ["stun"] = [[оглушение]] }; + { ["armour_piercing"] = [[бронебойность]] }; + { ["agility"] = [[ловкость]] }; + { ["counterattack"] = [[контрудар]] }; + { ["damage"] = [[базовый урон]] }; + { ["damage_min"] = [[минимальный урон]] }; + { ["damage_max"] = [[максимальный урон]] }; + { ["damage_mult"] = [[множитель урона]] }; + { ["vampiric"] = [[вампиризм]] }; + { ["stun_count"] = [[оглушённость]] }; + } + + local propread_values = tiappend( + tclone(propwrite_values), + { + { ["race_id"] = [[расу]] }, + { ["level"] = [[уровень]] }, + { ["grade"] = [[степень]] }, -- TODO: clan_rank?! + { ["rank"] = [[ранг]] }, + { ["glory"] = [[доблесть]] }, + { ["scalps"] = [[скальпы]] }, + { ["kills"] = [[убийства]] }, + } + ) + + -- TODO: Be more specific. Should be at least "abie-1.03". + jsle:version("1.03") -- WARNING: Do an ordering cleanup when this changes + + jsle:record "ROOT" + { + children = + { + [1] = "TARGET_LIST"; + [2] = "IMMEDIATE_EFFECT_LIST"; + [3] = "OVERTIME_EFFECT"; + [4] = { "BOOLEAN", default = 0 }; -- Warning! Do not use BOOLOP_VARIANT, nothing of it would work at this point. + [5] = { "CUSTOM_OVERTIME_EFFECTS", default = empty_table }; + }; + html = [[<h2>Цели</h2>%C(1)%<h2>Мгновенные эффекты</h2><b>Игнорировать активацию в статистике:</b>%C(4)%<br><br><b>Действия:</b>%C(2)%<h2>Овертайм-эффекты</h2>%C(3)%<hr>%C(5)%]]; + checker = no_check; + handler = function(self, node) + return self:effect_from_string( + node.value[1], -- Target list + node.value[4], -- Ignore usage stats flag + self:fill_placeholders( + node.value, +[[ +function(self) + self:set_custom_ot_effects($(5)) + + do + $(2) + end + + do + $(3) + end +end +]] + ) + ) + end; + } + + jsle:list "TARGET_LIST" + { + type = "TARGET_VALUE"; + html = [[%LIST(", ")%]]; + checker = non_empty_list; + handler = function(self, node) + local result = 0 + for i, v in ipairs(node.value) do + result = result + v + end + return result + end; + } + + jsle:enum "TARGET_VALUE" + { + values = + { + { [MTF.AUTO_ONLY] = [[неинтерактивно]] }; + { [MTF.SELF_HUMAN] = [[на себя]] }; + { [MTF.SELF_TEAM_HUMAN] = [[на человека в своей команде]] }; + { [MTF.OPP_HUMAN] = [[на противника]] }; + { [MTF.OPP_TEAM_HUMAN] = [[на человека в команде противника]] }; + { [MTF.FIELD_CHIP] = [[на фишку]] }; + }; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value_tonumber; + numeric_keys = true; + } + + jsle:list "IMMEDIATE_EFFECT_LIST" + { + type = "ACTION_VARIANT"; + html = [[%LE("<i>Нет</i>")%%LNE("<ol><li>")%%LIST("<li>")%%LNE("</ol>")%]]; + checker = no_check; + handler = get_children_concat_newline; + } + + jsle:record "OVERTIME_EFFECT" + { + children = + { + [1] = "OT_EFFECT_TARGET"; + [2] = "NUMOP_VARIANT"; + [3] = "NUMOP_VARIANT"; + [4] = "BOOLOP_VARIANT"; + [5] = "OVERTIME_EFFECT_LIST"; + [6] = "OVERTIME_EFFECT_LIST"; + [7] = "OVERTIME_EFFECT_LIST"; + [8] = "OT_MODIFIER_LIST"; + [9] = "NUMOP_VARIANT"; -- TODO: Must be higher in the list. Straighten numbers on next version change (do not forget to fix texts) + [10] = "NUMOP_VARIANT"; -- TODO: Must be higher in the list. Straighten numbers on next version change (do not forget to fix texts) + [11] = { "GAME_MODES", default = GMF.ALL }; -- TODO: Must be higher in the list. Straighten numbers on next version change (do not forget to fix texts) + [12] = { "BOOLEAN", default = 0 }; + }; + html = [[<br><b>Цель:</b> %C(1)%<br><b>Время жизни:</b> %C(2)% <i>(≥255 — бессрочно)</i><br><b>Период:</b> %C(3)%<br><b>Изначальный кулдаун:</b> %C(10)%<br><b>Сброс в конце боя:</b> %C(4)%<br><b>Остается при снятии всех эффектов вручную:</b> %C(12)%<br><b>Максимальное число одновременно активных эффектов:</b> %C(9)% <i>(0 — не ограничено)</i><br><b>Игровые режимы:</b> %C(11)%<h3>При изменении набора характеристик</h3>%C(5)%<h3>В конце хода цели</h3>%C(7)%<h3>Временные модификаторы <i>(кроме жизни)</i></h3>%C(8)%]]; + checker = no_check; + handler = function(self, node) + if + node.value[5] ~= "" or + node.value[6] ~= "" or + node.value[7] ~= "" or + node.value[8] ~= "{}" + then + -- Spawning OT effect only if have any actions in it. + return node_children_placeholders_filler + [[ + self:spawn_overtime_effect( + $(1), + $(2), + $(3), + $(10), + $(4), + $(9), + function(self) + $(5) + end, + function(self) + $(6) + end, + function(self) + $(7) + end, + $(8), + $(11), + $(12) + ) + ]] (self, node) + else + return [[-- No OT effects]] + end + end; + } + + jsle:list "OT_MODIFIER_LIST" + { + type = "OT_MODIFIER_VARIANT"; + html = [[%LE("<i>Нет</i>")%%LNE("<ol><li>")%%LIST("<li>")%%LNE("</ol>")%]]; + checker = no_check; + handler = get_children_concat_table; + } + + jsle:variant "OT_MODIFIER_VARIANT" + { + values = + { + { ["MOD_SET"] = [[Установить]] }; + { ["MOD_INC"] = [[Увеличить]] }; + { ["MOD_DEC"] = [[Уменьшить]] }; + { ["MOD_MULT"] = [[Умножить]] }; + }; + label = [["<i title=\"Модификатор\">M</i>"]]; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value; + } + + jsle:record "MOD_SET" + { + children = + { + [1] = "PROPWRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Установить %C(1)% цели в %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[{ name = $(1), fn = function(self, value) return ($(2)) end; }]]; + } + + jsle:record "MOD_INC" + { + children = + { + [1] = "PROPWRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Увеличить %C(1)% цели на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[{ name = $(1), fn = function(self, value) return value + ($(2)) end; }]]; + } + + jsle:record "MOD_DEC" + { + children = + { + [1] = "PROPWRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Уменьшить %C(1)% цели на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[{ name = $(1), fn = function(self, value) return value - ($(2)) end; }]]; + } + + jsle:record "MOD_MULT" + { + children = + { + [1] = "PROPWRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Умножить %C(1)% цели на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[{ name = $(1), fn = function(self, value) return value * ($(2)) end; }]]; + } + + jsle:list "OVERTIME_EFFECT_LIST" + { + type = "ACTION_VARIANT"; + html = [[%LE("<i>Нет</i>")%%LNE("<ol><li>")%%LIST("<li>")%%LNE("</ol>")%]]; + checker = no_check; + handler = get_children_concat_newline; + } + + jsle:list "ACTION_LIST" + { + type = "ACTION_VARIANT"; + html = [[<ol><li>%LIST("<li>")%</ol>]]; + checker = non_empty_list; + handler = get_children_concat_newline; + } + + jsle:variant "ACTION_VARIANT" + { + values = + { + { ["ACT_SET"] = [[Установить]] }; + { ["ACT_INC"] = [[Увеличить]] }; + { ["ACT_DEC"] = [[Уменьшить]] }; + { ["ACT_MULT"] = [[Умножить]] }; + { ["ACT_DIRECTSET"] = [[Установить напрямую]] }; + { ["ACT_DIRECTINC"] = [[Увеличить напрямую]] }; + { ["ACT_DIRECTDEC"] = [[Уменьшить напрямую]] }; + { ["ACT_DIRECTMULT"] = [[Умножить напрямую]] }; + { ["ACT_FLDEXPLODE"] = [[Взорвать фишки]] }; + { ["ACT_FLDLEVELDELTA"] = [[Поднять уровень фишек]] }; + { ["ACT_FLDCOLLECT_COORDS"] = [[Собрать фишки по координатам]] }; + { ["ACT_FLDREPLACE_COORDS"] = [[Заменить фишки по координатам]] }; + { ["ACT_ONEMOREACTION"] = [[Дать ещё одно действие]] }; + { ["ACT_KEEPTIMEOUT"] = [[Не сбрасывать таймер]] }; + { ["ACT_SETVAR"] = [[Запомнить]] }; + { ["ACT_SETOBJVAR_LOCAL"] = [[Запомнить в объекте локально]] }; + { ["ACT_SETOBJVAR_GLOBAL"] = [[Запомнить в объекте глобально]] }; + { ["ACT_SETOBJVAR_OT"] = [[Запомнить в текущем овертайме]] }; + { ["ACT_DOIF"] = [[Если]] }; + { ["ACT_DOIFELSE"] = [[Если ... иначе]] }; + { ["ACT_PLAYABIANIM"] = [[Играть эффект абилки]] }; + { ["ACT_SENDCUSTOMMSG"] = [[Отправить данные клиентам]] }; + { ["ACT_INCSTAT"] = [[Увеличить статистику клиента]] }; + { ["ACT_ACTIVATEOT"] = [[Активировать ОТ-эффект]] }; + { ["ACT_REMOVE_OVERTIMES"] = [[Снять ОТ-эффекты]] }; + -- Keep these below -- + { ["ACT_FLDREPLACE"] = [[Заменить фишки <b><i>(устарело)</i></b>]] }; + { ["ACT_CRASH_GAME"] = [[УРОНИТЬ игру <b><i>(только для тестов)</i></b>]] }; + -- { ["PLAINLUA"] = [[Lua]] }; + }; + label = [["<i title=\"Действие\">A</i>"]]; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value; + } + + declare_common(jsle, "ACT_DOIF", "ACT_DOIFELSE") + + jsle:record "ACT_SET" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Установить %C(1)% в %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propset($(1), $(2))]]; + } + + jsle:record "ACT_INC" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Увеличить %C(1)% на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propinc($(1), $(2))]]; + } + + jsle:record "ACT_DEC" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Уменьшить %C(1)% на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propdec($(1), $(2))]]; + } + + jsle:record "ACT_MULT" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Умножить %C(1)% на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propmult($(1), $(2))]]; + } + + jsle:record "ACT_DIRECTSET" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Установить напрямую %C(1)% в %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propset_direct($(1), $(2))]]; + } + + jsle:record "ACT_DIRECTINC" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Увеличить напрямую %C(1)% на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propinc_direct($(1), $(2))]]; + } + + jsle:record "ACT_DIRECTDEC" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Уменьшить напрямую %C(1)% на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propdec_direct($(1), $(2))]]; + } + + jsle:record "ACT_DIRECTMULT" + { + children = + { + [1] = "PROPPATH_WRITE"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Умножить напрямую %C(1)% на %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propmult_direct($(1), $(2))]]; + } + + jsle:record "ACT_FLDEXPLODE" + { + children = + { + [1] = "NUMOP_VARIANT"; + [2] = "CHIPCOORD"; + }; + html = [[Взорвать бомбу радиусом %C(1)% в координатах %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_explode($(1), $(2))]]; + } + + jsle:record "ACT_FLDREPLACE" + { + children = + { + [1] = "CHIPTYPE"; + [2] = "NUMOP_VARIANT"; + [3] = "CHIPTYPE"; + [4] = "NUMOP_VARIANT"; + }; + html = [[Заменить %C(1)% уровня %C(2)% на %C(3)% уровня %C(4)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_replace($(1), $(2), $(3), $(4))]]; + doc = [[Deprecated, use other replace actions]]; + } + + jsle:record "ACT_FLDLEVELDELTA" + { + children = + { + [1] = "NUMOP_VARIANT"; + [2] = "CHIPTYPE"; + [3] = "NUMOP_VARIANT"; + [4] = "NUMOP_VARIANT"; + }; + html = [[Поднять уровень %C(2)% на %C(1)% в диапазоне от %C(3)% до %C(4)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_level_delta($(1), $(2), $(3), $(4))]]; + } + + jsle:record "ACT_FLDCOLLECT_COORDS" + { + children = + { + [1] = "COORDLISTOP_VARIANT"; + }; + html = [[Собрать %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_collect_coords($(1))]]; + } + + jsle:record "ACT_FLDREPLACE_COORDS" + { + children = + { + [1] = "COORDLISTOP_VARIANT"; + [2] = "CHIPTYPE_LIST"; + [3] = "NUMOP_VARIANT"; + }; + html = [[Заменить %C(1)% на %C(2)% уровня %C(3)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_replace_coords($(1),$(2),$(3))]]; + } + + jsle:literal "ACT_ONEMOREACTION" + { + html = [[Дать ещё одно действие <i>(только мгновенный эффект)</i>]]; + checker = no_check; + handler = invariant [[self:one_more_action()]]; + } + + jsle:literal "ACT_KEEPTIMEOUT" + { + html = [[Не сбрасывать таймер <i>(только мгновенный эффект)</i>]]; + checker = no_check; + handler = invariant [[self:keep_timeout()]]; + } + + jsle:record "ACT_SETVAR" + { + children = + { + [1] = "NUMOP_VARIANT"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Запомнить в №%C(1)% значение %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:setvar($(1), $(2))]]; + } + + jsle:enum "OT_EFFECT_TARGET" + { + values = + { + { [PO.SELF] = [[на себя]] }; + { [PO.OPP] = [[на противника]] }; + { [PO.TARGET] = [[на цель]] }; + }; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value_quoted; + } + + jsle:variant "BOOLOP_VARIANT" + { + values = + { + { ["BOOLEAN"] = [[Логическое значение]] }; + { ["BOOLOP_LT"] = [[<]] }; + { ["BOOLOP_LTE"] = [[≤]] }; + { ["BOOLOP_GT"] = [[>]] }; + { ["BOOLOP_GTE"] = [[≥]] }; + { ["BOOLOP_EQ"] = [[==]] }; + { ["BOOLOP_NEQ"] = [[!=]] }; + { ["BOOLOP_AND_MANY"] = [[И (Список)]] }; + { ["BOOLOP_OR_MANY"] = [[ИЛИ (Список)]] }; + { ["BOOLOP_NOT"] = [[НЕ]] }; + { ["BOOLOP_HAVEMEDAL"] = [[МЕДАЛЬ]] }; + { ["BOOLOP_ISACTIVE"] = [[Изменения инициированы целью овертайм-эффекта]] }; + { ["BOOLOP_IS_GAME_IN_MODE"] = [[Текущий игровой режим]] }; + -- Deprecated, keep below -- + { ["BOOLOP_AND"] = [[И]] }; + { ["BOOLOP_OR"] = [[ИЛИ]] }; + --{ ["PLAINLUA"] = [[Lua]] }; + }; + label = [["<i title=\"Логическая операция\">B</i>"]]; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value; + } + + jsle:record "BOOLOP_HAVEMEDAL" + { + children = + { + [1] = "PROPOBJECT"; + [2] = "NUMOP_VARIANT"; + }; + html = [[есть медаль №%C(2)% %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:have_medal($(1), $(2))]]; + } + + jsle:literal "BOOLOP_ISACTIVE" + { + html = [[изменения инициированы целью овертайм-эффекта]]; + checker = no_check; -- Only for on_changeset event. + handler = invariant [[self:is_overtime_target_active()]]; + } + + declare_common( + jsle, + "BOOLOP_LT", + "BOOLOP_LTE", + "BOOLOP_GT", + "BOOLOP_GTE", + "BOOLOP_EQ", + "BOOLOP_NEQ", + "BOOLOP_AND", + "BOOLOP_OR", + "BOOLOP_NOT" + ) + + jsle:variant "NUMOP_VARIANT" + { + values = + { + { ["NUMBER"] = [[Число]] }; + { ["NUMOP_ADD_MANY"] = [[+ (Список)]] }; + { ["NUMOP_DEC_MANY"] = [[- (Список)]] }; + { ["NUMOP_MUL_MANY"] = [[* (Список)]] }; + { ["NUMOP_DIV_MANY"] = [[/ (Список)]] }; + { ["NUMOP_POV"] = [[POW]] }; -- TODO: POW, not POV! Fix by search and replace + { ["NUMOP_MOD"] = [[MOD]] }; + { ["NUMOP_MIN"] = [[MIN]] }; + { ["NUMOP_MAX"] = [[MAX]] }; + { ["NUMOP_UNM"] = [[Знак]] }; + { ["NUMOP_GET"] = [[Характеристика]] }; + { ["NUMOP_GET_RAW"] = [[Базовое значение характеристики]] }; + { ["NUMOP_GET_ABIPROP"] = [[Характеристика абилки]] }; + { ["NUMOP_PERCENT_ROLL"] = [[Cлучайный процент]] }; + { ["NUMOP_TEAMSIZE"] = [[Размер команды]] }; + { ["NUMOP_GETVAR"] = [[Вспомнить]] }; + { ["NUMOP_GETOBJVAR_LOCAL"] = [[Вспомнить из объекта локально]] }; + { ["NUMOP_GETOBJVAR_GLOBAL"] = [[Вспомнить из объекта глобально]] }; + { ["NUMOP_GETOBJVAR_OT"] = [[Вспомнить из текущего овертайма]] }; + { ["NUMOP_OTLIFETIMELEFT"] = [[Оставшееся время жизни]] }; + { ["NUMOP_OTLIFETIMETOTAL"] = [[Общее время жизни]] }; + { ["NUMOP_FLDGETQUANTITYOFCHIPS"] = [[Число фишек по цвету и уровню]] }; + { ["NUMOP_TARGETX"] = [[Координата X выбранной фишки]] }; + { ["NUMOP_TARGETY"] = [[Координата Y выбранной фишки]] }; + { ["NUMOP_OTEFFECTCOUNT"] = [[Число активных овертайм-эффектов]] }; + { ["NUMOP_IFF"] = [[Если]] }; + { ["NUMOP_GETUID"] = [[Идентификатор игрока]] }; + -- Keep these below -- + { ["NUMOP_FLDCOUNTCHIPS"] = [[Число фишек на поле <b><i>(устарело)</i></b>]] }; + { ["NUMOP_ADD"] = [[+]] }; + { ["NUMOP_DEC"] = [[-]] }; + { ["NUMOP_MUL"] = [[*]] }; + { ["NUMOP_DIV"] = [[/]] }; + { ["NUMOP_CRASH_GAME"] = [[УРОНИТЬ игру <b><i>(только для тестов)</i></b>]] }; + --{ ["PLAINLUA"] = [[Lua]] }; + }; + label = [["<i title=\"Численная операция\">I</i>"]]; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value; + } + + declare_common( + jsle, + "NUMOP_ADD", + "NUMOP_DEC", + "NUMOP_MUL", + "NUMOP_DIV", + "NUMOP_POV", + "NUMOP_MOD", + "NUMOP_MIN", + "NUMOP_MAX", + "NUMOP_UNM" + ) + + jsle:record "NUMOP_GET" + { + children = + { + [1] = "PROPPATH_READ"; + }; + html = [[%C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propget($(1), false)]]; + } + + declare_common(jsle, "NUMOP_PERCENT_ROLL") + + jsle:record "NUMOP_FLDCOUNTCHIPS" + { + children = + { + [1] = "CHIPTYPE"; + [2] = "BOOLOP_VARIANT"; + }; + html = [[число %C(1)% на поле (учитывая уровни: %C(2)%)]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_count_chips($(1), $(2))]]; + doc = [[Deprecated, use other chip count operations]]; + } + + jsle:record "NUMOP_TEAMSIZE" + { + children = + { + [1] = "PROPOBJECT"; + }; + html = [[размер команды %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:team_size($(1))]]; + } + + jsle:record "NUMOP_GETVAR" + { + children = + { + [1] = "NUMOP_VARIANT"; + }; + html = [[вспомнить из №%C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:getvar($(1))]]; + } + + jsle:literal "NUMOP_OTLIFETIMELEFT" + { + html = [[оставшееся время жизни]]; + checker = no_check; + handler = invariant [[self:ot_lifetime_left()]]; + } + + jsle:literal "NUMOP_OTLIFETIMETOTAL" + { + html = [[общее время жизни]]; + checker = no_check; + handler = invariant [[self:ot_lifetime_total()]]; + } + + jsle:literal "NUMOP_TARGETX" + { + html = [[X выбранной фишки]]; + checker = no_check; + handler = invariant [[self:target_x()]]; + } + + jsle:literal "NUMOP_TARGETY" + { + html = [[Y выбранной фишки]]; + checker = no_check; + handler = invariant [[self:target_y()]]; + } + + jsle:record "PROPPATH_WRITE" + { + children = + { + [1] = "PROPOBJECT"; + [2] = "PROPWRITE"; + }; + html = [[%C(2)% %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:make_proppath($(1), $(2))]]; + } + + jsle:record "PROPPATH_READ" + { + children = + { + [1] = "PROPOBJECT"; + [2] = "PROPREAD"; + }; + html = [[%C(2)% %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:make_proppath($(1), $(2))]]; + } + + jsle:enum "PROPOBJECT" + { + values = + { + { [PO.SELF] = [[у себя]] }; + { [PO.OPP] = [[у противника]] }; + { [PO.TARGET] = [[у цели]] }; + { [PO.OWN_CHANGESET] = [[в своём наборе изменений]] }; + { [PO.OPP_CHANGESET] = [[в наборе изменений противника]] }; + }; + html = [[%VALUE()%]]; + checker = no_check; -- Check value is valid for current action list subtype + handler = get_value_quoted; + } + + jsle:enum "PROPWRITE" + { + values = propwrite_values; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value_quoted; + } + + jsle:enum "PROPREAD" + { + values = propread_values; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value_quoted; + } + + jsle:enum "CHIPTYPE" + { + values = + { + { [CT.EMERALD] = [[зелёных фишек]] }; + { [CT.RUBY] = [[красных фишек]] }; + { [CT.AQUA] = [[синих фишек]] }; + { [CT.DMG] = [[черепов]] }; + { [CT.CHIP5] = [[фишек-5]] }; + { [CT.CHIP6] = [[фишек-6]] }; + { [CT.CHIP7] = [[фишек-7]] }; + { [CT.CHIP8] = [[фишек-8]] }; + { [CT.EMPTY] = [[пустых фишек]] }; + }; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value_tonumber; + numeric_keys = true; + } + + jsle:edit "NUMBER" + { + size = 4; + numeric = true; + checker = check_tonumber; + handler = get_value_tonumber; + } + + declare_common( + jsle, + "BOOLEAN", + "PLAINLUA" + ) + + jsle:list "COORDLISTOP_STD" + { + type = "CHIPCOORD"; + html = [[фишки с координатами %LIST(", ")%]]; + checker = non_empty_list; + handler = get_children_concat_table; + } + + jsle:record "CHIPCOORD" + { + children = + { + [1] = "NUMOP_VARIANT"; + [2] = "NUMOP_VARIANT"; + }; + html = [[(x: %C(1)%, y: %C(2)%)]]; + checker = no_check; + handler = node_children_placeholders_filler [[{x=$(1), y=$(2)}]]; + } + + -- TODO: UNUSED. Remove or use. + jsle:record "BOOLOP_SELECTEDTARGET" + { + children = + { + [1] = "TARGET_VALUE"; + }; + html = [[выбрана цель %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:is_target_selected($(1))]]; + doc = [[Currently not used]]; + } + + jsle:record "NUMOP_OTEFFECTCOUNT" + { + children = + { + [1] = "PROPOBJECT"; + [2] = "NUMOP_VARIANT"; + [3] = "NUMOP_VARIANT"; + }; + html = [[число овертайм-эффектов абилки ID %C(2)% <i>(0 — этот эффект)</i> № эффекта %C(3)% <i>(0 — по умолчанию)</i>, активных %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:active_ot_effect_count($(1), $(2), $(3))]]; + } + + declare_common(jsle, "NUMOP_IFF") + + jsle:record "NUMOP_GET_RAW" + { + children = + { + [1] = "PROPPATH_READ"; + }; + html = [[базовое значение %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:propget($(1), true)]]; + } + + -- TODO: Get rid of non-list versions! + + declare_common( + jsle, + "NUMOP_ADD_MANY", + "NUMOP_DEC_MANY", + "NUMOP_MUL_MANY", + "NUMOP_DIV_MANY" + ) + + declare_common( + jsle, + "BOOLOP_AND_MANY", + "BOOLOP_OR_MANY" + ) + + jsle:list "CHIPTYPE_LIST" + { + type = "CHIPTYPE"; + html = [[%LIST(", ")%]]; + checker = non_empty_list; + handler = get_children_concat_table; + } + + jsle:record "NUMOP_GET_ABIPROP" + { + children = + { + [1] = "ABIPROP_NAME"; + }; + html = [[%C(1)% абилки]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:abipropget($(1))]]; + } + + jsle:enum "ABIPROP_NAME" + { + values = + { + { [AP.prob] = [[вероятность активации]] }; + }; + html = [[%VALUE()%]]; + checker = check_mapping_tonumber; + handler = get_value_mapped_tonumber_quoted(abiprob_mapping); + } + + jsle:record "ACT_SENDCUSTOMMSG" + { + children = + { + [1] = "NUMOP_LIST"; + }; + html = [[Отправить участникам боя данные: %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:send_custom_msg($(1))]]; + } + + declare_common(jsle, "NUMOP_LIST") + + jsle:record "ACT_PLAYABIANIM" + { + children = + { + [1] = "NUMOP_VARIANT"; + }; + html = [[Играть эффект абилки ID: %C(1)%]]; + checker = no_check; + -- Hack. Should format be hardcoded here or below? + handler = node_children_placeholders_filler( + [[self:send_custom_msg({]]..assert_is_number(CM.PLAYABIANIM) + ..[[, $(1), self:get_uid("]]..PO.SELF..[[")})]] + ); + } + + jsle:variant "COORDLISTOP_VARIANT" + { + values = + { + { ["COORDLISTOP_STD"] = [[Обычный список коордтнат]] }; + { ["COORDLISTOP_GETLEVEL"] = [[Фишки цвета <i>цв1</i> с уровнями от <i>ур1</i> до <i>ур2</i>]] }; + }; + label = [["<i title=\"Список координат\">C</i>"]]; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value; + } + + jsle:record "COORDLISTOP_GETLEVEL" + { + children = + { + [1] = "CHIPTYPE"; + [2] = "NUMOP_VARIANT"; + [3] = "NUMOP_VARIANT"; + }; + html = [[%C(1)% с уровнями от %C(2)% до %C(3)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_get_coordlist_from_levels_and_type($(1), $(2), $(3))]]; + } + + jsle:record "NUMOP_FLDGETQUANTITYOFCHIPS" + { + children = + { + [1] = "CHIPTYPE"; + [2] = "NUMOP_VARIANT"; + [3] = "NUMOP_VARIANT"; + [4] = "BOOLOP_VARIANT"; + }; + html = [[число %C(1)% на поле уровней с %C(2)% до %C(3)% (учитывая уровень в счетчике: %C(4)%)]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:fld_get_quantity_of_chips($(1), $(2), $(3), $(4))]]; + } + + jsle:enum "CLIENTSTAT" + { + values = + { + -- TODO: Support commented out variants? + { [CST.SPELL_USE] = [[исп. спеллов]] }; + --{ [CST.SPELL_FRAG] = [[фраги от спеллов]] }; + { [CST.CONSUMABLE_USE] = [[исп. расходников]] }; + --{ [CST.CONSUMABLE_FRAG] = [[фраги от расходников]] }; + { [CST.AUTOABILITY_USE] = [[исп. автоабилок]] }; + --{ [CST.AUTOABILITY_FRAG] = [[фраги от автоабилок]] }; + --{ [CST.RATING] = [[рейтинг]] }; + --{ [CST.CUSTOM] = [[пользовательская]] }; + }; + html = [[%VALUE()%]]; + checker = check_mapping_tonumber; + handler = get_value_tonumber; + } + + jsle:record "ACT_INCSTAT" + { + children = + { + [1] = "PROPOBJECT"; + [2] = "CLIENTSTAT"; + [3] = "NUMOP_VARIANT"; + [4] = "NUMOP_VARIANT"; + }; + html = [[Увеличить %C(1)% статистику «%C(2)%» эффекта №%C(3)% <i>(0 — текущий)</i> на %C(4)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:inc_client_stat($(1), $(2), $(3), $(4))]]; + } + + jsle:record "ACT_ACTIVATEOT" + { + children = + { + [1] = "NUMOP_VARIANT"; + [2] = { "KEYVALUE_LIST", default = empty_table }; + }; + html = [[Активировать ОТ-эффект №%C(1)%, передав %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:activate_custom_ot_effect($(1),$(2))]]; + } + + jsle:list "CUSTOM_OVERTIME_EFFECTS" + { + type = "OVERTIME_EFFECT"; + html = [[%LE("<i>(Нет дополнительных ОТ-эффектов)</i>")%%LNE("<ol><li><h2>Дополнительный OT-эффект</h2>")%%LIST("<hr><li><h2>Дополнительный OT-эффект</h2>")%%LNE("</ol>")%]]; + checker = no_check; + handler = function(self, node) + local buf = {[[{]]} + local _ = function(v) buf[#buf + 1] = tostring(v) end + for i, child in ipairs(node.value) do + _ [[ +[]] _(i) _[[] = function(self) +]] _(child) _ [[ +end; +]] + end + _ [[}]] + return table.concat(buf) + end; + } + + jsle:record "NUMOP_GETUID" + { + children = + { + [1] = "PROPOBJECT"; + }; + html = [[идентификатор игрока %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:get_uid($(1))]]; + } + + jsle:enum "STORE_OBJ" + { + values = + { + { [SO.CLIENT_SELF] = [[на себе]] }; + { [SO.CLIENT_OPP] = [[на противнике]] }; + { [SO.CLIENT_TARGET] = [[на цели]] }; + { [SO.FIGHT] = [[на бою]] }; + { [SO.GAME] = [[на игре]] }; + }; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value_tonumber; + } + + jsle:record "ACT_SETOBJVAR_LOCAL" + { + children = + { + [1] = "STORE_OBJ"; + [2] = "NUMOP_VARIANT"; + [3] = "NUMOP_VARIANT"; + }; + html = [[Запомнить в объекте «%C(1)%» в слот №%C(2)% <b>приватное</b> значение %C(3)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:setobjvar_local($(1), $(2), $(3))]]; + } + + jsle:record "NUMOP_GETOBJVAR_LOCAL" + { + children = + { + [1] = "STORE_OBJ"; + [2] = "NUMOP_VARIANT"; + }; + html = [[вспомнить из объекта «%C(1)%» из слота №%C(2)% <b>приватное</b> значение]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:getobjvar_local($(1), $(2))]]; + } + + jsle:record "ACT_SETOBJVAR_GLOBAL" + { + children = + { + [1] = "STORE_OBJ"; + [2] = "NUMOP_VARIANT"; + [3] = "NUMOP_VARIANT"; + }; + html = [[Запомнить в объекте %C(1)% в слот №%C(2)% <b>публичное</b> значение %C(3)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:setobjvar_global($(1), $(2), $(3))]]; + } + + jsle:record "NUMOP_GETOBJVAR_GLOBAL" + { + children = + { + [1] = "STORE_OBJ"; + [2] = "NUMOP_VARIANT"; + }; + html = [[вспомнить из объекта %C(1)% из слота №%C(2)% <b>публичное</b> значение]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:getobjvar_global($(1), $(2))]]; + } + + jsle:record "ACT_REMOVE_OVERTIMES" + { + children = + { + [1] = "OT_EFFECT_TARGET"; + }; + html = [[Снять все эффекты, наложенные %C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:remove_overtime_effects($(1))]]; + } + + jsle:enum "GAME_MODES" + { + values = + { + { [GMF.ALL] = [[любой]] }; + { [GMF.DUEL] = [[дуэль]] }; + { [GMF.SINGLE] = [[одиночная игра]] }; + }; + html = [[%VALUE()%]]; + checker = no_check; + handler = get_value_tonumber; + } + + jsle:record "BOOLOP_IS_GAME_IN_MODE" + { + children = + { + [1] = "GAME_MODES"; + }; + html = [[игровой режим «%C(1)%» включён]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:is_game_in_mode($(1))]]; + } + + jsle:record "ACT_SETOBJVAR_OT" + { + children = + { + [1] = "NUMOP_VARIANT"; + [2] = "NUMOP_VARIANT"; + }; + html = [[Запомнить в текущем овертайме в слот №%C(1)% значение %C(2)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:setobjvar_ot($(1), $(2))]]; + } + + jsle:record "NUMOP_GETOBJVAR_OT" + { + children = + { + [1] = "NUMOP_VARIANT"; + }; + html = [[Вспомнить из текущего овертайма из слота №%C(1)%]]; + checker = no_check; + handler = node_children_placeholders_filler [[self:getobjvar_ot($(1))]]; + } + + declare_common( + jsle, + "KEYVALUE_LIST", + "KEYVALUE" + ) + + jsle:literal "ACT_CRASH_GAME" + { + html = [[<span style="color:red"><b>УРОНИТЬ</b> игру (только для теста)<span>]]; + checker = function(self, node) + if common_get_config().crashers_enabled == true then + errr("WARNING: ACT_CRASH_GAME CRASHER IS ON") + return true + end + + errr("DETECTED ATTEMPT TO UPLOAD CRASHERS (SCHEMA)") + return false, "crashers are disabled in config" + end; + handler = invariant [[self:crash_game()]]; + } + + jsle:literal "NUMOP_CRASH_GAME" + { + html = [[<span style="color:red"><b>УРОНИТЬ</b> игру (только для теста)<span>]]; + checker = function(self, node) + if common_get_config().crashers_enabled == true then + errr("WARNING: NUMOP_CRASH_GAME CRASHER IS ON") + return true + end + + errr("DETECTED ATTEMPT TO UPLOAD CRASHERS (SCHEMA)") + return false, "crashers are disabled in config" + end; + handler = invariant [[(self:crash_game() or 0)]]; + } + + return jsle +end + +return +{ + define_schema = define_schema; +}
diff --git a/tests/reweave/scope.lua b/tests/reweave/scope.lua new file mode 100644 index 0000000..f871746 --- /dev/null +++ b/tests/reweave/scope.lua
@@ -0,0 +1,3 @@ +do + print("scope") +end
diff --git a/tests/reweave/str.lua b/tests/reweave/str.lua new file mode 100644 index 0000000..bf63ff3 --- /dev/null +++ b/tests/reweave/str.lua
@@ -0,0 +1,2 @@ +sample=[==========[perl -e 'print "<IMG SRC=javascript:alert(\"XSS\")>";' > out]==========] +sample=[==========[perl -e 'print "<IMG SRC=javascript:alert(\"XSS\")>";' > out]==========]
diff --git a/tests/reweave/ws_simple.lua b/tests/reweave/ws_simple.lua new file mode 100644 index 0000000..044284a --- /dev/null +++ b/tests/reweave/ws_simple.lua
@@ -0,0 +1 @@ +repeat until true
diff --git a/tests/run.mlua b/tests/run.mlua new file mode 100644 index 0000000..f9f9896 --- /dev/null +++ b/tests/run.mlua
@@ -0,0 +1,56 @@ +------------------------------------------------------------------------------- +-- Copyright (c) 2006-2013 Fabien Fleutot and others. +-- +-- All rights reserved. +-- +-- This program and the accompanying materials are made available +-- under the terms of the Eclipse Public License v1.0 which +-- accompanies this distribution, and is available at +-- http://www.eclipse.org/legal/epl-v10.html +-- +-- This program and the accompanying materials are also made available +-- under the terms of the MIT public license which accompanies this +-- distribution, and is available at http://www.lua.org/license.html +-- +-- Contributors: +-- Fabien Fleutot - API and implementation +-- +------------------------------------------------------------------------------- + +-- Run all *.lua and *.mlua files in this directory. +-- This makes it easy to run all tests in the directory, + +-{ extension 'xloop' } + +LS_COMMANDS = { "ls", "dir /b" } +for i, cmd in ipairs(LS_COMMANDS) do + local f = io.popen (cmd) + ls = f :read '*a' + f :close() + if ls ~= '' then + break + elseif i == #LS_COMMANDS then + error "Can't figure out how to list files on your OS" + end +end + +this_script = arg[1] + +local errors = {} + +for filename in ls :gmatch "[^\n]+" if filename ~= this_script and filename :strmatch "%.m?lua$" do + printf ("*** running %s ***", filename) + local ret = os.execute ("metalua "..filename) + if ret ~= 0 then + errors[#errors + 1] = "Test "..filename.." failed, returned "..ret + end +end + +if #errors > 0 then + print("\n\n================================================================================") + error( + "TEST FAILURES DETECTED:\n" .. + "-----------------------\n" .. + " * " .. table.concat(errors, "\n * ") + ) +end