(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-call (fn (&rest args) (let ((f (first args)) (rargs (rest args))) (cond ((or (= (type-of f) "function") (= (type-of f) "lambda")) (sx-apply-ref f rargs)) ((= (type-of f) "dict") (let ((m (lua-get-mm f "__call"))) (cond ((= m nil) (error "lua: attempt to call non-function")) (else (sx-apply-ref m (cons f rargs)))))) (else (error "lua: attempt to call non-function"))))))