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.
This commit is contained in:
parent
fe00a91064
commit
12481e9257
33
lib/metatable_monkey.lua
Normal file
33
lib/metatable_monkey.lua
Normal file
|
@ -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}
|
||||||
|
|
11
lib/util.fnl
11
lib/util.fnl
|
@ -134,9 +134,18 @@
|
||||||
(fn condlist [...] (let [l []] (lume.push l ...) l))
|
(fn condlist [...] (let [l []] (lume.push l ...) l))
|
||||||
|
|
||||||
(fn prototype [base] (setmetatable {} {:__index base}))
|
(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
|
{: 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
|
: reload : hotswap : swappable :require swappable-require : hot-table : nested-tset : pairoff : countiter
|
||||||
: readjson : writejson : file-exists : waitfor : in-coro : multival}
|
: readjson : writejson : file-exists : waitfor : in-coro : multival}
|
||||||
|
|
||||||
|
|
1
main.lua
1
main.lua
|
@ -5,6 +5,7 @@ debug.traceback = fennel.traceback
|
||||||
fv = fennel.view
|
fv = fennel.view
|
||||||
pp = function(x) print(fv(x)) end
|
pp = function(x) print(fv(x)) end
|
||||||
lume = require("lib.lume")
|
lume = require("lib.lume")
|
||||||
|
require("lib.metatable_monkey") -- unbreak luajit ipairs
|
||||||
-- these set global variables and can't be required after requiring core.strict
|
-- these set global variables and can't be required after requiring core.strict
|
||||||
_, luars232 = pcall(function () require("luars232") end)
|
_, luars232 = pcall(function () require("luars232") end)
|
||||||
|
|
||||||
|
|
23
ssc/init.fnl
23
ssc/init.fnl
|
@ -36,7 +36,7 @@
|
||||||
(local Ssc (Object:extend))
|
(local Ssc (Object:extend))
|
||||||
(local Prg (require :asm.asm))
|
(local Prg (require :asm.asm))
|
||||||
(local util (require :lib.util))
|
(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]
|
(fn Ssc.new [self ?opts]
|
||||||
(local opts (or ?opts {}))
|
(local opts (or ?opts {}))
|
||||||
|
@ -46,7 +46,6 @@
|
||||||
(set self.locals [])
|
(set self.locals [])
|
||||||
(set self.addr-to-callsite {})
|
(set self.addr-to-callsite {})
|
||||||
(set self.modules (prototype (or (?. opts.parent :modules) {})))
|
(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.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.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})))
|
(set self.macrobarriers (prototype (or (?. opts.parent :macrobarriers) {:fn true :far-fn true :do true})))
|
||||||
|
@ -262,9 +261,10 @@
|
||||||
(tset self.modules name mod)
|
(tset self.modules name mod)
|
||||||
(func self ...))))
|
(func self ...))))
|
||||||
:global (lambda [self etype name ?const]
|
: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
|
(self.org:append [:hot-preserve name
|
||||||
(match etype
|
(match etype
|
||||||
|
:byte [:db ?const]
|
||||||
:word [:dw ?const]
|
:word [:dw ?const]
|
||||||
:long [:dl ?const]
|
:long [:dl ?const]
|
||||||
_ (error (.. "Unrecognized type " (fv etype))))]))
|
_ (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])]}
|
(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)}])}))
|
{: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]
|
(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
|
(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]]
|
{:lo #[:block [:ldy 0] [$1 [(self:local-offset name) :s] :y]]
|
||||||
|
@ -439,8 +437,7 @@
|
||||||
|
|
||||||
(fn Ssc.opgen-lhs [self expr]
|
(fn Ssc.opgen-lhs [self expr]
|
||||||
(match [(type expr) expr]
|
(match [(type expr) expr]
|
||||||
[:string _] (if (self:local-offset expr) (self:opgen-local expr)
|
(where [:string _] (self:local-offset expr)) (self:opgen-local expr)
|
||||||
(. self.globals expr) (self:opgen-global expr))
|
|
||||||
(where [_ [type-at [:ref name]]] (string? name) (xxxx-at type-at)) (self:opgen-symbol name (xxxx-at type-at))
|
(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))))
|
(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)]
|
(let [m (getmetatable expr)]
|
||||||
(when (and m m.filename) (set self.expr-metadata m))))
|
(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]
|
(fn Ssc.expr-expand [self expr]
|
||||||
(let [mt (getmetatable expr)
|
(let [mt (or (getmetatable expr) {})
|
||||||
expanded (match expr
|
expanded (match expr
|
||||||
|
[:quote rawsymbol] rawsymbol
|
||||||
(where c (. self.constants c)) (self:expr-expand (. self.constants c))
|
(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 [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)]
|
||||||
_ expr)
|
(if (= (type expanded) :table) (proxy expanded #(self:expr-expand $1))
|
||||||
_ (when (= (type expanded) :table) (setmetatable expanded mt))]
|
expanded)))
|
||||||
expanded))
|
|
||||||
|
|
||||||
(fn Ssc.expr-poly [self expr]
|
(fn Ssc.expr-poly [self expr]
|
||||||
(self:enter-expr expr)
|
(self:enter-expr expr)
|
||||||
|
|
Loading…
Reference in a new issue