rose-ash/lib/lua/runtime.sx

(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})