2209 lines
70 KiB
Plaintext
2209 lines
70 KiB
Plaintext
(define lua-truthy? (fn (v) (let ((v1 (if (and (= (type-of v) "list") (> (len v) 0) (= (first v) (quote lua-multi))) (if (> (len v) 1) (nth v 1) nil) v))) (and (not (= v1 nil)) (not (= v1 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)
|
||
(let ((a (lua-first a)) (b (lua-first 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)
|
||
(let ((a (lua-first a)) (b (lua-first 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)
|
||
(let ((a (lua-first a)) (b (lua-first 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
|
||
(when (not (= (nth v i) nil))
|
||
(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
|
||
(when (not (= val nil))
|
||
(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)
|
||
((= (type-of t) "string") (lua-get string k))
|
||
((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
|
||
((= v nil)
|
||
(when (has-key? t key) (dict-delete! t key)))
|
||
((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)
|
||
(dict-set! coroutine "running" (fn () __current-co))
|
||
(dict-set! coroutine "isyieldable" (fn () (not (= __current-co nil))))
|
||
|
||
;; ── 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-set-end
|
||
(fn (pat pat-pos)
|
||
(let ((i (+ pat-pos 1)))
|
||
(begin
|
||
(when (and (< i (len pat)) (= (char-at pat i) "^"))
|
||
(set! i (+ i 1)))
|
||
(when (and (< i (len pat)) (= (char-at pat i) "]"))
|
||
(set! i (+ i 1)))
|
||
(define
|
||
se-loop
|
||
(fn ()
|
||
(when (< i (len pat))
|
||
(let ((c (char-at pat i)))
|
||
(cond
|
||
((= c "]") nil)
|
||
((= c "%")
|
||
(begin (set! i (+ i 2)) (se-loop)))
|
||
(else
|
||
(begin (set! i (+ i 1)) (se-loop))))))))
|
||
(se-loop)
|
||
i))))
|
||
|
||
(define
|
||
lua-pat-atom-len
|
||
(fn (pat pat-pos)
|
||
(cond
|
||
((>= pat-pos (len pat)) 0)
|
||
((= (char-at pat pat-pos) "%") 2)
|
||
((= (char-at pat pat-pos) "[")
|
||
(let ((end (lua-pat-set-end pat pat-pos)))
|
||
(- (+ end 1) pat-pos)))
|
||
(else 1))))
|
||
|
||
(define
|
||
lua-pat-set-match
|
||
(fn (pat set-start sc)
|
||
(let ((i (+ set-start 1)) (negated false) (matched false))
|
||
(begin
|
||
(when (and (< i (len pat)) (= (char-at pat i) "^"))
|
||
(begin (set! negated true) (set! i (+ i 1))))
|
||
(define
|
||
sm-loop
|
||
(fn ()
|
||
(when (and (< i (len pat)) (not (= (char-at pat i) "]")))
|
||
(let ((c (char-at pat i)))
|
||
(cond
|
||
((= c "%")
|
||
(cond
|
||
((< (+ i 1) (len pat))
|
||
(begin
|
||
(when (lua-pat-class-match (char-at pat (+ i 1)) sc)
|
||
(set! matched true))
|
||
(set! i (+ i 2))
|
||
(sm-loop)))
|
||
(else (set! i (+ i 1)))))
|
||
((and (< (+ i 2) (len pat)) (= (char-at pat (+ i 1)) "-") (not (= (char-at pat (+ i 2)) "]")))
|
||
(begin
|
||
(when (and (>= sc c) (<= sc (char-at pat (+ i 2))))
|
||
(set! matched true))
|
||
(set! i (+ i 3))
|
||
(sm-loop)))
|
||
(else
|
||
(begin
|
||
(when (= sc c) (set! matched true))
|
||
(set! i (+ i 1))
|
||
(sm-loop))))))))
|
||
(sm-loop)
|
||
(if negated (not matched) matched)))))
|
||
|
||
(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))))
|
||
((= pc "[") (lua-pat-set-match pat pat-pos 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-raw (if (> (len args) 1) (nth args 1) nil))
|
||
(j-raw (if (> (len args) 2) (nth args 2) nil)))
|
||
(let ((i (if (= i-raw nil) 1 i-raw)))
|
||
(let ((j (if (= j-raw nil) i j-raw)))
|
||
(let ((slen (len s)))
|
||
(let ((ni (cond ((< i 0) (+ slen i 1)) ((= i 0) 1) (else i)))
|
||
(nj (cond ((< j 0) (+ slen j 1)) (else j))))
|
||
(cond
|
||
((or (< ni 1) (> ni slen) (< nj ni)) nil)
|
||
((= ni nj) (char-code (char-at s (- ni 1))))
|
||
(else
|
||
(let ((out (list (quote lua-multi))))
|
||
(begin
|
||
(define
|
||
b-loop
|
||
(fn (k)
|
||
(when (and (<= k nj) (<= k slen))
|
||
(begin
|
||
(set! out (append out (list (char-code (char-at s (- k 1))))))
|
||
(b-loop (+ k 1))))))
|
||
(b-loop ni)
|
||
out)))))))))))
|
||
|
||
(define __lua-ctrl-32 "
|
||
|
||
")
|
||
|
||
(define __lua-127-255 "<><7F><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>")
|
||
|
||
(define
|
||
lua-char-one
|
||
(fn (n)
|
||
(cond
|
||
((= n 9) "\t")
|
||
((= n 10) "\n")
|
||
((= n 13) "\r")
|
||
((and (>= n 0) (< n 32)) (char-at __lua-ctrl-32 n))
|
||
((and (>= n 32) (<= n 126)) (char-at __ascii-32-126 (- n 32)))
|
||
((and (>= n 127) (<= n 255)) (char-at __lua-127-255 (- n 127)))
|
||
(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-fmt-pad
|
||
(fn (s width left-align zero-pad)
|
||
(let ((diff (- width (len s))))
|
||
(cond
|
||
((<= diff 0) s)
|
||
(else
|
||
(let ((pad (lua-string-rep (if (and zero-pad (not left-align)) "0" " ") diff)))
|
||
(if left-align (str s pad) (str pad s))))))))
|
||
|
||
(define
|
||
lua-fmt-int-base
|
||
(fn (n base upper)
|
||
(cond
|
||
((= n 0) "0")
|
||
(else
|
||
(let ((sign "") (v n) (out ""))
|
||
(begin
|
||
(when (< v 0) (begin (set! sign "-") (set! v (- 0 v))))
|
||
(set! v (floor v))
|
||
(define
|
||
ib-loop
|
||
(fn ()
|
||
(when (> v 0)
|
||
(let ((d (- v (* base (floor (/ v base))))))
|
||
(let ((c (cond
|
||
((< d 10) (char-at "0123456789" d))
|
||
(upper (char-at "ABCDEFGHIJKLMNOP" (- d 10)))
|
||
(else (char-at "abcdefghijklmnop" (- d 10))))))
|
||
(begin (set! out (str c out)) (set! v (floor (/ v base))) (ib-loop)))))))
|
||
(ib-loop)
|
||
(str sign out)))))))
|
||
|
||
(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 ((j (+ i 1)) (left-align false) (zero-pad false) (width 0) (prec -1))
|
||
(begin
|
||
(when (and (< j (len fmt)) (= (char-at fmt j) "-"))
|
||
(begin (set! left-align true) (set! j (+ j 1))))
|
||
(when (and (< j (len fmt)) (= (char-at fmt j) "0"))
|
||
(begin (set! zero-pad true) (set! j (+ j 1))))
|
||
(define
|
||
wd-loop
|
||
(fn ()
|
||
(when (and (< j (len fmt)) (>= (char-at fmt j) "0") (<= (char-at fmt j) "9"))
|
||
(begin
|
||
(set! width (+ (* width 10) (- (char-code (char-at fmt j)) (char-code "0"))))
|
||
(set! j (+ j 1))
|
||
(wd-loop)))))
|
||
(wd-loop)
|
||
(when (and (< j (len fmt)) (= (char-at fmt j) "."))
|
||
(begin
|
||
(set! prec 0)
|
||
(set! j (+ j 1))
|
||
(define
|
||
pr-loop
|
||
(fn ()
|
||
(when (and (< j (len fmt)) (>= (char-at fmt j) "0") (<= (char-at fmt j) "9"))
|
||
(begin
|
||
(set! prec (+ (* prec 10) (- (char-code (char-at fmt j)) (char-code "0"))))
|
||
(set! j (+ j 1))
|
||
(pr-loop)))))
|
||
(pr-loop)))
|
||
(when (< j (len fmt))
|
||
(let ((spec (char-at fmt j)))
|
||
(cond
|
||
((= spec "%")
|
||
(begin (set! out (str out "%")) (set! i (+ j 1))))
|
||
((= spec "s")
|
||
(let ((v (lua-concat-coerce (nth vals vi))))
|
||
(let ((vt (if (and (>= prec 0) (< prec (len v))) (substring v 0 prec) v)))
|
||
(begin
|
||
(set! out (str out (lua-fmt-pad vt width left-align false)))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1))))))
|
||
((= spec "d")
|
||
(let ((v (lua-fmt-int-base (lua-to-number (nth vals vi)) 10 false)))
|
||
(begin
|
||
(set! out (str out (lua-fmt-pad v width left-align zero-pad)))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1)))))
|
||
((= spec "x")
|
||
(let ((v (lua-fmt-int-base (lua-to-number (nth vals vi)) 16 false)))
|
||
(begin
|
||
(set! out (str out (lua-fmt-pad v width left-align zero-pad)))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1)))))
|
||
((= spec "X")
|
||
(let ((v (lua-fmt-int-base (lua-to-number (nth vals vi)) 16 true)))
|
||
(begin
|
||
(set! out (str out (lua-fmt-pad v width left-align zero-pad)))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1)))))
|
||
((= spec "o")
|
||
(let ((v (lua-fmt-int-base (lua-to-number (nth vals vi)) 8 false)))
|
||
(begin
|
||
(set! out (str out (lua-fmt-pad v width left-align zero-pad)))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1)))))
|
||
((= spec "f")
|
||
(let ((v (str (lua-to-number (nth vals vi)))))
|
||
(begin
|
||
(set! out (str out (lua-fmt-pad v width left-align zero-pad)))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1)))))
|
||
((= spec "c")
|
||
(let ((v (lua-char-one (lua-to-number (nth vals vi)))))
|
||
(begin
|
||
(set! out (str out v))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1)))))
|
||
((= spec "q")
|
||
(let ((v (str "\"" (lua-concat-coerce (nth vals vi)) "\"")))
|
||
(begin
|
||
(set! out (str out v))
|
||
(set! vi (+ vi 1))
|
||
(set! i (+ j 1)))))
|
||
(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)
|
||
(dict-set! string "dump" (fn (&rest args) (str (first args))))
|
||
(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-num
|
||
(fn (name x)
|
||
(let ((n (lua-to-number x)))
|
||
(cond
|
||
((= n nil) (error (str "bad argument to '" name "' (number expected)")))
|
||
(else n)))))
|
||
|
||
(define lua-math-abs (fn (x) (abs (lua-math-num "abs" x))))
|
||
(define lua-math-ceil (fn (x) (ceil (lua-math-num "ceil" x))))
|
||
(define lua-math-floor (fn (x) (floor (lua-math-num "floor" x))))
|
||
(define lua-math-sqrt (fn (x) (sqrt (lua-math-num "sqrt" x))))
|
||
(define lua-math-exp (fn (x) (exp (lua-math-num "exp" x))))
|
||
(define lua-math-sin (fn (x) (sin (lua-math-num "sin" x))))
|
||
(define lua-math-cos (fn (x) (cos (lua-math-num "cos" x))))
|
||
(define lua-math-tan (fn (x) (tan (lua-math-num "tan" x))))
|
||
(define lua-math-asin (fn (x) (asin (lua-math-num "asin" x))))
|
||
(define lua-math-acos (fn (x) (acos (lua-math-num "acos" x))))
|
||
(define lua-math-atan (fn (x) (atan (lua-math-num "atan" x))))
|
||
(define lua-math-atan2 (fn (y x) (atan2 (lua-math-num "atan2" y) (lua-math-num "atan2" x))))
|
||
(define lua-math-pow (fn (a b) (pow (lua-math-num "pow" a) (lua-math-num "pow" b))))
|
||
(define lua-math-sinh (fn (x) (sinh (lua-math-num "sinh" x))))
|
||
(define lua-math-cosh (fn (x) (cosh (lua-math-num "cosh" x))))
|
||
(define lua-math-tanh (fn (x) (tanh (lua-math-num "tanh" x))))
|
||
|
||
(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 "sinh" lua-math-sinh)
|
||
(dict-set! math "cosh" lua-math-cosh)
|
||
(dict-set! math "tanh" lua-math-tanh)
|
||
(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 "mod" lua-math-fmod)
|
||
(define
|
||
lua-math-frexp
|
||
(fn (x)
|
||
(cond
|
||
((= x 0) (list (quote lua-multi) 0 0))
|
||
(else
|
||
(let ((sign (if (< x 0) -1 1)) (ax (abs x)) (e 0))
|
||
(begin
|
||
(define
|
||
fr-up
|
||
(fn ()
|
||
(when (>= ax 1)
|
||
(begin (set! ax (/ ax 2)) (set! e (+ e 1)) (fr-up)))))
|
||
(define
|
||
fr-dn
|
||
(fn ()
|
||
(when (< ax 0.5)
|
||
(begin (set! ax (* ax 2)) (set! e (- e 1)) (fr-dn)))))
|
||
(fr-up)
|
||
(fr-dn)
|
||
(list (quote lua-multi) (* sign ax) e)))))))
|
||
|
||
(define
|
||
lua-math-ldexp
|
||
(fn (m e) (* m (pow 2 e))))
|
||
|
||
(dict-set! math "frexp" lua-math-frexp)
|
||
(dict-set! math "ldexp" lua-math-ldexp)
|
||
(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)))
|
||
(let ((i-raw (if (> (len args) 1) (nth args 1) nil))
|
||
(j-raw (if (> (len args) 2) (nth args 2) nil)))
|
||
(let ((i (if (= i-raw nil) 1 i-raw))
|
||
(j (if (= j-raw nil) (lua-len t) j-raw)))
|
||
(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-parse-int-base
|
||
(fn (s base)
|
||
(let ((trimmed (trim s)) (neg false) (i 0) (n 0) (valid false))
|
||
(begin
|
||
(when (and (> (len trimmed) 0) (= (char-at trimmed 0) "-"))
|
||
(begin (set! neg true) (set! i 1)))
|
||
(when (and (> (len trimmed) i) (= (char-at trimmed i) "+"))
|
||
(set! i (+ i 1)))
|
||
(define
|
||
pi-loop
|
||
(fn ()
|
||
(when (< i (len trimmed))
|
||
(let ((c (char-at trimmed i)))
|
||
(let ((d (cond
|
||
((and (>= c "0") (<= c "9")) (- (char-code c) (char-code "0")))
|
||
((and (>= c "a") (<= c "z")) (+ 10 (- (char-code c) (char-code "a"))))
|
||
((and (>= c "A") (<= c "Z")) (+ 10 (- (char-code c) (char-code "A"))))
|
||
(else -1))))
|
||
(cond
|
||
((or (< d 0) (>= d base)) (set! i (len trimmed)))
|
||
(else
|
||
(begin
|
||
(set! n (+ (* n base) d))
|
||
(set! valid true)
|
||
(set! i (+ i 1))
|
||
(pi-loop)))))))))
|
||
(pi-loop)
|
||
(cond
|
||
((not valid) nil)
|
||
((< i (len trimmed)) nil)
|
||
(neg (- 0 n))
|
||
(else n))))))
|
||
|
||
(define
|
||
lua-tonumber
|
||
(fn (&rest args)
|
||
(let ((v (first args))
|
||
(base (if (> (len args) 1) (nth args 1) nil)))
|
||
(cond
|
||
((not (= base nil))
|
||
(cond
|
||
((= (type-of v) "string") (lua-parse-int-base v base))
|
||
(else nil)))
|
||
((= (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"))
|
||
(list (make-symbol "let")
|
||
(list (list (make-symbol "__varargs")
|
||
(list (make-symbol "lua-varargs")
|
||
(make-symbol "__args") 0)))
|
||
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 (if (< n 0)
|
||
(+ (len rest-args) 1 n -1)
|
||
(- 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 nil)
|
||
|
||
;; 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))
|
||
|
||
;; Populate _G with the standard Lua 5.1 global environment.
|
||
;; _G must be non-empty so that next(_G) returns a key-value pair.
|
||
(dict-set! _G "assert" assert)
|
||
(dict-set! _G "collectgarbage" collectgarbage)
|
||
(dict-set! _G "dofile" dofile)
|
||
(dict-set! _G "error" error)
|
||
(dict-set! _G "getfenv" getfenv)
|
||
(dict-set! _G "getmetatable" getmetatable)
|
||
(dict-set! _G "ipairs" ipairs)
|
||
(dict-set! _G "load" load)
|
||
(dict-set! _G "loadfile" loadfile)
|
||
(dict-set! _G "loadstring" loadstring)
|
||
(dict-set! _G "next" next)
|
||
(dict-set! _G "pairs" pairs)
|
||
(dict-set! _G "pcall" pcall)
|
||
(dict-set! _G "print" print)
|
||
(dict-set! _G "rawequal" rawequal)
|
||
(dict-set! _G "rawget" rawget)
|
||
(dict-set! _G "rawset" rawset)
|
||
(dict-set! _G "require" require)
|
||
(dict-set! _G "select" select)
|
||
(dict-set! _G "setfenv" setfenv)
|
||
(dict-set! _G "setmetatable" setmetatable)
|
||
(dict-set! _G "tonumber" tonumber)
|
||
(dict-set! _G "tostring" tostring)
|
||
(dict-set! _G "type" type)
|
||
(dict-set! _G "unpack" unpack)
|
||
(dict-set! _G "xpcall" xpcall)
|
||
(dict-set! _G "string" string)
|
||
(dict-set! _G "table" table)
|
||
(dict-set! _G "math" math)
|
||
(dict-set! _G "io" io)
|
||
(dict-set! _G "os" os)
|
||
(dict-set! _G "coroutine" coroutine)
|
||
(dict-set! _G "package" package)
|
||
(dict-set! _G "debug" debug)
|
||
(dict-set! _G "_VERSION" _VERSION)
|
||
(dict-set! _G "_G" _G)
|
||
;; Soft mode: skip tests that require io/os/C facilities
|
||
(dict-set! _G "_soft" true)
|