From 01a1e5e5146153a8b7c84be6202fef28b7d138a5 Mon Sep 17 00:00:00 2001 From: g012 Date: Tue, 5 Sep 2017 19:46:57 +0200 Subject: [PATCH] Set pragma syntax. --- 6502-def.lua | 7 - l65.lua | 37 ++- macro.lua | 713 --------------------------------------------------- 3 files changed, 28 insertions(+), 729 deletions(-) delete mode 100644 6502-def.lua delete mode 100644 macro.lua diff --git a/6502-def.lua b/6502-def.lua deleted file mode 100644 index 4eec05c..0000000 --- a/6502-def.lua +++ /dev/null @@ -1,7 +0,0 @@ -local macro = require "macro" - -function addressing(get) - local t,v = get:next() -end - -macro.define('lda', addressing) diff --git a/l65.lua b/l65.lua index bf2b2e1..90f14f8 100644 --- a/l65.lua +++ b/l65.lua @@ -10,6 +10,7 @@ local function lookupify(tb, dst, not_val) end local WhiteChars = lookupify{' ', '\n', '\t', '\r'} +local Spaces = lookupify{' ', '\t'} local EscapeLookup = {['\r'] = '\\r', ['\n'] = '\\n', ['\t'] = '\\t', ['"'] = '\\"', ["'"] = "\\'"} local LowerChars = lookupify{'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', @@ -201,16 +202,26 @@ local function LexLua(src) p = p + 1 return c end + local function get_n(count) for i=1,count do get() end end local function peek(n) n = n or 0 return src:sub(p+n,p+n) end + local function peek_n(sz) return src:sub(p, p+sz-1) end local function consume(chars) local c = peek() for i = 1, #chars do if c == chars:sub(i,i) then return get() end end end + local function get_word(spaces) + if not spaces then spaces = Spaces end + local c + repeat get() c = peek() until not spaces[c] + local start = p + repeat get() c = peek() until not (UpperChars[c] or LowerChars[c] or Digits[c] or c == '_') + return src:sub(start, p-1) + end --shared stuff local function generateError(err) @@ -394,8 +405,23 @@ local function LexLua(src) --symbol to emit local toEmit = nil + --pragma + if char == 1 and peek_n(7) == '#pragma' then + get_n(7) + local dat = get_word() + if dat == 'syntax6502' then + local opt = get_word() + if opt == 'on' then syntax6502(true) + elseif opt == 'off' then syntax6502(false) + else generateError("invalid option for pragma syntax6502, expected: [on,off]") + end + else + generateError("unknown pragma: " .. dat) + end + toEmit = {Type = 'Symbol', Data = ';'} + --branch on type - if c == '' then + elseif c == '' then --eof toEmit = { Type = 'Eof' } @@ -410,14 +436,7 @@ local function LexLua(src) if Keywords[dat] then toEmit = {Type = 'Keyword', Data = dat} else - if dat == 'syntax6502_on' then - syntax6502(true) - toEmit = {Type = 'Symbol', Data = ';'} - elseif dat == 'syntax6502_off' then - syntax6502(false) - toEmit = {Type = 'Symbol', Data = ';'} - else toEmit = {Type = 'Ident', Data = dat} - end + toEmit = {Type = 'Ident', Data = dat} end elseif Digits[c] or (peek() == '.' and Digits[peek(1)]) then diff --git a/macro.lua b/macro.lua deleted file mode 100644 index a7caf1d..0000000 --- a/macro.lua +++ /dev/null @@ -1,713 +0,0 @@ ----------------------------------------------- --- LuaMacro 2, a macro-preprocessor for Lua. --- Unlike LuaMacro 1.x, it does not depend on the token-filter patch and generates --- Lua code which can be printed out or compiled directly. C-style macros are easy, but LM2 --- allows for macros that can read their own input and generate output using Lua code. --- New in this release are lexically-scoped macros. --- The Lua Lpeg Lexer is by Peter Odding. --- --- Examples: --- --- macro.define 'sqr(x) ((x)*(x))' --- macro.define 'assert_(expr) assert(expr,_STR_(expr))' --- macro.define('R(n)',function(n) --- n = n:get_number() --- return ('-'):rep(n) --- end --- macro.define('lazy',function(get) --- get() -- skip space --- local expr,endt = get:upto(function(t,v) --- return t == ',' or t == ')' or t == ';' --- or (t=='space' and v:match '\n') --- end) --- return 'function(_) return '..tostring(expr)..' end'..tostring(endt) --- end) --- --- --- @author Steve Donovan --- @copyright 2011 --- @license MIT/X11 --- @module macro --- @alias M - -local macro = {} -local M = macro -local lexer = require 'macro.lexer' -local Getter = require 'macro.Getter' -local TokenList = require 'macro.TokenList' -local scan_code = lexer.scan_lua -local append = table.insert -local setmetatable = setmetatable - ---local tdump = require 'pl.pretty'.dump - -local scan_iter, tnext = Getter.scan_iter, Getter.next - - -M.upto_keywords = Getter.upto_keywords -M.Putter = TokenList.new - --- given a token list, a set of formal arguments and the actual arguments, --- return a new token list where the formal arguments have been replaced --- by the actual arguments -local function substitute_tokenlist (tl,parms,args) - local append,put_tokens = table.insert,TokenList.tokens - local parm_map = {} - for i,name in ipairs(parms) do - parm_map[name] = args[i] - end - local res = {} - for _,tv in ipairs(tl) do - local t,v = tv[1],tv[2] - if t == 'iden' then - local pval = parm_map[v] - if pval then - put_tokens(res,pval) - else - append(res,tv) - end - else - append(res,tv) - end - end - return res -end - ----------------- --- Defining and Working with Macros. --- @section macros - ---- make a copy of a list of tokens. --- @param tok the list --- @param pred copy up to this condition; if defined, must be a function --- of two arguments, the token type and the token value. --- @return the copy --- @return the token that matched the predicate -function M.copy_tokens(tok,pred) - local res = {} - local t,v = tok() - while t and not (pred and pred(t,v)) do - append(res,{t,v}) - t,v = tok() - end - return res,{t,v} -end - ----- define new lexical tokens. --- @param extra a list of strings defining the new tokens --- @usage macro.define_tokens{'{|'} -function M.define_tokens(extra) - lexer.add_extra_tokens(extra) -end - -local imacros,smacros = {},{} - -M.macro_table = imacros - ---- define a macro using a specification string and optional function. --- The specification looks very much like a C preprocessor macro: the name, --- followed by an optional formal argument list (_no_ space after name!) and --- the substitution. e.g `answer 42` or `sqr(x) ((x)*(x))` --- --- If there is no substitution, then the second argument must be a function which --- will be evaluated for the actual substitution. If there are explicit parameters, then they will be passed as token lists. Otherwise, the function is passed a `get` and a `put` argument, which are `Getter` and `TokenList` objects. --- --- The substitution function may return a `TokenList` object, or a string. --- @param macstr --- @param subst_fn the optional substitution function --- @see macro.Getter, macro.TokenList -function M.define(macstr,subst_fn) - local tok,t,macname,parms,parm_map - local mtbl - tok = scan_code(macstr) - t,macname = tok() - if t == 'iden' then mtbl = imacros - elseif t ~= 'string' and t ~= 'number' and t ~= 'keyword' then - mtbl = smacros - else - error("a macro cannot be of type "..t) - end - t = tok() - if t == '(' then - parms = Getter.new(tok):idens() - end - mtbl[macname] = { - name = macname, - subst = subst_fn or M.copy_tokens(tok), - parms = parms - } -end - ---- define a macro using a function and a parameter list. --- @param name either an identifier or an operator. --- @param subst a function --- @param parms a list of parameter names --- @return the existing value of this macro, if any -function M.set_macro(name,subst,parms) - local macros - if name:match '^[_%a][_%w]*$' then - macros = imacros - else - macros = smacros - end - if subst == nil then - macros[name] = nil - return - end - local last = macros[name] - if type(subst) ~= 'table' or not subst.name then - subst = { - name = name, - subst = subst, - parms = parms - } - end - macros[name] = subst - return last -end - ---- defined a scoped macro. Like define except this macro will not --- be visible outside the current scope. --- @param name either an identifier or an operator. --- @param subst a function --- @param parms a list of parameter names --- @see set_macro -function M.define_scoped (name,subst,parms) - local old_value = M.set_macro(name,subst,parms) - M.block_handler(-1,function() - M.set_macro(name,old_value) - end) -end - ---- get the value of a macro. The macro substitution must either be a --- a string or a single token. --- @param name existing macro name --- @return a string value, or nil if the macro does not exist. -function M.get_macro_value(name) - local mac = imacros[name] - if not mac then return nil end - if type(mac.subst) == 'table' then - return mac.subst[1][2] - else - return mac.subst - end -end - -local function get_macro (mac, no_error) - local macro = imacros[mac] - if not macro and not no_error then - M.error("macro "..mac.." is not defined") - end - return macro -end - -local push,pop = table.insert,table.remove - ---- push a value on the stack associated with a macro. --- @param name macro name --- @param value any value -function M.push_macro_stack (name,value) - local macro = get_macro(name) - macro.stack = macro.stack or {} - push(macro.stack,value) -end - ---- pop a value from a macro stack. --- @param name macro name --- @return any value, if defined -function M.pop_macro_stack (name) - local macro = get_macro(name) - if macro.stack and #macro.stack > 0 then - return pop(macro.stack) - end -end - ---- value of top of macro stack. --- @param name macro name --- @return any value, if defined -function M.value_of_macro_stack (name) - local macro = get_macro(name,true) - if not macro then return nil end - if macro.stack and #macro.stack > 0 then - return macro.stack[#macro.stack] - end -end - -local lua_keywords = { - ['do'] = 'open', ['then'] = 'open', ['else'] = 'open', ['function'] = 'open', - ['repeat'] = 'open'; - ['end'] = 'close', ['until'] = 'close',['elseif'] = 'close' -} - -local c_keywords = {} -local keywords = lua_keywords - -local block_handlers,keyword_handlers = {},{} -local level = 1 - ---- specify a block handler at a given level. --- a block handler may indicate with an extra true return --- that it wants to persist; it is passed the getter and the keyword --- so we can get more specific end-of-block handlers. --- @param lev relative block level --- @param action will be called when the block reaches the level -function M.block_handler (lev,action) - lev = lev + level - if not block_handlers[lev] then - block_handlers[lev] = {} - end - append(block_handlers[lev],action) -end - -local function process_block_handlers(level,get,v) - local persist,result - for _,bh in pairs(block_handlers[level]) do - local res,keep = bh(get,v) - if not keep then - if res then result = res end - else - persist = persist or {} - append(persist,bh) - end - end - block_handlers[level] = persist - return result -end - - ---- set a keyword handler. Unlike macros, the keyword itself is always --- passed through, but the handler may add some output afterwards. --- If the action is nil, then the handler for that keyword is removed. --- @param word keyword --- @param action function to be called when keyword is encountered --- @return previous handler associated with this keyword -function M.keyword_handler (word,action) - if word == 'BEGIN' or word == 'END' then - keyword_handlers[word] = action - return - end - if action then - local last = keyword_handlers[word] - keyword_handlers[word] = action - return last - else - keyword_handlers[word] = nil - end -end - ---- set a scoped keyword handler. Like keyword_handler, except --- it restores the original keyword handler (if any) at the end --- of the current block. --- @param word keyword --- @param action to be called when keyword is encountered --- @see keyword_handler -function M.scoped_keyword_handler (keyword, action) - local last = M.keyword_handler(keyword,action) - M.block_handler(-1,function() - M.keyword_handler(keyword,last) - end) -end - --- a convenient way to use keyword handlers. This sets a handler and restores --- the old handler at the end of the current block. --- @param word keyword --- @param action to be called when keyword is encountered --- @return a function that creates a scoped keyword handler -function M.make_scoped_handler(keyword,handler) - return function() M.scoped_keyword_handler(keyword, action) end -end - -M.please_throw = false - ---- macro error messages. --- @param msg the message: will also have file:line. -function M.error(msg) - msg = M.filename..':'..lexer.line..': '..msg - if M.please_throw then - error(msg,2) - else - io.stderr:write(msg,'\n') - os.exit(1) - end -end - -M.define ('debug_',function() - M.DEBUG = true -end) - ---- macro error assert. --- @param expr an expression. --- @param msg a message -function M.assert(expr,msg) - if not expr then M.error(msg or 'internal error') end - return expr -end - -Getter.error = M.error -Getter.assert = M.assert -TokenList.assert = M.assert - -local line_updater, line_table, last_name, last_lang - -local function lua_line_updater (iline,oline) - if not line_table then line_table = {} end - append(line_table,{il=iline,ol=oline}) -end - -local function c_line_updater (iline,oline,last_t,last_v) - local endt = last_t == 'space' and last_v or '\n' - return '#line '..iline..' "'..M.filename..'"'..endt -end - -local make_putter = TokenList.new - ---- do a macro substitution on Lua source. --- @param src Lua source (either string or file-like reader) --- @param out output (a file-like writer) --- @param name input file name --- @param use_c nil for Lua; if 'line', then output #line directives; if true, then don't --- @return the result as table of strings --- @return line number information -function M.substitute(src,name, use_c) - local out, ii = {}, 1 - local subparse - if name then - last_name = name - last_lang = use_c - else - name = last_name - use_c = last_lang and true - subparse = true - end - M.filename = name - if use_c then - lexer = require 'macro.clexer' - scan_code = lexer.scan_c - keywords = c_keywords - if use_c == 'line' then - line_updater = c_line_updater - else - line_updater = function() end - end - else - lexer = require 'macro.lexer' - scan_code = lexer.scan_lua - keywords = lua_keywords - line_updater = lua_line_updater - end - local tok = scan_code(src,name) - local iline,iline_changed = 0 - local last_t,last_v = 'space','\n' - local do_action - - - local t,v = tok() - - -- this function get() is always used, so that we can handle end-of-stream properly. - -- The substitution mechanism pushes a new stream on the tstack, which is popped - -- when empty. - local tstack = {} - local push,pop = table.insert,table.remove - - local function get () - last_t,last_v = t,v - local t,v = tok() - while not t do - tok = pop(tstack) - if tok == nil then - if not subparse and keyword_handlers.END then - do_action(keyword_handlers.END) - keyword_handlers.END = nil - end - if tok == nil then -- END action might have inserted some tokens - return nil - end - end -- finally finished - t,v = tok() - end - if name == lexer.name and iline ~= lexer.line then - iline = lexer.line -- input line has changed - iline_changed = last_v - end - return t,v - end - - local getter = Getter.new(get) - - --- get a list of consecutive matching tokens. - -- @param get token fetching function - -- @param accept set of token types (default: `{space=true,comment=true}`) - function getter.matching (get, accept) - accept = accept or {space=true, comment=true} - local tl = TokenList.new() - local t,v = get:peek(1, true) - while accept[t] do - t,v = get () - append(tl, {t, v}) - t,v = get:peek(1, true) - end - return tl - end - - function getter:peek (offset,dont_skip) - local step = offset < 0 and -1 or 1 -- passing offset 0 is undefined - local k = 0 - local token, t, v - repeat - while true do - token = tok (k) - if not token then return nil, 'EOS' end - t,v = token[1], token[2] - if dont_skip or (t ~= 'space' and t ~= 'comment') then break end - k = k + 1 - end - offset = offset - step - k = k + step - until offset == 0 - return t,v,k+1 - end - - function getter:peek2 () - local t1,v1,k1 = self:peek(1) - local t2,v2 = self:peek(k1+1) - return t1,v1,t2,v2 - end - - function getter:patch (idx,text) - out[idx] = text - end - - function getter:placeholder (put) - put:iden '/MARK?/' - return ii - end - - function getter:copy_from (pos,clear) - local res = {} - for i = pos, ii do - if out[i] and not out[i]:match '^#line' then - append(res,out[i]) - end - end - if clear then - for i = pos, ii do - table.remove(out,pos) - ii = ii - 1 - end - end - return table.concat(res) - end - - -- this feeds the results of a substitution into the token stream. - -- substitutions may be token lists, Lua strings or nil, in which case - -- the substitution is ignored. The result is to push a new token stream - -- onto the tstack, so it can be fetched using get() above - local function push_substitution (subst) - if subst == nil then return end - local st = type(subst) - push(tstack,tok) - if st == 'table' then - subst = scan_iter(subst) - elseif st == 'string' then - subst = scan_code(subst) - end - tok = subst - end - M.push_substitution = push_substitution - - -- a macro object consists of a subst object and (optional) parameters. - -- If there are parms, then a macro argument list must follow. - -- The subst object is either a token list or a function; if a token list we - -- substitute the actual parameters for the formal parameters; if a function - -- then we call it with the actual parameters. - -- Without parameters, it may be a simple substitution (TL or Lua string) or - -- may be a function. In the latter case we call it passing the token getter, - -- assuming that it will grab anything it needs from the token stream. - local function expand_macro(get,mac) - local pass_through - local subst = mac.subst - local fun = type(subst)=='function' - if mac.parms then - t = tnext(get); - if t ~= '(' then - M.error('macro '..mac.name..' expects parameters') - end - local args,err = Getter.list(get) - M.assert(args,'no end of argument list') - if fun then - subst = subst(unpack(args)) - else - if #mac.parms ~= #args then - M.error(mac.name.." takes "..#mac.parms.." arguments") - end - subst = substitute_tokenlist(subst,mac.parms,args) - end - elseif fun then - subst,pass_through = subst(getter,make_putter()) - end - push_substitution(subst) - return pass_through - end - - local multiline_tokens,sync = lexer.multiline_tokens,lexer.sync - local line,last_diff = 0,0 - - function do_action (action) - push_substitution(action(getter,make_putter())) - end - - if not subparse and keyword_handlers.BEGIN then - do_action(keyword_handlers.BEGIN) - end - - while t do - --print('tv',t,v) - local dump = true - if t == 'iden' then -- classic name macro - local mac = imacros[v] - if mac then - dump = expand_macro(get,mac) - end - elseif t == 'keyword' then - -- important to track block level for lexical scoping and block handlers - local class = keywords[v] - if class == 'open' then - if v ~= 'else' then level = level + 1 end - elseif class == 'close' then - level = level - 1 - if block_handlers[level] then - local res = process_block_handlers(level,get,v) - if res then push_substitution(res) end - end - --* elseif class == 'hook' then - end - local action = keyword_handlers[v] - if action then do_action(action) end - else -- any unused 'operator' token (like @, \, #) can be used as a macro - if use_c then - if v == '{' then - level = level + 1 - elseif v == '}' then - level = level - 1 - if block_handlers[level] then - local res = process_block_handlers(level,get,v) - if res then push_substitution(res) end - end - end - end - local mac = smacros[v] - if mac then - dump = expand_macro(get,mac) - end - end - if dump then - if multiline_tokens[t] then -- track output line - line = sync(line, v) - end - if iline_changed then - local diff = line - iline - if diff ~= last_diff then - local ldir = line_updater(iline,line,last_t,last_v) - if ldir then out[ii] = ldir; ii=ii+1 end - last_diff = diff - end - iline_changed = nil - end - out[ii] = v - ii = ii + 1 - end - t,v = get() - end - - return out,line_table -end - ---- take some Lua source and return the result of the substitution. --- Does not raise any errors. --- @param src either a string or a readable file object --- @param name optional name for the chunk --- @return the result or nil --- @return the error, if error -function M.substitute_tostring(src,name,use_c,throw) - M.please_throw = true - local ok,out,li - if throw then - out,li = M.substitute(src,name,use_c) - else - ok,out,li = pcall(M.substitute,src,name,use_c) - end - if type(src) ~= 'string' and src.close then src:close() end - if not ok then return nil, out - else - return table.concat(out), li - end -end - -local lua52 = _VERSION:match '5.2' -local load, searchpath = load, package.searchpath - -if not lua52 then -- Lua 5.1 - function load (env,src,name) - local chunk,err = loadstring(src,name) - if chunk and env then - setfenv(chunk,env) - end - return chunk,err - end -end - -if not searchpath then - local sep = package.config:sub(1,1) - searchpath = function (mod,path) - mod = mod:gsub('%.',sep) - for m in path:gmatch('[^;]+') do - local nm = m:gsub('?',mod) - local f = io.open(nm,'r') - if f then f:close(); return nm end - end - end -end - ---- load Lua code in a given envrionment after passing --- through the macro preprocessor. --- @param src either a string or a readable file object --- @param name optional name for the chunk --- @param env the environment (may be nil) --- @return the cnunk, or nil --- @return the error, if no chunk -function M.load(src,name,env) - local res,err = M.substitute_tostring(src,'tmp') - if not res then return nil,err end - return loadin(env,res,name) -end - ---- evaluate Lua macro code in a given environment. --- @param src either a string or a readable file object --- @param env the environment (can be nil) --- @return true if succeeded --- @return result(s) -function M.eval(src,env) - local chunk,err = M.loadin(src,'(tmp)',env) - if not chunk then return nil,err end - return pcall(chunk) -end - -package.mpath = './?.m.lua' - ---- Make `require` use macro expansion. --- This is controlled by package.mpath, which is initially './?.m.lua' -function M.set_package_loader() - -- directly inspired by https://github.com/bartbes/Meta/blob/master/meta.lua#L32, - -- after a suggestion by Alexander Gladysh - table.insert(package.searchers, function(name) - local fname = searchpath(name,package.mpath) - if not fname then return nil,"cannot find "..name end - local res,err = M.load(io.open(fname),lname) - if not res then - error (err) - end - return res - end) -end - -return macro