lua: generic for-in; ipairs/pairs/next; arity-tolerant fns +9 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-24 18:23:50 +00:00
parent e224fb2db0
commit 0934c4bd28
5 changed files with 313 additions and 42 deletions

View File

@@ -35,6 +35,7 @@
((= tag (quote lua-while)) (lua-tx-while node))
((= tag (quote lua-repeat)) (lua-tx-repeat node))
((= tag (quote lua-for-num)) (lua-tx-for-num node))
((= tag (quote lua-for-in)) (lua-tx-for-in node))
((= tag (quote lua-do)) (lua-tx-do node))
((= tag (quote lua-break)) (quote lua-break-marker))
((= tag (quote lua-return)) (lua-tx-return node))
@@ -160,6 +161,19 @@
(lua-tx (nth f 2))))
(else (error "lua-transpile: unknown table field")))))
(define
lua-tx-function-bindings
(fn
(params i)
(if
(>= i (len params))
(list)
(cons
(list
(make-symbol (nth params i))
(list (make-symbol "lua-arg") (make-symbol "__args") i))
(lua-tx-function-bindings params (+ i 1))))))
(define
lua-tx-function
(fn
@@ -168,9 +182,20 @@
((params (nth node 1))
(is-vararg (nth node 2))
(body (nth node 3)))
(let
((sym-params (map make-symbol params)))
(list (make-symbol "fn") sym-params (lua-tx body))))))
(cond
((= (len params) 0)
(list
(make-symbol "fn")
(list (make-symbol "&rest") (make-symbol "__args"))
(lua-tx body)))
(else
(list
(make-symbol "fn")
(list (make-symbol "&rest") (make-symbol "__args"))
(list
(make-symbol "let")
(lua-tx-function-bindings params 0)
(lua-tx body))))))))
(define
lua-tx-block
@@ -536,3 +561,100 @@
(nth lhss i)
(list (make-symbol "lua-nth-ret") tmp i))
(lua-tx-multi-assign-pairs lhss tmp (+ i 1))))))
(define
lua-tx-for-in-decls
(fn
(names i)
(if
(>= i (len names))
(list)
(cons
(list (make-symbol "define") (make-symbol (nth names i)) nil)
(lua-tx-for-in-decls names (+ i 1))))))
(define
lua-tx-for-in-sets
(fn
(names rets-sym i)
(if
(>= i (len names))
(list)
(cons
(list
(make-symbol "set!")
(make-symbol (nth names i))
(list (make-symbol "lua-nth-ret") rets-sym i))
(lua-tx-for-in-sets names rets-sym (+ i 1))))))
(define
lua-tx-for-in-step-body
(fn
(names body v-sym loop-sym first-name)
(list
(make-symbol "when")
(list (make-symbol "not") (list (make-symbol "=") first-name nil))
(list
(make-symbol "begin")
(list (make-symbol "set!") v-sym first-name)
body
(list loop-sym)))))
(define
lua-tx-for-in-loop-body
(fn
(names body f-sym s-sym v-sym rets-sym loop-sym first-name)
(list
(make-symbol "let")
(list
(list
rets-sym
(list
(make-symbol "lua-pack-return")
(list
(make-symbol "list")
(list (make-symbol "lua-call") f-sym s-sym v-sym)))))
(cons
(make-symbol "begin")
(append
(lua-tx-for-in-sets names rets-sym 0)
(list (lua-tx-for-in-step-body names body v-sym loop-sym first-name)))))))
(define
lua-tx-for-in
(fn
(node)
(let
((names (nth node 1))
(exps (nth node 2))
(body (lua-tx (nth node 3))))
(let
((pack-sym (make-symbol "__for_pack"))
(f-sym (make-symbol "__for_f"))
(s-sym (make-symbol "__for_s"))
(v-sym (make-symbol "__for_var"))
(rets-sym (make-symbol "__for_rets"))
(loop-sym (make-symbol "__for_loop"))
(first-name (make-symbol (first names))))
(list
(make-symbol "let")
(list (list pack-sym (lua-tx-multi-rhs exps)))
(list
(make-symbol "let")
(list
(list f-sym (list (make-symbol "lua-nth-ret") pack-sym 0))
(list s-sym (list (make-symbol "lua-nth-ret") pack-sym 1))
(list v-sym (list (make-symbol "lua-nth-ret") pack-sym 2)))
(cons
(make-symbol "begin")
(append
(lua-tx-for-in-decls names 0)
(list
(list
(make-symbol "define")
loop-sym
(list
(make-symbol "fn")
(list)
(lua-tx-for-in-loop-body names body f-sym s-sym v-sym rets-sym loop-sym first-name)))
(list loop-sym))))))))))