(define lua-truthy? (fn (v) (and (not (= v nil)) (not (= v false))))) (define lua-to-number (fn (v) (cond ((= (type-of v) "number") v) ((= (type-of v) "string") (let ((n (parse-number (trim v)))) (if (= n nil) nil n))) (else nil)))) (define lua-to-string (fn (v) (cond ((= v nil) "nil") ((= v true) "true") ((= v false) "false") ((= (type-of v) "number") (str v)) ((= (type-of v) "string") v) (else (str v))))) (define lua-num-op (fn (op a b) (let ((na (lua-to-number a)) (nb (lua-to-number b))) (begin (when (or (= na nil) (= nb nil)) (error (str "lua: arith on non-number: " a " " op " " b))) (cond ((= op "+") (+ na nb)) ((= op "-") (- na nb)) ((= op "*") (* na nb)) ((= op "/") (/ na nb)) ((= op "%") (- na (* nb (floor (/ na nb))))) ((= op "^") (pow na nb)) (else (error (str "lua: unknown arith op " op)))))))) (define lua-get-mm (fn (v name) (cond ((not (= (type-of v) "dict")) nil) (else (let ((mt (get v "__meta"))) (cond ((= mt nil) nil) ((not (= (type-of mt) "dict")) nil) ((has-key? mt name) (get mt name)) (else nil))))))) (define lua-arith (fn (mm op a-in b-in) (let ((a (lua-first a-in)) (b (lua-first b-in))) (cond ((and (= (type-of a) "number") (= (type-of b) "number")) (lua-num-op op a b)) ((and (or (= (type-of a) "number") (= (type-of a) "string")) (or (= (type-of b) "number") (= (type-of b) "string")) (not (= (lua-to-number a) nil)) (not (= (lua-to-number b) nil))) (lua-num-op op a b)) (else (let ((m (lua-get-mm a mm))) (cond ((not (= m nil)) (lua-first (m a b))) (else (let ((m2 (lua-get-mm b mm))) (if (not (= m2 nil)) (lua-first (m2 a b)) (error (str "lua: arith on " (type-of a) " " op " " (type-of b))))))))))))) (define lua-add (fn (a b) (lua-arith "__add" "+" a b))) (define lua-sub (fn (a b) (lua-arith "__sub" "-" a b))) (define lua-mul (fn (a b) (lua-arith "__mul" "*" a b))) (define lua-div (fn (a b) (lua-arith "__div" "/" a b))) (define lua-mod (fn (a b) (lua-arith "__mod" "%" a b))) (define lua-pow (fn (a b) (lua-arith "__pow" "^" a b))) (define lua-neg (fn (a) (cond ((= (type-of a) "number") (- 0 a)) (else (let ((na (lua-to-number a))) (cond ((not (= na nil)) (- 0 na)) (else (let ((m (lua-get-mm a "__unm"))) (if (not (= m nil)) (lua-first (m a)) (error (str "lua: neg on non-number: " (type-of a)))))))))))) (define lua-concat-coerce (fn (v-in) (let ((v (lua-first v-in))) (cond ((= (type-of v) "string") v) ((= (type-of v) "number") (str v)) (else (error (str "lua: cannot concat " v))))))) (define lua-concat (fn (a-in b-in) (let ((a (lua-first a-in)) (b (lua-first b-in))) (cond ((and (or (= (type-of a) "string") (= (type-of a) "number")) (or (= (type-of b) "string") (= (type-of b) "number"))) (str (lua-concat-coerce a) (lua-concat-coerce b))) (else (let ((m (lua-get-mm a "__concat"))) (cond ((not (= m nil)) (lua-first (m a b))) (else (let ((m2 (lua-get-mm b "__concat"))) (if (not (= m2 nil)) (lua-first (m2 a b)) (error (str "lua: concat on " (type-of a) " and " (type-of b))))))))))))) (define lua-eq (fn (a b) (cond ((and (= a nil) (= b nil)) true) ((or (= a nil) (= b nil)) false) ((and (= (type-of a) (type-of b)) (= a b)) true) ((and (= (type-of a) "dict") (= (type-of b) "dict")) (let ((m (lua-get-mm a "__eq"))) (cond ((not (= m nil)) (let ((r (lua-first (m a b)))) (and (not (= r nil)) (not (= r false))))) (else false)))) (else false)))) (define lua-neq (fn (a b) (not (lua-eq a b)))) (define lua-lt (fn (a b) (cond ((and (= (type-of a) "number") (= (type-of b) "number")) (< a b)) ((and (= (type-of a) "string") (= (type-of b) "string")) (< a b)) (else (let ((m (lua-get-mm a "__lt"))) (cond ((not (= m nil)) (let ((r (lua-first (m a b)))) (and (not (= r nil)) (not (= r false))))) (else (let ((m2 (lua-get-mm b "__lt"))) (cond ((not (= m2 nil)) (let ((r (lua-first (m2 a b)))) (and (not (= r nil)) (not (= r false))))) (else (error "lua: attempt to compare incompatible types"))))))))))) (define lua-le (fn (a b) (cond ((and (= (type-of a) "number") (= (type-of b) "number")) (<= a b)) ((and (= (type-of a) "string") (= (type-of b) "string")) (or (< a b) (= a b))) (else (let ((m (lua-get-mm a "__le"))) (cond ((not (= m nil)) (let ((r (lua-first (m a b)))) (and (not (= r nil)) (not (= r false))))) (else (let ((m2 (lua-get-mm b "__le"))) (cond ((not (= m2 nil)) (let ((r (lua-first (m2 a b)))) (and (not (= r nil)) (not (= r false))))) (else (not (lua-lt b a)))))))))))) (define lua-gt (fn (a b) (lua-lt b a))) (define lua-ge (fn (a b) (lua-le b a))) (define lua-len (fn (a) (cond ((= (type-of a) "string") (len a)) ((= (type-of a) "list") (len a)) ((= (type-of a) "dict") (let ((m (lua-get-mm a "__len"))) (cond ((not (= m nil)) (lua-first (m a))) (else (let ((n 0)) (begin (define count-loop (fn (i) (if (has-key? a (str i)) (begin (set! n i) (count-loop (+ i 1))) n))) (count-loop 1))))))) (else (error (str "lua: len on non-len type: " (type-of a))))))) (define lua-for-continue? (fn (i stop step) (if (> step 0) (<= i stop) (>= i stop)))) (define lua-make-table (fn (&rest fields) (let ((t {}) (array-idx 1)) (begin (define process (fn (fs) (when (> (len fs) 0) (begin (let ((f (first fs))) (cond ((= (first f) "pos") (let ((v (nth f 1))) (cond ((and (lua-multi? v) (= (len fs) 1)) (begin (define spread-loop (fn (i) (when (< i (len v)) (begin (set! t (assoc t (str array-idx) (nth v i))) (set! array-idx (+ array-idx 1)) (spread-loop (+ i 1)))))) (spread-loop 1))) (else (let ((val (if (lua-multi? v) (lua-first v) v))) (begin (set! t (assoc t (str array-idx) val)) (set! array-idx (+ array-idx 1)))))))) ((= (first f) "kv") (let ((k (nth f 1)) (v (nth f 2))) (set! t (assoc t (str k) v)))))) (process (rest fs)))))) (process fields) t)))) (define lua-get (fn (t k) (cond ((= t nil) nil) ((not (= (type-of t) "dict")) nil) (else (let ((key (str k))) (cond ((has-key? t key) (get t key)) (else (let ((m (lua-get-mm t "__index"))) (cond ((= m nil) nil) ((= (type-of m) "dict") (lua-get m k)) (else (lua-first (m t k)))))))))))) (define lua-set! (fn (t k v) (let ((key (str k))) (cond ((has-key? t key) (dict-set! t key v)) (else (let ((m (lua-get-mm t "__newindex"))) (cond ((= m nil) (dict-set! t key v)) ((= (type-of m) "dict") (lua-set! m k v)) (else (begin (m t k v) nil))))))))) (define lua-multi? (fn (v) (and (= (type-of v) "list") (> (len v) 0) (= (first v) (quote lua-multi))))) (define lua-first (fn (v) (cond ((lua-multi? v) (if (> (len v) 1) (nth v 1) nil)) (else v)))) (define lua-nth-ret (fn (v i) (cond ((lua-multi? v) (let ((idx (+ i 1))) (if (< idx (len v)) (nth v idx) nil))) (else (if (= i 0) v nil))))) (define lua-pack-build (fn (vals i) (cond ((>= i (len vals)) (list)) ((= i (- (len vals) 1)) (let ((last (nth vals i))) (if (lua-multi? last) (rest last) (list last)))) (else (cons (nth vals i) (lua-pack-build vals (+ i 1))))))) (define lua-pack-return (fn (vals) (cond ((= (len vals) 0) (list (quote lua-multi))) (else (cons (quote lua-multi) (lua-pack-build vals 0)))))) (define lua-setmetatable (fn (t mt) (begin (dict-set! t "__meta" mt) t))) (define lua-getmetatable (fn (t) (cond ((not (= (type-of t) "dict")) nil) ((has-key? t "__meta") (get t "__meta")) (else nil)))) (define setmetatable lua-setmetatable) (define getmetatable lua-getmetatable) (define lua-type (fn (v) (cond ((= v nil) "nil") ((= (type-of v) "number") "number") ((= (type-of v) "string") "string") ((= v true) "boolean") ((= v false) "boolean") ((= (type-of v) "dict") "table") ((or (= (type-of v) "function") (= (type-of v) "lambda")) "function") (else (type-of v))))) (define type lua-type) (define sx-apply-ref apply) (define lua-spread-last-multi (fn (rargs) (cond ((= (len rargs) 0) rargs) (else (let ((last-idx (- (len rargs) 1))) (let ((last (nth rargs last-idx))) (cond ((lua-multi? last) (let ((init (lua-pack-build rargs 0))) (append (if (> last-idx 0) (lua-init-before rargs 0 last-idx) (list)) (rest last)))) (else rargs)))))))) (define lua-init-before (fn (rargs i limit) (if (>= i limit) (list) (cons (nth rargs i) (lua-init-before rargs (+ i 1) limit))))) (define lua-apply (fn (f rargs-in) (let ((rargs (lua-spread-last-multi rargs-in))) (let ((n (len rargs))) (cond ((= n 0) (f)) ((= n 1) (f (nth rargs 0))) ((= n 2) (f (nth rargs 0) (nth rargs 1))) ((= n 3) (f (nth rargs 0) (nth rargs 1) (nth rargs 2))) ((= n 4) (f (nth rargs 0) (nth rargs 1) (nth rargs 2) (nth rargs 3))) ((= n 5) (f (nth rargs 0) (nth rargs 1) (nth rargs 2) (nth rargs 3) (nth rargs 4))) ((= n 6) (f (nth rargs 0) (nth rargs 1) (nth rargs 2) (nth rargs 3) (nth rargs 4) (nth rargs 5))) ((= n 7) (f (nth rargs 0) (nth rargs 1) (nth rargs 2) (nth rargs 3) (nth rargs 4) (nth rargs 5) (nth rargs 6))) ((= n 8) (f (nth rargs 0) (nth rargs 1) (nth rargs 2) (nth rargs 3) (nth rargs 4) (nth rargs 5) (nth rargs 6) (nth rargs 7))) (else (sx-apply-ref f rargs))))))) (define lua-call (fn (&rest args) (let ((f (first args)) (rargs (rest args))) (cond ((or (= (type-of f) "function") (= (type-of f) "lambda")) (lua-apply f rargs)) ((= (type-of f) "dict") (let ((m (lua-get-mm f "__call"))) (cond ((= m nil) (error "lua: attempt to call non-function")) (else (lua-apply m (cons f rargs)))))) (else (error "lua: attempt to call non-function")))))) (define lua-error (fn (&rest args) (raise (first args)))) (define error lua-error) (define pcall (fn (&rest args) (let ((f (first args)) (rargs (rest args))) (guard (e (true (list (quote lua-multi) false e))) (let ((r (lua-apply f rargs))) (cond ((lua-multi? r) (cons (quote lua-multi) (cons true (rest r)))) (else (list (quote lua-multi) true r)))))))) (define xpcall (fn (f msgh) (guard (e (true (list (quote lua-multi) false (lua-first (lua-apply msgh (list e)))))) (let ((r (lua-apply f (list)))) (cond ((lua-multi? r) (cons (quote lua-multi) (cons true (rest r)))) (else (list (quote lua-multi) true r))))))) (define lua-ipairs-iter (fn (t i) (let ((nk (+ i 1))) (let ((v (get t (str nk)))) (if (= v nil) nil (list (quote lua-multi) nk v)))))) (define lua-ipairs (fn (t) (list (quote lua-multi) lua-ipairs-iter t 0))) (define ipairs lua-ipairs) (define lua-next-skip-meta (fn (ks) (cond ((= (len ks) 0) (list)) ((= (first ks) "__meta") (lua-next-skip-meta (rest ks))) (else ks)))) (define lua-next-after (fn (ks prev-key) (cond ((= (len ks) 0) (list)) ((= (first ks) (str prev-key)) (lua-next-skip-meta (rest ks))) (else (lua-next-after (rest ks) prev-key))))) (define lua-key-to-value (fn (k) (cond ((= k "true") true) ((= k "false") false) (else (let ((n (lua-to-number k))) (if (= n nil) k n)))))) (define lua-next (fn (&rest args) (let ((t (first args)) (prev (if (> (len (rest args)) 0) (first (rest args)) nil))) (let ((all-keys (keys t))) (let ((ks (if (= prev nil) (lua-next-skip-meta all-keys) (lua-next-after all-keys prev)))) (cond ((= (len ks) 0) nil) (else (let ((k (first ks))) (list (quote lua-multi) (lua-key-to-value k) (get t k)))))))))) (define next lua-next) (define lua-pairs (fn (t) (list (quote lua-multi) lua-next t nil))) (define pairs lua-pairs) (define lua-arg (fn (args i) (if (< i (len args)) (nth args i) nil))) ;; ── Coroutines (call/cc based) ──────────────────────────────── (define __current-co nil) (define lua-coroutine-create (fn (f) (let ((co {})) (begin (dict-set! co "__co" true) (dict-set! co "status" "suspended") (dict-set! co "body" f) (dict-set! co "resume-k" nil) (dict-set! co "caller-k" nil) co)))) (define lua-coroutine-status (fn (co) (if (and (= (type-of co) "dict") (has-key? co "__co")) (get co "status") (error "lua: not a coroutine")))) (define lua-co-wrap-result (fn (r) (cond ((lua-multi? r) (cons (quote lua-multi) (cons true (rest r)))) (else (list (quote lua-multi) true r))))) (define lua-co-first-call (fn (co rvals prev) (let ((r (lua-apply (get co "body") rvals))) (begin (dict-set! co "status" "dead") (set! __current-co prev) ((get co "caller-k") (lua-co-wrap-result r)))))) (define lua-co-continue-call (fn (co rvals) (let ((rk (get co "resume-k"))) (begin (dict-set! co "resume-k" nil) (rk (if (> (len rvals) 0) (first rvals) nil)))))) (define lua-coroutine-resume (fn (&rest args) (let ((co (first args)) (rvals (rest args))) (cond ((not (and (= (type-of co) "dict") (has-key? co "__co"))) (list (quote lua-multi) false "not a coroutine")) ((= (get co "status") "dead") (list (quote lua-multi) false "cannot resume dead coroutine")) ((= (get co "status") "running") (list (quote lua-multi) false "cannot resume running coroutine")) (else (call/cc (fn (k) (let ((prev __current-co)) (begin (dict-set! co "caller-k" k) (dict-set! co "status" "running") (set! __current-co co) (guard (e (true (begin (dict-set! co "status" "dead") (set! __current-co prev) (list (quote lua-multi) false e)))) (cond ((= (get co "resume-k") nil) (lua-co-first-call co rvals prev)) (else (lua-co-continue-call co rvals))))))))))))) (define lua-coroutine-yield (fn (&rest yvals) (cond ((= __current-co nil) (error "lua: attempt to yield from outside a coroutine")) (else (call/cc (fn (k) (let ((co __current-co)) (begin (dict-set! co "resume-k" k) (dict-set! co "status" "suspended") (set! __current-co nil) ((get co "caller-k") (cons (quote lua-multi) (cons true yvals))))))))))) (define lua-co-wrap-caller (fn (co args) (let ((r (sx-apply-ref lua-coroutine-resume (cons co args)))) (cond ((and (lua-multi? r) (> (len r) 1) (= (nth r 1) true)) (cond ((<= (len r) 2) nil) ((= (len r) 3) (nth r 2)) (else (cons (quote lua-multi) (rest (rest r)))))) ((and (lua-multi? r) (> (len r) 1)) (error (if (> (len r) 2) (nth r 2) "coroutine error"))) (else nil))))) (define lua-coroutine-wrap (fn (f) (let ((co (lua-coroutine-create f))) (fn (&rest args) (lua-co-wrap-caller co args))))) (define coroutine {}) (dict-set! coroutine "create" lua-coroutine-create) (dict-set! coroutine "resume" lua-coroutine-resume) (dict-set! coroutine "yield" lua-coroutine-yield) (dict-set! coroutine "status" lua-coroutine-status) (dict-set! coroutine "wrap" lua-coroutine-wrap) ;; ── string library ──────────────────────────────────────────── ;; ── Lua patterns (minimal) ──────────────────────────────────── ;; Predicates for single-char classes (define lua-pat-class-match (fn (class c) (cond ((= class "d") (and (>= c "0") (<= c "9"))) ((= class "D") (not (and (>= c "0") (<= c "9")))) ((= class "a") (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z")))) ((= class "A") (not (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))) ((= class "s") (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))) ((= class "S") (not (or (= c " ") (= c "\t") (= c "\n") (= c "\r")))) ((= class "w") (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z")) (and (>= c "0") (<= c "9")))) ((= class "W") (not (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z")) (and (>= c "0") (<= c "9"))))) ((= class "l") (and (>= c "a") (<= c "z"))) ((= class "L") (not (and (>= c "a") (<= c "z")))) ((= class "u") (and (>= c "A") (<= c "Z"))) ((= class "U") (not (and (>= c "A") (<= c "Z")))) ((= class "p") (or (and (>= c "!") (<= c "/")) (and (>= c ":") (<= c "@")) (and (>= c "[") (<= c "`")) (and (>= c "{") (<= c "~")))) ((= class "P") (not (or (and (>= c "!") (<= c "/")) (and (>= c ":") (<= c "@")) (and (>= c "[") (<= c "`")) (and (>= c "{") (<= c "~"))))) ((= class "c") (or (< c " ") (= c "\127"))) ((= class "C") (not (or (< c " ") (= c "\127")))) ((= class "x") (or (and (>= c "0") (<= c "9")) (and (>= c "a") (<= c "f")) (and (>= c "A") (<= c "F")))) ((= class "X") (not (or (and (>= c "0") (<= c "9")) (and (>= c "a") (<= c "f")) (and (>= c "A") (<= c "F"))))) (else (= c class))))) ;; Match a single "pattern atom" (char or class) at src position — returns true or false. ;; pat-pos is position of the atom start. Returns the atom's length in pat (1 or 2). (define lua-pat-atom-len (fn (pat pat-pos) (cond ((>= pat-pos (len pat)) 0) ((= (char-at pat pat-pos) "%") 2) (else 1)))) (define lua-pat-atom-match (fn (pat pat-pos s s-pos) (cond ((>= s-pos (len s)) false) ((>= pat-pos (len pat)) false) (else (let ((pc (char-at pat pat-pos)) (sc (char-at s s-pos))) (cond ((= pc ".") true) ((= pc "%") (cond ((>= (+ pat-pos 1) (len pat)) false) (else (lua-pat-class-match (char-at pat (+ pat-pos 1)) sc)))) (else (= pc sc)))))))) ;; Match pattern against string starting at s-pos and pat-pos. Returns end-pos (inclusive+1) or -1 on no-match. (define lua-pat-match (fn (pat pat-pos s s-pos) (cond ((>= pat-pos (len pat)) s-pos) ((and (= (char-at pat pat-pos) "$") (= (+ pat-pos 1) (len pat))) (if (= s-pos (len s)) s-pos -1)) (else (let ((alen (lua-pat-atom-len pat pat-pos))) (let ((next-pat (+ pat-pos alen))) (let ((qc (if (< next-pat (len pat)) (char-at pat next-pat) ""))) (cond ((= qc "*") (lua-pat-match-greedy pat pat-pos alen s s-pos (+ next-pat 1) 0)) ((= qc "+") (lua-pat-match-greedy pat pat-pos alen s s-pos (+ next-pat 1) 1)) ((= qc "-") (lua-pat-match-lazy pat pat-pos alen s s-pos (+ next-pat 1))) ((= qc "?") (let ((tried (if (lua-pat-atom-match pat pat-pos s s-pos) (lua-pat-match pat (+ next-pat 1) s (+ s-pos 1)) -1))) (if (>= tried 0) tried (lua-pat-match pat (+ next-pat 1) s s-pos)))) (else (cond ((lua-pat-atom-match pat pat-pos s s-pos) (lua-pat-match pat next-pat s (+ s-pos 1))) (else -1))))))))))) (define lua-pat-match-greedy (fn (pat atom-pos atom-len s s-pos rest-pat-pos min-count) (let ((count 0) (i s-pos)) (begin (define count-loop (fn () (when (lua-pat-atom-match pat atom-pos s i) (begin (set! i (+ i 1)) (set! count (+ count 1)) (count-loop))))) (count-loop) (let ((best -1)) (begin (define try-loop (fn (k) (when (and (< best 0) (>= k min-count)) (let ((r (lua-pat-match pat rest-pat-pos s (+ s-pos k)))) (cond ((>= r 0) (set! best r)) (else (try-loop (- k 1)))))))) (try-loop count) best)))))) (define lua-pat-match-lazy (fn (pat atom-pos atom-len s s-pos rest-pat-pos) (let ((best -1) (i s-pos)) (begin (define try-loop (fn () (when (< best 0) (let ((r (lua-pat-match pat rest-pat-pos s i))) (cond ((>= r 0) (set! best r)) ((and (< i (len s)) (lua-pat-atom-match pat atom-pos s i)) (begin (set! i (+ i 1)) (try-loop))) (else (set! best -2))))))) (try-loop) (if (= best -2) -1 best))))) ;; Top-level find: return (start-index-0based . end-index) or nil on no match. ;; If pat starts with ^, anchor to init. Otherwise scan. (define lua-pat-strip-captures (fn (pat) (let ((out "") (i 0)) (begin (define sc-loop (fn () (when (< i (len pat)) (let ((c (char-at pat i))) (cond ((= c "%") (begin (set! out (str out c)) (when (< (+ i 1) (len pat)) (set! out (str out (char-at pat (+ i 1))))) (set! i (+ i 2)) (sc-loop))) ((or (= c "(") (= c ")")) (begin (set! i (+ i 1)) (sc-loop))) (else (begin (set! out (str out c)) (set! i (+ i 1)) (sc-loop)))))))) (sc-loop) out)))) (define lua-pat-find (fn (pat s init) (let ((anchored (and (> (len pat) 0) (= (char-at pat 0) "^")))) (let ((start-pat (if anchored 1 0))) (cond (anchored (let ((end (lua-pat-match pat start-pat s init))) (if (>= end 0) (list init end) nil))) (else (let ((i init) (result nil)) (begin (define scan (fn () (when (and (= result nil) (<= i (len s))) (let ((end (lua-pat-match pat 0 s i))) (cond ((>= end 0) (set! result (list i end))) (else (begin (set! i (+ i 1)) (scan)))))))) (scan) result)))))))) (define string {}) (define __ascii-32-126 " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~") (define lua-string-len (fn (s) (len s))) (define lua-string-upper (fn (s) (upcase s))) (define lua-string-lower (fn (s) (downcase s))) (define lua-string-rep (fn (s n) (cond ((<= n 0) "") ((= n 1) s) (else (str s (lua-string-rep s (- n 1))))))) (define lua-string-sub (fn (&rest args) (let ((s (first args)) (slen (len (first args))) (i (nth args 1)) (j (if (> (len args) 2) (nth args 2) -1))) (let ((ni (cond ((< i 0) (+ slen i 1)) ((= i 0) 1) (else i))) (nj (cond ((< j 0) (+ slen j 1)) ((> j slen) slen) (else j)))) (let ((ci (if (< ni 1) 1 ni)) (cj (if (> nj slen) slen nj))) (cond ((> ci cj) "") (else (substring s (- ci 1) cj)))))))) (define lua-string-byte (fn (&rest args) (let ((s (first args)) (i (if (> (len args) 1) (nth args 1) 1))) (cond ((or (< i 1) (> i (len s))) nil) (else (char-code (char-at s (- i 1)))))))) (define lua-char-one (fn (n) (cond ((= n 9) "\t") ((= n 10) "\n") ((= n 13) "\r") ((and (>= n 32) (<= n 126)) (char-at __ascii-32-126 (- n 32))) (else (error (str "lua: string.char out of range: " n)))))) (define lua-string-char (fn (&rest args) (cond ((= (len args) 0) "") (else (let ((out "")) (begin (define loop (fn (i) (when (< i (len args)) (begin (set! out (str out (lua-char-one (nth args i)))) (loop (+ i 1)))))) (loop 0) out)))))) ;; Literal-only string.find: returns (start, end) 1-indexed or nil. (define lua-string-find (fn (&rest args) (let ((s (first args)) (pat (nth args 1)) (init (if (> (len args) 2) (nth args 2) 1)) (plain (if (> (len args) 3) (nth args 3) false))) (let ((start-i0 (cond ((< init 0) (let ((v (+ (len s) init))) (if (< v 0) 0 v))) ((= init 0) 0) (else (- init 1))))) (cond ((lua-truthy? plain) (let ((sub (if (<= start-i0 0) s (substring s start-i0 (len s))))) (let ((idx (index-of sub pat))) (cond ((< idx 0) nil) (else (list (quote lua-multi) (+ start-i0 idx 1) (+ start-i0 idx (len pat)))))))) (else (let ((r (lua-pat-find (lua-pat-strip-captures pat) s start-i0))) (cond ((= r nil) nil) (else (list (quote lua-multi) (+ (first r) 1) (nth r 1))))))))))) ;; Literal-only string.match: returns matched substring or nil (no captures since no pattern). (define lua-string-match (fn (&rest args) (let ((s (first args)) (pat (nth args 1)) (init (if (> (len args) 2) (nth args 2) 1))) (let ((start-i0 (cond ((< init 0) (let ((v (+ (len s) init))) (if (< v 0) 0 v))) ((= init 0) 0) (else (- init 1))))) (let ((r (lua-pat-find (lua-pat-strip-captures pat) s start-i0))) (cond ((= r nil) nil) (else (substring s (first r) (nth r 1))))))))) ;; Literal-only string.gmatch: iterator producing each literal match of pat. (define lua-string-gmatch (fn (s pat) (let ((pos 0)) (fn (&rest __) (cond ((> pos (len s)) nil) (else (let ((r (lua-pat-find (lua-pat-strip-captures pat) s pos))) (cond ((= r nil) (begin (set! pos (+ (len s) 1)) nil)) (else (let ((start (first r)) (end (nth r 1))) (begin (set! pos (if (= end start) (+ end 1) end)) (substring s start end)))))))))))) ;; Literal-only string.gsub: replace all occurrences of pat with repl (string only for now). (define lua-string-gsub (fn (&rest args) (let ((s (first args)) (pat (nth args 1)) (repl (nth args 2)) (max-n (if (> (len args) 3) (nth args 3) -1))) (cond ((= (len pat) 0) (list (quote lua-multi) s 0)) (else (let ((out "") (pos 0) (count 0) (done false)) (begin (define gsub-loop (fn () (when (and (not done) (<= pos (len s))) (let ((r (lua-pat-find (lua-pat-strip-captures pat) s pos))) (cond ((= r nil) (begin (set! out (str out (substring s pos (len s)))) (set! done true))) ((and (>= max-n 0) (>= count max-n)) (begin (set! out (str out (substring s pos (len s)))) (set! done true))) (else (let ((start (first r)) (end (nth r 1))) (let ((matched (substring s start end))) (let ((replacement (cond ((= (type-of repl) "string") repl) ((or (= (type-of repl) "function") (= (type-of repl) "lambda")) (let ((rv (lua-call repl matched))) (cond ((or (= rv nil) (= rv false)) matched) (else (str rv))))) ((= (type-of repl) "dict") (let ((v (get repl matched))) (cond ((= v nil) matched) (else (str v))))) (else (str repl))))) (begin (set! out (str out (substring s pos start) replacement)) (set! pos (if (= end start) (+ end 1) end)) (set! count (+ count 1)) (gsub-loop))))))))))) (gsub-loop) (list (quote lua-multi) out count)))))))) ;; Basic string.format: %s %d %f (%%.Nf ignored), %%. (define lua-format-int (fn (n) (cond ((= (type-of n) "number") (str (floor n))) (else (str n))))) (define lua-string-format (fn (&rest args) (let ((fmt (first args)) (vals (rest args))) (let ((out "") (i 0) (vi 0)) (begin (define loop (fn () (when (< i (len fmt)) (let ((c (char-at fmt i))) (cond ((and (= c "%") (< (+ i 1) (len fmt))) (let ((spec (char-at fmt (+ i 1)))) (cond ((= spec "%") (begin (set! out (str out "%")) (set! i (+ i 2)) (loop))) ((= spec "s") (begin (set! out (str out (lua-concat-coerce (nth vals vi)))) (set! vi (+ vi 1)) (set! i (+ i 2)) (loop))) ((= spec "d") (begin (set! out (str out (lua-format-int (nth vals vi)))) (set! vi (+ vi 1)) (set! i (+ i 2)) (loop))) ((= spec "f") (begin (set! out (str out (str (nth vals vi)))) (set! vi (+ vi 1)) (set! i (+ i 2)) (loop))) (else (begin (set! out (str out c)) (set! i (+ i 1)) (loop)))))) (else (begin (set! out (str out c)) (set! i (+ i 1)) (loop)))))))) (loop) out))))) (dict-set! string "len" lua-string-len) (dict-set! string "upper" lua-string-upper) (dict-set! string "lower" lua-string-lower) (dict-set! string "rep" lua-string-rep) (dict-set! string "sub" lua-string-sub) (dict-set! string "byte" lua-string-byte) (dict-set! string "char" lua-string-char) (dict-set! string "find" lua-string-find) (dict-set! string "match" lua-string-match) (dict-set! string "gmatch" lua-string-gmatch) (dict-set! string "gsub" lua-string-gsub) (dict-set! string "format" lua-string-format) (define lua-string-reverse (fn (s) (let ((out "")) (begin (define rloop (fn (i) (when (>= i 0) (begin (set! out (str out (char-at s i))) (rloop (- i 1)))))) (rloop (- (len s) 1)) out)))) (dict-set! string "reverse" lua-string-reverse) ;; ── math library ────────────────────────────────────────────── (define math {}) (define lua-math-pi 3.141592653589793) (define lua-math-huge (/ 1.0 0.0)) (define lua-math-abs (fn (x) (abs x))) (define lua-math-ceil (fn (x) (ceil x))) (define lua-math-floor (fn (x) (floor x))) (define lua-math-sqrt (fn (x) (sqrt x))) (define lua-math-exp (fn (x) (exp x))) (define lua-math-sin (fn (x) (sin x))) (define lua-math-cos (fn (x) (cos x))) (define lua-math-tan (fn (x) (tan x))) (define lua-math-asin (fn (x) (asin x))) (define lua-math-acos (fn (x) (acos x))) (define lua-math-atan (fn (x) (atan x))) (define lua-math-atan2 (fn (y x) (atan2 y x))) (define lua-math-pow (fn (a b) (pow a b))) (define lua-math-log (fn (&rest args) (cond ((= (len args) 1) (log (first args))) (else (/ (log (first args)) (log (nth args 1))))))) (define lua-math-log10 (fn (x) (/ (log x) (log 10)))) (define lua-math-deg (fn (x) (* x (/ 180 lua-math-pi)))) (define lua-math-rad (fn (x) (* x (/ lua-math-pi 180)))) (define lua-math-min (fn (&rest args) (cond ((= (len args) 0) (error "lua: min: no values")) ((= (len args) 1) (first args)) (else (let ((m (first args))) (begin (define loop (fn (i) (when (< i (len args)) (begin (when (< (nth args i) m) (set! m (nth args i))) (loop (+ i 1)))))) (loop 1) m)))))) (define lua-math-max (fn (&rest args) (cond ((= (len args) 0) (error "lua: max: no values")) ((= (len args) 1) (first args)) (else (let ((m (first args))) (begin (define loop (fn (i) (when (< i (len args)) (begin (when (> (nth args i) m) (set! m (nth args i))) (loop (+ i 1)))))) (loop 1) m)))))) (define lua-math-fmod (fn (a b) (- a (* b (if (> b 0) (floor (/ a b)) (ceil (/ a b))))))) (define lua-math-modf (fn (x) (let ((i (if (>= x 0) (floor x) (ceil x)))) (list (quote lua-multi) i (- x i))))) (define __rand-scale 1048576) (define lua-math-random (fn (&rest args) (cond ((= (len args) 0) (/ (random-int 0 (- __rand-scale 1)) (* 1.0 __rand-scale))) ((= (len args) 1) (random-int 1 (first args))) (else (random-int (first args) (nth args 1)))))) (define lua-math-randomseed (fn (s) nil)) (dict-set! math "pi" lua-math-pi) (dict-set! math "huge" lua-math-huge) (dict-set! math "abs" lua-math-abs) (dict-set! math "ceil" lua-math-ceil) (dict-set! math "floor" lua-math-floor) (dict-set! math "sqrt" lua-math-sqrt) (dict-set! math "exp" lua-math-exp) (dict-set! math "log" lua-math-log) (dict-set! math "log10" lua-math-log10) (dict-set! math "pow" lua-math-pow) (dict-set! math "sin" lua-math-sin) (dict-set! math "cos" lua-math-cos) (dict-set! math "tan" lua-math-tan) (dict-set! math "asin" lua-math-asin) (dict-set! math "acos" lua-math-acos) (dict-set! math "atan" lua-math-atan) (dict-set! math "atan2" lua-math-atan2) (dict-set! math "deg" lua-math-deg) (dict-set! math "rad" lua-math-rad) (dict-set! math "min" lua-math-min) (dict-set! math "max" lua-math-max) (dict-set! math "fmod" lua-math-fmod) (dict-set! math "modf" lua-math-modf) (dict-set! math "random" lua-math-random) (dict-set! math "randomseed" lua-math-randomseed) ;; ── table library ───────────────────────────────────────────── (define table {}) (define lua-table-insert (fn (&rest args) (cond ((= (len args) 2) (let ((t (first args)) (v (nth args 1))) (let ((n (lua-len t))) (dict-set! t (str (+ n 1)) v)))) ((= (len args) 3) (let ((t (first args)) (pos (nth args 1)) (v (nth args 2))) (let ((n (lua-len t))) (begin (define tbl-shift-up (fn (i) (when (>= i pos) (begin (dict-set! t (str (+ i 1)) (get t (str i))) (tbl-shift-up (- i 1)))))) (tbl-shift-up n) (dict-set! t (str pos) v))))) (else (error "lua: table.insert: wrong args"))))) (define lua-table-remove (fn (&rest args) (let ((t (first args))) (let ((n (lua-len t))) (let ((pos (if (> (len args) 1) (nth args 1) n))) (cond ((<= n 0) nil) (else (let ((v (get t (str pos)))) (begin (define tbl-shift-down (fn (i) (when (< i n) (begin (dict-set! t (str i) (get t (str (+ i 1)))) (tbl-shift-down (+ i 1)))))) (tbl-shift-down pos) (dict-set! t (str n) nil) v))))))))) (define lua-table-concat (fn (&rest args) (let ((t (first args)) (sep (if (> (len args) 1) (nth args 1) "")) (i (if (> (len args) 2) (nth args 2) 1)) (j (if (> (len args) 3) (nth args 3) (lua-len (first args))))) (cond ((> i j) "") (else (let ((out (lua-concat-coerce (get t (str i))))) (begin (define loop (fn (k) (when (<= k j) (begin (set! out (str out sep (lua-concat-coerce (get t (str k))))) (loop (+ k 1)))))) (loop (+ i 1)) out))))))) ;; Simple insertion sort for tables (define lua-table-sort (fn (&rest args) (let ((t (first args)) (comp (if (> (len args) 1) (nth args 1) nil))) (let ((n (lua-len t))) (begin (define lt? (fn (a b) (cond ((= comp nil) (lua-lt a b)) (else (lua-truthy? (lua-call comp a b)))))) (define ts-swap (fn (i j) (let ((vi (get t (str i))) (vj (get t (str j)))) (begin (dict-set! t (str i) vj) (dict-set! t (str j) vi))))) (define ts-partition (fn (lo hi) (let ((pivot (get t (str hi))) (i (- lo 1))) (begin (define pt-loop (fn (j) (when (< j hi) (begin (when (lt? (get t (str j)) pivot) (begin (set! i (+ i 1)) (ts-swap i j))) (pt-loop (+ j 1)))))) (pt-loop lo) (ts-swap (+ i 1) hi) (+ i 1))))) (define ts-qsort (fn (lo hi) (when (< lo hi) (let ((p (ts-partition lo hi))) (begin (ts-qsort lo (- p 1)) (ts-qsort (+ p 1) hi)))))) (ts-qsort 1 n) nil))))) (define lua-unpack (fn (&rest args) (let ((t (first args)) (i (if (> (len args) 1) (nth args 1) 1)) (j (if (> (len args) 2) (nth args 2) (lua-len (first args))))) (cond ((> i j) nil) (else (let ((out (list (quote lua-multi)))) (begin (define loop (fn (k) (when (<= k j) (begin (set! out (append out (list (get t (str k))))) (loop (+ k 1)))))) (loop i) out))))))) (define lua-table-maxn (fn (t) (lua-len t))) (dict-set! table "insert" lua-table-insert) (dict-set! table "remove" lua-table-remove) (dict-set! table "concat" lua-table-concat) (dict-set! table "sort" lua-table-sort) (dict-set! table "unpack" lua-unpack) (dict-set! table "maxn" lua-table-maxn) (dict-set! table "getn" lua-len) (dict-set! table "setn" (fn (t n) nil)) (define lua-table-foreach (fn (t f) (let ((ks (keys t))) (begin (define tfl (fn (i) (when (< i (len ks)) (let ((k (nth ks i))) (cond ((= k "__meta") (tfl (+ i 1))) (else (let ((r (lua-call f (lua-key-to-value k) (get t k)))) (cond ((lua-truthy? r) r) (else (tfl (+ i 1))))))))))) (tfl 0) nil)))) (dict-set! table "foreach" lua-table-foreach) (define lua-table-foreachi (fn (t f) (let ((n (lua-len t))) (begin (define tfi (fn (i) (when (<= i n) (let ((r (lua-call f i (get t (str i))))) (cond ((lua-truthy? r) r) (else (tfi (+ i 1)))))))) (tfi 1) nil)))) (dict-set! table "foreachi" lua-table-foreachi) (define unpack lua-unpack) ;; ── io library (minimal stub — buffered; no real stdio) ─────── (define io {}) (define __io-buffer "") (define lua-io-write (fn (&rest args) (begin (define loop (fn (i) (when (< i (len args)) (begin (set! __io-buffer (str __io-buffer (lua-concat-coerce (nth args i)))) (loop (+ i 1)))))) (loop 0) io))) (define lua-io-read (fn (&rest args) nil)) (define lua-io-open (fn (&rest args) nil)) (define lua-io-lines (fn (&rest args) (fn (&rest __) nil))) (define lua-io-close (fn (&rest args) true)) (define lua-io-flush (fn (&rest args) nil)) (define lua-io-buffer (fn () (let ((out __io-buffer)) (begin (set! __io-buffer "") out)))) ;; print(a, b, c) — args joined by tab, trailing newline (define lua-print (fn (&rest args) (begin (define loop (fn (i) (when (< i (len args)) (begin (when (> i 0) (set! __io-buffer (str __io-buffer "\t"))) (set! __io-buffer (str __io-buffer (lua-to-display (nth args i)))) (loop (+ i 1)))))) (loop 0) (set! __io-buffer (str __io-buffer "\n")) nil))) (define lua-to-display (fn (v) (cond ((= v nil) "nil") ((= v true) "true") ((= v false) "false") ((= (type-of v) "string") v) ((= (type-of v) "number") (str v)) ((= (type-of v) "dict") (str "table")) ((or (= (type-of v) "function") (= (type-of v) "lambda")) "function") (else (str v))))) (define lua-tostring (fn (v) (cond ((= (type-of v) "dict") (let ((m (lua-get-mm v "__tostring"))) (cond ((not (= m nil)) (lua-first (m v))) (else (lua-to-display v))))) (else (lua-to-display v))))) (define lua-tonumber (fn (&rest args) (let ((v (first args)) (base (if (> (len args) 1) (nth args 1) nil))) (cond ((= (type-of v) "number") v) ((= (type-of v) "string") (lua-to-number v)) (else nil))))) (dict-set! io "write" lua-io-write) (dict-set! io "read" lua-io-read) (dict-set! io "open" lua-io-open) (dict-set! io "lines" lua-io-lines) (dict-set! io "close" lua-io-close) (dict-set! io "flush" lua-io-flush) (dict-set! io "__buffer" lua-io-buffer) (dict-set! io "output" (fn (&rest args) (if (> (len args) 0) (first args) nil))) (dict-set! io "input" (fn (&rest args) (if (> (len args) 0) (first args) nil))) (define __io-stdout {}) (dict-set! __io-stdout "write" lua-io-write) (dict-set! __io-stdout "close" lua-io-close) (dict-set! io "stdout" __io-stdout) (dict-set! io "stderr" __io-stdout) (define print lua-print) (define tostring lua-tostring) (define tonumber lua-tonumber) ;; ── os library (minimal stub — no real clock/filesystem) ────── (define os {}) (define __os-counter 0) (define lua-os-time (fn (&rest args) (begin (set! __os-counter (+ __os-counter 1)) __os-counter))) (define lua-os-clock (fn () (/ __os-counter 1000))) (define lua-os-difftime (fn (t2 t1) (- t2 t1))) (define lua-os-date (fn (&rest args) (let ((fmt (if (> (len args) 0) (first args) "%c"))) (cond ((= fmt "*t") (let ((d {})) (begin (dict-set! d "year" 1970) (dict-set! d "month" 1) (dict-set! d "day" 1) (dict-set! d "hour" 0) (dict-set! d "min" 0) (dict-set! d "sec" 0) (dict-set! d "wday" 5) (dict-set! d "yday" 1) (dict-set! d "isdst" false) d))) (else "1970-01-01 00:00:00"))))) (define lua-os-getenv (fn (name) nil)) (define lua-os-exit (fn (&rest args) (error "lua: os.exit called"))) (define lua-os-remove (fn (name) true)) (define lua-os-rename (fn (a b) (list (quote lua-multi) nil "os.rename not supported"))) (define lua-os-tmpname (fn () "/tmp/lua_stub")) (define lua-os-execute (fn (&rest args) 0)) (dict-set! os "time" lua-os-time) (dict-set! os "clock" lua-os-clock) (dict-set! os "difftime" lua-os-difftime) (dict-set! os "date" lua-os-date) (dict-set! os "getenv" lua-os-getenv) (dict-set! os "exit" lua-os-exit) (dict-set! os "remove" lua-os-remove) (dict-set! os "rename" lua-os-rename) (dict-set! os "tmpname" lua-os-tmpname) (dict-set! os "execute" lua-os-execute) ;; ── package / require ───────────────────────────────────────── (define package {}) (define __package-loaded {}) (define __package-preload {}) (dict-set! package "loaded" __package-loaded) (dict-set! package "preload" __package-preload) (dict-set! package "path" "?;?.lua") (dict-set! package "cpath" "?;?.so") (dict-set! package "config" "/\n;\n?\n!\n-") (dict-set! package "loaders" {}) (dict-set! package "searchers" {}) (dict-set! package "searchpath" (fn (&rest args) nil)) (define lua-require (fn (name) (cond ((has-key? __package-loaded name) (get __package-loaded name)) ((has-key? __package-preload name) (let ((loader (get __package-preload name))) (let ((m (lua-call loader name))) (let ((result (if (= m nil) true m))) (begin (dict-set! __package-loaded name result) result))))) (else (error (str "lua: module '" name "' not found")))))) (define require lua-require) ;; ── raw operations + loadstring ─────────────────────────────── (define lua-rawget (fn (t k) (cond ((not (= (type-of t) "dict")) nil) ((has-key? t (str k)) (get t (str k))) (else nil)))) (define lua-rawset (fn (t k v) (begin (dict-set! t (str k) v) t))) (define lua-rawequal (fn (a b) (cond ((and (= a nil) (= b nil)) true) ((or (= a nil) (= b nil)) false) ((and (= (type-of a) (type-of b)) (= a b)) true) (else false)))) (define lua-rawlen (fn (v) (cond ((= (type-of v) "string") (len v)) ((= (type-of v) "dict") (let ((n 0)) (begin (define rl-count (fn (i) (if (has-key? v (str i)) (begin (set! n i) (rl-count (+ i 1))) n))) (rl-count 1) n))) (else 0)))) (define rawget lua-rawget) (define rawset lua-rawset) (define rawequal lua-rawequal) (define rawlen lua-rawlen) ;; loadstring(src) returns a function that, when called, evaluates src. (define lua-loadstring (fn (src) (guard (e (true (list (quote lua-multi) nil (str e)))) (let ((compiled (lua-transpile src))) (let ((guarded (list (make-symbol "guard") (list (make-symbol "e") (list (list (make-symbol "lua-return-sentinel?") (make-symbol "e")) (list (make-symbol "lua-return-value") (make-symbol "e")))) (list (make-symbol "let") (list) compiled)))) (let ((wrapped (list (make-symbol "fn") (list (make-symbol "&rest") (make-symbol "__args")) guarded))) (eval-expr wrapped))))))) (define loadstring lua-loadstring) (define load lua-loadstring) (define dostring (fn (s) (let ((f (lua-loadstring s))) (f)))) ;; select(n, ...) — Lua 5.1 built-in. select("#", ...) is arg count; select(i, ...) returns args from i on. (define lua-select (fn (&rest args) (let ((n (first args)) (rest-args (rest args))) (cond ((= n "#") (len rest-args)) ((= (type-of n) "number") (let ((i (- n 1))) (cond ((< i 0) (error "lua: bad argument to select")) ((>= i (len rest-args)) nil) (else (let ((out (list (quote lua-multi)))) (begin (define sel-loop (fn (j) (when (< j (len rest-args)) (begin (set! out (append out (list (nth rest-args j)))) (sel-loop (+ j 1)))))) (sel-loop i) out)))))) (else (error "lua: bad argument to select")))))) (define select lua-select) ;; assert(v, msg) — errors with msg if v is falsy. (define lua-assert (fn (&rest args) (let ((v (first args))) (cond ((lua-truthy? v) (cond ((= (len args) 1) v) (else (cons (quote lua-multi) args)))) (else (error (if (> (len args) 1) (nth args 1) "assertion failed!"))))))) (define assert lua-assert) (define _G {}) (define _VERSION "Lua 5.1") (define lua-varargs (fn (args skip) (cons (quote lua-multi) (lua-varargs-tail args skip)))) (define lua-varargs-tail (fn (args i) (if (>= i (len args)) (list) (cons (nth args i) (lua-varargs-tail args (+ i 1)))))) ;; preload standard libs in package.loaded (dict-set! __package-loaded "string" string) (dict-set! __package-loaded "math" math) (dict-set! __package-loaded "table" table) (dict-set! __package-loaded "io" io) (dict-set! __package-loaded "os" os) (dict-set! __package-loaded "coroutine" coroutine) (dict-set! __package-loaded "package" package) (dict-set! __package-loaded "_G" _G) (define arg {}) ;; preload debug stub (define debug {}) (dict-set! debug "traceback" (fn (&rest args) (if (> (len args) 0) (first args) ""))) (dict-set! debug "getinfo" (fn (&rest args) {})) (dict-set! debug "sethook" (fn (&rest args) nil)) (dict-set! debug "gethook" (fn () nil)) (dict-set! debug "getlocal" (fn (&rest args) nil)) (dict-set! debug "setlocal" (fn (&rest args) nil)) (dict-set! debug "getupvalue" (fn (&rest args) nil)) (dict-set! debug "setupvalue" (fn (&rest args) nil)) (dict-set! __package-loaded "debug" debug) ;; collectgarbage stubs + env stubs (define lua-collectgarbage (fn (&rest args) (cond ((= (len args) 0) 0) ((= (first args) "count") 0) ((= (first args) "collect") 0) (else 0)))) (define collectgarbage lua-collectgarbage) ;; setfenv/getfenv — Lua 5.1 env manipulation. Stubs. (define setfenv (fn (&rest args) (if (> (len args) 0) (first args) nil))) (define getfenv (fn (&rest args) _G)) ;; T — debug/testC placeholder for tests that check it conditionally (define T nil) ;; Build Lua 5.0-style `arg` table: array + .n counter, skipping leading explicit params. (define lua-varargs-arg-table (fn (args skip) (let ((t {}) (n 0)) (begin (define va-build (fn (i) (when (< i (len args)) (begin (set! n (+ n 1)) (dict-set! t (str n) (nth args i)) (va-build (+ i 1)))))) (va-build skip) (dict-set! t "n" n) t)))) ;; Return-sentinel: wrap function bodies so mid-block `return` can escape. (define lua-return-sentinel? (fn (e) (and (= (type-of e) "list") (> (len e) 0) (= (first e) (quote lua-ret))))) (define lua-return-value (fn (e) (if (> (len e) 1) (nth e 1) nil))) (define lua-break-sentinel? (fn (e) (and (= (type-of e) "list") (> (len e) 0) (= (first e) (quote lua-brk))))) (define dofile (fn (&rest args) nil)) (define loadfile (fn (&rest args) nil))