From 12481e92574df3897629d564d1c00d2dfdc673b2 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Fri, 22 Oct 2021 20:44:24 -0400 Subject: [PATCH] non-working attempt to lazily expand macros using lua proxy objects Unfortunately there is no way to override # in luajit, so I can't make a truly transparent proxy. Unclear if I could get away with a weird half-object, but it doesn't seem to be working. --- lib/metatable_monkey.lua | 33 +++++++++++++++++++++++++++++++++ lib/util.fnl | 11 ++++++++++- main.lua | 1 + ssc/init.fnl | 23 +++++++++++------------ 4 files changed, 55 insertions(+), 13 deletions(-) create mode 100644 lib/metatable_monkey.lua diff --git a/lib/metatable_monkey.lua b/lib/metatable_monkey.lua new file mode 100644 index 0000000..b6bd346 --- /dev/null +++ b/lib/metatable_monkey.lua @@ -0,0 +1,33 @@ +-- source: https://gitlab.com/technomancy/bussard/-/blob/master/metatable_monkey.lua +-- Versions of Lua prior to 5.1 could not properly support iterating over proxy +-- tables with their built-in iterators. This module fixes that problem. + +local original_pairs, original_ipairs = pairs, ipairs +local mtpairs = function(tab) + local mt = getmetatable(tab) + if(mt and mt.__pairs) then + return mt.__pairs(tab) + else + return original_pairs(tab) + end +end + +local mtipairs = function(tab) + local mt = getmetatable(tab) + if(mt and mt.__ipairs) then + return mt.__ipairs(tab) + else + return original_ipairs(tab) + end +end + +local patched, ipatched, t = false, false, {} +setmetatable(t, {__pairs = function() return next,{1},nil end}) + +for _ in pairs(t) do patched = true end +if(not patched) then pairs = mtpairs end +for _ in ipairs(t) do ipatched = true end +if(not ipatched) then ipairs = mtipairs end + +return {original_pairs, original_ipairs} + diff --git a/lib/util.fnl b/lib/util.fnl index 9330292..3600eb2 100644 --- a/lib/util.fnl +++ b/lib/util.fnl @@ -134,9 +134,18 @@ (fn condlist [...] (let [l []] (lume.push l ...) l)) (fn prototype [base] (setmetatable {} {:__index base})) +(fn proxy [t f] + (let [p {} + iter #(let [i (+ $2 1) v (. $1 i)] (when v (values i v))) + pnext #(let [k (next t $2)] (when k (values k (. $1 k))))] + (setmetatable p + {:__index #(f (. t $2) $2 t) + :__len #(length t) + :__ipairs #(values iter p 0) + :__pairs #(values pnext p nil)}))) {: int8-to-bytes : int16-to-bytes : int24-to-bytes : int32-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24 : bytes-to-uint32 - : splice : lo : hi : loword : hiword : condlist : prototype + : splice : lo : hi : loword : hiword : condlist : prototype : proxy : reload : hotswap : swappable :require swappable-require : hot-table : nested-tset : pairoff : countiter : readjson : writejson : file-exists : waitfor : in-coro : multival} diff --git a/main.lua b/main.lua index 06f1671..c718d88 100644 --- a/main.lua +++ b/main.lua @@ -5,6 +5,7 @@ debug.traceback = fennel.traceback fv = fennel.view pp = function(x) print(fv(x)) end lume = require("lib.lume") +require("lib.metatable_monkey") -- unbreak luajit ipairs -- these set global variables and can't be required after requiring core.strict _, luars232 = pcall(function () require("luars232") end) diff --git a/ssc/init.fnl b/ssc/init.fnl index ccddb4d..781fa2d 100644 --- a/ssc/init.fnl +++ b/ssc/init.fnl @@ -36,7 +36,7 @@ (local Ssc (Object:extend)) (local Prg (require :asm.asm)) (local util (require :lib.util)) -(local {: loword : hiword : pairoff : countiter : condlist : prototype} util) +(local {: loword : hiword : pairoff : countiter : condlist : prototype : proxy} util) (fn Ssc.new [self ?opts] (local opts (or ?opts {})) @@ -46,7 +46,6 @@ (set self.locals []) (set self.addr-to-callsite {}) (set self.modules (prototype (or (?. opts.parent :modules) {}))) - (set self.globals (prototype (or (?. opts.parent :globals) {}))) (set self.constants (prototype (or (?. opts.parent :constants) {:true 0xffff true 0xffff :false 0 false 0}))) (set self.macros (prototype (or opts.macros (?. opts.parent :macros) self.__index.macros))) (set self.macrobarriers (prototype (or (?. opts.parent :macrobarriers) {:fn true :far-fn true :do true}))) @@ -262,9 +261,10 @@ (tset self.modules name mod) (func self ...)))) :global (lambda [self etype name ?const] - (tset self.globals name {:type etype : name}) + (tset self.constants name [(.. etype :-at) [:ref [:quote name]]]) (self.org:append [:hot-preserve name (match etype + :byte [:db ?const] :word [:dw ?const] :long [:dl ?const] _ (error (.. "Unrecognized type " (fv etype))))])) @@ -430,8 +430,6 @@ (if (= etype :byte) {:lo #[:block [:sep 0x30] [$1 name] [:rep 0x30] (when (= $1 :lda) [:and 0xff])]} {:lo #[$1 name] :hi (when (= etype :long) #[$1 {:abs #(+ ($1:lookup-addr name) 2)}])})) -(fn Ssc.opgen-global [self name] (self:opgen-symbol name (. self.globals name :type))) - (fn Ssc.opgen-ref-loc [self name etype] (when (= (self:local-type name) :word) ; long pointer deref is not possible directly from the stack; have to eval and move to LONG register {:lo #[:block [:ldy 0] [$1 [(self:local-offset name) :s] :y]] @@ -439,8 +437,7 @@ (fn Ssc.opgen-lhs [self expr] (match [(type expr) expr] - [:string _] (if (self:local-offset expr) (self:opgen-local expr) - (. self.globals expr) (self:opgen-global expr)) + (where [:string _] (self:local-offset expr)) (self:opgen-local expr) (where [_ [type-at [:ref name]]] (string? name) (xxxx-at type-at)) (self:opgen-symbol name (xxxx-at type-at)) (where [_ [type-at name]] (string? name) (xxxx-at type-at) (self:local-offset name)) (self:opgen-ref-loc name (xxxx-at type-at)))) @@ -492,15 +489,17 @@ (let [m (getmetatable expr)] (when (and m m.filename) (set self.expr-metadata m)))) +(fn Ssc.expr-index [self expr index] (self:expr-expand (. expr index))) + (fn Ssc.expr-expand [self expr] - (let [mt (getmetatable expr) + (let [mt (or (getmetatable expr) {}) expanded (match expr + [:quote rawsymbol] rawsymbol (where c (. self.constants c)) (self:expr-expand (. self.constants c)) (where [m & args] (. self.macros m)) (self:expr-expand ((. self.macros m) self (table.unpack args))) - (where [f & args] (not (. self.macrobarriers f))) (lume.concat [f] (icollect [_ arg (ipairs args)] (self:expr-expand arg))) - _ expr) - _ (when (= (type expanded) :table) (setmetatable expanded mt))] - expanded)) + _ expr)] + (if (= (type expanded) :table) (proxy expanded #(self:expr-expand $1)) + expanded))) (fn Ssc.expr-poly [self expr] (self:enter-expr expr)