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

@@ -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}
+

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}
 

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)
 

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)