Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
994 lines
28 KiB
Plaintext
994 lines
28 KiB
Plaintext
(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 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 b)
|
|
(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)
|
|
(cond
|
|
((= (type-of v) "string") v)
|
|
((= (type-of v) "number") (str v))
|
|
(else (error (str "lua: cannot concat " v))))))
|
|
|
|
(define
|
|
lua-concat
|
|
(fn
|
|
(a b)
|
|
(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")
|
|
(begin
|
|
(set! t (assoc t (str array-idx) (nth f 1)))
|
|
(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-apply
|
|
(fn
|
|
(f rargs)
|
|
(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 ────────────────────────────────────────────
|
|
(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)))
|
|
(let ((start-i (cond
|
|
((< init 0) (+ (len s) init 1))
|
|
((= init 0) 1)
|
|
(else init))))
|
|
(let ((sub (if (<= start-i 1) s (substring s (- start-i 1) (len s)))))
|
|
(let ((idx (index-of sub pat)))
|
|
(cond
|
|
((< idx 0) nil)
|
|
(else
|
|
(list
|
|
(quote lua-multi)
|
|
(+ start-i idx)
|
|
(+ start-i idx (len pat) -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)))
|
|
(let ((idx (index-of s pat)))
|
|
(cond
|
|
((< idx 0) nil)
|
|
(else pat))))))
|
|
|
|
;; 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 ((rest-str (if (= pos 0) s (substring s pos (len s)))))
|
|
(let ((idx (index-of rest-str pat)))
|
|
(cond
|
|
((< idx 0) (begin (set! pos (+ (len s) 1)) nil))
|
|
(else
|
|
(begin
|
|
(set! pos (+ pos idx (len pat)))
|
|
pat)))))))))))
|
|
|
|
;; 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
|
|
loop
|
|
(fn ()
|
|
(when (and (not done) (<= pos (len s)))
|
|
(let ((rest-str (if (= pos 0) s (substring s pos (len s)))))
|
|
(let ((idx (index-of rest-str pat)))
|
|
(cond
|
|
((< idx 0)
|
|
(begin
|
|
(set! out (str out rest-str))
|
|
(set! done true)))
|
|
((and (>= max-n 0) (>= count max-n))
|
|
(begin
|
|
(set! out (str out rest-str))
|
|
(set! done true)))
|
|
(else
|
|
(let ((before (substring rest-str 0 idx)))
|
|
(begin
|
|
(set! out (str out before (if (= (type-of repl) "string") repl (str repl))))
|
|
(set! pos (+ pos idx (len pat)))
|
|
(set! count (+ count 1))
|
|
(loop))))))))))
|
|
(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)
|
|
|
|
;; ── 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)
|