Salvaged from worktree-agent-* branches killed during sx-tree MCP outage: - lua: tokenizer + parser + phase-2 transpile (~157 tests) - prolog: tokenizer + parser + unification (72 tests, plan update lost to WIP) - forth: phase-1 reader/interpreter + phase-2 colon/VARIABLE (134 tests) - erlang: tokenizer + parser (114 tests) - haskell: tokenizer + parse tests (43 tests) Cherry-picked file contents only, not branch history, to avoid pulling in unrelated ocaml-vm merge commits that were in those branches' bases.
172 lines
3.9 KiB
Plaintext
172 lines
3.9 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-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
|
|
(has? 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)
|
|
(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)))
|