lua: string metatable, high-byte chars, multi-return truthy, perf
This commit is contained in:
@@ -1,4 +1,4 @@
|
||||
(define lua-truthy? (fn (v) (and (not (= v nil)) (not (= v false)))))
|
||||
(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
|
||||
@@ -151,18 +151,19 @@
|
||||
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))))
|
||||
(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))))
|
||||
|
||||
@@ -170,44 +171,46 @@
|
||||
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")))))))))))
|
||||
(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)
|
||||
(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))))))))))))
|
||||
(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)))
|
||||
|
||||
@@ -271,14 +274,16 @@
|
||||
(fn (i)
|
||||
(when (< i (len v))
|
||||
(begin
|
||||
(set! t (assoc t (str array-idx) (nth v i)))
|
||||
(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
|
||||
(set! t (assoc t (str array-idx) val))
|
||||
(when (not (= val nil))
|
||||
(set! t (assoc t (str array-idx) val)))
|
||||
(set! array-idx (+ array-idx 1))))))))
|
||||
((= (first f) "kv")
|
||||
(let
|
||||
@@ -294,6 +299,7 @@
|
||||
(t k)
|
||||
(cond
|
||||
((= t nil) nil)
|
||||
((= (type-of t) "string") (lua-get string k))
|
||||
((not (= (type-of t) "dict")) nil)
|
||||
(else
|
||||
(let
|
||||
@@ -315,6 +321,8 @@
|
||||
(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
|
||||
@@ -1015,14 +1023,21 @@
|
||||
(b-loop ni)
|
||||
out)))))))))))
|
||||
|
||||
(define __lua-ctrl-32 "
|
||||
|
||||
")
|
||||
|
||||
(define __lua-127-255 "€<7F>‚ƒ„…†‡ˆ‰Š‹Œ<E280B9>Ž<EFBFBD><C5BD>‘’“”•–—˜™š›œ<E280BA>žŸ ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
|
||||
|
||||
(define
|
||||
lua-char-one
|
||||
(fn (n)
|
||||
((= n 9) "\t")
|
||||
(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))))))
|
||||
|
||||
@@ -1999,7 +2014,14 @@
|
||||
(list
|
||||
(list (make-symbol "lua-return-sentinel?") (make-symbol "e"))
|
||||
(list (make-symbol "lua-return-value") (make-symbol "e"))))
|
||||
(let ((wrapped (list (make-symbol "fn") (list (make-symbol "&rest") (make-symbol "__args")) guarded)))
|
||||
(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)))))))
|
||||
|
||||
@@ -2015,7 +2037,9 @@
|
||||
(let ((n (first args)) (rest-args (rest args)))
|
||||
(cond
|
||||
((= n "#") (len rest-args))
|
||||
(let ((i (- n 1)))
|
||||
((= (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"))
|
||||
@@ -2075,7 +2099,7 @@
|
||||
(dict-set! __package-loaded "coroutine" coroutine)
|
||||
(dict-set! __package-loaded "package" package)
|
||||
(dict-set! __package-loaded "_G" _G)
|
||||
(define arg {})
|
||||
|
||||
(define arg nil)
|
||||
|
||||
;; preload debug stub
|
||||
@@ -2141,3 +2165,44 @@
|
||||
(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
|
||||
|
||||
Reference in New Issue
Block a user