(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-add (fn (a b) (lua-num-op "+" a b))) (define lua-sub (fn (a b) (lua-num-op "-" a b))) (define lua-mul (fn (a b) (lua-num-op "*" a b))) (define lua-div (fn (a b) (lua-num-op "/" a b))) (define lua-mod (fn (a b) (lua-num-op "%" a b))) (define lua-pow (fn (a b) (lua-num-op "^" a b))) (define lua-neg (fn (a) (let ((na (lua-to-number a))) (begin (when (= na nil) (error (str "lua: neg on non-number: " a))) (- 0 na))))) (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) (let ((sa (lua-concat-coerce a)) (sb (lua-concat-coerce b))) (str sa sb)))) (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) (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 (error "lua: attempt to compare incompatible types"))))) (define lua-le (fn (a b) (or (lua-lt a b) (lua-eq a b)))) (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 ((n 0)) (begin (define count-loop (fn (i) (if (not (= (get a (str i)) nil)) (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) (if (= t nil) nil (let ((v (get t (str k)))) (if (= v nil) nil v))))) (define lua-set! (fn (t k v) (assoc t (str k) v))) ;; --------------------------------------------------------------------------- ;; Helpers for stdlib ;; --------------------------------------------------------------------------- ;; Apply a char function to every character in a string (define (lua-str-map s fn) (list->string (map fn (string->list s)))) ;; Repeat string s n times (define (lua-str-rep s n) (letrec ((go (fn (acc i) (if (= i 0) acc (go (str acc s) (- i 1)))))) (go "" n))) ;; Force a promise created by delay (define (lua-force p) (if (and (dict? p) (get p :_promise)) (if (get p :forced) (get p :value) ((get p :thunk))) p)) ;; --------------------------------------------------------------------------- ;; math — Lua math library ;; --------------------------------------------------------------------------- (define math {:asin asin :floor floor :exp exp :huge 1e+308 :tan tan :sqrt sqrt :log log :abs abs :ceil ceil :sin sin :max (fn (a b) (if (> a b) a b)) :acos acos :min (fn (a b) (if (< a b) a b)) :cos cos :pi 3.14159 :atan atan}) ;; --------------------------------------------------------------------------- ;; string — Lua string library ;; --------------------------------------------------------------------------- (define (lua-string-find s pat) (let ((m (regexp-match (make-regexp pat) s))) (if (= m nil) nil (list (+ (get m :start) 1) (get m :end))))) (define (lua-string-match s pat) (let ((m (regexp-match (make-regexp pat) s))) (if (= m nil) nil (let ((groups (get m :groups))) (if (= (len groups) 0) (get m :match) (first groups)))))) (define (lua-string-gmatch s pat) (map (fn (m) (get m :match)) (regexp-match-all (make-regexp pat) s))) (define (lua-string-gsub s pat repl) (regexp-replace-all (make-regexp pat) s repl)) (define string {:rep lua-str-rep :sub (fn (s i &rest j-args) (let ((slen (len s)) (j (if (= (len j-args) 0) -1 (first j-args)))) (let ((from (if (< i 0) (let ((r (+ slen i))) (if (< r 0) 0 r)) (- i 1))) (to (if (< j 0) (let ((r (+ slen j 1))) (if (< r 0) 0 r)) (if (> j slen) slen j)))) (if (> from to) "" (substring s from to))))) :len (fn (s) (len s)) :upper (fn (s) (lua-str-map s char-upcase)) :char (fn (&rest codes) (list->string (map (fn (c) (integer->char (truncate c))) codes))) :gmatch lua-string-gmatch :gsub lua-string-gsub :lower (fn (s) (lua-str-map s char-downcase)) :byte (fn (s &rest args) (char->integer (nth (string->list s) (- (if (= (len args) 0) 1 (first args)) 1)))) :match lua-string-match :find lua-string-find :reverse (fn (s) (list->string (reverse (string->list s))))}) ;; --------------------------------------------------------------------------- ;; table — Lua table library ;; --------------------------------------------------------------------------- (define (lua-table-insert t v) (assoc t (str (+ (lua-len t) 1)) v)) (define (lua-table-remove t &rest args) (let ((n (lua-len t)) (pos (if (= (len args) 0) (lua-len t) (first args)))) (letrec ((slide (fn (t i) (if (< i n) (assoc (slide t (+ i 1)) (str i) (lua-get t (+ i 1))) (assoc t (str n) nil))))) (slide t pos)))) (define (lua-table-concat t &rest args) (let ((sep (if (= (len args) 0) "" (first args))) (n (lua-len t))) (letrec ((go (fn (acc i) (if (> i n) acc (go (str acc (if (= i 1) "" sep) (lua-to-string (lua-get t i))) (+ i 1)))))) (go "" 1)))) (define (lua-table-sort t) (let ((n (lua-len t))) (letrec ((collect (fn (i acc) (if (< i 1) acc (collect (- i 1) (cons (lua-get t i) acc))))) (rebuild (fn (t i items) (if (= (len items) 0) t (rebuild (assoc t (str i) (first items)) (+ i 1) (rest items)))))) (rebuild t 1 (sort (collect n (list))))))) (define table {:sort lua-table-sort :concat lua-table-concat :insert lua-table-insert :remove lua-table-remove})