Compare commits
2 Commits
loops/comm
...
loops/ruby
| Author | SHA1 | Date | |
|---|---|---|---|
| 15eb133311 | |||
| 96019e9fe8 |
@@ -1,578 +0,0 @@
|
|||||||
;; Common Lisp evaluator — evaluates CL AST forms.
|
|
||||||
;;
|
|
||||||
;; Depends on: lib/common-lisp/reader.sx, lib/common-lisp/parser.sx
|
|
||||||
;;
|
|
||||||
;; Environment:
|
|
||||||
;; {:vars {"NAME" val ...} :fns {"NAME" cl-fn ...}}
|
|
||||||
;; CL function:
|
|
||||||
;; {:cl-type "function" :params ll :body forms :env env}
|
|
||||||
;;
|
|
||||||
;; Public API:
|
|
||||||
;; (cl-make-env) — create empty environment
|
|
||||||
;; (cl-eval form env) — evaluate one CL AST form
|
|
||||||
;; (cl-eval-str src env) — read+eval a CL source string
|
|
||||||
;; (cl-eval-all-str src env) — read-all+eval-each, return last
|
|
||||||
;; cl-global-env — global mutable environment
|
|
||||||
|
|
||||||
;; ── environment ──────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-make-env (fn () {:vars {} :fns {}}))
|
|
||||||
|
|
||||||
(define cl-global-env (cl-make-env))
|
|
||||||
|
|
||||||
(define cl-env-get-var (fn (env name) (get (get env "vars") name)))
|
|
||||||
(define cl-env-has-var? (fn (env name) (has-key? (get env "vars") name)))
|
|
||||||
(define cl-env-get-fn (fn (env name) (get (get env "fns") name)))
|
|
||||||
(define cl-env-has-fn? (fn (env name) (has-key? (get env "fns") name)))
|
|
||||||
|
|
||||||
(define cl-env-bind-var
|
|
||||||
(fn (env name value)
|
|
||||||
{:vars (assoc (get env "vars") name value)
|
|
||||||
:fns (get env "fns")}))
|
|
||||||
|
|
||||||
(define cl-env-bind-fn
|
|
||||||
(fn (env name fn-obj)
|
|
||||||
{:vars (get env "vars")
|
|
||||||
:fns (assoc (get env "fns") name fn-obj)}))
|
|
||||||
|
|
||||||
;; ── body evaluation ───────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-eval-body
|
|
||||||
(fn (forms env)
|
|
||||||
(cond
|
|
||||||
((= (len forms) 0) nil)
|
|
||||||
((= (len forms) 1) (cl-eval (nth forms 0) env))
|
|
||||||
(:else
|
|
||||||
(do
|
|
||||||
(cl-eval (nth forms 0) env)
|
|
||||||
(cl-eval-body (rest forms) env))))))
|
|
||||||
|
|
||||||
;; ── lambda-list binding helpers ───────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-bind-required
|
|
||||||
(fn (names args env)
|
|
||||||
(if (= (len names) 0)
|
|
||||||
env
|
|
||||||
(cl-bind-required
|
|
||||||
(rest names)
|
|
||||||
(if (> (len args) 0) (rest args) args)
|
|
||||||
(cl-env-bind-var env
|
|
||||||
(nth names 0)
|
|
||||||
(if (> (len args) 0) (nth args 0) nil))))))
|
|
||||||
|
|
||||||
;; returns {:env e :rest remaining-args}
|
|
||||||
(define cl-bind-optional
|
|
||||||
(fn (opts args env)
|
|
||||||
(if (= (len opts) 0)
|
|
||||||
{:env env :rest args}
|
|
||||||
(let ((spec (nth opts 0))
|
|
||||||
(has-val (> (len args) 0)))
|
|
||||||
(let ((val (if has-val (nth args 0) nil))
|
|
||||||
(rem (if has-val (rest args) args)))
|
|
||||||
(let ((e1 (cl-env-bind-var env (get spec "name")
|
|
||||||
(if has-val val
|
|
||||||
(if (get spec "default")
|
|
||||||
(cl-eval (get spec "default") env) nil)))))
|
|
||||||
(let ((e2 (if (get spec "supplied")
|
|
||||||
(cl-env-bind-var e1 (get spec "supplied") has-val)
|
|
||||||
e1)))
|
|
||||||
(cl-bind-optional (rest opts) rem e2))))))))
|
|
||||||
|
|
||||||
;; returns {:found bool :value v}
|
|
||||||
(define cl-find-kw-arg
|
|
||||||
(fn (kw args i)
|
|
||||||
(if (>= i (len args))
|
|
||||||
{:found false :value nil}
|
|
||||||
(let ((a (nth args i)))
|
|
||||||
(if (and (dict? a)
|
|
||||||
(= (get a "cl-type") "keyword")
|
|
||||||
(= (get a "name") kw))
|
|
||||||
{:found true
|
|
||||||
:value (if (< (+ i 1) (len args)) (nth args (+ i 1)) nil)}
|
|
||||||
(cl-find-kw-arg kw args (+ i 2)))))))
|
|
||||||
|
|
||||||
(define cl-bind-key
|
|
||||||
(fn (key-specs all-args env)
|
|
||||||
(if (= (len key-specs) 0)
|
|
||||||
env
|
|
||||||
(let ((spec (nth key-specs 0))
|
|
||||||
(r (cl-find-kw-arg (get (nth key-specs 0) "keyword") all-args 0)))
|
|
||||||
(let ((found (get r "found"))
|
|
||||||
(kval (get r "value")))
|
|
||||||
(let ((e1 (cl-env-bind-var env (get spec "name")
|
|
||||||
(if found kval
|
|
||||||
(if (get spec "default")
|
|
||||||
(cl-eval (get spec "default") env) nil)))))
|
|
||||||
(let ((e2 (if (get spec "supplied")
|
|
||||||
(cl-env-bind-var e1 (get spec "supplied") found)
|
|
||||||
e1)))
|
|
||||||
(cl-bind-key (rest key-specs) all-args e2))))))))
|
|
||||||
|
|
||||||
(define cl-bind-aux
|
|
||||||
(fn (aux-specs env)
|
|
||||||
(if (= (len aux-specs) 0)
|
|
||||||
env
|
|
||||||
(let ((spec (nth aux-specs 0)))
|
|
||||||
(cl-bind-aux
|
|
||||||
(rest aux-specs)
|
|
||||||
(cl-env-bind-var env (get spec "name")
|
|
||||||
(if (get spec "init") (cl-eval (get spec "init") env) nil)))))))
|
|
||||||
|
|
||||||
;; ── function creation ─────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; ll-and-body: (list lambda-list-form body-form ...)
|
|
||||||
(define cl-make-lambda
|
|
||||||
(fn (ll-and-body env)
|
|
||||||
{:cl-type "function"
|
|
||||||
:params (cl-parse-lambda-list (nth ll-and-body 0))
|
|
||||||
:body (rest ll-and-body)
|
|
||||||
:env env}))
|
|
||||||
|
|
||||||
;; ── function application ──────────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-apply
|
|
||||||
(fn (fn-obj args)
|
|
||||||
(cond
|
|
||||||
((and (dict? fn-obj) (has-key? fn-obj "builtin-fn"))
|
|
||||||
((get fn-obj "builtin-fn") args))
|
|
||||||
((or (not (dict? fn-obj)) (not (= (get fn-obj "cl-type") "function")))
|
|
||||||
{:cl-type "error" :message "Not a function"})
|
|
||||||
(:else
|
|
||||||
(let ((params (get fn-obj "params"))
|
|
||||||
(body (get fn-obj "body"))
|
|
||||||
(cenv (get fn-obj "env")))
|
|
||||||
(let ((req (get params "required"))
|
|
||||||
(opt (get params "optional"))
|
|
||||||
(rest-name (get params "rest"))
|
|
||||||
(key-specs (get params "key"))
|
|
||||||
(aux-specs (get params "aux")))
|
|
||||||
(let ((e1 (cl-bind-required req args cenv)))
|
|
||||||
(let ((opt-r (cl-bind-optional
|
|
||||||
opt (slice args (len req) (len args)) e1)))
|
|
||||||
(let ((e2 (get opt-r "env"))
|
|
||||||
(rem (get opt-r "rest")))
|
|
||||||
(let ((e3 (if rest-name
|
|
||||||
(cl-env-bind-var e2 rest-name rem)
|
|
||||||
e2)))
|
|
||||||
(let ((e4 (cl-bind-key key-specs args e3)))
|
|
||||||
(let ((e5 (cl-bind-aux aux-specs e4)))
|
|
||||||
(cl-eval-body body e5)))))))))))))
|
|
||||||
|
|
||||||
;; ── built-in functions ────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-builtins
|
|
||||||
(dict
|
|
||||||
"+" (fn (args) (reduce (fn (a b) (+ a b)) 0 args))
|
|
||||||
"-" (fn (args)
|
|
||||||
(cond
|
|
||||||
((= (len args) 0) 0)
|
|
||||||
((= (len args) 1) (- 0 (nth args 0)))
|
|
||||||
(:else (reduce (fn (a b) (- a b)) (nth args 0) (rest args)))))
|
|
||||||
"*" (fn (args) (reduce (fn (a b) (* a b)) 1 args))
|
|
||||||
"/" (fn (args)
|
|
||||||
(cond
|
|
||||||
((= (len args) 0) 1)
|
|
||||||
((= (len args) 1) (/ 1 (nth args 0)))
|
|
||||||
(:else (reduce (fn (a b) (/ a b)) (nth args 0) (rest args)))))
|
|
||||||
"1+" (fn (args) (+ (nth args 0) 1))
|
|
||||||
"1-" (fn (args) (- (nth args 0) 1))
|
|
||||||
"=" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
|
||||||
"/=" (fn (args) (if (not (= (nth args 0) (nth args 1))) true nil))
|
|
||||||
"<" (fn (args) (if (< (nth args 0) (nth args 1)) true nil))
|
|
||||||
">" (fn (args) (if (> (nth args 0) (nth args 1)) true nil))
|
|
||||||
"<=" (fn (args) (if (<= (nth args 0) (nth args 1)) true nil))
|
|
||||||
">=" (fn (args) (if (>= (nth args 0) (nth args 1)) true nil))
|
|
||||||
"NOT" (fn (args) (if (nth args 0) nil true))
|
|
||||||
"NULL" (fn (args) (if (= (nth args 0) nil) true nil))
|
|
||||||
"NUMBERP" (fn (args) (if (number? (nth args 0)) true nil))
|
|
||||||
"STRINGP" (fn (args) (if (string? (nth args 0)) true nil))
|
|
||||||
"SYMBOLP" (fn (args) nil)
|
|
||||||
"LISTP" (fn (args)
|
|
||||||
(if (or (list? (nth args 0)) (= (nth args 0) nil)) true nil))
|
|
||||||
"CONSP" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (dict? x) (= (get x "cl-type") "cons")) true nil)))
|
|
||||||
"ATOM" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (dict? x) (= (get x "cl-type") "cons")) nil true)))
|
|
||||||
"FUNCTIONP" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (dict? x) (= (get x "cl-type") "function")) true nil)))
|
|
||||||
"ZEROP" (fn (args) (if (= (nth args 0) 0) true nil))
|
|
||||||
"PLUSP" (fn (args) (if (> (nth args 0) 0) true nil))
|
|
||||||
"MINUSP" (fn (args) (if (< (nth args 0) 0) true nil))
|
|
||||||
"EVENP" (fn (args)
|
|
||||||
(let ((n (nth args 0)))
|
|
||||||
(if (= (mod n 2) 0) true nil)))
|
|
||||||
"ODDP" (fn (args)
|
|
||||||
(let ((n (nth args 0)))
|
|
||||||
(if (not (= (mod n 2) 0)) true nil)))
|
|
||||||
"ABS" (fn (args) (let ((n (nth args 0))) (if (< n 0) (- 0 n) n)))
|
|
||||||
"MAX" (fn (args) (reduce (fn (a b) (if (> a b) a b)) (nth args 0) (rest args)))
|
|
||||||
"MIN" (fn (args) (reduce (fn (a b) (if (< a b) a b)) (nth args 0) (rest args)))
|
|
||||||
"CONS" (fn (args) {:cl-type "cons" :car (nth args 0) :cdr (nth args 1)})
|
|
||||||
"CAR" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (dict? x) (= (get x "cl-type") "cons"))
|
|
||||||
(get x "car")
|
|
||||||
(if (and (list? x) (> (len x) 0)) (nth x 0) nil))))
|
|
||||||
"CDR" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (dict? x) (= (get x "cl-type") "cons"))
|
|
||||||
(get x "cdr")
|
|
||||||
(if (list? x) (rest x) nil))))
|
|
||||||
"LIST" (fn (args) args)
|
|
||||||
"APPEND" (fn (args)
|
|
||||||
(if (= (len args) 0) (list)
|
|
||||||
(reduce (fn (a b)
|
|
||||||
(if (= a nil) b (if (= b nil) a (concat a b))))
|
|
||||||
(list) args)))
|
|
||||||
"LENGTH" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (= x nil) 0 (len x))))
|
|
||||||
"NTH" (fn (args) (nth (nth args 1) (nth args 0)))
|
|
||||||
"FIRST" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (list? x) (> (len x) 0)) (nth x 0) nil)))
|
|
||||||
"SECOND" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (list? x) (> (len x) 1)) (nth x 1) nil)))
|
|
||||||
"THIRD" (fn (args)
|
|
||||||
(let ((x (nth args 0)))
|
|
||||||
(if (and (list? x) (> (len x) 2)) (nth x 2) nil)))
|
|
||||||
"REST" (fn (args) (rest (nth args 0)))
|
|
||||||
"REVERSE" (fn (args)
|
|
||||||
(reduce (fn (acc x) (concat (list x) acc))
|
|
||||||
(list) (nth args 0)))
|
|
||||||
"IDENTITY" (fn (args) (nth args 0))
|
|
||||||
"VALUES" (fn (args) (if (> (len args) 0) (nth args 0) nil))
|
|
||||||
"PRINT" (fn (args) (nth args 0))
|
|
||||||
"PRIN1" (fn (args) (nth args 0))
|
|
||||||
"PRINC" (fn (args) (nth args 0))
|
|
||||||
"TERPRI" (fn (args) nil)
|
|
||||||
"WRITE" (fn (args) (nth args 0))
|
|
||||||
"STRING-UPCASE" (fn (args) (upcase (nth args 0)))
|
|
||||||
"STRING-DOWNCASE" (fn (args) (downcase (nth args 0)))
|
|
||||||
"STRING=" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
|
||||||
"CONCATENATE" (fn (args) (reduce (fn (a b) (str a b)) "" (rest args)))
|
|
||||||
"EQ" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
|
||||||
"EQL" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))
|
|
||||||
"EQUAL" (fn (args) (if (= (nth args 0) (nth args 1)) true nil))))
|
|
||||||
|
|
||||||
;; Register builtins in cl-global-env so (function #'name) resolves them
|
|
||||||
(for-each
|
|
||||||
(fn (name)
|
|
||||||
(dict-set! (get cl-global-env "fns") name
|
|
||||||
{:cl-type "function" :builtin-fn (get cl-builtins name)}))
|
|
||||||
(keys cl-builtins))
|
|
||||||
|
|
||||||
;; ── special form evaluators ───────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-eval-if
|
|
||||||
(fn (args env)
|
|
||||||
(let ((cond-val (cl-eval (nth args 0) env))
|
|
||||||
(then-form (nth args 1))
|
|
||||||
(else-form (if (> (len args) 2) (nth args 2) nil)))
|
|
||||||
(if cond-val
|
|
||||||
(cl-eval then-form env)
|
|
||||||
(if else-form (cl-eval else-form env) nil)))))
|
|
||||||
|
|
||||||
(define cl-eval-and
|
|
||||||
(fn (args env)
|
|
||||||
(if (= (len args) 0)
|
|
||||||
true
|
|
||||||
(let ((val (cl-eval (nth args 0) env)))
|
|
||||||
(if (not val)
|
|
||||||
nil
|
|
||||||
(if (= (len args) 1)
|
|
||||||
val
|
|
||||||
(cl-eval-and (rest args) env)))))))
|
|
||||||
|
|
||||||
(define cl-eval-or
|
|
||||||
(fn (args env)
|
|
||||||
(if (= (len args) 0)
|
|
||||||
nil
|
|
||||||
(let ((val (cl-eval (nth args 0) env)))
|
|
||||||
(if val
|
|
||||||
val
|
|
||||||
(cl-eval-or (rest args) env))))))
|
|
||||||
|
|
||||||
(define cl-eval-cond
|
|
||||||
(fn (clauses env)
|
|
||||||
(if (= (len clauses) 0)
|
|
||||||
nil
|
|
||||||
(let ((clause (nth clauses 0)))
|
|
||||||
(let ((test-val (cl-eval (nth clause 0) env)))
|
|
||||||
(if test-val
|
|
||||||
(if (= (len clause) 1)
|
|
||||||
test-val
|
|
||||||
(cl-eval-body (rest clause) env))
|
|
||||||
(cl-eval-cond (rest clauses) env)))))))
|
|
||||||
|
|
||||||
;; Parallel LET and sequential LET*
|
|
||||||
(define cl-eval-let
|
|
||||||
(fn (args env sequential)
|
|
||||||
(let ((bindings (nth args 0))
|
|
||||||
(body (rest args)))
|
|
||||||
(if sequential
|
|
||||||
;; LET*: each binding sees previous ones
|
|
||||||
(let ((new-env env))
|
|
||||||
(define bind-seq
|
|
||||||
(fn (bs e)
|
|
||||||
(if (= (len bs) 0)
|
|
||||||
e
|
|
||||||
(let ((b (nth bs 0)))
|
|
||||||
(let ((name (if (list? b) (nth b 0) b))
|
|
||||||
(init (if (and (list? b) (> (len b) 1)) (nth b 1) nil)))
|
|
||||||
(bind-seq (rest bs)
|
|
||||||
(cl-env-bind-var e name (cl-eval init e))))))))
|
|
||||||
(cl-eval-body body (bind-seq bindings env)))
|
|
||||||
;; LET: evaluate all inits in current env, then bind
|
|
||||||
(let ((pairs (map
|
|
||||||
(fn (b)
|
|
||||||
(let ((name (if (list? b) (nth b 0) b))
|
|
||||||
(init (if (and (list? b) (> (len b) 1)) (nth b 1) nil)))
|
|
||||||
{:name name :value (cl-eval init env)}))
|
|
||||||
bindings)))
|
|
||||||
(let ((new-env (reduce
|
|
||||||
(fn (e pair)
|
|
||||||
(cl-env-bind-var e (get pair "name") (get pair "value")))
|
|
||||||
env pairs)))
|
|
||||||
(cl-eval-body body new-env)))))))
|
|
||||||
|
|
||||||
;; SETQ / SETF (simplified: mutate nearest scope or global)
|
|
||||||
(define cl-eval-setq
|
|
||||||
(fn (args env)
|
|
||||||
(if (< (len args) 2)
|
|
||||||
nil
|
|
||||||
(let ((name (nth args 0))
|
|
||||||
(val (cl-eval (nth args 1) env)))
|
|
||||||
(if (has-key? (get env "vars") name)
|
|
||||||
(dict-set! (get env "vars") name val)
|
|
||||||
(dict-set! (get cl-global-env "vars") name val))
|
|
||||||
(if (> (len args) 2)
|
|
||||||
(cl-eval-setq (rest (rest args)) env)
|
|
||||||
val)))))
|
|
||||||
|
|
||||||
;; FUNCTION: get function value or create lambda
|
|
||||||
(define cl-eval-function
|
|
||||||
(fn (args env)
|
|
||||||
(let ((spec (nth args 0)))
|
|
||||||
(cond
|
|
||||||
((and (list? spec) (> (len spec) 0) (= (nth spec 0) "LAMBDA"))
|
|
||||||
(cl-make-lambda (rest spec) env))
|
|
||||||
((string? spec)
|
|
||||||
(cond
|
|
||||||
((cl-env-has-fn? env spec) (cl-env-get-fn env spec))
|
|
||||||
((cl-env-has-fn? cl-global-env spec)
|
|
||||||
(cl-env-get-fn cl-global-env spec))
|
|
||||||
(:else {:cl-type "error" :message (str "Undefined function: " spec)})))
|
|
||||||
(:else {:cl-type "error" :message "FUNCTION: invalid spec"})))))
|
|
||||||
|
|
||||||
;; FLET: local functions (non-recursive, close over outer env)
|
|
||||||
(define cl-eval-flet
|
|
||||||
(fn (args env)
|
|
||||||
(let ((fn-defs (nth args 0))
|
|
||||||
(body (rest args)))
|
|
||||||
(let ((new-env (reduce
|
|
||||||
(fn (e def)
|
|
||||||
(let ((name (nth def 0))
|
|
||||||
(ll (nth def 1))
|
|
||||||
(fn-body (rest (rest def))))
|
|
||||||
(cl-env-bind-fn e name
|
|
||||||
{:cl-type "function"
|
|
||||||
:params (cl-parse-lambda-list ll)
|
|
||||||
:body fn-body
|
|
||||||
:env env})))
|
|
||||||
env fn-defs)))
|
|
||||||
(cl-eval-body body new-env)))))
|
|
||||||
|
|
||||||
;; LABELS: mutually-recursive local functions
|
|
||||||
(define cl-eval-labels
|
|
||||||
(fn (args env)
|
|
||||||
(let ((fn-defs (nth args 0))
|
|
||||||
(body (rest args)))
|
|
||||||
;; Build env with placeholder nil entries for each name
|
|
||||||
(let ((new-env (reduce
|
|
||||||
(fn (e def) (cl-env-bind-fn e (nth def 0) nil))
|
|
||||||
env fn-defs)))
|
|
||||||
;; Fill in real function objects that capture new-env
|
|
||||||
(for-each
|
|
||||||
(fn (def)
|
|
||||||
(let ((name (nth def 0))
|
|
||||||
(ll (nth def 1))
|
|
||||||
(fn-body (rest (rest def))))
|
|
||||||
(dict-set! (get new-env "fns") name
|
|
||||||
{:cl-type "function"
|
|
||||||
:params (cl-parse-lambda-list ll)
|
|
||||||
:body fn-body
|
|
||||||
:env new-env})))
|
|
||||||
fn-defs)
|
|
||||||
(cl-eval-body body new-env)))))
|
|
||||||
|
|
||||||
;; EVAL-WHEN: evaluate body only if :execute is in situations
|
|
||||||
(define cl-eval-eval-when
|
|
||||||
(fn (args env)
|
|
||||||
(let ((situations (nth args 0))
|
|
||||||
(body (rest args)))
|
|
||||||
(define has-exec
|
|
||||||
(some (fn (s)
|
|
||||||
(or
|
|
||||||
(and (dict? s)
|
|
||||||
(= (get s "cl-type") "keyword")
|
|
||||||
(= (get s "name") "EXECUTE"))
|
|
||||||
(= s "EXECUTE")))
|
|
||||||
situations))
|
|
||||||
(if has-exec (cl-eval-body body env) nil))))
|
|
||||||
|
|
||||||
;; DEFUN: define function in global fns namespace
|
|
||||||
(define cl-eval-defun
|
|
||||||
(fn (args env)
|
|
||||||
(let ((name (nth args 0))
|
|
||||||
(ll (nth args 1))
|
|
||||||
(fn-body (rest (rest args))))
|
|
||||||
(let ((fn-obj {:cl-type "function"
|
|
||||||
:params (cl-parse-lambda-list ll)
|
|
||||||
:body fn-body
|
|
||||||
:env env}))
|
|
||||||
(dict-set! (get cl-global-env "fns") name fn-obj)
|
|
||||||
name))))
|
|
||||||
|
|
||||||
;; DEFVAR / DEFPARAMETER / DEFCONSTANT
|
|
||||||
(define cl-eval-defvar
|
|
||||||
(fn (args env always-assign)
|
|
||||||
(let ((name (nth args 0))
|
|
||||||
(has-init (> (len args) 1)))
|
|
||||||
(let ((val (if has-init (cl-eval (nth args 1) env) nil)))
|
|
||||||
(when (or always-assign
|
|
||||||
(not (cl-env-has-var? cl-global-env name)))
|
|
||||||
(dict-set! (get cl-global-env "vars") name val))
|
|
||||||
name))))
|
|
||||||
|
|
||||||
;; Function call: evaluate name → look up fns, builtins; evaluate args
|
|
||||||
(define cl-call-fn
|
|
||||||
(fn (name args env)
|
|
||||||
(let ((evaled (map (fn (a) (cl-eval a env)) args)))
|
|
||||||
(cond
|
|
||||||
;; FUNCALL: (funcall fn arg...)
|
|
||||||
((= name "FUNCALL")
|
|
||||||
(cl-apply (nth evaled 0) (rest evaled)))
|
|
||||||
;; APPLY: (apply fn arg... list)
|
|
||||||
((= name "APPLY")
|
|
||||||
(let ((fn-obj (nth evaled 0))
|
|
||||||
(all-args (rest evaled)))
|
|
||||||
(let ((leading (slice all-args 0 (- (len all-args) 1)))
|
|
||||||
(last-arg (nth all-args (- (len all-args) 1))))
|
|
||||||
(cl-apply fn-obj (concat leading (if (= last-arg nil) (list) last-arg))))))
|
|
||||||
;; MAPCAR: (mapcar fn list)
|
|
||||||
((= name "MAPCAR")
|
|
||||||
(let ((fn-obj (nth evaled 0))
|
|
||||||
(lst (nth evaled 1)))
|
|
||||||
(if (= lst nil) (list)
|
|
||||||
(map (fn (x) (cl-apply fn-obj (list x))) lst))))
|
|
||||||
;; Look up in local fns namespace
|
|
||||||
((cl-env-has-fn? env name)
|
|
||||||
(cl-apply (cl-env-get-fn env name) evaled))
|
|
||||||
;; Look up in global fns namespace
|
|
||||||
((cl-env-has-fn? cl-global-env name)
|
|
||||||
(cl-apply (cl-env-get-fn cl-global-env name) evaled))
|
|
||||||
;; Look up in builtins
|
|
||||||
((has-key? cl-builtins name)
|
|
||||||
((get cl-builtins name) evaled))
|
|
||||||
(:else
|
|
||||||
{:cl-type "error" :message (str "Undefined function: " name)})))))
|
|
||||||
|
|
||||||
;; ── main evaluator ────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-eval
|
|
||||||
(fn (form env)
|
|
||||||
(cond
|
|
||||||
;; Nil and booleans are self-evaluating
|
|
||||||
((= form nil) nil)
|
|
||||||
((= form true) true)
|
|
||||||
;; Numbers are self-evaluating
|
|
||||||
((number? form) form)
|
|
||||||
;; Dicts: typed CL values
|
|
||||||
((dict? form)
|
|
||||||
(let ((ct (get form "cl-type")))
|
|
||||||
(cond
|
|
||||||
((= ct "string") (get form "value")) ;; CL string → SX string
|
|
||||||
(:else form)))) ;; keywords, floats, chars, etc.
|
|
||||||
;; Symbol reference (variable lookup)
|
|
||||||
((string? form)
|
|
||||||
(cond
|
|
||||||
((cl-env-has-var? env form) (cl-env-get-var env form))
|
|
||||||
((cl-env-has-var? cl-global-env form)
|
|
||||||
(cl-env-get-var cl-global-env form))
|
|
||||||
(:else {:cl-type "error" :message (str "Undefined variable: " form)})))
|
|
||||||
;; List: special forms or function call
|
|
||||||
((list? form) (cl-eval-list form env))
|
|
||||||
;; Anything else self-evaluates
|
|
||||||
(:else form))))
|
|
||||||
|
|
||||||
(define cl-eval-list
|
|
||||||
(fn (form env)
|
|
||||||
(if (= (len form) 0)
|
|
||||||
nil
|
|
||||||
(let ((head (nth form 0))
|
|
||||||
(args (rest form)))
|
|
||||||
(cond
|
|
||||||
((= head "QUOTE") (nth args 0))
|
|
||||||
((= head "IF") (cl-eval-if args env))
|
|
||||||
((= head "PROGN") (cl-eval-body args env))
|
|
||||||
((= head "LET") (cl-eval-let args env false))
|
|
||||||
((= head "LET*") (cl-eval-let args env true))
|
|
||||||
((= head "AND") (cl-eval-and args env))
|
|
||||||
((= head "OR") (cl-eval-or args env))
|
|
||||||
((= head "COND") (cl-eval-cond args env))
|
|
||||||
((= head "WHEN")
|
|
||||||
(if (cl-eval (nth args 0) env)
|
|
||||||
(cl-eval-body (rest args) env) nil))
|
|
||||||
((= head "UNLESS")
|
|
||||||
(if (not (cl-eval (nth args 0) env))
|
|
||||||
(cl-eval-body (rest args) env) nil))
|
|
||||||
((= head "SETQ") (cl-eval-setq args env))
|
|
||||||
((= head "SETF") (cl-eval-setq args env))
|
|
||||||
((= head "FUNCTION") (cl-eval-function args env))
|
|
||||||
((= head "LAMBDA") (cl-make-lambda args env))
|
|
||||||
((= head "FLET") (cl-eval-flet args env))
|
|
||||||
((= head "LABELS") (cl-eval-labels args env))
|
|
||||||
((= head "THE") (cl-eval (nth args 1) env))
|
|
||||||
((= head "LOCALLY") (cl-eval-body args env))
|
|
||||||
((= head "EVAL-WHEN") (cl-eval-eval-when args env))
|
|
||||||
((= head "DEFUN") (cl-eval-defun args env))
|
|
||||||
((= head "DEFVAR") (cl-eval-defvar args env false))
|
|
||||||
((= head "DEFPARAMETER") (cl-eval-defvar args env true))
|
|
||||||
((= head "DEFCONSTANT") (cl-eval-defvar args env true))
|
|
||||||
((= head "DECLAIM") nil)
|
|
||||||
((= head "PROCLAIM") nil)
|
|
||||||
;; Named function call
|
|
||||||
((string? head)
|
|
||||||
(cl-call-fn head args env))
|
|
||||||
;; Anonymous call: ((lambda ...) args)
|
|
||||||
(:else
|
|
||||||
(let ((fn-obj (cl-eval head env)))
|
|
||||||
(if (and (dict? fn-obj) (= (get fn-obj "cl-type") "function"))
|
|
||||||
(cl-apply fn-obj (map (fn (a) (cl-eval a env)) args))
|
|
||||||
{:cl-type "error" :message "Not callable"}))))))))
|
|
||||||
|
|
||||||
;; ── public API ────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-eval-str
|
|
||||||
(fn (src env)
|
|
||||||
(cl-eval (cl-read src) env)))
|
|
||||||
|
|
||||||
(define cl-eval-all-str
|
|
||||||
(fn (src env)
|
|
||||||
(let ((forms (cl-read-all src)))
|
|
||||||
(if (= (len forms) 0)
|
|
||||||
nil
|
|
||||||
(let ((result nil) (i 0))
|
|
||||||
(define loop (fn ()
|
|
||||||
(when (< i (len forms))
|
|
||||||
(do
|
|
||||||
(set! result (cl-eval (nth forms i) env))
|
|
||||||
(set! i (+ i 1))
|
|
||||||
(loop)))))
|
|
||||||
(loop)
|
|
||||||
result)))))
|
|
||||||
@@ -1,377 +0,0 @@
|
|||||||
;; Common Lisp reader — converts token stream to CL AST forms.
|
|
||||||
;;
|
|
||||||
;; Depends on: lib/common-lisp/reader.sx (cl-tokenize)
|
|
||||||
;;
|
|
||||||
;; AST representation:
|
|
||||||
;; integer/float → SX number (or {:cl-type "float"/:ratio ...})
|
|
||||||
;; string → SX string
|
|
||||||
;; symbol FOO → SX string "FOO" (upcase)
|
|
||||||
;; symbol NIL → nil
|
|
||||||
;; symbol T → true
|
|
||||||
;; :keyword → {:cl-type "keyword" :name "FOO"}
|
|
||||||
;; #\char → {:cl-type "char" :value "a"}
|
|
||||||
;; #:uninterned → {:cl-type "uninterned" :name "FOO"}
|
|
||||||
;; ratio 1/3 → {:cl-type "ratio" :value "1/3"}
|
|
||||||
;; float 3.14 → {:cl-type "float" :value "3.14"}
|
|
||||||
;; proper list (a b c) → SX list (a b c)
|
|
||||||
;; dotted pair (a . b) → {:cl-type "cons" :car a :cdr b}
|
|
||||||
;; vector #(a b) → {:cl-type "vector" :elements (list a b)}
|
|
||||||
;; 'x → ("QUOTE" x)
|
|
||||||
;; `x → ("QUASIQUOTE" x)
|
|
||||||
;; ,x → ("UNQUOTE" x)
|
|
||||||
;; ,@x → ("UNQUOTE-SPLICING" x)
|
|
||||||
;; #'x → ("FUNCTION" x)
|
|
||||||
;;
|
|
||||||
;; Public API:
|
|
||||||
;; (cl-read src) — parse first form from string, return form
|
|
||||||
;; (cl-read-all src) — parse all top-level forms, return list
|
|
||||||
|
|
||||||
;; ── number conversion ─────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-hex-val
|
|
||||||
(fn
|
|
||||||
(c)
|
|
||||||
(let
|
|
||||||
((o (cl-ord c)))
|
|
||||||
(cond
|
|
||||||
((and (>= o 48) (<= o 57)) (- o 48))
|
|
||||||
((and (>= o 65) (<= o 70)) (+ 10 (- o 65)))
|
|
||||||
((and (>= o 97) (<= o 102)) (+ 10 (- o 97)))
|
|
||||||
(:else 0)))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-parse-radix-str
|
|
||||||
(fn
|
|
||||||
(s radix start)
|
|
||||||
(let
|
|
||||||
((n (string-length s)) (i start) (acc 0))
|
|
||||||
(define
|
|
||||||
loop
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(< i n)
|
|
||||||
(do
|
|
||||||
(set! acc (+ (* acc radix) (cl-hex-val (substring s i (+ i 1)))))
|
|
||||||
(set! i (+ i 1))
|
|
||||||
(loop)))))
|
|
||||||
(loop)
|
|
||||||
acc)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-convert-integer
|
|
||||||
(fn
|
|
||||||
(s)
|
|
||||||
(let
|
|
||||||
((n (string-length s)) (neg false))
|
|
||||||
(cond
|
|
||||||
((and (> n 2) (= (substring s 0 1) "#"))
|
|
||||||
(let
|
|
||||||
((letter (downcase (substring s 1 2))))
|
|
||||||
(cond
|
|
||||||
((= letter "x") (cl-parse-radix-str s 16 2))
|
|
||||||
((= letter "b") (cl-parse-radix-str s 2 2))
|
|
||||||
((= letter "o") (cl-parse-radix-str s 8 2))
|
|
||||||
(:else (parse-int s 0)))))
|
|
||||||
(:else (parse-int s 0))))))
|
|
||||||
|
|
||||||
;; ── reader ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
;; Read one form from token list.
|
|
||||||
;; Returns {:form F :rest remaining-toks} or {:form nil :rest toks :eof true}
|
|
||||||
(define
|
|
||||||
cl-read-form
|
|
||||||
(fn
|
|
||||||
(toks)
|
|
||||||
(if
|
|
||||||
(not toks)
|
|
||||||
{:form nil :rest toks :eof true}
|
|
||||||
(let
|
|
||||||
((tok (nth toks 0)) (nxt (rest toks)))
|
|
||||||
(let
|
|
||||||
((type (get tok "type")) (val (get tok "value")))
|
|
||||||
(cond
|
|
||||||
((= type "eof") {:form nil :rest toks :eof true})
|
|
||||||
((= type "integer") {:form (cl-convert-integer val) :rest nxt})
|
|
||||||
((= type "float") {:form {:cl-type "float" :value val} :rest nxt})
|
|
||||||
((= type "ratio") {:form {:cl-type "ratio" :value val} :rest nxt})
|
|
||||||
((= type "string") {:form val :rest nxt})
|
|
||||||
((= type "char") {:form {:cl-type "char" :value val} :rest nxt})
|
|
||||||
((= type "keyword") {:form {:cl-type "keyword" :name val} :rest nxt})
|
|
||||||
((= type "uninterned") {:form {:cl-type "uninterned" :name val} :rest nxt})
|
|
||||||
((= type "symbol")
|
|
||||||
(cond
|
|
||||||
((= val "NIL") {:form nil :rest nxt})
|
|
||||||
((= val "T") {:form true :rest nxt})
|
|
||||||
(:else {:form val :rest nxt})))
|
|
||||||
;; list forms
|
|
||||||
((= type "lparen") (cl-read-list nxt))
|
|
||||||
((= type "hash-paren") (cl-read-vector nxt))
|
|
||||||
;; reader macros that wrap the next form
|
|
||||||
((= type "quote") (cl-read-wrap "QUOTE" nxt))
|
|
||||||
((= type "backquote") (cl-read-wrap "QUASIQUOTE" nxt))
|
|
||||||
((= type "comma") (cl-read-wrap "UNQUOTE" nxt))
|
|
||||||
((= type "comma-at") (cl-read-wrap "UNQUOTE-SPLICING" nxt))
|
|
||||||
((= type "hash-quote") (cl-read-wrap "FUNCTION" nxt))
|
|
||||||
;; skip unrecognised tokens
|
|
||||||
(:else (cl-read-form nxt))))))))
|
|
||||||
|
|
||||||
;; Wrap next form in a list: (name form)
|
|
||||||
(define
|
|
||||||
cl-read-wrap
|
|
||||||
(fn
|
|
||||||
(name toks)
|
|
||||||
(let
|
|
||||||
((inner (cl-read-form toks)))
|
|
||||||
{:form (list name (get inner "form")) :rest (get inner "rest")})))
|
|
||||||
|
|
||||||
;; Read list forms until ')'; handles dotted pair (a . b)
|
|
||||||
;; Called after consuming '('
|
|
||||||
(define
|
|
||||||
cl-read-list
|
|
||||||
(fn
|
|
||||||
(toks)
|
|
||||||
(let
|
|
||||||
((result (cl-read-list-items toks (list))))
|
|
||||||
{:form (get result "items") :rest (get result "rest")})))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-read-list-items
|
|
||||||
(fn
|
|
||||||
(toks acc)
|
|
||||||
(if
|
|
||||||
(not toks)
|
|
||||||
{:items acc :rest toks}
|
|
||||||
(let
|
|
||||||
((tok (nth toks 0)))
|
|
||||||
(let
|
|
||||||
((type (get tok "type")))
|
|
||||||
(cond
|
|
||||||
((= type "eof") {:items acc :rest toks})
|
|
||||||
((= type "rparen") {:items acc :rest (rest toks)})
|
|
||||||
;; dotted pair: read one more form then expect ')'
|
|
||||||
((= type "dot")
|
|
||||||
(let
|
|
||||||
((cdr-result (cl-read-form (rest toks))))
|
|
||||||
(let
|
|
||||||
((cdr-form (get cdr-result "form"))
|
|
||||||
(after-cdr (get cdr-result "rest")))
|
|
||||||
;; skip the closing ')'
|
|
||||||
(let
|
|
||||||
((close (if after-cdr (nth after-cdr 0) nil)))
|
|
||||||
(let
|
|
||||||
((remaining
|
|
||||||
(if
|
|
||||||
(and close (= (get close "type") "rparen"))
|
|
||||||
(rest after-cdr)
|
|
||||||
after-cdr)))
|
|
||||||
;; build dotted structure
|
|
||||||
(let
|
|
||||||
((dotted (cl-build-dotted acc cdr-form)))
|
|
||||||
{:items dotted :rest remaining}))))))
|
|
||||||
(:else
|
|
||||||
(let
|
|
||||||
((item (cl-read-form toks)))
|
|
||||||
(cl-read-list-items
|
|
||||||
(get item "rest")
|
|
||||||
(concat acc (list (get item "form"))))))))))))
|
|
||||||
|
|
||||||
;; Build dotted form: (a b . c) → ((DOTTED a b) . c) style
|
|
||||||
;; In CL (a b c . d) means a proper dotted structure.
|
|
||||||
;; We represent it as {:cl-type "cons" :car a :cdr (list->dotted b c d)}
|
|
||||||
(define
|
|
||||||
cl-build-dotted
|
|
||||||
(fn
|
|
||||||
(head-items tail)
|
|
||||||
(if
|
|
||||||
(= (len head-items) 0)
|
|
||||||
tail
|
|
||||||
(if
|
|
||||||
(= (len head-items) 1)
|
|
||||||
{:cl-type "cons" :car (nth head-items 0) :cdr tail}
|
|
||||||
(let
|
|
||||||
((last-item (nth head-items (- (len head-items) 1)))
|
|
||||||
(but-last (slice head-items 0 (- (len head-items) 1))))
|
|
||||||
{:cl-type "cons"
|
|
||||||
:car (cl-build-dotted but-last (list last-item))
|
|
||||||
:cdr tail})))))
|
|
||||||
|
|
||||||
;; Read vector #(…) elements until ')'
|
|
||||||
(define
|
|
||||||
cl-read-vector
|
|
||||||
(fn
|
|
||||||
(toks)
|
|
||||||
(let
|
|
||||||
((result (cl-read-vector-items toks (list))))
|
|
||||||
{:form {:cl-type "vector" :elements (get result "items")} :rest (get result "rest")})))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-read-vector-items
|
|
||||||
(fn
|
|
||||||
(toks acc)
|
|
||||||
(if
|
|
||||||
(not toks)
|
|
||||||
{:items acc :rest toks}
|
|
||||||
(let
|
|
||||||
((tok (nth toks 0)))
|
|
||||||
(let
|
|
||||||
((type (get tok "type")))
|
|
||||||
(cond
|
|
||||||
((= type "eof") {:items acc :rest toks})
|
|
||||||
((= type "rparen") {:items acc :rest (rest toks)})
|
|
||||||
(:else
|
|
||||||
(let
|
|
||||||
((item (cl-read-form toks)))
|
|
||||||
(cl-read-vector-items
|
|
||||||
(get item "rest")
|
|
||||||
(concat acc (list (get item "form"))))))))))))
|
|
||||||
|
|
||||||
;; ── lambda-list parser ───────────────────────────────────────────
|
|
||||||
;;
|
|
||||||
;; (cl-parse-lambda-list forms) — parse a list of CL forms (already read)
|
|
||||||
;; into a structured dict:
|
|
||||||
;; {:required (list sym ...)
|
|
||||||
;; :optional (list {:name N :default D :supplied S} ...)
|
|
||||||
;; :rest nil | "SYM"
|
|
||||||
;; :key (list {:name N :keyword K :default D :supplied S} ...)
|
|
||||||
;; :allow-other-keys false | true
|
|
||||||
;; :aux (list {:name N :init I} ...)}
|
|
||||||
;;
|
|
||||||
;; Symbols arrive as SX strings (upcase). &-markers are strings like "&OPTIONAL".
|
|
||||||
;; Key params: keyword is the upcase name string; caller uses it as :keyword.
|
|
||||||
;; Supplied-p: nil when absent.
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-parse-opt-spec
|
|
||||||
(fn
|
|
||||||
(spec)
|
|
||||||
(if
|
|
||||||
(list? spec)
|
|
||||||
{:name (nth spec 0)
|
|
||||||
:default (if (> (len spec) 1) (nth spec 1) nil)
|
|
||||||
:supplied (if (> (len spec) 2) (nth spec 2) nil)}
|
|
||||||
{:name spec :default nil :supplied nil})))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-parse-key-spec
|
|
||||||
(fn
|
|
||||||
(spec)
|
|
||||||
(if
|
|
||||||
(list? spec)
|
|
||||||
(let
|
|
||||||
((first (nth spec 0)))
|
|
||||||
(if
|
|
||||||
(list? first)
|
|
||||||
;; ((:keyword var) default supplied-p)
|
|
||||||
{:name (nth first 1)
|
|
||||||
:keyword (get first "name")
|
|
||||||
:default (if (> (len spec) 1) (nth spec 1) nil)
|
|
||||||
:supplied (if (> (len spec) 2) (nth spec 2) nil)}
|
|
||||||
;; (var default supplied-p)
|
|
||||||
{:name first
|
|
||||||
:keyword first
|
|
||||||
:default (if (> (len spec) 1) (nth spec 1) nil)
|
|
||||||
:supplied (if (> (len spec) 2) (nth spec 2) nil)}))
|
|
||||||
{:name spec :keyword spec :default nil :supplied nil})))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-parse-aux-spec
|
|
||||||
(fn
|
|
||||||
(spec)
|
|
||||||
(if
|
|
||||||
(list? spec)
|
|
||||||
{:name (nth spec 0) :init (if (> (len spec) 1) (nth spec 1) nil)}
|
|
||||||
{:name spec :init nil})))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-parse-lambda-list
|
|
||||||
(fn
|
|
||||||
(forms)
|
|
||||||
(let
|
|
||||||
((state "required")
|
|
||||||
(required (list))
|
|
||||||
(optional (list))
|
|
||||||
(rest-name nil)
|
|
||||||
(key (list))
|
|
||||||
(allow-other-keys false)
|
|
||||||
(aux (list)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
scan
|
|
||||||
(fn
|
|
||||||
(items)
|
|
||||||
(when
|
|
||||||
(> (len items) 0)
|
|
||||||
(let
|
|
||||||
((item (nth items 0)) (tail (rest items)))
|
|
||||||
(cond
|
|
||||||
((= item "&OPTIONAL")
|
|
||||||
(do (set! state "optional") (scan tail)))
|
|
||||||
((= item "&REST")
|
|
||||||
(do (set! state "rest") (scan tail)))
|
|
||||||
((= item "&BODY")
|
|
||||||
(do (set! state "rest") (scan tail)))
|
|
||||||
((= item "&KEY")
|
|
||||||
(do (set! state "key") (scan tail)))
|
|
||||||
((= item "&AUX")
|
|
||||||
(do (set! state "aux") (scan tail)))
|
|
||||||
((= item "&ALLOW-OTHER-KEYS")
|
|
||||||
(do (set! allow-other-keys true) (scan tail)))
|
|
||||||
((= state "required")
|
|
||||||
(do (append! required item) (scan tail)))
|
|
||||||
((= state "optional")
|
|
||||||
(do (append! optional (cl-parse-opt-spec item)) (scan tail)))
|
|
||||||
((= state "rest")
|
|
||||||
(do (set! rest-name item) (set! state "done") (scan tail)))
|
|
||||||
((= state "key")
|
|
||||||
(do (append! key (cl-parse-key-spec item)) (scan tail)))
|
|
||||||
((= state "aux")
|
|
||||||
(do (append! aux (cl-parse-aux-spec item)) (scan tail)))
|
|
||||||
(:else (scan tail)))))))
|
|
||||||
|
|
||||||
(scan forms)
|
|
||||||
{:required required
|
|
||||||
:optional optional
|
|
||||||
:rest rest-name
|
|
||||||
:key key
|
|
||||||
:allow-other-keys allow-other-keys
|
|
||||||
:aux aux})))
|
|
||||||
|
|
||||||
;; Convenience: parse lambda list from a CL source string
|
|
||||||
(define
|
|
||||||
cl-parse-lambda-list-str
|
|
||||||
(fn
|
|
||||||
(src)
|
|
||||||
(cl-parse-lambda-list (cl-read src))))
|
|
||||||
|
|
||||||
;; ── public API ────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-read
|
|
||||||
(fn
|
|
||||||
(src)
|
|
||||||
(let
|
|
||||||
((toks (cl-tokenize src)))
|
|
||||||
(get (cl-read-form toks) "form"))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-read-all
|
|
||||||
(fn
|
|
||||||
(src)
|
|
||||||
(let
|
|
||||||
((toks (cl-tokenize src)))
|
|
||||||
(define
|
|
||||||
loop
|
|
||||||
(fn
|
|
||||||
(toks acc)
|
|
||||||
(if
|
|
||||||
(or (not toks) (= (get (nth toks 0) "type") "eof"))
|
|
||||||
acc
|
|
||||||
(let
|
|
||||||
((result (cl-read-form toks)))
|
|
||||||
(if
|
|
||||||
(get result "eof")
|
|
||||||
acc
|
|
||||||
(loop (get result "rest") (concat acc (list (get result "form")))))))))
|
|
||||||
(loop toks (list)))))
|
|
||||||
@@ -1,381 +0,0 @@
|
|||||||
;; Common Lisp tokenizer
|
|
||||||
;;
|
|
||||||
;; Tokens: {:type T :value V :pos P}
|
|
||||||
;;
|
|
||||||
;; Types:
|
|
||||||
;; "symbol" — FOO, PKG:SYM, PKG::SYM, T, NIL (upcase)
|
|
||||||
;; "keyword" — :foo (value is upcase name without colon)
|
|
||||||
;; "integer" — 42, -5, #xFF, #b1010, #o17 (string)
|
|
||||||
;; "float" — 3.14, 1.0e10 (string)
|
|
||||||
;; "ratio" — 1/3 (string "N/D")
|
|
||||||
;; "string" — unescaped content
|
|
||||||
;; "char" — single-character string
|
|
||||||
;; "lparen" "rparen" "quote" "backquote" "comma" "comma-at"
|
|
||||||
;; "hash-quote" — #'
|
|
||||||
;; "hash-paren" — #(
|
|
||||||
;; "uninterned" — #:foo (upcase name)
|
|
||||||
;; "dot" — standalone . (dotted pair separator)
|
|
||||||
;; "eof"
|
|
||||||
|
|
||||||
(define cl-make-tok (fn (type value pos) {:type type :value value :pos pos}))
|
|
||||||
|
|
||||||
;; ── char ordinal table ────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-ord-table
|
|
||||||
(let
|
|
||||||
((t (dict)) (i 0))
|
|
||||||
(define
|
|
||||||
cl-fill
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(< i 128)
|
|
||||||
(do
|
|
||||||
(dict-set! t (char-from-code i) i)
|
|
||||||
(set! i (+ i 1))
|
|
||||||
(cl-fill)))))
|
|
||||||
(cl-fill)
|
|
||||||
t))
|
|
||||||
|
|
||||||
(define cl-ord (fn (c) (or (get cl-ord-table c) 0)))
|
|
||||||
|
|
||||||
;; ── character predicates ──────────────────────────────────────────
|
|
||||||
|
|
||||||
(define cl-digit? (fn (c) (and (>= (cl-ord c) 48) (<= (cl-ord c) 57))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-hex?
|
|
||||||
(fn
|
|
||||||
(c)
|
|
||||||
(or
|
|
||||||
(cl-digit? c)
|
|
||||||
(and (>= (cl-ord c) 65) (<= (cl-ord c) 70))
|
|
||||||
(and (>= (cl-ord c) 97) (<= (cl-ord c) 102)))))
|
|
||||||
|
|
||||||
(define cl-octal? (fn (c) (and (>= (cl-ord c) 48) (<= (cl-ord c) 55))))
|
|
||||||
|
|
||||||
(define cl-binary? (fn (c) (or (= c "0") (= c "1"))))
|
|
||||||
|
|
||||||
(define cl-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-alpha?
|
|
||||||
(fn
|
|
||||||
(c)
|
|
||||||
(or
|
|
||||||
(and (>= (cl-ord c) 65) (<= (cl-ord c) 90))
|
|
||||||
(and (>= (cl-ord c) 97) (<= (cl-ord c) 122)))))
|
|
||||||
|
|
||||||
;; Characters that end a token (whitespace + terminating macro chars)
|
|
||||||
(define
|
|
||||||
cl-terminating?
|
|
||||||
(fn
|
|
||||||
(c)
|
|
||||||
(or
|
|
||||||
(cl-ws? c)
|
|
||||||
(= c "(")
|
|
||||||
(= c ")")
|
|
||||||
(= c "\"")
|
|
||||||
(= c ";")
|
|
||||||
(= c "`")
|
|
||||||
(= c ","))))
|
|
||||||
|
|
||||||
;; Symbol constituent: not terminating, not reader-special
|
|
||||||
(define
|
|
||||||
cl-sym-char?
|
|
||||||
(fn
|
|
||||||
(c)
|
|
||||||
(not
|
|
||||||
(or
|
|
||||||
(cl-terminating? c)
|
|
||||||
(= c "#")
|
|
||||||
(= c "|")
|
|
||||||
(= c "\\")
|
|
||||||
(= c "'")))))
|
|
||||||
|
|
||||||
;; ── named character table ─────────────────────────────────────────
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-named-chars
|
|
||||||
{:space " "
|
|
||||||
:newline "\n"
|
|
||||||
:tab "\t"
|
|
||||||
:return "\r"
|
|
||||||
:backspace (char-from-code 8)
|
|
||||||
:rubout (char-from-code 127)
|
|
||||||
:delete (char-from-code 127)
|
|
||||||
:escape (char-from-code 27)
|
|
||||||
:altmode (char-from-code 27)
|
|
||||||
:null (char-from-code 0)
|
|
||||||
:nul (char-from-code 0)
|
|
||||||
:page (char-from-code 12)
|
|
||||||
:formfeed (char-from-code 12)})
|
|
||||||
|
|
||||||
;; ── main tokenizer ────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-tokenize
|
|
||||||
(fn
|
|
||||||
(src)
|
|
||||||
(let
|
|
||||||
((pos 0) (n (string-length src)) (toks (list)))
|
|
||||||
|
|
||||||
(define at (fn () (if (< pos n) (substring src pos (+ pos 1)) nil)))
|
|
||||||
(define peek1 (fn () (if (< (+ pos 1) n) (substring src (+ pos 1) (+ pos 2)) nil)))
|
|
||||||
(define adv (fn () (set! pos (+ pos 1))))
|
|
||||||
|
|
||||||
;; Advance while predicate holds; return substring from start to end
|
|
||||||
(define
|
|
||||||
read-while
|
|
||||||
(fn
|
|
||||||
(pred)
|
|
||||||
(let
|
|
||||||
((start pos))
|
|
||||||
(define
|
|
||||||
rw-loop
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(and (at) (pred (at)))
|
|
||||||
(do (adv) (rw-loop)))))
|
|
||||||
(rw-loop)
|
|
||||||
(substring src start pos))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
skip-line
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(and (at) (not (= (at) "\n")))
|
|
||||||
(do (adv) (skip-line)))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
skip-block
|
|
||||||
(fn
|
|
||||||
(depth)
|
|
||||||
(when
|
|
||||||
(at)
|
|
||||||
(cond
|
|
||||||
((and (= (at) "#") (= (peek1) "|"))
|
|
||||||
(do (adv) (adv) (skip-block (+ depth 1))))
|
|
||||||
((and (= (at) "|") (= (peek1) "#"))
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(adv)
|
|
||||||
(when (> depth 1) (skip-block (- depth 1)))))
|
|
||||||
(:else (do (adv) (skip-block depth)))))))
|
|
||||||
|
|
||||||
;; Read string literal — called with pos just past opening "
|
|
||||||
(define
|
|
||||||
read-str
|
|
||||||
(fn
|
|
||||||
(acc)
|
|
||||||
(if
|
|
||||||
(not (at))
|
|
||||||
acc
|
|
||||||
(cond
|
|
||||||
((= (at) "\"") (do (adv) acc))
|
|
||||||
((= (at) "\\")
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(let
|
|
||||||
((e (at)))
|
|
||||||
(adv)
|
|
||||||
(read-str
|
|
||||||
(str
|
|
||||||
acc
|
|
||||||
(cond
|
|
||||||
((= e "n") "\n")
|
|
||||||
((= e "t") "\t")
|
|
||||||
((= e "r") "\r")
|
|
||||||
((= e "\"") "\"")
|
|
||||||
((= e "\\") "\\")
|
|
||||||
(:else e)))))))
|
|
||||||
(:else
|
|
||||||
(let
|
|
||||||
((c (at)))
|
|
||||||
(adv)
|
|
||||||
(read-str (str acc c))))))))
|
|
||||||
|
|
||||||
;; Read #\ char literal — called with pos just past the backslash
|
|
||||||
(define
|
|
||||||
read-char-lit
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(let
|
|
||||||
((first (at)))
|
|
||||||
(adv)
|
|
||||||
(let
|
|
||||||
((rest (if (and (at) (cl-alpha? (at))) (read-while cl-alpha?) "")))
|
|
||||||
(if
|
|
||||||
(= rest "")
|
|
||||||
first
|
|
||||||
(let
|
|
||||||
((name (downcase (str first rest))))
|
|
||||||
(or (get cl-named-chars name) first)))))))
|
|
||||||
|
|
||||||
;; Number scanner — called with pos just past first digit(s).
|
|
||||||
;; acc holds what was already consumed (first digit or sign+digit).
|
|
||||||
(define
|
|
||||||
scan-num
|
|
||||||
(fn
|
|
||||||
(p acc)
|
|
||||||
(let
|
|
||||||
((more (read-while cl-digit?)))
|
|
||||||
(set! acc (str acc more))
|
|
||||||
(cond
|
|
||||||
;; ratio N/D
|
|
||||||
((and (at) (= (at) "/") (peek1) (cl-digit? (peek1)))
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(let
|
|
||||||
((denom (read-while cl-digit?)))
|
|
||||||
{:type "ratio" :value (str acc "/" denom) :pos p})))
|
|
||||||
;; float: decimal point N.M[eE]
|
|
||||||
((and (at) (= (at) ".") (peek1) (cl-digit? (peek1)))
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(let
|
|
||||||
((frac (read-while cl-digit?)))
|
|
||||||
(set! acc (str acc "." frac))
|
|
||||||
(when
|
|
||||||
(and (at) (or (= (at) "e") (= (at) "E")))
|
|
||||||
(do
|
|
||||||
(set! acc (str acc (at)))
|
|
||||||
(adv)
|
|
||||||
(when
|
|
||||||
(and (at) (or (= (at) "+") (= (at) "-")))
|
|
||||||
(do (set! acc (str acc (at))) (adv)))
|
|
||||||
(set! acc (str acc (read-while cl-digit?)))))
|
|
||||||
{:type "float" :value acc :pos p})))
|
|
||||||
;; float: exponent only NeE
|
|
||||||
((and (at) (or (= (at) "e") (= (at) "E")))
|
|
||||||
(do
|
|
||||||
(set! acc (str acc (at)))
|
|
||||||
(adv)
|
|
||||||
(when
|
|
||||||
(and (at) (or (= (at) "+") (= (at) "-")))
|
|
||||||
(do (set! acc (str acc (at))) (adv)))
|
|
||||||
(set! acc (str acc (read-while cl-digit?)))
|
|
||||||
{:type "float" :value acc :pos p}))
|
|
||||||
(:else {:type "integer" :value acc :pos p})))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
read-radix
|
|
||||||
(fn
|
|
||||||
(letter p)
|
|
||||||
(let
|
|
||||||
((pred
|
|
||||||
(cond
|
|
||||||
((or (= letter "x") (= letter "X")) cl-hex?)
|
|
||||||
((or (= letter "b") (= letter "B")) cl-binary?)
|
|
||||||
((or (= letter "o") (= letter "O")) cl-octal?)
|
|
||||||
(:else cl-digit?))))
|
|
||||||
{:type "integer"
|
|
||||||
:value (str "#" letter (read-while pred))
|
|
||||||
:pos p})))
|
|
||||||
|
|
||||||
(define emit (fn (tok) (append! toks tok)))
|
|
||||||
|
|
||||||
(define
|
|
||||||
scan
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(< pos n)
|
|
||||||
(let
|
|
||||||
((c (at)) (p pos))
|
|
||||||
(cond
|
|
||||||
((cl-ws? c) (do (adv) (scan)))
|
|
||||||
((= c ";") (do (adv) (skip-line) (scan)))
|
|
||||||
((= c "(") (do (adv) (emit (cl-make-tok "lparen" "(" p)) (scan)))
|
|
||||||
((= c ")") (do (adv) (emit (cl-make-tok "rparen" ")" p)) (scan)))
|
|
||||||
((= c "'") (do (adv) (emit (cl-make-tok "quote" "'" p)) (scan)))
|
|
||||||
((= c "`") (do (adv) (emit (cl-make-tok "backquote" "`" p)) (scan)))
|
|
||||||
((= c ",")
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(if
|
|
||||||
(= (at) "@")
|
|
||||||
(do (adv) (emit (cl-make-tok "comma-at" ",@" p)))
|
|
||||||
(emit (cl-make-tok "comma" "," p)))
|
|
||||||
(scan)))
|
|
||||||
((= c "\"")
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(emit (cl-make-tok "string" (read-str "") p))
|
|
||||||
(scan)))
|
|
||||||
;; :keyword
|
|
||||||
((= c ":")
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(emit (cl-make-tok "keyword" (upcase (read-while cl-sym-char?)) p))
|
|
||||||
(scan)))
|
|
||||||
;; dispatch macro #
|
|
||||||
((= c "#")
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(let
|
|
||||||
((d (at)))
|
|
||||||
(cond
|
|
||||||
((= d "'") (do (adv) (emit (cl-make-tok "hash-quote" "#'" p)) (scan)))
|
|
||||||
((= d "(") (do (adv) (emit (cl-make-tok "hash-paren" "#(" p)) (scan)))
|
|
||||||
((= d ":")
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(emit
|
|
||||||
(cl-make-tok "uninterned" (upcase (read-while cl-sym-char?)) p))
|
|
||||||
(scan)))
|
|
||||||
((= d "|") (do (adv) (skip-block 1) (scan)))
|
|
||||||
((= d "\\")
|
|
||||||
(do (adv) (emit (cl-make-tok "char" (read-char-lit) p)) (scan)))
|
|
||||||
((or (= d "x") (= d "X"))
|
|
||||||
(do (adv) (emit (read-radix d p)) (scan)))
|
|
||||||
((or (= d "b") (= d "B"))
|
|
||||||
(do (adv) (emit (read-radix d p)) (scan)))
|
|
||||||
((or (= d "o") (= d "O"))
|
|
||||||
(do (adv) (emit (read-radix d p)) (scan)))
|
|
||||||
(:else (scan))))))
|
|
||||||
;; standalone dot, float .5, or symbol starting with dots
|
|
||||||
((= c ".")
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(cond
|
|
||||||
((or (not (at)) (cl-terminating? (at)))
|
|
||||||
(do (emit (cl-make-tok "dot" "." p)) (scan)))
|
|
||||||
((cl-digit? (at))
|
|
||||||
(do
|
|
||||||
(emit
|
|
||||||
(cl-make-tok "float" (str "0." (read-while cl-digit?)) p))
|
|
||||||
(scan)))
|
|
||||||
(:else
|
|
||||||
(do
|
|
||||||
(emit
|
|
||||||
(cl-make-tok "symbol" (upcase (str "." (read-while cl-sym-char?))) p))
|
|
||||||
(scan))))))
|
|
||||||
;; sign followed by digit → number
|
|
||||||
((and (or (= c "+") (= c "-")) (peek1) (cl-digit? (peek1)))
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(let
|
|
||||||
((first-d (at)))
|
|
||||||
(adv)
|
|
||||||
(emit (scan-num p (str c first-d))))
|
|
||||||
(scan)))
|
|
||||||
;; decimal digit → number
|
|
||||||
((cl-digit? c)
|
|
||||||
(do
|
|
||||||
(adv)
|
|
||||||
(emit (scan-num p c))
|
|
||||||
(scan)))
|
|
||||||
;; symbol constituent (includes bare +, -, etc.)
|
|
||||||
((cl-sym-char? c)
|
|
||||||
(do
|
|
||||||
(emit (cl-make-tok "symbol" (upcase (read-while cl-sym-char?)) p))
|
|
||||||
(scan)))
|
|
||||||
(:else (do (adv) (scan))))))))
|
|
||||||
|
|
||||||
(scan)
|
|
||||||
(append! toks (cl-make-tok "eof" nil n))
|
|
||||||
toks)))
|
|
||||||
@@ -1,100 +0,0 @@
|
|||||||
#!/usr/bin/env bash
|
|
||||||
# Common Lisp on SX test runner — pipes directly to sx_server.exe
|
|
||||||
#
|
|
||||||
# Usage:
|
|
||||||
# bash lib/common-lisp/test.sh # all tests
|
|
||||||
# bash lib/common-lisp/test.sh -v # verbose
|
|
||||||
# bash lib/common-lisp/test.sh tests/read.sx # one file
|
|
||||||
|
|
||||||
set -euo pipefail
|
|
||||||
cd "$(git rev-parse --show-toplevel)"
|
|
||||||
|
|
||||||
SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
|
|
||||||
if [ ! -x "$SX_SERVER" ]; then
|
|
||||||
MAIN_ROOT=$(git worktree list | awk 'NR==1{print $1}')
|
|
||||||
if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
|
|
||||||
SX_SERVER="$MAIN_ROOT/$SX_SERVER"
|
|
||||||
else
|
|
||||||
echo "ERROR: sx_server.exe not found"
|
|
||||||
exit 1
|
|
||||||
fi
|
|
||||||
fi
|
|
||||||
|
|
||||||
VERBOSE=""
|
|
||||||
FILES=()
|
|
||||||
for arg in "$@"; do
|
|
||||||
case "$arg" in
|
|
||||||
-v|--verbose) VERBOSE=1 ;;
|
|
||||||
*) FILES+=("$arg") ;;
|
|
||||||
esac
|
|
||||||
done
|
|
||||||
|
|
||||||
if [ ${#FILES[@]} -eq 0 ]; then
|
|
||||||
mapfile -t FILES < <(find lib/common-lisp/tests -maxdepth 2 -name '*.sx' | sort)
|
|
||||||
fi
|
|
||||||
|
|
||||||
TOTAL_PASS=0
|
|
||||||
TOTAL_FAIL=0
|
|
||||||
FAILED_FILES=()
|
|
||||||
|
|
||||||
for FILE in "${FILES[@]}"; do
|
|
||||||
[ -f "$FILE" ] || { echo "skip $FILE (not found)"; continue; }
|
|
||||||
TMPFILE=$(mktemp)
|
|
||||||
cat > "$TMPFILE" <<EPOCHS
|
|
||||||
(epoch 1)
|
|
||||||
(load "lib/common-lisp/reader.sx")
|
|
||||||
(load "lib/common-lisp/parser.sx")
|
|
||||||
(epoch 2)
|
|
||||||
(load "$FILE")
|
|
||||||
(epoch 3)
|
|
||||||
(eval "(list cl-test-pass cl-test-fail)")
|
|
||||||
EPOCHS
|
|
||||||
|
|
||||||
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
|
|
||||||
rm -f "$TMPFILE"
|
|
||||||
|
|
||||||
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}' || true)
|
|
||||||
if [ -z "$LINE" ]; then
|
|
||||||
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
|
|
||||||
| sed -E 's/^\(ok 3 //; s/\)$//' || true)
|
|
||||||
fi
|
|
||||||
if [ -z "$LINE" ]; then
|
|
||||||
echo "✗ $FILE: could not extract summary"
|
|
||||||
echo "$OUTPUT" | tail -20
|
|
||||||
TOTAL_FAIL=$((TOTAL_FAIL + 1))
|
|
||||||
FAILED_FILES+=("$FILE")
|
|
||||||
continue
|
|
||||||
fi
|
|
||||||
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
|
|
||||||
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
|
|
||||||
TOTAL_PASS=$((TOTAL_PASS + P))
|
|
||||||
TOTAL_FAIL=$((TOTAL_FAIL + F))
|
|
||||||
if [ "$F" -gt 0 ]; then
|
|
||||||
FAILED_FILES+=("$FILE")
|
|
||||||
printf '✗ %-40s %d/%d\n' "$FILE" "$P" "$((P+F))"
|
|
||||||
TMPFILE2=$(mktemp)
|
|
||||||
cat > "$TMPFILE2" <<EPOCHS
|
|
||||||
(epoch 1)
|
|
||||||
(load "lib/common-lisp/reader.sx")
|
|
||||||
(load "lib/common-lisp/parser.sx")
|
|
||||||
(epoch 2)
|
|
||||||
(load "$FILE")
|
|
||||||
(epoch 3)
|
|
||||||
(eval "(map (fn (f) (get f \"name\")) cl-test-fails)")
|
|
||||||
EPOCHS
|
|
||||||
FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>&1 | grep -E '^\(ok 3 ' || true)
|
|
||||||
rm -f "$TMPFILE2"
|
|
||||||
echo " $FAILS"
|
|
||||||
elif [ "$VERBOSE" = "1" ]; then
|
|
||||||
printf '✓ %-40s %d passed\n' "$FILE" "$P"
|
|
||||||
fi
|
|
||||||
done
|
|
||||||
|
|
||||||
TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
|
|
||||||
if [ $TOTAL_FAIL -eq 0 ]; then
|
|
||||||
echo "✓ $TOTAL_PASS/$TOTAL common-lisp-on-sx tests passed"
|
|
||||||
else
|
|
||||||
echo "✗ $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed in: ${FAILED_FILES[*]}"
|
|
||||||
fi
|
|
||||||
|
|
||||||
[ $TOTAL_FAIL -eq 0 ]
|
|
||||||
@@ -1,285 +0,0 @@
|
|||||||
;; CL evaluator tests
|
|
||||||
|
|
||||||
(define cl-test-pass 0)
|
|
||||||
(define cl-test-fail 0)
|
|
||||||
(define cl-test-fails (list))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-deep=
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(cond
|
|
||||||
((= a b) true)
|
|
||||||
((and (dict? a) (dict? b))
|
|
||||||
(let
|
|
||||||
((ak (keys a)) (bk (keys b)))
|
|
||||||
(if
|
|
||||||
(not (= (len ak) (len bk)))
|
|
||||||
false
|
|
||||||
(every?
|
|
||||||
(fn (k) (and (has-key? b k) (cl-deep= (get a k) (get b k))))
|
|
||||||
ak))))
|
|
||||||
((and (list? a) (list? b))
|
|
||||||
(if
|
|
||||||
(not (= (len a) (len b)))
|
|
||||||
false
|
|
||||||
(let
|
|
||||||
((i 0) (ok true))
|
|
||||||
(define
|
|
||||||
chk
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(and ok (< i (len a)))
|
|
||||||
(do
|
|
||||||
(when
|
|
||||||
(not (cl-deep= (nth a i) (nth b i)))
|
|
||||||
(set! ok false))
|
|
||||||
(set! i (+ i 1))
|
|
||||||
(chk)))))
|
|
||||||
(chk)
|
|
||||||
ok)))
|
|
||||||
(:else false))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-test
|
|
||||||
(fn
|
|
||||||
(name actual expected)
|
|
||||||
(if
|
|
||||||
(cl-deep= actual expected)
|
|
||||||
(set! cl-test-pass (+ cl-test-pass 1))
|
|
||||||
(do
|
|
||||||
(set! cl-test-fail (+ cl-test-fail 1))
|
|
||||||
(append! cl-test-fails {:name name :expected expected :actual actual})))))
|
|
||||||
|
|
||||||
;; Convenience: evaluate CL string with fresh env each time
|
|
||||||
(define ev (fn (src) (cl-eval-str src (cl-make-env))))
|
|
||||||
(define evall (fn (src) (cl-eval-all-str src (cl-make-env))))
|
|
||||||
|
|
||||||
;; ── self-evaluating literals ──────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "lit: nil" (ev "nil") nil)
|
|
||||||
(cl-test "lit: t" (ev "t") true)
|
|
||||||
(cl-test "lit: integer" (ev "42") 42)
|
|
||||||
(cl-test "lit: negative" (ev "-7") -7)
|
|
||||||
(cl-test "lit: zero" (ev "0") 0)
|
|
||||||
(cl-test "lit: string" (ev "\"hello\"") "hello")
|
|
||||||
(cl-test "lit: empty string" (ev "\"\"") "")
|
|
||||||
(cl-test "lit: keyword type" (get (ev ":foo") "cl-type") "keyword")
|
|
||||||
(cl-test "lit: keyword name" (get (ev ":foo") "name") "FOO")
|
|
||||||
(cl-test "lit: float type" (get (ev "3.14") "cl-type") "float")
|
|
||||||
|
|
||||||
;; ── QUOTE ─────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "quote: symbol" (ev "'x") "X")
|
|
||||||
(cl-test "quote: list" (ev "'(a b c)") (list "A" "B" "C"))
|
|
||||||
(cl-test "quote: nil" (ev "'nil") nil)
|
|
||||||
(cl-test "quote: integer" (ev "'42") 42)
|
|
||||||
(cl-test "quote: nested" (ev "'(a (b c))") (list "A" (list "B" "C")))
|
|
||||||
|
|
||||||
;; ── IF ────────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "if: true branch" (ev "(if t 1 2)") 1)
|
|
||||||
(cl-test "if: false branch" (ev "(if nil 1 2)") 2)
|
|
||||||
(cl-test "if: no else nil" (ev "(if nil 99)") nil)
|
|
||||||
(cl-test "if: number truthy" (ev "(if 0 'yes 'no)") "YES")
|
|
||||||
(cl-test "if: empty string truthy" (ev "(if \"\" 'yes 'no)") "YES")
|
|
||||||
(cl-test "if: nested" (ev "(if t (if nil 1 2) 3)") 2)
|
|
||||||
|
|
||||||
;; ── PROGN ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "progn: single" (ev "(progn 42)") 42)
|
|
||||||
(cl-test "progn: multiple" (ev "(progn 1 2 3)") 3)
|
|
||||||
(cl-test "progn: nil last" (ev "(progn 1 nil)") nil)
|
|
||||||
|
|
||||||
;; ── AND / OR ─────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "and: empty" (ev "(and)") true)
|
|
||||||
(cl-test "and: all true" (ev "(and 1 2 3)") 3)
|
|
||||||
(cl-test "and: short-circuit" (ev "(and nil 99)") nil)
|
|
||||||
(cl-test "and: returns last" (ev "(and 1 2)") 2)
|
|
||||||
(cl-test "or: empty" (ev "(or)") nil)
|
|
||||||
(cl-test "or: first truthy" (ev "(or 1 2)") 1)
|
|
||||||
(cl-test "or: all nil" (ev "(or nil nil)") nil)
|
|
||||||
(cl-test "or: short-circuit" (ev "(or nil 42)") 42)
|
|
||||||
|
|
||||||
;; ── COND ─────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "cond: first match" (ev "(cond (t 1) (t 2))") 1)
|
|
||||||
(cl-test "cond: second match" (ev "(cond (nil 1) (t 2))") 2)
|
|
||||||
(cl-test "cond: no match" (ev "(cond (nil 1) (nil 2))") nil)
|
|
||||||
(cl-test "cond: returns test value" (ev "(cond (42))") 42)
|
|
||||||
|
|
||||||
;; ── WHEN / UNLESS ─────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "when: true" (ev "(when t 1 2 3)") 3)
|
|
||||||
(cl-test "when: nil" (ev "(when nil 99)") nil)
|
|
||||||
(cl-test "unless: nil runs" (ev "(unless nil 42)") 42)
|
|
||||||
(cl-test "unless: true skips" (ev "(unless t 99)") nil)
|
|
||||||
|
|
||||||
;; ── LET ──────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "let: empty bindings" (ev "(let () 42)") 42)
|
|
||||||
(cl-test "let: single binding" (ev "(let ((x 5)) x)") 5)
|
|
||||||
(cl-test "let: two bindings" (ev "(let ((x 3) (y 4)) (+ x y))") 7)
|
|
||||||
(cl-test "let: parallel" (ev "(let ((x 1)) (let ((x 2) (y x)) y))") 1)
|
|
||||||
(cl-test "let: nested" (ev "(let ((x 1)) (let ((y 2)) (+ x y)))") 3)
|
|
||||||
(cl-test "let: progn body" (ev "(let ((x 5)) (+ x 1) (* x 2))") 10)
|
|
||||||
(cl-test "let: bare name nil" (ev "(let (x) x)") nil)
|
|
||||||
|
|
||||||
;; ── LET* ─────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "let*: sequential" (ev "(let* ((x 1) (y (+ x 1))) y)") 2)
|
|
||||||
(cl-test "let*: chain" (ev "(let* ((a 2) (b (* a 3)) (c (+ b 1))) c)") 7)
|
|
||||||
(cl-test "let*: shadow" (ev "(let ((x 1)) (let* ((x 2) (y x)) y))") 2)
|
|
||||||
|
|
||||||
;; ── SETQ / SETF ──────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "setq: basic" (ev "(let ((x 0)) (setq x 5) x)") 5)
|
|
||||||
(cl-test "setq: returns value" (ev "(let ((x 0)) (setq x 99))") 99)
|
|
||||||
(cl-test "setf: basic" (ev "(let ((x 0)) (setf x 7) x)") 7)
|
|
||||||
|
|
||||||
;; ── LAMBDA ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "lambda: call" (ev "((lambda (x) x) 42)") 42)
|
|
||||||
(cl-test "lambda: multi-arg" (ev "((lambda (x y) (+ x y)) 3 4)") 7)
|
|
||||||
(cl-test "lambda: closure" (ev "(let ((n 10)) ((lambda (x) (+ x n)) 5))") 15)
|
|
||||||
(cl-test "lambda: rest arg"
|
|
||||||
(ev "((lambda (x &rest xs) (cons x xs)) 1 2 3)")
|
|
||||||
{:cl-type "cons" :car 1 :cdr (list 2 3)})
|
|
||||||
(cl-test "lambda: optional no default"
|
|
||||||
(ev "((lambda (&optional x) x))")
|
|
||||||
nil)
|
|
||||||
(cl-test "lambda: optional with arg"
|
|
||||||
(ev "((lambda (&optional (x 99)) x) 42)")
|
|
||||||
42)
|
|
||||||
(cl-test "lambda: optional default used"
|
|
||||||
(ev "((lambda (&optional (x 7)) x))")
|
|
||||||
7)
|
|
||||||
|
|
||||||
;; ── FUNCTION ─────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "function: lambda" (get (ev "(function (lambda (x) x))") "cl-type") "function")
|
|
||||||
|
|
||||||
;; ── DEFUN ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "defun: returns name" (evall "(defun sq (x) (* x x))") "SQ")
|
|
||||||
(cl-test "defun: call" (evall "(defun sq (x) (* x x)) (sq 5)") 25)
|
|
||||||
(cl-test "defun: multi-arg" (evall "(defun add (x y) (+ x y)) (add 3 4)") 7)
|
|
||||||
(cl-test "defun: recursive factorial"
|
|
||||||
(evall "(defun fact (n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 5)")
|
|
||||||
120)
|
|
||||||
(cl-test "defun: multiple calls"
|
|
||||||
(evall "(defun double (x) (* x 2)) (+ (double 3) (double 5))")
|
|
||||||
16)
|
|
||||||
|
|
||||||
;; ── FLET ─────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "flet: basic"
|
|
||||||
(ev "(flet ((double (x) (* x 2))) (double 5))")
|
|
||||||
10)
|
|
||||||
(cl-test "flet: sees outer vars"
|
|
||||||
(ev "(let ((n 3)) (flet ((add-n (x) (+ x n))) (add-n 7)))")
|
|
||||||
10)
|
|
||||||
(cl-test "flet: non-recursive"
|
|
||||||
(ev "(flet ((f (x) (+ x 1))) (flet ((f (x) (f (f x)))) (f 5)))")
|
|
||||||
7)
|
|
||||||
|
|
||||||
;; ── LABELS ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "labels: basic"
|
|
||||||
(ev "(labels ((greet (x) x)) (greet 42))")
|
|
||||||
42)
|
|
||||||
(cl-test "labels: recursive"
|
|
||||||
(ev "(labels ((count (n) (if (<= n 0) 0 (+ 1 (count (- n 1)))))) (count 5))")
|
|
||||||
5)
|
|
||||||
(cl-test "labels: mutual recursion"
|
|
||||||
(ev "(labels
|
|
||||||
((even? (n) (if (= n 0) t (odd? (- n 1))))
|
|
||||||
(odd? (n) (if (= n 0) nil (even? (- n 1)))))
|
|
||||||
(list (even? 4) (odd? 3)))")
|
|
||||||
(list true true))
|
|
||||||
|
|
||||||
;; ── THE / LOCALLY / EVAL-WHEN ────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "the: passthrough" (ev "(the integer 42)") 42)
|
|
||||||
(cl-test "the: string" (ev "(the string \"hi\")") "hi")
|
|
||||||
(cl-test "locally: body" (ev "(locally 1 2 3)") 3)
|
|
||||||
(cl-test "eval-when: execute" (ev "(eval-when (:execute) 99)") 99)
|
|
||||||
(cl-test "eval-when: no execute" (ev "(eval-when (:compile-toplevel) 99)") nil)
|
|
||||||
|
|
||||||
;; ── DEFVAR / DEFPARAMETER ────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "defvar: returns name" (evall "(defvar *x* 10)") "*X*")
|
|
||||||
(cl-test "defparameter: sets value" (evall "(defparameter *y* 42) *y*") 42)
|
|
||||||
(cl-test "defvar: no reinit" (evall "(defvar *z* 1) (defvar *z* 99) *z*") 1)
|
|
||||||
|
|
||||||
;; ── built-in arithmetic ───────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "arith: +" (ev "(+ 1 2 3)") 6)
|
|
||||||
(cl-test "arith: + zero" (ev "(+)") 0)
|
|
||||||
(cl-test "arith: -" (ev "(- 10 3 2)") 5)
|
|
||||||
(cl-test "arith: - negate" (ev "(- 5)") -5)
|
|
||||||
(cl-test "arith: *" (ev "(* 2 3 4)") 24)
|
|
||||||
(cl-test "arith: * one" (ev "(*)") 1)
|
|
||||||
(cl-test "arith: /" (ev "(/ 12 3)") 4)
|
|
||||||
(cl-test "arith: max" (ev "(max 3 1 4 1 5)") 5)
|
|
||||||
(cl-test "arith: min" (ev "(min 3 1 4 1 5)") 1)
|
|
||||||
(cl-test "arith: abs neg" (ev "(abs -7)") 7)
|
|
||||||
(cl-test "arith: abs pos" (ev "(abs 7)") 7)
|
|
||||||
|
|
||||||
;; ── built-in comparisons ──────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "cmp: = true" (ev "(= 3 3)") true)
|
|
||||||
(cl-test "cmp: = false" (ev "(= 3 4)") nil)
|
|
||||||
(cl-test "cmp: /=" (ev "(/= 3 4)") true)
|
|
||||||
(cl-test "cmp: <" (ev "(< 1 2)") true)
|
|
||||||
(cl-test "cmp: > false" (ev "(> 1 2)") nil)
|
|
||||||
(cl-test "cmp: <=" (ev "(<= 2 2)") true)
|
|
||||||
|
|
||||||
;; ── built-in predicates ───────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "pred: null nil" (ev "(null nil)") true)
|
|
||||||
(cl-test "pred: null non-nil" (ev "(null 5)") nil)
|
|
||||||
(cl-test "pred: not nil" (ev "(not nil)") true)
|
|
||||||
(cl-test "pred: not truthy" (ev "(not 5)") nil)
|
|
||||||
(cl-test "pred: numberp" (ev "(numberp 5)") true)
|
|
||||||
(cl-test "pred: numberp str" (ev "(numberp \"x\")") nil)
|
|
||||||
(cl-test "pred: stringp" (ev "(stringp \"hello\")") true)
|
|
||||||
(cl-test "pred: listp list" (ev "(listp '(1))") true)
|
|
||||||
(cl-test "pred: listp nil" (ev "(listp nil)") true)
|
|
||||||
(cl-test "pred: zerop" (ev "(zerop 0)") true)
|
|
||||||
(cl-test "pred: plusp" (ev "(plusp 3)") true)
|
|
||||||
(cl-test "pred: evenp" (ev "(evenp 4)") true)
|
|
||||||
(cl-test "pred: oddp" (ev "(oddp 3)") true)
|
|
||||||
|
|
||||||
;; ── built-in list ops ─────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "list: car" (ev "(car '(1 2 3))") 1)
|
|
||||||
(cl-test "list: cdr" (ev "(cdr '(1 2 3))") (list 2 3))
|
|
||||||
(cl-test "list: cons" (get (ev "(cons 1 2)") "car") 1)
|
|
||||||
(cl-test "list: list fn" (ev "(list 1 2 3)") (list 1 2 3))
|
|
||||||
(cl-test "list: length" (ev "(length '(a b c))") 3)
|
|
||||||
(cl-test "list: length nil" (ev "(length nil)") 0)
|
|
||||||
(cl-test "list: append" (ev "(append '(1 2) '(3 4))") (list 1 2 3 4))
|
|
||||||
(cl-test "list: first" (ev "(first '(10 20 30))") 10)
|
|
||||||
(cl-test "list: second" (ev "(second '(10 20 30))") 20)
|
|
||||||
(cl-test "list: third" (ev "(third '(10 20 30))") 30)
|
|
||||||
(cl-test "list: rest" (ev "(rest '(1 2 3))") (list 2 3))
|
|
||||||
(cl-test "list: nth" (ev "(nth 1 '(a b c))") "B")
|
|
||||||
(cl-test "list: reverse" (ev "(reverse '(1 2 3))") (list 3 2 1))
|
|
||||||
|
|
||||||
;; ── FUNCALL / APPLY / MAPCAR ─────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "funcall: lambda"
|
|
||||||
(ev "(funcall (lambda (x) (* x x)) 5)")
|
|
||||||
25)
|
|
||||||
(cl-test "apply: basic"
|
|
||||||
(ev "(apply #'+ '(1 2 3))")
|
|
||||||
6)
|
|
||||||
(cl-test "apply: leading args"
|
|
||||||
(ev "(apply #'+ 1 2 '(3 4))")
|
|
||||||
10)
|
|
||||||
(cl-test "mapcar: basic"
|
|
||||||
(ev "(mapcar (lambda (x) (* x 2)) '(1 2 3))")
|
|
||||||
(list 2 4 6))
|
|
||||||
@@ -1,204 +0,0 @@
|
|||||||
;; Lambda list parser tests
|
|
||||||
|
|
||||||
(define cl-test-pass 0)
|
|
||||||
(define cl-test-fail 0)
|
|
||||||
(define cl-test-fails (list))
|
|
||||||
|
|
||||||
;; Deep structural equality for dicts and lists
|
|
||||||
(define
|
|
||||||
cl-deep=
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(cond
|
|
||||||
((= a b) true)
|
|
||||||
((and (dict? a) (dict? b))
|
|
||||||
(let
|
|
||||||
((ak (keys a)) (bk (keys b)))
|
|
||||||
(if
|
|
||||||
(not (= (len ak) (len bk)))
|
|
||||||
false
|
|
||||||
(every?
|
|
||||||
(fn (k) (and (has-key? b k) (cl-deep= (get a k) (get b k))))
|
|
||||||
ak))))
|
|
||||||
((and (list? a) (list? b))
|
|
||||||
(if
|
|
||||||
(not (= (len a) (len b)))
|
|
||||||
false
|
|
||||||
(let
|
|
||||||
((i 0) (ok true))
|
|
||||||
(define
|
|
||||||
chk
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(and ok (< i (len a)))
|
|
||||||
(do
|
|
||||||
(when
|
|
||||||
(not (cl-deep= (nth a i) (nth b i)))
|
|
||||||
(set! ok false))
|
|
||||||
(set! i (+ i 1))
|
|
||||||
(chk)))))
|
|
||||||
(chk)
|
|
||||||
ok)))
|
|
||||||
(:else false))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-test
|
|
||||||
(fn
|
|
||||||
(name actual expected)
|
|
||||||
(if
|
|
||||||
(cl-deep= actual expected)
|
|
||||||
(set! cl-test-pass (+ cl-test-pass 1))
|
|
||||||
(do
|
|
||||||
(set! cl-test-fail (+ cl-test-fail 1))
|
|
||||||
(append! cl-test-fails {:name name :expected expected :actual actual})))))
|
|
||||||
|
|
||||||
;; Helper: parse lambda list from string "(x y ...)"
|
|
||||||
(define ll (fn (src) (cl-parse-lambda-list-str src)))
|
|
||||||
(define ll-req (fn (src) (get (ll src) "required")))
|
|
||||||
(define ll-opt (fn (src) (get (ll src) "optional")))
|
|
||||||
(define ll-rest (fn (src) (get (ll src) "rest")))
|
|
||||||
(define ll-key (fn (src) (get (ll src) "key")))
|
|
||||||
(define ll-aok (fn (src) (get (ll src) "allow-other-keys")))
|
|
||||||
(define ll-aux (fn (src) (get (ll src) "aux")))
|
|
||||||
|
|
||||||
;; ── required parameters ───────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "required: empty" (ll-req "()") (list))
|
|
||||||
(cl-test "required: one" (ll-req "(x)") (list "X"))
|
|
||||||
(cl-test "required: two" (ll-req "(x y)") (list "X" "Y"))
|
|
||||||
(cl-test "required: three" (ll-req "(a b c)") (list "A" "B" "C"))
|
|
||||||
(cl-test "required: upcased" (ll-req "(foo bar)") (list "FOO" "BAR"))
|
|
||||||
|
|
||||||
;; ── &optional ─────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "optional: none" (ll-opt "(x)") (list))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"optional: bare symbol"
|
|
||||||
(ll-opt "(x &optional z)")
|
|
||||||
(list {:name "Z" :default nil :supplied nil}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"optional: with default"
|
|
||||||
(ll-opt "(x &optional (z 0))")
|
|
||||||
(list {:name "Z" :default 0 :supplied nil}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"optional: with supplied-p"
|
|
||||||
(ll-opt "(x &optional (z 0 z-p))")
|
|
||||||
(list {:name "Z" :default 0 :supplied "Z-P"}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"optional: two params"
|
|
||||||
(ll-opt "(&optional a (b 1))")
|
|
||||||
(list {:name "A" :default nil :supplied nil} {:name "B" :default 1 :supplied nil}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"optional: string default"
|
|
||||||
(ll-opt "(&optional (name \"world\"))")
|
|
||||||
(list {:name "NAME" :default {:cl-type "string" :value "world"} :supplied nil}))
|
|
||||||
|
|
||||||
;; ── &rest ─────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "rest: none" (ll-rest "(x)") nil)
|
|
||||||
(cl-test "rest: present" (ll-rest "(x &rest args)") "ARGS")
|
|
||||||
(cl-test "rest: with required" (ll-rest "(a b &rest tail)") "TAIL")
|
|
||||||
|
|
||||||
;; &body is an alias for &rest
|
|
||||||
(cl-test "body: alias for rest" (ll-rest "(&body forms)") "FORMS")
|
|
||||||
|
|
||||||
;; rest doesn't consume required params
|
|
||||||
(cl-test "rest: required still there" (ll-req "(a b &rest rest)") (list "A" "B"))
|
|
||||||
|
|
||||||
;; ── &key ──────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "key: none" (ll-key "(x)") (list))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"key: bare symbol"
|
|
||||||
(ll-key "(&key x)")
|
|
||||||
(list {:name "X" :keyword "X" :default nil :supplied nil}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"key: with default"
|
|
||||||
(ll-key "(&key (x 42))")
|
|
||||||
(list {:name "X" :keyword "X" :default 42 :supplied nil}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"key: with supplied-p"
|
|
||||||
(ll-key "(&key (x 42 x-p))")
|
|
||||||
(list {:name "X" :keyword "X" :default 42 :supplied "X-P"}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"key: two params"
|
|
||||||
(ll-key "(&key a b)")
|
|
||||||
(list
|
|
||||||
{:name "A" :keyword "A" :default nil :supplied nil}
|
|
||||||
{:name "B" :keyword "B" :default nil :supplied nil}))
|
|
||||||
|
|
||||||
;; ── &allow-other-keys ─────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "aok: absent" (ll-aok "(x)") false)
|
|
||||||
(cl-test "aok: present" (ll-aok "(&key x &allow-other-keys)") true)
|
|
||||||
|
|
||||||
;; ── &aux ──────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "aux: none" (ll-aux "(x)") (list))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"aux: bare symbol"
|
|
||||||
(ll-aux "(&aux temp)")
|
|
||||||
(list {:name "TEMP" :init nil}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"aux: with init"
|
|
||||||
(ll-aux "(&aux (count 0))")
|
|
||||||
(list {:name "COUNT" :init 0}))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"aux: two vars"
|
|
||||||
(ll-aux "(&aux a (b 1))")
|
|
||||||
(list {:name "A" :init nil} {:name "B" :init 1}))
|
|
||||||
|
|
||||||
;; ── combined ──────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"combined: full lambda list"
|
|
||||||
(let
|
|
||||||
((parsed (ll "(x y &optional (z 0 z-p) &rest args &key a (b nil b-p) &aux temp)")))
|
|
||||||
(list
|
|
||||||
(get parsed "required")
|
|
||||||
(get (nth (get parsed "optional") 0) "name")
|
|
||||||
(get (nth (get parsed "optional") 0) "default")
|
|
||||||
(get (nth (get parsed "optional") 0) "supplied")
|
|
||||||
(get parsed "rest")
|
|
||||||
(get (nth (get parsed "key") 0) "name")
|
|
||||||
(get (nth (get parsed "key") 1) "supplied")
|
|
||||||
(get (nth (get parsed "aux") 0) "name")))
|
|
||||||
(list
|
|
||||||
(list "X" "Y")
|
|
||||||
"Z"
|
|
||||||
0
|
|
||||||
"Z-P"
|
|
||||||
"ARGS"
|
|
||||||
"A"
|
|
||||||
"B-P"
|
|
||||||
"TEMP"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"combined: required only stops before &"
|
|
||||||
(ll-req "(a b &optional c)")
|
|
||||||
(list "A" "B"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"combined: required only with &key"
|
|
||||||
(ll-req "(x &key y)")
|
|
||||||
(list "X"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"combined: &rest and &key together"
|
|
||||||
(let
|
|
||||||
((parsed (ll "(&rest args &key verbose)")))
|
|
||||||
(list (get parsed "rest") (get (nth (get parsed "key") 0) "name")))
|
|
||||||
(list "ARGS" "VERBOSE"))
|
|
||||||
@@ -1,160 +0,0 @@
|
|||||||
;; Common Lisp reader/parser tests
|
|
||||||
|
|
||||||
(define cl-test-pass 0)
|
|
||||||
(define cl-test-fail 0)
|
|
||||||
(define cl-test-fails (list))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-deep=
|
|
||||||
(fn
|
|
||||||
(a b)
|
|
||||||
(cond
|
|
||||||
((= a b) true)
|
|
||||||
((and (dict? a) (dict? b))
|
|
||||||
(let
|
|
||||||
((ak (keys a)) (bk (keys b)))
|
|
||||||
(if
|
|
||||||
(not (= (len ak) (len bk)))
|
|
||||||
false
|
|
||||||
(every?
|
|
||||||
(fn (k) (and (has-key? b k) (cl-deep= (get a k) (get b k))))
|
|
||||||
ak))))
|
|
||||||
((and (list? a) (list? b))
|
|
||||||
(if
|
|
||||||
(not (= (len a) (len b)))
|
|
||||||
false
|
|
||||||
(let
|
|
||||||
((i 0) (ok true))
|
|
||||||
(define
|
|
||||||
chk
|
|
||||||
(fn
|
|
||||||
()
|
|
||||||
(when
|
|
||||||
(and ok (< i (len a)))
|
|
||||||
(do
|
|
||||||
(when
|
|
||||||
(not (cl-deep= (nth a i) (nth b i)))
|
|
||||||
(set! ok false))
|
|
||||||
(set! i (+ i 1))
|
|
||||||
(chk)))))
|
|
||||||
(chk)
|
|
||||||
ok)))
|
|
||||||
(:else false))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-test
|
|
||||||
(fn
|
|
||||||
(name actual expected)
|
|
||||||
(if
|
|
||||||
(cl-deep= actual expected)
|
|
||||||
(set! cl-test-pass (+ cl-test-pass 1))
|
|
||||||
(do
|
|
||||||
(set! cl-test-fail (+ cl-test-fail 1))
|
|
||||||
(append! cl-test-fails {:name name :expected expected :actual actual})))))
|
|
||||||
|
|
||||||
;; ── atoms ─────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "integer: 42" (cl-read "42") 42)
|
|
||||||
(cl-test "integer: 0" (cl-read "0") 0)
|
|
||||||
(cl-test "integer: negative" (cl-read "-5") -5)
|
|
||||||
(cl-test "integer: positive sign" (cl-read "+3") 3)
|
|
||||||
(cl-test "integer: hex #xFF" (cl-read "#xFF") 255)
|
|
||||||
(cl-test "integer: hex #xAB" (cl-read "#xAB") 171)
|
|
||||||
(cl-test "integer: binary #b1010" (cl-read "#b1010") 10)
|
|
||||||
(cl-test "integer: octal #o17" (cl-read "#o17") 15)
|
|
||||||
|
|
||||||
(cl-test "float: type" (get (cl-read "3.14") "cl-type") "float")
|
|
||||||
(cl-test "float: value" (get (cl-read "3.14") "value") "3.14")
|
|
||||||
(cl-test "float: neg" (get (cl-read "-2.5") "value") "-2.5")
|
|
||||||
(cl-test "float: exp" (get (cl-read "1.0e10") "value") "1.0e10")
|
|
||||||
|
|
||||||
(cl-test "ratio: type" (get (cl-read "1/3") "cl-type") "ratio")
|
|
||||||
(cl-test "ratio: value" (get (cl-read "1/3") "value") "1/3")
|
|
||||||
(cl-test "ratio: 22/7" (get (cl-read "22/7") "value") "22/7")
|
|
||||||
|
|
||||||
(cl-test "string: basic" (cl-read "\"hello\"") {:cl-type "string" :value "hello"})
|
|
||||||
(cl-test "string: empty" (cl-read "\"\"") {:cl-type "string" :value ""})
|
|
||||||
(cl-test "string: with escape" (cl-read "\"a\\nb\"") {:cl-type "string" :value "a\nb"})
|
|
||||||
|
|
||||||
(cl-test "symbol: foo" (cl-read "foo") "FOO")
|
|
||||||
(cl-test "symbol: BAR" (cl-read "BAR") "BAR")
|
|
||||||
(cl-test "symbol: pkg:sym" (cl-read "cl:car") "CL:CAR")
|
|
||||||
(cl-test "symbol: pkg::sym" (cl-read "pkg::foo") "PKG::FOO")
|
|
||||||
|
|
||||||
(cl-test "nil: symbol" (cl-read "nil") nil)
|
|
||||||
(cl-test "nil: uppercase" (cl-read "NIL") nil)
|
|
||||||
(cl-test "t: symbol" (cl-read "t") true)
|
|
||||||
(cl-test "t: uppercase" (cl-read "T") true)
|
|
||||||
|
|
||||||
(cl-test "keyword: type" (get (cl-read ":foo") "cl-type") "keyword")
|
|
||||||
(cl-test "keyword: name" (get (cl-read ":foo") "name") "FOO")
|
|
||||||
(cl-test "keyword: :test" (get (cl-read ":test") "name") "TEST")
|
|
||||||
|
|
||||||
(cl-test "char: type" (get (cl-read "#\\a") "cl-type") "char")
|
|
||||||
(cl-test "char: value" (get (cl-read "#\\a") "value") "a")
|
|
||||||
(cl-test "char: Space" (get (cl-read "#\\Space") "value") " ")
|
|
||||||
(cl-test "char: Newline" (get (cl-read "#\\Newline") "value") "\n")
|
|
||||||
|
|
||||||
(cl-test "uninterned: type" (get (cl-read "#:foo") "cl-type") "uninterned")
|
|
||||||
(cl-test "uninterned: name" (get (cl-read "#:foo") "name") "FOO")
|
|
||||||
|
|
||||||
;; ── lists ─────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "list: empty" (cl-read "()") (list))
|
|
||||||
(cl-test "list: one element" (cl-read "(foo)") (list "FOO"))
|
|
||||||
(cl-test "list: two elements" (cl-read "(foo bar)") (list "FOO" "BAR"))
|
|
||||||
(cl-test "list: nested" (cl-read "((a b) c)") (list (list "A" "B") "C"))
|
|
||||||
(cl-test "list: with integer" (cl-read "(+ 1 2)") (list "+" 1 2))
|
|
||||||
(cl-test "list: with string" (cl-read "(print \"hi\")") (list "PRINT" {:cl-type "string" :value "hi"}))
|
|
||||||
(cl-test "list: nil element" (cl-read "(a nil b)") (list "A" nil "B"))
|
|
||||||
(cl-test "list: t element" (cl-read "(a t b)") (list "A" true "B"))
|
|
||||||
|
|
||||||
;; ── dotted pairs ──────────────────────────────────────────────<E29480><E29480>──
|
|
||||||
|
|
||||||
(cl-test "dotted: type" (get (cl-read "(a . b)") "cl-type") "cons")
|
|
||||||
(cl-test "dotted: car" (get (cl-read "(a . b)") "car") "A")
|
|
||||||
(cl-test "dotted: cdr" (get (cl-read "(a . b)") "cdr") "B")
|
|
||||||
(cl-test "dotted: number cdr" (get (cl-read "(x . 42)") "cdr") 42)
|
|
||||||
|
|
||||||
;; ── reader macros ────────────────────────────────────────────────<E29480><E29480>
|
|
||||||
|
|
||||||
(cl-test "quote: form" (cl-read "'x") (list "QUOTE" "X"))
|
|
||||||
(cl-test "quote: list" (cl-read "'(a b)") (list "QUOTE" (list "A" "B")))
|
|
||||||
(cl-test "backquote: form" (cl-read "`x") (list "QUASIQUOTE" "X"))
|
|
||||||
(cl-test "unquote: form" (cl-read ",x") (list "UNQUOTE" "X"))
|
|
||||||
(cl-test "comma-at: form" (cl-read ",@x") (list "UNQUOTE-SPLICING" "X"))
|
|
||||||
(cl-test "function: form" (cl-read "#'foo") (list "FUNCTION" "FOO"))
|
|
||||||
|
|
||||||
;; ── vector ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "vector: type" (get (cl-read "#(1 2 3)") "cl-type") "vector")
|
|
||||||
(cl-test "vector: elements" (get (cl-read "#(1 2 3)") "elements") (list 1 2 3))
|
|
||||||
(cl-test "vector: empty" (get (cl-read "#()") "elements") (list))
|
|
||||||
(cl-test "vector: mixed" (get (cl-read "#(a 1 \"s\")") "elements") (list "A" 1 {:cl-type "string" :value "s"}))
|
|
||||||
|
|
||||||
;; ── cl-read-all ───────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"read-all: empty"
|
|
||||||
(cl-read-all "")
|
|
||||||
(list))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"read-all: two forms"
|
|
||||||
(cl-read-all "42 foo")
|
|
||||||
(list 42 "FOO"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"read-all: three forms"
|
|
||||||
(cl-read-all "(+ 1 2) (+ 3 4) hello")
|
|
||||||
(list (list "+" 1 2) (list "+" 3 4) "HELLO"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"read-all: with comments"
|
|
||||||
(cl-read-all "; this is a comment\n42 ; inline\nfoo")
|
|
||||||
(list 42 "FOO"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"read-all: defun form"
|
|
||||||
(nth (cl-read-all "(defun square (x) (* x x))") 0)
|
|
||||||
(list "DEFUN" "SQUARE" (list "X") (list "*" "X" "X")))
|
|
||||||
@@ -1,180 +0,0 @@
|
|||||||
;; Common Lisp tokenizer tests
|
|
||||||
|
|
||||||
(define cl-test-pass 0)
|
|
||||||
(define cl-test-fail 0)
|
|
||||||
(define cl-test-fails (list))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-test
|
|
||||||
(fn
|
|
||||||
(name actual expected)
|
|
||||||
(if
|
|
||||||
(= actual expected)
|
|
||||||
(set! cl-test-pass (+ cl-test-pass 1))
|
|
||||||
(do
|
|
||||||
(set! cl-test-fail (+ cl-test-fail 1))
|
|
||||||
(append! cl-test-fails {:name name :expected expected :actual actual})))))
|
|
||||||
|
|
||||||
;; Helpers: extract types and values from token stream (drops eof)
|
|
||||||
(define
|
|
||||||
cl-tok-types
|
|
||||||
(fn
|
|
||||||
(src)
|
|
||||||
(map
|
|
||||||
(fn (t) (get t "type"))
|
|
||||||
(filter (fn (t) (not (= (get t "type") "eof"))) (cl-tokenize src)))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-tok-values
|
|
||||||
(fn
|
|
||||||
(src)
|
|
||||||
(map
|
|
||||||
(fn (t) (get t "value"))
|
|
||||||
(filter (fn (t) (not (= (get t "type") "eof"))) (cl-tokenize src)))))
|
|
||||||
|
|
||||||
(define
|
|
||||||
cl-tok-first
|
|
||||||
(fn (src) (nth (cl-tokenize src) 0)))
|
|
||||||
|
|
||||||
;; ── symbols ───────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "symbol: bare lowercase" (cl-tok-values "foo") (list "FOO"))
|
|
||||||
(cl-test "symbol: uppercase" (cl-tok-values "BAR") (list "BAR"))
|
|
||||||
(cl-test "symbol: mixed case folded" (cl-tok-values "FooBar") (list "FOOBAR"))
|
|
||||||
(cl-test "symbol: with hyphen" (cl-tok-values "foo-bar") (list "FOO-BAR"))
|
|
||||||
(cl-test "symbol: with star" (cl-tok-values "*special*") (list "*SPECIAL*"))
|
|
||||||
(cl-test "symbol: with question" (cl-tok-values "null?") (list "NULL?"))
|
|
||||||
(cl-test "symbol: with exclamation" (cl-tok-values "set!") (list "SET!"))
|
|
||||||
(cl-test "symbol: plus sign alone" (cl-tok-values "+") (list "+"))
|
|
||||||
(cl-test "symbol: minus sign alone" (cl-tok-values "-") (list "-"))
|
|
||||||
(cl-test "symbol: type is symbol" (cl-tok-types "foo") (list "symbol"))
|
|
||||||
|
|
||||||
;; ── package-qualified symbols ─────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "symbol: pkg:sym external" (cl-tok-values "cl:car") (list "CL:CAR"))
|
|
||||||
(cl-test "symbol: pkg::sym internal" (cl-tok-values "pkg::foo") (list "PKG::FOO"))
|
|
||||||
(cl-test "symbol: cl:car type" (cl-tok-types "cl:car") (list "symbol"))
|
|
||||||
|
|
||||||
;; ── keywords ──────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "keyword: basic" (cl-tok-values ":foo") (list "FOO"))
|
|
||||||
(cl-test "keyword: type" (cl-tok-types ":foo") (list "keyword"))
|
|
||||||
(cl-test "keyword: upcase" (cl-tok-values ":hello-world") (list "HELLO-WORLD"))
|
|
||||||
(cl-test "keyword: multiple" (cl-tok-types ":a :b :c") (list "keyword" "keyword" "keyword"))
|
|
||||||
|
|
||||||
;; ── integers ──────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "integer: zero" (cl-tok-values "0") (list "0"))
|
|
||||||
(cl-test "integer: positive" (cl-tok-values "42") (list "42"))
|
|
||||||
(cl-test "integer: negative" (cl-tok-values "-5") (list "-5"))
|
|
||||||
(cl-test "integer: positive-sign" (cl-tok-values "+3") (list "+3"))
|
|
||||||
(cl-test "integer: type" (cl-tok-types "42") (list "integer"))
|
|
||||||
(cl-test "integer: multi-digit" (cl-tok-values "12345678") (list "12345678"))
|
|
||||||
|
|
||||||
;; ── hex, binary, octal ───────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "hex: lowercase x" (cl-tok-values "#xFF") (list "#xFF"))
|
|
||||||
(cl-test "hex: uppercase X" (cl-tok-values "#XFF") (list "#XFF"))
|
|
||||||
(cl-test "hex: type" (cl-tok-types "#xFF") (list "integer"))
|
|
||||||
(cl-test "hex: zero" (cl-tok-values "#x0") (list "#x0"))
|
|
||||||
(cl-test "binary: #b" (cl-tok-values "#b1010") (list "#b1010"))
|
|
||||||
(cl-test "binary: type" (cl-tok-types "#b1010") (list "integer"))
|
|
||||||
(cl-test "octal: #o" (cl-tok-values "#o17") (list "#o17"))
|
|
||||||
(cl-test "octal: type" (cl-tok-types "#o17") (list "integer"))
|
|
||||||
|
|
||||||
;; ── floats ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "float: basic" (cl-tok-values "3.14") (list "3.14"))
|
|
||||||
(cl-test "float: type" (cl-tok-types "3.14") (list "float"))
|
|
||||||
(cl-test "float: negative" (cl-tok-values "-2.5") (list "-2.5"))
|
|
||||||
(cl-test "float: exponent" (cl-tok-values "1.0e10") (list "1.0e10"))
|
|
||||||
(cl-test "float: neg exponent" (cl-tok-values "1.5e-3") (list "1.5e-3"))
|
|
||||||
(cl-test "float: leading dot" (cl-tok-values ".5") (list "0.5"))
|
|
||||||
(cl-test "float: exp only" (cl-tok-values "1e5") (list "1e5"))
|
|
||||||
|
|
||||||
;; ── ratios ────────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "ratio: 1/3" (cl-tok-values "1/3") (list "1/3"))
|
|
||||||
(cl-test "ratio: type" (cl-tok-types "1/3") (list "ratio"))
|
|
||||||
(cl-test "ratio: 22/7" (cl-tok-values "22/7") (list "22/7"))
|
|
||||||
(cl-test "ratio: negative" (cl-tok-values "-1/2") (list "-1/2"))
|
|
||||||
|
|
||||||
;; ── strings ───────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "string: empty" (cl-tok-values "\"\"") (list ""))
|
|
||||||
(cl-test "string: basic" (cl-tok-values "\"hello\"") (list "hello"))
|
|
||||||
(cl-test "string: type" (cl-tok-types "\"hello\"") (list "string"))
|
|
||||||
(cl-test "string: with space" (cl-tok-values "\"hello world\"") (list "hello world"))
|
|
||||||
(cl-test "string: escaped quote" (cl-tok-values "\"say \\\"hi\\\"\"") (list "say \"hi\""))
|
|
||||||
(cl-test "string: escaped backslash" (cl-tok-values "\"a\\\\b\"") (list "a\\b"))
|
|
||||||
(cl-test "string: newline escape" (cl-tok-values "\"a\\nb\"") (list "a\nb"))
|
|
||||||
(cl-test "string: tab escape" (cl-tok-values "\"a\\tb\"") (list "a\tb"))
|
|
||||||
|
|
||||||
;; ── characters ────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "char: lowercase a" (cl-tok-values "#\\a") (list "a"))
|
|
||||||
(cl-test "char: uppercase A" (cl-tok-values "#\\A") (list "A"))
|
|
||||||
(cl-test "char: digit" (cl-tok-values "#\\1") (list "1"))
|
|
||||||
(cl-test "char: type" (cl-tok-types "#\\a") (list "char"))
|
|
||||||
(cl-test "char: Space" (cl-tok-values "#\\Space") (list " "))
|
|
||||||
(cl-test "char: Newline" (cl-tok-values "#\\Newline") (list "\n"))
|
|
||||||
(cl-test "char: Tab" (cl-tok-values "#\\Tab") (list "\t"))
|
|
||||||
(cl-test "char: Return" (cl-tok-values "#\\Return") (list "\r"))
|
|
||||||
|
|
||||||
;; ── reader macros ─────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "quote: type" (cl-tok-types "'x") (list "quote" "symbol"))
|
|
||||||
(cl-test "backquote: type" (cl-tok-types "`x") (list "backquote" "symbol"))
|
|
||||||
(cl-test "comma: type" (cl-tok-types ",x") (list "comma" "symbol"))
|
|
||||||
(cl-test "comma-at: type" (cl-tok-types ",@x") (list "comma-at" "symbol"))
|
|
||||||
(cl-test "hash-quote: type" (cl-tok-types "#'foo") (list "hash-quote" "symbol"))
|
|
||||||
(cl-test "hash-paren: type" (cl-tok-types "#(1 2)") (list "hash-paren" "integer" "integer" "rparen"))
|
|
||||||
|
|
||||||
;; ── uninterned ────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "uninterned: type" (cl-tok-types "#:foo") (list "uninterned"))
|
|
||||||
(cl-test "uninterned: value upcase" (cl-tok-values "#:foo") (list "FOO"))
|
|
||||||
(cl-test "uninterned: compound" (cl-tok-values "#:my-sym") (list "MY-SYM"))
|
|
||||||
|
|
||||||
;; ── parens and structure ──────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "paren: empty list" (cl-tok-types "()") (list "lparen" "rparen"))
|
|
||||||
(cl-test "paren: nested" (cl-tok-types "((a))") (list "lparen" "lparen" "symbol" "rparen" "rparen"))
|
|
||||||
(cl-test "dot: standalone" (cl-tok-types "(a . b)") (list "lparen" "symbol" "dot" "symbol" "rparen"))
|
|
||||||
|
|
||||||
;; ── comments ──────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test "comment: line" (cl-tok-types "; comment\nfoo") (list "symbol"))
|
|
||||||
(cl-test "comment: inline" (cl-tok-values "foo ; bar\nbaz") (list "FOO" "BAZ"))
|
|
||||||
(cl-test "block-comment: basic" (cl-tok-types "#| hello |# foo") (list "symbol"))
|
|
||||||
(cl-test "block-comment: nested" (cl-tok-types "#| a #| b |# c |# x") (list "symbol"))
|
|
||||||
|
|
||||||
;; ── combined ──────────────────────────────────────────────────────
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"combined: defun skeleton"
|
|
||||||
(cl-tok-types "(defun foo (x) x)")
|
|
||||||
(list "lparen" "symbol" "symbol" "lparen" "symbol" "rparen" "symbol" "rparen"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"combined: let form"
|
|
||||||
(cl-tok-types "(let ((x 1)) x)")
|
|
||||||
(list
|
|
||||||
"lparen"
|
|
||||||
"symbol"
|
|
||||||
"lparen"
|
|
||||||
"lparen"
|
|
||||||
"symbol"
|
|
||||||
"integer"
|
|
||||||
"rparen"
|
|
||||||
"rparen"
|
|
||||||
"symbol"
|
|
||||||
"rparen"))
|
|
||||||
|
|
||||||
(cl-test
|
|
||||||
"combined: whitespace skip"
|
|
||||||
(cl-tok-values " foo bar baz ")
|
|
||||||
(list "FOO" "BAR" "BAZ"))
|
|
||||||
|
|
||||||
(cl-test "eof: present" (get (nth (cl-tokenize "") 0) "type") "eof")
|
|
||||||
(cl-test "eof: at end of tokens" (get (nth (cl-tokenize "x") 1) "type") "eof")
|
|
||||||
831
lib/ruby/parser.sx
Normal file
831
lib/ruby/parser.sx
Normal file
@@ -0,0 +1,831 @@
|
|||||||
|
;; Ruby parser: token list → AST.
|
||||||
|
;; Entry: (rb-parse tokens) or (rb-parse-str src)
|
||||||
|
;; AST nodes: dicts with :type plus type-specific fields.
|
||||||
|
|
||||||
|
(define rb-parse
|
||||||
|
(fn (tokens)
|
||||||
|
(let ((pos 0) (tok-count (len tokens)))
|
||||||
|
|
||||||
|
(define rb-p-cur
|
||||||
|
(fn () (nth tokens pos)))
|
||||||
|
(define rb-p-peek
|
||||||
|
(fn (n)
|
||||||
|
(if (< (+ pos n) tok-count)
|
||||||
|
(nth tokens (+ pos n))
|
||||||
|
{:type "eof" :value nil :line 0 :col 0})))
|
||||||
|
(define rb-p-advance!
|
||||||
|
(fn () (set! pos (+ pos 1))))
|
||||||
|
(define rb-p-type
|
||||||
|
(fn () (get (rb-p-cur) :type)))
|
||||||
|
(define rb-p-val
|
||||||
|
(fn () (get (rb-p-cur) :value)))
|
||||||
|
(define rb-p-sep?
|
||||||
|
(fn () (or (= (rb-p-type) "newline") (= (rb-p-type) "semi"))))
|
||||||
|
(define rb-p-skip-seps!
|
||||||
|
(fn ()
|
||||||
|
(when (rb-p-sep?)
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-seps!)))))
|
||||||
|
(define rb-p-skip-newlines!
|
||||||
|
(fn ()
|
||||||
|
(when (= (rb-p-type) "newline")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!)))))
|
||||||
|
(define rb-p-expect!
|
||||||
|
(fn (type)
|
||||||
|
(if (= (rb-p-type) type)
|
||||||
|
(let ((tok (rb-p-cur)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
tok)
|
||||||
|
{:type "error"
|
||||||
|
:msg (join "" (list "expected " type " got " (rb-p-type)))})))
|
||||||
|
(define rb-p-expect-kw!
|
||||||
|
(fn (kw)
|
||||||
|
(when (and (= (rb-p-type) "keyword") (= (rb-p-val) kw))
|
||||||
|
(rb-p-advance!))))
|
||||||
|
|
||||||
|
;; Block: do |params| body end or { |params| body }
|
||||||
|
(define rb-p-parse-block-params
|
||||||
|
(fn ()
|
||||||
|
(if (= (rb-p-type) "pipe")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((params (list)))
|
||||||
|
(define rb-p-bp-loop
|
||||||
|
(fn ()
|
||||||
|
(when (not (or (= (rb-p-type) "pipe") (= (rb-p-type) "eof")))
|
||||||
|
(do
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(append! params {:type "param-kwrest" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!)))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (= (rb-p-type) "ident")
|
||||||
|
(do
|
||||||
|
(append! params {:type "param-rest" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!))
|
||||||
|
(append! params {:type "param-rest" :name nil}))))
|
||||||
|
(:else
|
||||||
|
(do
|
||||||
|
(append! params {:type "param-req" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!))))
|
||||||
|
(when (= (rb-p-type) "comma") (rb-p-advance!))
|
||||||
|
(rb-p-bp-loop)))))
|
||||||
|
(rb-p-bp-loop)
|
||||||
|
(rb-p-expect! "pipe")
|
||||||
|
params))
|
||||||
|
(list))))
|
||||||
|
|
||||||
|
(define rb-p-parse-block
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "do"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((params (rb-p-parse-block-params)))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(let ((body (rb-p-parse-stmts (list "end"))))
|
||||||
|
(rb-p-expect-kw! "end")
|
||||||
|
{:type "block" :params params :body body}))))
|
||||||
|
((= (rb-p-type) "lbrace")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((params (rb-p-parse-block-params)))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(let ((body (rb-p-parse-stmts (list "rbrace"))))
|
||||||
|
(rb-p-expect! "rbrace")
|
||||||
|
{:type "block" :params params :body body}))))
|
||||||
|
(:else nil))))
|
||||||
|
|
||||||
|
;; Method def params
|
||||||
|
(define rb-p-parse-def-params
|
||||||
|
(fn ()
|
||||||
|
(let ((params (list)))
|
||||||
|
(define rb-p-dp-one
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "&"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(append! params {:type "param-block" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!)))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(append! params {:type "param-kwrest" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!)))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (= (rb-p-type) "ident")
|
||||||
|
(do
|
||||||
|
(append! params {:type "param-rest" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!))
|
||||||
|
(append! params {:type "param-rest" :name nil}))))
|
||||||
|
((and (= (rb-p-type) "ident")
|
||||||
|
(= (get (rb-p-peek 1) :type) "colon"))
|
||||||
|
(do
|
||||||
|
(let ((name (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (or (rb-p-sep?) (= (rb-p-type) "comma")
|
||||||
|
(= (rb-p-type) "rparen") (= (rb-p-type) "eof"))
|
||||||
|
(append! params {:type "param-kw" :name name :default nil})
|
||||||
|
(append! params {:type "param-kw" :name name
|
||||||
|
:default (rb-p-parse-assign)})))))
|
||||||
|
(:else
|
||||||
|
(let ((name (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (and (= (rb-p-type) "op") (= (rb-p-val) "="))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(append! params {:type "param-opt" :name name
|
||||||
|
:default (rb-p-parse-assign)}))
|
||||||
|
(append! params {:type "param-req" :name name})))))))
|
||||||
|
(define rb-p-dp-loop
|
||||||
|
(fn ()
|
||||||
|
(when (not (or (= (rb-p-type) "rparen") (rb-p-sep?)
|
||||||
|
(= (rb-p-type) "eof")))
|
||||||
|
(do
|
||||||
|
(rb-p-dp-one)
|
||||||
|
(when (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!)))
|
||||||
|
(rb-p-dp-loop)))))
|
||||||
|
(rb-p-dp-loop)
|
||||||
|
params)))
|
||||||
|
|
||||||
|
;; def [recv.] name [(params)] body end
|
||||||
|
(define rb-p-parse-def
|
||||||
|
(fn ()
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((recv nil) (name nil))
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "self")
|
||||||
|
(= (get (rb-p-peek 1) :type) "dot"))
|
||||||
|
(do
|
||||||
|
(set! recv {:type "self"})
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! name (rb-p-val))
|
||||||
|
(rb-p-advance!)))
|
||||||
|
((and (= (rb-p-type) "ident")
|
||||||
|
(= (get (rb-p-peek 1) :type) "dot"))
|
||||||
|
(do
|
||||||
|
(set! recv {:type "lvar" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! name (rb-p-val))
|
||||||
|
(rb-p-advance!)))
|
||||||
|
(:else
|
||||||
|
(do
|
||||||
|
(set! name (rb-p-val))
|
||||||
|
(rb-p-advance!))))
|
||||||
|
(let ((params (list)))
|
||||||
|
(cond
|
||||||
|
((= (rb-p-type) "lparen")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(set! params (rb-p-parse-def-params))
|
||||||
|
(rb-p-expect! "rparen")))
|
||||||
|
((not (or (rb-p-sep?) (= (rb-p-type) "eof")))
|
||||||
|
(set! params (rb-p-parse-def-params)))
|
||||||
|
(:else nil))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(let ((body (rb-p-parse-stmts (list "end"))))
|
||||||
|
(rb-p-expect-kw! "end")
|
||||||
|
{:type "method-def" :recv recv :name name
|
||||||
|
:params params :body body})))))
|
||||||
|
|
||||||
|
;; class [<<obj | Name [<Super]] body end
|
||||||
|
(define rb-p-parse-class
|
||||||
|
(fn ()
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (and (= (rb-p-type) "op") (= (rb-p-val) "<<"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((obj (rb-p-parse-primary)))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(let ((body (rb-p-parse-stmts (list "end"))))
|
||||||
|
(rb-p-expect-kw! "end")
|
||||||
|
{:type "sclass" :obj obj :body body})))
|
||||||
|
(let ((name (rb-p-parse-const-path)))
|
||||||
|
(let ((super nil))
|
||||||
|
(when (and (= (rb-p-type) "op") (= (rb-p-val) "<"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! super (rb-p-parse-const-path))))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(let ((body (rb-p-parse-stmts (list "end"))))
|
||||||
|
(rb-p-expect-kw! "end")
|
||||||
|
{:type "class-def" :name name :super super :body body}))))))
|
||||||
|
|
||||||
|
;; module Name body end
|
||||||
|
(define rb-p-parse-module
|
||||||
|
(fn ()
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((name (rb-p-parse-const-path)))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(let ((body (rb-p-parse-stmts (list "end"))))
|
||||||
|
(rb-p-expect-kw! "end")
|
||||||
|
{:type "module-def" :name name :body body}))))
|
||||||
|
|
||||||
|
;; Const or Const::Const::...
|
||||||
|
(define rb-p-parse-const-path
|
||||||
|
(fn ()
|
||||||
|
(let ((node {:type "const" :name (rb-p-val)}))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(define rb-p-cp-loop
|
||||||
|
(fn ()
|
||||||
|
(when (= (rb-p-type) "dcolon")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((name (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "const-path" :left node :name name})
|
||||||
|
(rb-p-cp-loop))))))
|
||||||
|
(rb-p-cp-loop)
|
||||||
|
node)))
|
||||||
|
|
||||||
|
;; [e, *e, ...]
|
||||||
|
(define rb-p-parse-array
|
||||||
|
(fn ()
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(let ((elems (list)))
|
||||||
|
(define rb-p-arr-loop
|
||||||
|
(fn ()
|
||||||
|
(when (not (or (= (rb-p-type) "rbracket") (= (rb-p-type) "eof")))
|
||||||
|
(do
|
||||||
|
(if (and (= (rb-p-type) "op") (= (rb-p-val) "*"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(append! elems {:type "splat" :value (rb-p-parse-assign)}))
|
||||||
|
(append! elems (rb-p-parse-assign)))
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(when (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!)))
|
||||||
|
(rb-p-arr-loop)))))
|
||||||
|
(rb-p-arr-loop)
|
||||||
|
(rb-p-expect! "rbracket")
|
||||||
|
{:type "array" :elems elems})))
|
||||||
|
|
||||||
|
;; {k: v, k => v, ...}
|
||||||
|
(define rb-p-parse-hash
|
||||||
|
(fn ()
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(let ((pairs (list)))
|
||||||
|
(define rb-p-hash-loop
|
||||||
|
(fn ()
|
||||||
|
(when (not (or (= (rb-p-type) "rbrace") (= (rb-p-type) "eof")))
|
||||||
|
(do
|
||||||
|
(let ((key nil) (val nil) (style nil))
|
||||||
|
(cond
|
||||||
|
((and (or (= (rb-p-type) "ident") (= (rb-p-type) "const"))
|
||||||
|
(= (get (rb-p-peek 1) :type) "colon"))
|
||||||
|
(do
|
||||||
|
(set! key {:type "lit-sym" :value (rb-p-val)})
|
||||||
|
(set! style "colon")
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-advance!)))
|
||||||
|
(:else
|
||||||
|
(do
|
||||||
|
(set! key (rb-p-parse-assign))
|
||||||
|
(set! style "rocket")
|
||||||
|
(when (and (= (rb-p-type) "op") (= (rb-p-val) "=>"))
|
||||||
|
(rb-p-advance!)))))
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(set! val (rb-p-parse-assign))
|
||||||
|
(append! pairs {:key key :val val :style style}))
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(when (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!)))
|
||||||
|
(rb-p-hash-loop)))))
|
||||||
|
(rb-p-hash-loop)
|
||||||
|
(rb-p-expect! "rbrace")
|
||||||
|
{:type "hash" :pairs pairs})))
|
||||||
|
|
||||||
|
;; (a, *b, **c, &d)
|
||||||
|
(define rb-p-parse-args-parens
|
||||||
|
(fn ()
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(let ((args (list)))
|
||||||
|
(define rb-p-ap-loop
|
||||||
|
(fn ()
|
||||||
|
(when (not (or (= (rb-p-type) "rparen") (= (rb-p-type) "eof")))
|
||||||
|
(do
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
(append! args {:type "dsplat" :value (rb-p-parse-assign)})))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
(append! args {:type "splat" :value (rb-p-parse-assign)})))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "&"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
(append! args {:type "block-pass" :value (rb-p-parse-assign)})))
|
||||||
|
(:else (append! args (rb-p-parse-assign))))
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(when (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!)))
|
||||||
|
(rb-p-ap-loop)))))
|
||||||
|
(rb-p-ap-loop)
|
||||||
|
(rb-p-expect! "rparen")
|
||||||
|
args)))
|
||||||
|
|
||||||
|
;; No-paren arg list up to sep/end-keyword
|
||||||
|
(define rb-p-parse-args-bare
|
||||||
|
(fn ()
|
||||||
|
(let ((args (list)) (going true))
|
||||||
|
(define rb-p-ab-loop
|
||||||
|
(fn ()
|
||||||
|
(when (and going
|
||||||
|
(not (rb-p-sep?))
|
||||||
|
(not (= (rb-p-type) "eof"))
|
||||||
|
(not (= (rb-p-type) "rparen"))
|
||||||
|
(not (= (rb-p-type) "rbracket"))
|
||||||
|
(not (= (rb-p-type) "rbrace"))
|
||||||
|
(not (and (= (rb-p-type) "keyword")
|
||||||
|
(contains? (list "end" "else" "elsif" "when"
|
||||||
|
"rescue" "ensure" "then" "do")
|
||||||
|
(rb-p-val)))))
|
||||||
|
(do
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
(append! args {:type "splat" :value (rb-p-parse-assign)})))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "**"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
(append! args {:type "dsplat" :value (rb-p-parse-assign)})))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "&"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
(append! args {:type "block-pass" :value (rb-p-parse-assign)})))
|
||||||
|
(:else (append! args (rb-p-parse-assign))))
|
||||||
|
(if (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!) (rb-p-ab-loop))
|
||||||
|
(set! going false))))))
|
||||||
|
(rb-p-ab-loop)
|
||||||
|
args)))
|
||||||
|
|
||||||
|
;; Primary expression
|
||||||
|
(define rb-p-parse-primary
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((= (rb-p-type) "int")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-int" :value v}))
|
||||||
|
((= (rb-p-type) "float")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-float" :value v}))
|
||||||
|
((= (rb-p-type) "string")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-str" :value v}))
|
||||||
|
((= (rb-p-type) "symbol")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-sym" :value v}))
|
||||||
|
((= (rb-p-type) "words")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-words" :elems v}))
|
||||||
|
((= (rb-p-type) "isymbols")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "lit-isyms" :elems v}))
|
||||||
|
((= (rb-p-type) "ivar")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "ivar" :name v}))
|
||||||
|
((= (rb-p-type) "cvar")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "cvar" :name v}))
|
||||||
|
((= (rb-p-type) "gvar")
|
||||||
|
(let ((v (rb-p-val))) (rb-p-advance!) {:type "gvar" :name v}))
|
||||||
|
((= (rb-p-type) "const")
|
||||||
|
(rb-p-parse-const-path))
|
||||||
|
((= (rb-p-type) "ident")
|
||||||
|
(let ((name (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (= (rb-p-type) "lparen")
|
||||||
|
(let ((args (rb-p-parse-args-parens))
|
||||||
|
(blk (rb-p-parse-block)))
|
||||||
|
{:type "send" :name name :args args :block blk})
|
||||||
|
{:type "send" :name name :args (list) :block nil})))
|
||||||
|
((= (rb-p-type) "keyword")
|
||||||
|
(cond
|
||||||
|
((= (rb-p-val) "nil")
|
||||||
|
(do (rb-p-advance!) {:type "lit-nil"}))
|
||||||
|
((= (rb-p-val) "true")
|
||||||
|
(do (rb-p-advance!) {:type "lit-bool" :value true}))
|
||||||
|
((= (rb-p-val) "false")
|
||||||
|
(do (rb-p-advance!) {:type "lit-bool" :value false}))
|
||||||
|
((= (rb-p-val) "self")
|
||||||
|
(do (rb-p-advance!) {:type "self"}))
|
||||||
|
((= (rb-p-val) "super")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((args (if (= (rb-p-type) "lparen")
|
||||||
|
(rb-p-parse-args-parens) (list)))
|
||||||
|
(blk (rb-p-parse-block)))
|
||||||
|
{:type "send" :name "super" :args args :block blk})))
|
||||||
|
(:else
|
||||||
|
{:type "error"
|
||||||
|
:msg (join "" (list "unexpected kw " (rb-p-val)))})))
|
||||||
|
((= (rb-p-type) "lbracket")
|
||||||
|
(rb-p-parse-array))
|
||||||
|
((= (rb-p-type) "lbrace")
|
||||||
|
(rb-p-parse-hash))
|
||||||
|
((= (rb-p-type) "lparen")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(let ((node (rb-p-parse-expr)))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(rb-p-expect! "rparen")
|
||||||
|
node)))
|
||||||
|
(:else
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
{:type "error"
|
||||||
|
:msg (join "" (list "unexpected " (rb-p-type)
|
||||||
|
" '" (or (rb-p-val) "") "'"))})))))
|
||||||
|
|
||||||
|
;; .method ::Const [index] chains
|
||||||
|
(define rb-p-parse-postfix
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-primary)))
|
||||||
|
(define rb-p-pf-loop
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((= (rb-p-type) "dot")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((method (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((args (if (= (rb-p-type) "lparen")
|
||||||
|
(rb-p-parse-args-parens) (list)))
|
||||||
|
(blk (rb-p-parse-block)))
|
||||||
|
(set! node {:type "call" :recv node :method method
|
||||||
|
:args args :block blk})
|
||||||
|
(rb-p-pf-loop)))))
|
||||||
|
((= (rb-p-type) "dcolon")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(let ((name (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (= (rb-p-type) "lparen")
|
||||||
|
(let ((args (rb-p-parse-args-parens))
|
||||||
|
(blk (rb-p-parse-block)))
|
||||||
|
(set! node {:type "call" :recv node :method name
|
||||||
|
:args args :block blk}))
|
||||||
|
(set! node {:type "const-path" :left node :name name}))
|
||||||
|
(rb-p-pf-loop))))
|
||||||
|
((= (rb-p-type) "lbracket")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(rb-p-skip-newlines!)
|
||||||
|
(let ((idxargs (list)))
|
||||||
|
(define rb-p-idx-loop
|
||||||
|
(fn ()
|
||||||
|
(when (not (or (= (rb-p-type) "rbracket") (= (rb-p-type) "eof")))
|
||||||
|
(do
|
||||||
|
(append! idxargs (rb-p-parse-assign))
|
||||||
|
(when (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!)))
|
||||||
|
(rb-p-idx-loop)))))
|
||||||
|
(rb-p-idx-loop)
|
||||||
|
(rb-p-expect! "rbracket")
|
||||||
|
(set! node {:type "index" :recv node :args idxargs})
|
||||||
|
(rb-p-pf-loop))))
|
||||||
|
(:else nil))))
|
||||||
|
(rb-p-pf-loop)
|
||||||
|
node)))
|
||||||
|
|
||||||
|
(define rb-p-parse-unary
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "!"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "unop" :op "!" :value (rb-p-parse-unary)}))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "~"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "unop" :op "~" :value (rb-p-parse-unary)}))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "-"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "unop" :op "-" :value (rb-p-parse-unary)}))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "+"))
|
||||||
|
(do (rb-p-advance!) (rb-p-parse-unary)))
|
||||||
|
(:else (rb-p-parse-postfix)))))
|
||||||
|
|
||||||
|
(define rb-p-parse-power
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-unary)))
|
||||||
|
(if (and (= (rb-p-type) "op") (= (rb-p-val) "**"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "binop" :op "**" :left node :right (rb-p-parse-power)})
|
||||||
|
node))))
|
||||||
|
|
||||||
|
(define rb-p-parse-mul
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-power)))
|
||||||
|
(define rb-p-mul-loop
|
||||||
|
(fn ()
|
||||||
|
(if (and (= (rb-p-type) "op")
|
||||||
|
(or (= (rb-p-val) "*") (= (rb-p-val) "/") (= (rb-p-val) "%")))
|
||||||
|
(let ((op (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op op :left node :right (rb-p-parse-power)})
|
||||||
|
(rb-p-mul-loop))
|
||||||
|
node)))
|
||||||
|
(rb-p-mul-loop))))
|
||||||
|
|
||||||
|
(define rb-p-parse-add
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-mul)))
|
||||||
|
(define rb-p-add-loop
|
||||||
|
(fn ()
|
||||||
|
(if (and (= (rb-p-type) "op")
|
||||||
|
(or (= (rb-p-val) "+") (= (rb-p-val) "-")))
|
||||||
|
(let ((op (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op op :left node :right (rb-p-parse-mul)})
|
||||||
|
(rb-p-add-loop))
|
||||||
|
node)))
|
||||||
|
(rb-p-add-loop))))
|
||||||
|
|
||||||
|
(define rb-p-parse-shift
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-add)))
|
||||||
|
(define rb-p-sh-loop
|
||||||
|
(fn ()
|
||||||
|
(if (and (= (rb-p-type) "op")
|
||||||
|
(or (= (rb-p-val) "<<") (= (rb-p-val) ">>")))
|
||||||
|
(let ((op (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op op :left node :right (rb-p-parse-add)})
|
||||||
|
(rb-p-sh-loop))
|
||||||
|
node)))
|
||||||
|
(rb-p-sh-loop))))
|
||||||
|
|
||||||
|
(define rb-p-parse-bitand
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-shift)))
|
||||||
|
(define rb-p-ba-loop
|
||||||
|
(fn ()
|
||||||
|
(if (and (= (rb-p-type) "op") (= (rb-p-val) "&"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op "&" :left node :right (rb-p-parse-shift)})
|
||||||
|
(rb-p-ba-loop))
|
||||||
|
node)))
|
||||||
|
(rb-p-ba-loop))))
|
||||||
|
|
||||||
|
;; | is "pipe" token (not "op")
|
||||||
|
(define rb-p-parse-bitor
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-bitand)))
|
||||||
|
(define rb-p-bo-loop
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((= (rb-p-type) "pipe")
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op "|" :left node :right (rb-p-parse-bitand)})
|
||||||
|
(rb-p-bo-loop)))
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "^"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op "^" :left node :right (rb-p-parse-bitand)})
|
||||||
|
(rb-p-bo-loop)))
|
||||||
|
(:else node))))
|
||||||
|
(rb-p-bo-loop))))
|
||||||
|
|
||||||
|
(define rb-p-parse-comparison
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-bitor)))
|
||||||
|
(if (and (= (rb-p-type) "op")
|
||||||
|
(contains? (list "==" "!=" "<" ">" "<=" ">="
|
||||||
|
"<=>" "===" "=~" "!~") (rb-p-val)))
|
||||||
|
(let ((op (rb-p-val)))
|
||||||
|
(rb-p-advance!)
|
||||||
|
{:type "binop" :op op :left node :right (rb-p-parse-bitor)})
|
||||||
|
node))))
|
||||||
|
|
||||||
|
(define rb-p-parse-not
|
||||||
|
(fn ()
|
||||||
|
(if (and (= (rb-p-type) "keyword") (= (rb-p-val) "not"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "not" :value (rb-p-parse-not)})
|
||||||
|
(rb-p-parse-comparison))))
|
||||||
|
|
||||||
|
(define rb-p-parse-and
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-not)))
|
||||||
|
(define rb-p-and-loop
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "&&"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op "&&" :left node :right (rb-p-parse-not)})
|
||||||
|
(rb-p-and-loop)))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "and"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op "and" :left node :right (rb-p-parse-not)})
|
||||||
|
(rb-p-and-loop)))
|
||||||
|
(:else node))))
|
||||||
|
(rb-p-and-loop))))
|
||||||
|
|
||||||
|
(define rb-p-parse-or
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-and)))
|
||||||
|
(define rb-p-or-loop
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "||"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op "||" :left node :right (rb-p-parse-and)})
|
||||||
|
(rb-p-or-loop)))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "or"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(set! node {:type "binop" :op "or" :left node :right (rb-p-parse-and)})
|
||||||
|
(rb-p-or-loop)))
|
||||||
|
(:else node))))
|
||||||
|
(rb-p-or-loop))))
|
||||||
|
|
||||||
|
(define rb-p-parse-range
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-or)))
|
||||||
|
(cond
|
||||||
|
((= (rb-p-type) "dotdot")
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "range" :from node :to (rb-p-parse-or) :exclusive false}))
|
||||||
|
((= (rb-p-type) "dotdotdot")
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "range" :from node :to (rb-p-parse-or) :exclusive true}))
|
||||||
|
(:else node)))))
|
||||||
|
|
||||||
|
(define rb-p-parse-assign
|
||||||
|
(fn ()
|
||||||
|
(let ((node (rb-p-parse-range)))
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "="))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "assign" :target node :value (rb-p-parse-assign)}))
|
||||||
|
((and (= (rb-p-type) "op")
|
||||||
|
(contains? (list "+=" "-=" "*=" "/=" "%=" "**="
|
||||||
|
"<<=" ">>=" "&=" "|=" "^=" "&&=" "||=")
|
||||||
|
(rb-p-val)))
|
||||||
|
(let ((op (substring (rb-p-val) 0 (- (len (rb-p-val)) 1))))
|
||||||
|
(rb-p-advance!)
|
||||||
|
{:type "op-assign" :target node :op op :value (rb-p-parse-assign)}))
|
||||||
|
(:else node)))))
|
||||||
|
|
||||||
|
(define rb-p-parse-expr
|
||||||
|
(fn () (rb-p-parse-assign)))
|
||||||
|
|
||||||
|
;; e, e, ... → single node or array
|
||||||
|
(define rb-p-parse-multi-val
|
||||||
|
(fn ()
|
||||||
|
(let ((vals (list)))
|
||||||
|
(define rb-p-mv-loop
|
||||||
|
(fn ()
|
||||||
|
(append! vals (rb-p-parse-assign))
|
||||||
|
(when (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!) (rb-p-mv-loop)))))
|
||||||
|
(rb-p-mv-loop)
|
||||||
|
(if (= (len vals) 1)
|
||||||
|
(nth vals 0)
|
||||||
|
{:type "array" :elems vals}))))
|
||||||
|
|
||||||
|
;; a, b, *c = rhs
|
||||||
|
(define rb-p-parse-massign
|
||||||
|
(fn ()
|
||||||
|
(let ((targets (list)))
|
||||||
|
(define rb-p-ma-loop
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "op") (= (rb-p-val) "*"))
|
||||||
|
(do
|
||||||
|
(rb-p-advance!)
|
||||||
|
(if (= (rb-p-type) "ident")
|
||||||
|
(do
|
||||||
|
(append! targets {:type "splat-target" :name (rb-p-val)})
|
||||||
|
(rb-p-advance!))
|
||||||
|
(append! targets {:type "splat-target" :name nil}))))
|
||||||
|
((= (rb-p-type) "ident")
|
||||||
|
(do (append! targets {:type "lvar" :name (rb-p-val)}) (rb-p-advance!)))
|
||||||
|
((= (rb-p-type) "ivar")
|
||||||
|
(do (append! targets {:type "ivar" :name (rb-p-val)}) (rb-p-advance!)))
|
||||||
|
((= (rb-p-type) "cvar")
|
||||||
|
(do (append! targets {:type "cvar" :name (rb-p-val)}) (rb-p-advance!)))
|
||||||
|
((= (rb-p-type) "gvar")
|
||||||
|
(do (append! targets {:type "gvar" :name (rb-p-val)}) (rb-p-advance!)))
|
||||||
|
((= (rb-p-type) "const")
|
||||||
|
(do (append! targets {:type "const" :name (rb-p-val)}) (rb-p-advance!)))
|
||||||
|
(:else nil))
|
||||||
|
(when (= (rb-p-type) "comma")
|
||||||
|
(do (rb-p-advance!) (rb-p-skip-newlines!) (rb-p-ma-loop)))))
|
||||||
|
(rb-p-ma-loop)
|
||||||
|
(rb-p-advance!)
|
||||||
|
{:type "massign" :targets targets :value (rb-p-parse-multi-val)})))
|
||||||
|
|
||||||
|
(define rb-p-parse-stmt
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "def"))
|
||||||
|
(rb-p-parse-def))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "class"))
|
||||||
|
(rb-p-parse-class))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "module"))
|
||||||
|
(rb-p-parse-module))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "return"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "return"
|
||||||
|
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
|
||||||
|
nil (rb-p-parse-multi-val))}))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "yield"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "yield"
|
||||||
|
:args (cond
|
||||||
|
((= (rb-p-type) "lparen") (rb-p-parse-args-parens))
|
||||||
|
((or (rb-p-sep?) (= (rb-p-type) "eof")) (list))
|
||||||
|
(:else (rb-p-parse-args-bare)))}))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "break"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "break"
|
||||||
|
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
|
||||||
|
nil (rb-p-parse-expr))}))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "next"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "next"
|
||||||
|
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
|
||||||
|
nil (rb-p-parse-expr))}))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "redo"))
|
||||||
|
(do (rb-p-advance!) {:type "redo"}))
|
||||||
|
((and (= (rb-p-type) "keyword") (= (rb-p-val) "raise"))
|
||||||
|
(do (rb-p-advance!)
|
||||||
|
{:type "raise"
|
||||||
|
:value (if (or (rb-p-sep?) (= (rb-p-type) "eof"))
|
||||||
|
nil (rb-p-parse-expr))}))
|
||||||
|
;; Massign: token followed by comma
|
||||||
|
((and (or (= (rb-p-type) "ident") (= (rb-p-type) "ivar")
|
||||||
|
(= (rb-p-type) "cvar") (= (rb-p-type) "gvar")
|
||||||
|
(= (rb-p-type) "const"))
|
||||||
|
(= (get (rb-p-peek 1) :type) "comma"))
|
||||||
|
(rb-p-parse-massign))
|
||||||
|
(:else
|
||||||
|
(let ((node (rb-p-parse-assign)))
|
||||||
|
(if (and (= (get node :type) "send")
|
||||||
|
(= (len (get node :args)) 0)
|
||||||
|
(nil? (get node :block)))
|
||||||
|
;; Bare send: check for block or no-paren args
|
||||||
|
(cond
|
||||||
|
;; Block immediately follows (do or {)
|
||||||
|
((or (and (= (rb-p-type) "keyword") (= (rb-p-val) "do"))
|
||||||
|
(= (rb-p-type) "lbrace"))
|
||||||
|
(let ((blk (rb-p-parse-block)))
|
||||||
|
{:type "send" :name (get node :name) :args (list) :block blk}))
|
||||||
|
;; No-paren args (stop before block/sep/end keywords)
|
||||||
|
((and (not (rb-p-sep?))
|
||||||
|
(not (= (rb-p-type) "eof"))
|
||||||
|
(not (= (rb-p-type) "op"))
|
||||||
|
(not (= (rb-p-type) "dot"))
|
||||||
|
(not (= (rb-p-type) "dcolon"))
|
||||||
|
(not (= (rb-p-type) "rparen"))
|
||||||
|
(not (= (rb-p-type) "rbracket"))
|
||||||
|
(not (= (rb-p-type) "rbrace"))
|
||||||
|
(not (= (rb-p-type) "lbrace"))
|
||||||
|
(not (and (= (rb-p-type) "keyword")
|
||||||
|
(contains? (list "end" "else" "elsif" "when"
|
||||||
|
"rescue" "ensure" "then" "do"
|
||||||
|
"and" "or" "not")
|
||||||
|
(rb-p-val)))))
|
||||||
|
(let ((args (rb-p-parse-args-bare))
|
||||||
|
(blk (rb-p-parse-block)))
|
||||||
|
(if (> (len args) 0)
|
||||||
|
{:type "send" :name (get node :name) :args args :block blk}
|
||||||
|
node)))
|
||||||
|
(:else node))
|
||||||
|
node))))))
|
||||||
|
|
||||||
|
(define rb-p-parse-stmts
|
||||||
|
(fn (terminators)
|
||||||
|
(let ((stmts (list)))
|
||||||
|
(define rb-p-at-term?
|
||||||
|
(fn ()
|
||||||
|
(or (= (rb-p-type) "eof")
|
||||||
|
(and (= (rb-p-type) "keyword")
|
||||||
|
(contains? terminators (rb-p-val)))
|
||||||
|
(and (= (rb-p-type) "rbrace")
|
||||||
|
(contains? terminators "rbrace")))))
|
||||||
|
(define rb-p-ps-loop
|
||||||
|
(fn ()
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(when (not (rb-p-at-term?))
|
||||||
|
(do
|
||||||
|
(append! stmts (rb-p-parse-stmt))
|
||||||
|
(rb-p-skip-seps!)
|
||||||
|
(rb-p-ps-loop)))))
|
||||||
|
(rb-p-ps-loop)
|
||||||
|
stmts)))
|
||||||
|
|
||||||
|
{:type "program" :stmts (rb-p-parse-stmts (list))})))
|
||||||
|
|
||||||
|
(define rb-parse-str
|
||||||
|
(fn (src) (rb-parse (rb-tokenize src))))
|
||||||
92
lib/ruby/test.sh
Executable file
92
lib/ruby/test.sh
Executable file
@@ -0,0 +1,92 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
# Ruby-on-SX test runner.
|
||||||
|
# Usage:
|
||||||
|
# bash lib/ruby/test.sh # run all tests
|
||||||
|
# bash lib/ruby/test.sh -v # verbose
|
||||||
|
# bash lib/ruby/test.sh tests/parse.sx # single file
|
||||||
|
|
||||||
|
set -euo pipefail
|
||||||
|
cd "$(git rev-parse --show-toplevel)"
|
||||||
|
|
||||||
|
SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||||
|
if [ ! -x "$SX_SERVER" ]; then
|
||||||
|
MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
|
||||||
|
if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
|
||||||
|
SX_SERVER="$MAIN_ROOT/$SX_SERVER"
|
||||||
|
else
|
||||||
|
echo "ERROR: sx_server.exe not found."
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
fi
|
||||||
|
|
||||||
|
VERBOSE=""
|
||||||
|
FILES=()
|
||||||
|
for arg in "$@"; do
|
||||||
|
case "$arg" in
|
||||||
|
-v|--verbose) VERBOSE=1 ;;
|
||||||
|
*) FILES+=("$arg") ;;
|
||||||
|
esac
|
||||||
|
done
|
||||||
|
|
||||||
|
if [ ${#FILES[@]} -eq 0 ]; then
|
||||||
|
mapfile -t FILES < <(find lib/ruby/tests -maxdepth 2 -name '*.sx' | sort)
|
||||||
|
fi
|
||||||
|
|
||||||
|
TOTAL_PASS=0
|
||||||
|
TOTAL_FAIL=0
|
||||||
|
FAILED_FILES=()
|
||||||
|
|
||||||
|
for FILE in "${FILES[@]}"; do
|
||||||
|
[ -f "$FILE" ] || { echo "skip $FILE (not found)"; continue; }
|
||||||
|
TMPFILE=$(mktemp)
|
||||||
|
# Build epoch sequence: load runtime files, then test file, then eval summary.
|
||||||
|
{
|
||||||
|
echo "(epoch 1)"
|
||||||
|
echo "(load \"lib/ruby/tokenizer.sx\")"
|
||||||
|
if [ -f "lib/ruby/parser.sx" ]; then
|
||||||
|
echo "(epoch 2)"
|
||||||
|
echo "(load \"lib/ruby/parser.sx\")"
|
||||||
|
fi
|
||||||
|
echo "(epoch 3)"
|
||||||
|
echo "(load \"$FILE\")"
|
||||||
|
echo "(epoch 4)"
|
||||||
|
echo "(eval \"(list rb-test-pass rb-test-fail)\")"
|
||||||
|
} > "$TMPFILE"
|
||||||
|
|
||||||
|
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
|
||||||
|
rm -f "$TMPFILE"
|
||||||
|
|
||||||
|
# Extract epoch 4 result: (ok-len 4 N)\n<val> or (ok 4 <val>)
|
||||||
|
LINE=$(printf '%s\n' "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
|
||||||
|
if [ -z "$LINE" ]; then
|
||||||
|
LINE=$(printf '%s\n' "$OUTPUT" \
|
||||||
|
| grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
|
||||||
|
| sed -E 's/^\(ok 4 //; s/\)$//')
|
||||||
|
fi
|
||||||
|
if [ -z "$LINE" ]; then
|
||||||
|
echo "✗ $FILE: could not extract summary"
|
||||||
|
printf '%s\n' "$OUTPUT" | grep -v '^(ok ' | tail -10
|
||||||
|
TOTAL_FAIL=$((TOTAL_FAIL + 1))
|
||||||
|
FAILED_FILES+=("$FILE")
|
||||||
|
continue
|
||||||
|
fi
|
||||||
|
P=$(printf '%s\n' "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
|
||||||
|
F=$(printf '%s\n' "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
|
||||||
|
TOTAL_PASS=$((TOTAL_PASS + P))
|
||||||
|
TOTAL_FAIL=$((TOTAL_FAIL + F))
|
||||||
|
if [ "$F" -gt 0 ]; then
|
||||||
|
FAILED_FILES+=("$FILE")
|
||||||
|
printf '✗ %-40s %d/%d\n' "$FILE" "$P" "$((P+F))"
|
||||||
|
elif [ "$VERBOSE" = "1" ]; then
|
||||||
|
printf '✓ %-40s %d passed\n' "$FILE" "$P"
|
||||||
|
fi
|
||||||
|
done
|
||||||
|
|
||||||
|
TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
|
||||||
|
if [ $TOTAL_FAIL -eq 0 ]; then
|
||||||
|
echo "✓ $TOTAL_PASS/$TOTAL ruby-on-sx tests passed"
|
||||||
|
else
|
||||||
|
echo "✗ $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed in: ${FAILED_FILES[*]}"
|
||||||
|
fi
|
||||||
|
|
||||||
|
[ $TOTAL_FAIL -eq 0 ]
|
||||||
439
lib/ruby/tests/parse.sx
Normal file
439
lib/ruby/tests/parse.sx
Normal file
@@ -0,0 +1,439 @@
|
|||||||
|
;; Parser tests for Ruby 2.7 subset.
|
||||||
|
|
||||||
|
(define rb-deep=?
|
||||||
|
(fn (a b)
|
||||||
|
(cond
|
||||||
|
((= a b) true)
|
||||||
|
((and (dict? a) (dict? b))
|
||||||
|
(let ((ak (keys a)) (bk (keys b)))
|
||||||
|
(if (not (= (len ak) (len bk)))
|
||||||
|
false
|
||||||
|
(every?
|
||||||
|
(fn (k)
|
||||||
|
(and (has-key? b k) (rb-deep=? (get a k) (get b k))))
|
||||||
|
ak))))
|
||||||
|
((and (list? a) (list? b))
|
||||||
|
(if (not (= (len a) (len b)))
|
||||||
|
false
|
||||||
|
(let ((i 0) (ok true))
|
||||||
|
(define rb-de-loop
|
||||||
|
(fn ()
|
||||||
|
(when (and ok (< i (len a)))
|
||||||
|
(do
|
||||||
|
(when (not (rb-deep=? (nth a i) (nth b i)))
|
||||||
|
(set! ok false))
|
||||||
|
(set! i (+ i 1))
|
||||||
|
(rb-de-loop)))))
|
||||||
|
(rb-de-loop)
|
||||||
|
ok)))
|
||||||
|
(:else false))))
|
||||||
|
|
||||||
|
(define rb-test-pass 0)
|
||||||
|
(define rb-test-fail 0)
|
||||||
|
(define rb-test-fails (list))
|
||||||
|
|
||||||
|
(define rb-test
|
||||||
|
(fn (name actual expected)
|
||||||
|
(if (rb-deep=? actual expected)
|
||||||
|
(set! rb-test-pass (+ rb-test-pass 1))
|
||||||
|
(do
|
||||||
|
(set! rb-test-fail (+ rb-test-fail 1))
|
||||||
|
(append! rb-test-fails {:name name :actual actual :expected expected})))))
|
||||||
|
|
||||||
|
;; Shorthand: parse src and extract :stmts list
|
||||||
|
(define rb-p-stmts
|
||||||
|
(fn (src)
|
||||||
|
(get (rb-parse-str src) :stmts)))
|
||||||
|
|
||||||
|
;; Shorthand: parse and get first statement
|
||||||
|
(define rb-p-first
|
||||||
|
(fn (src)
|
||||||
|
(nth (rb-p-stmts src) 0)))
|
||||||
|
|
||||||
|
;; ── Literals ─────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "int literal"
|
||||||
|
(rb-p-first "42")
|
||||||
|
{:type "lit-int" :value 42})
|
||||||
|
|
||||||
|
(rb-test "negative int"
|
||||||
|
(rb-p-first "-7")
|
||||||
|
{:type "unop" :op "-" :value {:type "lit-int" :value 7}})
|
||||||
|
|
||||||
|
(rb-test "float literal"
|
||||||
|
(rb-p-first "3.14")
|
||||||
|
{:type "lit-float" :value "3.14"})
|
||||||
|
|
||||||
|
(rb-test "string literal"
|
||||||
|
(rb-p-first "\"hello\"")
|
||||||
|
{:type "lit-str" :value "hello"})
|
||||||
|
|
||||||
|
(rb-test "symbol literal"
|
||||||
|
(rb-p-first ":foo")
|
||||||
|
{:type "lit-sym" :value "foo"})
|
||||||
|
|
||||||
|
(rb-test "nil literal"
|
||||||
|
(rb-p-first "nil")
|
||||||
|
{:type "lit-nil"})
|
||||||
|
|
||||||
|
(rb-test "true literal"
|
||||||
|
(rb-p-first "true")
|
||||||
|
{:type "lit-bool" :value true})
|
||||||
|
|
||||||
|
(rb-test "false literal"
|
||||||
|
(rb-p-first "false")
|
||||||
|
{:type "lit-bool" :value false})
|
||||||
|
|
||||||
|
(rb-test "self"
|
||||||
|
(rb-p-first "self")
|
||||||
|
{:type "self"})
|
||||||
|
|
||||||
|
(rb-test "%w[] words"
|
||||||
|
(rb-p-first "%w[a b c]")
|
||||||
|
{:type "lit-words" :elems (list "a" "b" "c")})
|
||||||
|
|
||||||
|
(rb-test "%i[] isymbols"
|
||||||
|
(rb-p-first "%i[x y]")
|
||||||
|
{:type "lit-isyms" :elems (list "x" "y")})
|
||||||
|
|
||||||
|
;; ── Variables ─────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "local var / send"
|
||||||
|
(rb-p-first "x")
|
||||||
|
{:type "send" :name "x" :args (list) :block nil})
|
||||||
|
|
||||||
|
(rb-test "ivar"
|
||||||
|
(rb-p-first "@foo")
|
||||||
|
{:type "ivar" :name "@foo"})
|
||||||
|
|
||||||
|
(rb-test "cvar"
|
||||||
|
(rb-p-first "@@count")
|
||||||
|
{:type "cvar" :name "@@count"})
|
||||||
|
|
||||||
|
(rb-test "gvar"
|
||||||
|
(rb-p-first "$stdout")
|
||||||
|
{:type "gvar" :name "$stdout"})
|
||||||
|
|
||||||
|
(rb-test "constant"
|
||||||
|
(rb-p-first "Foo")
|
||||||
|
{:type "const" :name "Foo"})
|
||||||
|
|
||||||
|
(rb-test "const path"
|
||||||
|
(rb-p-first "Foo::Bar")
|
||||||
|
{:type "const-path"
|
||||||
|
:left {:type "const" :name "Foo"}
|
||||||
|
:name "Bar"})
|
||||||
|
|
||||||
|
(rb-test "triple const path"
|
||||||
|
(rb-p-first "A::B::C")
|
||||||
|
{:type "const-path"
|
||||||
|
:left {:type "const-path"
|
||||||
|
:left {:type "const" :name "A"}
|
||||||
|
:name "B"}
|
||||||
|
:name "C"})
|
||||||
|
|
||||||
|
;; ── Arrays and Hashes ─────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "empty array"
|
||||||
|
(rb-p-first "[]")
|
||||||
|
{:type "array" :elems (list)})
|
||||||
|
|
||||||
|
(rb-test "array literal"
|
||||||
|
(rb-p-first "[1, 2, 3]")
|
||||||
|
{:type "array" :elems (list {:type "lit-int" :value 1}
|
||||||
|
{:type "lit-int" :value 2}
|
||||||
|
{:type "lit-int" :value 3})})
|
||||||
|
|
||||||
|
(rb-test "hash colon style"
|
||||||
|
(get (rb-p-first "{a: 1}") :type)
|
||||||
|
"hash")
|
||||||
|
|
||||||
|
(rb-test "hash pair style"
|
||||||
|
(get (nth (get (rb-p-first "{a: 1}") :pairs) 0) :style)
|
||||||
|
"colon")
|
||||||
|
|
||||||
|
(rb-test "hash symbol key"
|
||||||
|
(get (get (nth (get (rb-p-first "{a: 1}") :pairs) 0) :key) :value)
|
||||||
|
"a")
|
||||||
|
|
||||||
|
;; ── Binary operators ──────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "addition"
|
||||||
|
(rb-p-first "1 + 2")
|
||||||
|
{:type "binop" :op "+"
|
||||||
|
:left {:type "lit-int" :value 1}
|
||||||
|
:right {:type "lit-int" :value 2}})
|
||||||
|
|
||||||
|
(rb-test "subtraction"
|
||||||
|
(get (rb-p-first "a - b") :op)
|
||||||
|
"-")
|
||||||
|
|
||||||
|
(rb-test "multiplication"
|
||||||
|
(get (rb-p-first "x * y") :op)
|
||||||
|
"*")
|
||||||
|
|
||||||
|
(rb-test "precedence: * before +"
|
||||||
|
(rb-p-first "1 + 2 * 3")
|
||||||
|
{:type "binop" :op "+"
|
||||||
|
:left {:type "lit-int" :value 1}
|
||||||
|
:right {:type "binop" :op "*"
|
||||||
|
:left {:type "lit-int" :value 2}
|
||||||
|
:right {:type "lit-int" :value 3}}})
|
||||||
|
|
||||||
|
(rb-test "power right-assoc"
|
||||||
|
(rb-p-first "2 ** 3 ** 4")
|
||||||
|
{:type "binop" :op "**"
|
||||||
|
:left {:type "lit-int" :value 2}
|
||||||
|
:right {:type "binop" :op "**"
|
||||||
|
:left {:type "lit-int" :value 3}
|
||||||
|
:right {:type "lit-int" :value 4}}})
|
||||||
|
|
||||||
|
(rb-test "equality"
|
||||||
|
(get (rb-p-first "a == b") :op)
|
||||||
|
"==")
|
||||||
|
|
||||||
|
(rb-test "logical and"
|
||||||
|
(get (rb-p-first "a && b") :op)
|
||||||
|
"&&")
|
||||||
|
|
||||||
|
(rb-test "logical or"
|
||||||
|
(get (rb-p-first "a || b") :op)
|
||||||
|
"||")
|
||||||
|
|
||||||
|
(rb-test "range inclusive"
|
||||||
|
(rb-p-first "1..5")
|
||||||
|
{:type "range"
|
||||||
|
:from {:type "lit-int" :value 1}
|
||||||
|
:to {:type "lit-int" :value 5}
|
||||||
|
:exclusive false})
|
||||||
|
|
||||||
|
(rb-test "range exclusive"
|
||||||
|
(get (rb-p-first "1...5") :exclusive)
|
||||||
|
true)
|
||||||
|
|
||||||
|
;; ── Assignment ────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "assign"
|
||||||
|
(rb-p-first "x = 1")
|
||||||
|
{:type "assign"
|
||||||
|
:target {:type "send" :name "x" :args (list) :block nil}
|
||||||
|
:value {:type "lit-int" :value 1}})
|
||||||
|
|
||||||
|
(rb-test "op-assign +="
|
||||||
|
(get (rb-p-first "x += 1") :type)
|
||||||
|
"op-assign")
|
||||||
|
|
||||||
|
(rb-test "op-assign op"
|
||||||
|
(get (rb-p-first "x += 1") :op)
|
||||||
|
"+")
|
||||||
|
|
||||||
|
(rb-test "massign"
|
||||||
|
(get (rb-p-first "a, b = 1, 2") :type)
|
||||||
|
"massign")
|
||||||
|
|
||||||
|
(rb-test "massign targets"
|
||||||
|
(len (get (rb-p-first "a, b = 1, 2") :targets))
|
||||||
|
2)
|
||||||
|
|
||||||
|
(rb-test "massign value array"
|
||||||
|
(get (get (rb-p-first "a, b = 1, 2") :value) :type)
|
||||||
|
"array")
|
||||||
|
|
||||||
|
;; ── Method calls ──────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "call with parens"
|
||||||
|
(rb-p-first "foo(1, 2)")
|
||||||
|
{:type "send" :name "foo"
|
||||||
|
:args (list {:type "lit-int" :value 1}
|
||||||
|
{:type "lit-int" :value 2})
|
||||||
|
:block nil})
|
||||||
|
|
||||||
|
(rb-test "chained call"
|
||||||
|
(get (rb-p-first "obj.foo") :type)
|
||||||
|
"call")
|
||||||
|
|
||||||
|
(rb-test "chained call method"
|
||||||
|
(get (rb-p-first "obj.foo") :method)
|
||||||
|
"foo")
|
||||||
|
|
||||||
|
(rb-test "chained call with args"
|
||||||
|
(len (get (rb-p-first "obj.foo(1, 2)") :args))
|
||||||
|
2)
|
||||||
|
|
||||||
|
(rb-test "no-paren call"
|
||||||
|
(get (rb-p-first "puts \"hello\"") :type)
|
||||||
|
"send")
|
||||||
|
|
||||||
|
(rb-test "no-paren call name"
|
||||||
|
(get (rb-p-first "puts \"hello\"") :name)
|
||||||
|
"puts")
|
||||||
|
|
||||||
|
(rb-test "no-paren call args"
|
||||||
|
(len (get (rb-p-first "puts \"hello\"") :args))
|
||||||
|
1)
|
||||||
|
|
||||||
|
(rb-test "indexing"
|
||||||
|
(get (rb-p-first "a[0]") :type)
|
||||||
|
"index")
|
||||||
|
|
||||||
|
;; ── Unary operators ───────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "unary not"
|
||||||
|
(rb-p-first "!x")
|
||||||
|
{:type "unop" :op "!"
|
||||||
|
:value {:type "send" :name "x" :args (list) :block nil}})
|
||||||
|
|
||||||
|
(rb-test "unary minus"
|
||||||
|
(get (rb-p-first "-x") :op)
|
||||||
|
"-")
|
||||||
|
|
||||||
|
;; ── Method def ────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "empty method def"
|
||||||
|
(get (rb-p-first "def foo; end") :type)
|
||||||
|
"method-def")
|
||||||
|
|
||||||
|
(rb-test "method def name"
|
||||||
|
(get (rb-p-first "def foo; end") :name)
|
||||||
|
"foo")
|
||||||
|
|
||||||
|
(rb-test "method def no params"
|
||||||
|
(len (get (rb-p-first "def foo; end") :params))
|
||||||
|
0)
|
||||||
|
|
||||||
|
(rb-test "method def with params"
|
||||||
|
(len (get (rb-p-first "def foo(a, b); end") :params))
|
||||||
|
2)
|
||||||
|
|
||||||
|
(rb-test "method def param-req"
|
||||||
|
(get (nth (get (rb-p-first "def foo(a); end") :params) 0) :type)
|
||||||
|
"param-req")
|
||||||
|
|
||||||
|
(rb-test "method def param name"
|
||||||
|
(get (nth (get (rb-p-first "def foo(a); end") :params) 0) :name)
|
||||||
|
"a")
|
||||||
|
|
||||||
|
(rb-test "method def optional param"
|
||||||
|
(get (nth (get (rb-p-first "def foo(a, b=1); end") :params) 1) :type)
|
||||||
|
"param-opt")
|
||||||
|
|
||||||
|
(rb-test "method def splat"
|
||||||
|
(get (nth (get (rb-p-first "def foo(*args); end") :params) 0) :type)
|
||||||
|
"param-rest")
|
||||||
|
|
||||||
|
(rb-test "method def double splat"
|
||||||
|
(get (nth (get (rb-p-first "def foo(**opts); end") :params) 0) :type)
|
||||||
|
"param-kwrest")
|
||||||
|
|
||||||
|
(rb-test "method def block param"
|
||||||
|
(get (nth (get (rb-p-first "def foo(&blk); end") :params) 0) :type)
|
||||||
|
"param-block")
|
||||||
|
|
||||||
|
(rb-test "method def all param types"
|
||||||
|
(len (get (rb-p-first "def foo(a, b=1, *c, **d, &e); end") :params))
|
||||||
|
5)
|
||||||
|
|
||||||
|
(rb-test "method def singleton recv"
|
||||||
|
(get (get (rb-p-first "def self.bar; end") :recv) :type)
|
||||||
|
"self")
|
||||||
|
|
||||||
|
(rb-test "method def body"
|
||||||
|
(len (get (rb-p-first "def foo; 1; 2; end") :body))
|
||||||
|
2)
|
||||||
|
|
||||||
|
;; ── Class def ────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "class def type"
|
||||||
|
(get (rb-p-first "class Foo; end") :type)
|
||||||
|
"class-def")
|
||||||
|
|
||||||
|
(rb-test "class def name"
|
||||||
|
(get (get (rb-p-first "class Foo; end") :name) :name)
|
||||||
|
"Foo")
|
||||||
|
|
||||||
|
(rb-test "class def no super"
|
||||||
|
(nil? (get (rb-p-first "class Foo; end") :super))
|
||||||
|
true)
|
||||||
|
|
||||||
|
(rb-test "class def with super"
|
||||||
|
(get (get (rb-p-first "class Foo < Bar; end") :super) :name)
|
||||||
|
"Bar")
|
||||||
|
|
||||||
|
(rb-test "singleton class"
|
||||||
|
(get (rb-p-first "class << self; end") :type)
|
||||||
|
"sclass")
|
||||||
|
|
||||||
|
;; ── Module def ────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "module def type"
|
||||||
|
(get (rb-p-first "module M; end") :type)
|
||||||
|
"module-def")
|
||||||
|
|
||||||
|
(rb-test "module def name"
|
||||||
|
(get (get (rb-p-first "module M; end") :name) :name)
|
||||||
|
"M")
|
||||||
|
|
||||||
|
;; ── Blocks ────────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "block do...end"
|
||||||
|
(get (get (rb-p-first "foo do |x| x end") :block) :type)
|
||||||
|
"block")
|
||||||
|
|
||||||
|
(rb-test "block brace"
|
||||||
|
(get (get (rb-p-first "foo { |x| x }") :block) :type)
|
||||||
|
"block")
|
||||||
|
|
||||||
|
(rb-test "block params"
|
||||||
|
(len (get (get (rb-p-first "foo { |a, b| a }") :block) :params))
|
||||||
|
2)
|
||||||
|
|
||||||
|
(rb-test "block no params"
|
||||||
|
(len (get (get (rb-p-first "foo { 42 }") :block) :params))
|
||||||
|
0)
|
||||||
|
|
||||||
|
;; ── Control flow ──────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "return type"
|
||||||
|
(get (rb-p-first "return 1") :type)
|
||||||
|
"return")
|
||||||
|
|
||||||
|
(rb-test "return value"
|
||||||
|
(get (get (rb-p-first "return 1") :value) :value)
|
||||||
|
1)
|
||||||
|
|
||||||
|
(rb-test "return nil"
|
||||||
|
(nil? (get (rb-p-first "return") :value))
|
||||||
|
true)
|
||||||
|
|
||||||
|
(rb-test "yield type"
|
||||||
|
(get (rb-p-first "yield 1") :type)
|
||||||
|
"yield")
|
||||||
|
|
||||||
|
(rb-test "break type"
|
||||||
|
(get (rb-p-first "break") :type)
|
||||||
|
"break")
|
||||||
|
|
||||||
|
(rb-test "next type"
|
||||||
|
(get (rb-p-first "next") :type)
|
||||||
|
"next")
|
||||||
|
|
||||||
|
(rb-test "redo type"
|
||||||
|
(get (rb-p-first "redo") :type)
|
||||||
|
"redo")
|
||||||
|
|
||||||
|
;; ── Multi-statement program ───────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(rb-test "two statements"
|
||||||
|
(len (rb-p-stmts "1\n2"))
|
||||||
|
2)
|
||||||
|
|
||||||
|
(rb-test "semi-separated"
|
||||||
|
(len (rb-p-stmts "1; 2; 3"))
|
||||||
|
3)
|
||||||
|
|
||||||
|
(rb-test "class with method"
|
||||||
|
(let ((cls (rb-p-first "class Foo\n def bar\n 1\n end\nend")))
|
||||||
|
(len (get cls :body)))
|
||||||
|
1)
|
||||||
|
|
||||||
|
(list rb-test-pass rb-test-fail)
|
||||||
210
lib/ruby/tests/tokenizer.sx
Normal file
210
lib/ruby/tests/tokenizer.sx
Normal file
@@ -0,0 +1,210 @@
|
|||||||
|
;; Ruby tokenizer tests.
|
||||||
|
;; Final value: {:pass N :fail N :fails (list)}
|
||||||
|
|
||||||
|
(define rb-deep=?
|
||||||
|
(fn (a b)
|
||||||
|
(cond
|
||||||
|
((= a b) true)
|
||||||
|
((and (dict? a) (dict? b))
|
||||||
|
(let ((ak (keys a)) (bk (keys b)))
|
||||||
|
(if (not (= (len ak) (len bk)))
|
||||||
|
false
|
||||||
|
(every?
|
||||||
|
(fn (k) (and (has-key? b k) (rb-deep=? (get a k) (get b k))))
|
||||||
|
ak))))
|
||||||
|
((and (list? a) (list? b))
|
||||||
|
(if (not (= (len a) (len b)))
|
||||||
|
false
|
||||||
|
(let ((i 0) (ok true))
|
||||||
|
(define rb-de-loop
|
||||||
|
(fn ()
|
||||||
|
(when (and ok (< i (len a)))
|
||||||
|
(do
|
||||||
|
(when (not (rb-deep=? (nth a i) (nth b i)))
|
||||||
|
(set! ok false))
|
||||||
|
(set! i (+ i 1))
|
||||||
|
(rb-de-loop)))))
|
||||||
|
(rb-de-loop)
|
||||||
|
ok)))
|
||||||
|
(:else false))))
|
||||||
|
|
||||||
|
(define rb-test-pass 0)
|
||||||
|
(define rb-test-fail 0)
|
||||||
|
(define rb-test-fails (list))
|
||||||
|
|
||||||
|
(define rb-test
|
||||||
|
(fn (name actual expected)
|
||||||
|
(if (rb-deep=? actual expected)
|
||||||
|
(set! rb-test-pass (+ rb-test-pass 1))
|
||||||
|
(do
|
||||||
|
(set! rb-test-fail (+ rb-test-fail 1))
|
||||||
|
(append! rb-test-fails {:name name :actual actual :expected expected})))))
|
||||||
|
|
||||||
|
;; Helper: tokenize, drop newline+eof, return {:type :value} pairs
|
||||||
|
(define rb-toks
|
||||||
|
(fn (src)
|
||||||
|
(map
|
||||||
|
(fn (tok) {:value (get tok "value") :type (get tok "type")})
|
||||||
|
(filter
|
||||||
|
(fn (tok)
|
||||||
|
(let ((ty (get tok "type")))
|
||||||
|
(not (or (= ty "newline") (= ty "eof")))))
|
||||||
|
(rb-tokenize src)))))
|
||||||
|
|
||||||
|
;; Helper: get just types
|
||||||
|
(define rb-types
|
||||||
|
(fn (src) (map (fn (t) (get t "type")) (rb-toks src))))
|
||||||
|
|
||||||
|
;; Helper: get first token type
|
||||||
|
(define rb-first-type
|
||||||
|
(fn (src) (get (get (rb-tokenize src) 0) "type")))
|
||||||
|
|
||||||
|
(define rb-first-value
|
||||||
|
(fn (src) (get (get (rb-tokenize src) 0) "value")))
|
||||||
|
|
||||||
|
;; ── 1. Keywords ────────────────────────<E29480><E29480><EFBFBD>─────────────────────────
|
||||||
|
(rb-test "keyword def" (rb-toks "def") (list {:value "def" :type "keyword"}))
|
||||||
|
(rb-test "keyword end" (rb-toks "end") (list {:value "end" :type "keyword"}))
|
||||||
|
(rb-test "keyword class" (rb-toks "class") (list {:value "class" :type "keyword"}))
|
||||||
|
(rb-test "keyword if" (rb-toks "if") (list {:value "if" :type "keyword"}))
|
||||||
|
(rb-test "keyword while" (rb-toks "while") (list {:value "while" :type "keyword"}))
|
||||||
|
(rb-test "keyword nil" (rb-toks "nil") (list {:value "nil" :type "keyword"}))
|
||||||
|
(rb-test "keyword true" (rb-toks "true") (list {:value "true" :type "keyword"}))
|
||||||
|
(rb-test "keyword false" (rb-toks "false") (list {:value "false" :type "keyword"}))
|
||||||
|
(rb-test "keyword return" (rb-toks "return") (list {:value "return" :type "keyword"}))
|
||||||
|
(rb-test "keyword yield" (rb-toks "yield") (list {:value "yield" :type "keyword"}))
|
||||||
|
(rb-test "keyword begin" (rb-toks "begin") (list {:value "begin" :type "keyword"}))
|
||||||
|
(rb-test "keyword rescue" (rb-toks "rescue") (list {:value "rescue" :type "keyword"}))
|
||||||
|
(rb-test "keyword self" (rb-toks "self") (list {:value "self" :type "keyword"}))
|
||||||
|
(rb-test "keyword super" (rb-toks "super") (list {:value "super" :type "keyword"}))
|
||||||
|
|
||||||
|
;; ── 2. Identifiers ────────────────────────────────────────────────
|
||||||
|
(rb-test "ident simple" (rb-toks "foo") (list {:value "foo" :type "ident"}))
|
||||||
|
(rb-test "ident underscore" (rb-toks "_foo") (list {:value "_foo" :type "ident"}))
|
||||||
|
(rb-test "ident with digit" (rb-toks "foo2") (list {:value "foo2" :type "ident"}))
|
||||||
|
(rb-test "ident predicate" (rb-toks "empty?") (list {:value "empty?" :type "ident"}))
|
||||||
|
(rb-test "ident bang" (rb-toks "save!") (list {:value "save!" :type "ident"}))
|
||||||
|
(rb-test "defined?" (rb-toks "defined?") (list {:value "defined?" :type "keyword"}))
|
||||||
|
|
||||||
|
;; ── 3. Constants ──────────────────────────────────────────────────
|
||||||
|
(rb-test "const simple" (rb-toks "Foo") (list {:value "Foo" :type "const"}))
|
||||||
|
(rb-test "const upcase" (rb-toks "MY_CONST") (list {:value "MY_CONST" :type "const"}))
|
||||||
|
(rb-test "const class" (rb-toks "String") (list {:value "String" :type "const"}))
|
||||||
|
|
||||||
|
;; ── 4. Sigil variables ───────────────────────────────────────────
|
||||||
|
(rb-test "ivar" (rb-toks "@name") (list {:value "@name" :type "ivar"}))
|
||||||
|
(rb-test "cvar" (rb-toks "@@count") (list {:value "@@count" :type "cvar"}))
|
||||||
|
(rb-test "gvar" (rb-toks "$global") (list {:value "$global" :type "gvar"}))
|
||||||
|
|
||||||
|
;; ── 5. Integers ───────────────────────────────────────────────────
|
||||||
|
(rb-test "int decimal" (rb-first-value "42") 42)
|
||||||
|
(rb-test "int zero" (rb-first-value "0") 0)
|
||||||
|
(rb-test "int underscore" (rb-first-value "1_000") 1000)
|
||||||
|
(rb-test "int hex" (rb-first-value "0xFF") 255)
|
||||||
|
(rb-test "int hex lower" (rb-first-value "0xff") 255)
|
||||||
|
(rb-test "int octal" (rb-first-value "0o17") 15)
|
||||||
|
(rb-test "int binary" (rb-first-value "0b1010") 10)
|
||||||
|
(rb-test "int type" (rb-first-type "42") "int")
|
||||||
|
|
||||||
|
;; ── 6. Floats ─────────────────────────────────────────────────────
|
||||||
|
(rb-test "float simple" (rb-first-type "3.14") "float")
|
||||||
|
(rb-test "float value" (rb-first-value "3.14") "3.14")
|
||||||
|
(rb-test "float exp" (rb-first-type "1.5e10") "float")
|
||||||
|
(rb-test "float exp value" (rb-first-value "1.5e10") "1.5e10")
|
||||||
|
|
||||||
|
;; ── 7. Strings ────────────────────────────────────────────────────
|
||||||
|
(rb-test "dq string" (rb-first-value "\"hello\"") "hello")
|
||||||
|
(rb-test "dq string type" (rb-first-type "\"hello\"") "string")
|
||||||
|
(rb-test "sq string" (rb-first-value "'world'") "world")
|
||||||
|
(rb-test "dq escape nl" (rb-first-value "\"a\\nb\"") "a\nb")
|
||||||
|
(rb-test "dq escape tab" (rb-first-value "\"a\\tb\"") "a\tb")
|
||||||
|
(rb-test "dq escape quote" (rb-first-value "\"a\\\"b\"") "a\"b")
|
||||||
|
(rb-test "sq no escape" (rb-first-value "'a\\nb'") "a\\nb")
|
||||||
|
(rb-test "sq escape backslash" (rb-first-value "'a\\\\'") "a\\")
|
||||||
|
(rb-test "dq interp kept" (rb-first-value "\"#{x}\"") "#{x}")
|
||||||
|
|
||||||
|
;; ── 8. Symbols ────────────────────────────────────────────────────
|
||||||
|
(rb-test "symbol simple" (rb-first-type ":foo") "symbol")
|
||||||
|
(rb-test "symbol value" (rb-first-value ":foo") "foo")
|
||||||
|
(rb-test "symbol predicate" (rb-first-value ":empty?") "empty?")
|
||||||
|
(rb-test "symbol dq" (rb-first-value ":\"hello world\"") "hello world")
|
||||||
|
(rb-test "symbol sq" (rb-first-value ":'hello'") "hello")
|
||||||
|
|
||||||
|
;; ── 9. %w and %i literals ────────────────────────────────────────
|
||||||
|
(rb-test "%w bracket" (rb-first-type "%w[a b c]") "words")
|
||||||
|
(rb-test "%w value" (rb-first-value "%w[a b c]") (list "a" "b" "c"))
|
||||||
|
(rb-test "%w paren" (rb-first-value "%w(x y)") (list "x" "y"))
|
||||||
|
(rb-test "%i bracket" (rb-first-type "%i[a b]") "isymbols")
|
||||||
|
(rb-test "%i value" (rb-first-value "%i[foo bar]") (list "foo" "bar"))
|
||||||
|
|
||||||
|
;; ── 10. Punctuation ───────────────────────────────────────────────
|
||||||
|
(rb-test "dot" (rb-first-type ".") "dot")
|
||||||
|
(rb-test "dotdot" (rb-first-type "..") "dotdot")
|
||||||
|
(rb-test "dotdotdot" (rb-first-type "...") "dotdotdot")
|
||||||
|
(rb-test "dcolon" (rb-first-type "::") "dcolon")
|
||||||
|
(rb-test "comma" (rb-first-type ",") "comma")
|
||||||
|
(rb-test "semi" (rb-first-type ";") "semi")
|
||||||
|
(rb-test "lparen" (rb-first-type "(") "lparen")
|
||||||
|
(rb-test "rparen" (rb-first-type ")") "rparen")
|
||||||
|
(rb-test "lbracket" (rb-first-type "[") "lbracket")
|
||||||
|
(rb-test "rbracket" (rb-first-type "]") "rbracket")
|
||||||
|
(rb-test "lbrace" (rb-first-type "{") "lbrace")
|
||||||
|
(rb-test "rbrace" (rb-first-type "}") "rbrace")
|
||||||
|
(rb-test "pipe" (rb-first-type "|") "pipe")
|
||||||
|
|
||||||
|
;; ── 11. Operators ─────────────────────────────────────────────────
|
||||||
|
(rb-test "op plus" (rb-first-value "+") "+")
|
||||||
|
(rb-test "op minus" (rb-first-value "-") "-")
|
||||||
|
(rb-test "op star" (rb-first-value "*") "*")
|
||||||
|
(rb-test "op slash" (rb-first-value "/") "/")
|
||||||
|
(rb-test "op eq" (rb-first-value "=") "=")
|
||||||
|
(rb-test "op eqeq" (rb-first-value "==") "==")
|
||||||
|
(rb-test "op neq" (rb-first-value "!=") "!=")
|
||||||
|
(rb-test "op lt" (rb-first-value "<") "<")
|
||||||
|
(rb-test "op gt" (rb-first-value ">") ">")
|
||||||
|
(rb-test "op lte" (rb-first-value "<=") "<=")
|
||||||
|
(rb-test "op gte" (rb-first-value ">=") ">=")
|
||||||
|
(rb-test "op spaceship" (rb-first-value "<=>") "<=>")
|
||||||
|
(rb-test "op tripleq" (rb-first-value "===") "===")
|
||||||
|
(rb-test "op match" (rb-first-value "=~") "=~")
|
||||||
|
(rb-test "op nomatch" (rb-first-value "!~") "!~")
|
||||||
|
(rb-test "op lshift" (rb-first-value "<<") "<<")
|
||||||
|
(rb-test "op rshift" (rb-first-value ">>") ">>")
|
||||||
|
(rb-test "op and" (rb-first-value "&&") "&&")
|
||||||
|
(rb-test "op or" (rb-first-value "||") "||")
|
||||||
|
(rb-test "op power" (rb-first-value "**") "**")
|
||||||
|
(rb-test "op plus-eq" (rb-first-value "+=") "+=")
|
||||||
|
(rb-test "op minus-eq" (rb-first-value "-=") "-=")
|
||||||
|
(rb-test "op arrow" (rb-first-value "->") "->")
|
||||||
|
(rb-test "op hash-rocket" (rb-first-value "=>") "=>")
|
||||||
|
|
||||||
|
;; ── 12. Comments ──────────────────────────────────────────────────
|
||||||
|
(rb-test "comment skipped" (len (rb-toks "# this is a comment")) 0)
|
||||||
|
(rb-test "comment mid-line" (rb-types "x = 1 # comment") (list "ident" "op" "int"))
|
||||||
|
|
||||||
|
;; ── 13. Multi-token sequences ─────────────────────────────────────
|
||||||
|
(rb-test "method call" (rb-types "foo.bar")
|
||||||
|
(list "ident" "dot" "ident"))
|
||||||
|
(rb-test "class def" (rb-types "class Foo")
|
||||||
|
(list "keyword" "const"))
|
||||||
|
(rb-test "method def" (rb-types "def greet(name)")
|
||||||
|
(list "keyword" "ident" "lparen" "ident" "rparen"))
|
||||||
|
(rb-test "assignment" (rb-types "x = 42")
|
||||||
|
(list "ident" "op" "int"))
|
||||||
|
(rb-test "block params" (rb-types "|x, y|")
|
||||||
|
(list "pipe" "ident" "comma" "ident" "pipe"))
|
||||||
|
(rb-test "scope resolution" (rb-types "Foo::Bar")
|
||||||
|
(list "const" "dcolon" "const"))
|
||||||
|
(rb-test "range" (rb-types "1..10")
|
||||||
|
(list "int" "dotdot" "int"))
|
||||||
|
(rb-test "exclusive range" (rb-types "1...10")
|
||||||
|
(list "int" "dotdotdot" "int"))
|
||||||
|
|
||||||
|
;; ── 14. Line/col tracking ────────────────────────────────────────
|
||||||
|
(define rb-tok1 (get (rb-tokenize "hello\nworld") 0))
|
||||||
|
(define rb-tok2 (get (rb-tokenize "hello\nworld") 2))
|
||||||
|
(rb-test "line track start" (get rb-tok1 "line") 1)
|
||||||
|
(rb-test "line track second" (get rb-tok2 "line") 2)
|
||||||
|
(rb-test "col track start" (get rb-tok1 "col") 1)
|
||||||
|
|
||||||
|
(list rb-test-pass rb-test-fail)
|
||||||
549
lib/ruby/tokenizer.sx
Normal file
549
lib/ruby/tokenizer.sx
Normal file
@@ -0,0 +1,549 @@
|
|||||||
|
;; Ruby tokenizer for Ruby 2.7 subset.
|
||||||
|
;; Token: {:type T :value V :line L :col C}
|
||||||
|
;;
|
||||||
|
;; Types: keyword ident ivar cvar gvar const
|
||||||
|
;; int float string symbol
|
||||||
|
;; op dot dotdot dotdotdot dcolon colon
|
||||||
|
;; lparen rparen lbracket rbracket lbrace rbrace
|
||||||
|
;; comma semi pipe newline words isymbols eof
|
||||||
|
|
||||||
|
;; ── Character code table ──────────────────────────────────────────
|
||||||
|
(define rb-ord-table
|
||||||
|
(let ((t (dict)) (i 0))
|
||||||
|
(define rb-build-table
|
||||||
|
(fn ()
|
||||||
|
(when (< i 128)
|
||||||
|
(do
|
||||||
|
(dict-set! t (char-from-code i) i)
|
||||||
|
(set! i (+ i 1))
|
||||||
|
(rb-build-table)))))
|
||||||
|
(rb-build-table)
|
||||||
|
t))
|
||||||
|
|
||||||
|
(define rb-ord (fn (c) (or (get rb-ord-table c) 0)))
|
||||||
|
|
||||||
|
;; ── Character predicates ──────────────────────────────────────────
|
||||||
|
(define rb-digit?
|
||||||
|
(fn (c) (and (string? c) (>= (rb-ord c) 48) (<= (rb-ord c) 57))))
|
||||||
|
|
||||||
|
(define rb-hex-digit?
|
||||||
|
(fn (c)
|
||||||
|
(and (string? c)
|
||||||
|
(or (and (>= (rb-ord c) 48) (<= (rb-ord c) 57))
|
||||||
|
(and (>= (rb-ord c) 97) (<= (rb-ord c) 102))
|
||||||
|
(and (>= (rb-ord c) 65) (<= (rb-ord c) 70))))))
|
||||||
|
|
||||||
|
(define rb-octal-digit?
|
||||||
|
(fn (c) (and (string? c) (>= (rb-ord c) 48) (<= (rb-ord c) 55))))
|
||||||
|
|
||||||
|
(define rb-binary-digit? (fn (c) (or (= c "0") (= c "1"))))
|
||||||
|
|
||||||
|
(define rb-lower?
|
||||||
|
(fn (c) (and (string? c) (>= (rb-ord c) 97) (<= (rb-ord c) 122))))
|
||||||
|
|
||||||
|
(define rb-upper?
|
||||||
|
(fn (c) (and (string? c) (>= (rb-ord c) 65) (<= (rb-ord c) 90))))
|
||||||
|
|
||||||
|
(define rb-ident-start?
|
||||||
|
(fn (c) (or (rb-lower? c) (rb-upper? c) (= c "_"))))
|
||||||
|
|
||||||
|
(define rb-ident-cont?
|
||||||
|
(fn (c) (or (rb-lower? c) (rb-upper? c) (rb-digit? c) (= c "_"))))
|
||||||
|
|
||||||
|
(define rb-space? (fn (c) (or (= c " ") (= c "\t") (= c "\r"))))
|
||||||
|
|
||||||
|
;; ── Reserved words ────────────────────────────────────────────────
|
||||||
|
(define rb-keywords
|
||||||
|
(list "__ENCODING__" "__LINE__" "__FILE__"
|
||||||
|
"BEGIN" "END"
|
||||||
|
"alias" "and"
|
||||||
|
"begin" "break"
|
||||||
|
"case" "class"
|
||||||
|
"def" "defined?" "do"
|
||||||
|
"else" "elsif" "end" "ensure"
|
||||||
|
"false" "for"
|
||||||
|
"if" "in"
|
||||||
|
"module"
|
||||||
|
"next" "nil" "not"
|
||||||
|
"or"
|
||||||
|
"redo" "rescue" "retry" "return"
|
||||||
|
"self" "super"
|
||||||
|
"then" "true"
|
||||||
|
"undef" "unless" "until"
|
||||||
|
"when" "while"
|
||||||
|
"yield"))
|
||||||
|
|
||||||
|
(define rb-keyword? (fn (w) (contains? rb-keywords w)))
|
||||||
|
|
||||||
|
;; ── Token constructor ─────────────────────────────────────────────
|
||||||
|
(define rb-make-token
|
||||||
|
(fn (type value line col) {:type type :value value :line line :col col}))
|
||||||
|
|
||||||
|
;; ── Radix number parser ───────────────────────────────────────────
|
||||||
|
(define rb-parse-radix
|
||||||
|
(fn (s radix)
|
||||||
|
(let ((n (len s)) (i 0) (acc 0))
|
||||||
|
(define rb-rad-loop
|
||||||
|
(fn ()
|
||||||
|
(when (< i n)
|
||||||
|
(do
|
||||||
|
(let ((c (substring s i (+ i 1))))
|
||||||
|
(cond
|
||||||
|
((and (>= (rb-ord c) 48) (<= (rb-ord c) 57))
|
||||||
|
(set! acc (+ (* acc radix) (- (rb-ord c) 48))))
|
||||||
|
((and (>= (rb-ord c) 97) (<= (rb-ord c) 102))
|
||||||
|
(set! acc (+ (* acc radix) (+ 10 (- (rb-ord c) 97)))))
|
||||||
|
((and (>= (rb-ord c) 65) (<= (rb-ord c) 70))
|
||||||
|
(set! acc (+ (* acc radix) (+ 10 (- (rb-ord c) 65)))))))
|
||||||
|
(set! i (+ i 1))
|
||||||
|
(rb-rad-loop)))))
|
||||||
|
(rb-rad-loop)
|
||||||
|
acc)))
|
||||||
|
|
||||||
|
;; ── Strip underscores from numeric literals ───────────────────────
|
||||||
|
(define rb-strip-underscores
|
||||||
|
(fn (s)
|
||||||
|
(let ((n (len s)) (i 0) (parts (list)))
|
||||||
|
(define rb-su-loop
|
||||||
|
(fn ()
|
||||||
|
(when (< i n)
|
||||||
|
(do
|
||||||
|
(let ((c (substring s i (+ i 1))))
|
||||||
|
(when (not (= c "_"))
|
||||||
|
(append! parts c)))
|
||||||
|
(set! i (+ i 1))
|
||||||
|
(rb-su-loop)))))
|
||||||
|
(rb-su-loop)
|
||||||
|
(join "" parts))))
|
||||||
|
|
||||||
|
;; ── Main tokenizer ────────────────────────────────────────────────
|
||||||
|
(define rb-tokenize
|
||||||
|
(fn (src)
|
||||||
|
(let ((tokens (list))
|
||||||
|
(pos 0)
|
||||||
|
(line 1)
|
||||||
|
(col 1)
|
||||||
|
(src-len (len src)))
|
||||||
|
(define rb-peek
|
||||||
|
(fn (offset)
|
||||||
|
(if (< (+ pos offset) src-len)
|
||||||
|
(substring src (+ pos offset) (+ pos offset 1))
|
||||||
|
nil)))
|
||||||
|
(define rb-cur (fn () (rb-peek 0)))
|
||||||
|
(define rb-advance!
|
||||||
|
(fn ()
|
||||||
|
(let ((c (rb-cur)))
|
||||||
|
(set! pos (+ pos 1))
|
||||||
|
(if (= c "\n")
|
||||||
|
(do (set! line (+ line 1)) (set! col 1))
|
||||||
|
(set! col (+ col 1))))))
|
||||||
|
(define rb-advance-n!
|
||||||
|
(fn (n)
|
||||||
|
(when (> n 0)
|
||||||
|
(do (rb-advance!) (rb-advance-n! (- n 1))))))
|
||||||
|
(define rb-push!
|
||||||
|
(fn (type value tok-line tok-col)
|
||||||
|
(append! tokens (rb-make-token type value tok-line tok-col))))
|
||||||
|
(define rb-read-while
|
||||||
|
(fn (pred)
|
||||||
|
(let ((start pos))
|
||||||
|
(define rb-rw-loop
|
||||||
|
(fn ()
|
||||||
|
(when (and (< pos src-len) (pred (rb-cur)))
|
||||||
|
(do (rb-advance!) (rb-rw-loop)))))
|
||||||
|
(rb-rw-loop)
|
||||||
|
(substring src start pos))))
|
||||||
|
(define rb-skip-line-comment!
|
||||||
|
(fn ()
|
||||||
|
(define rb-slc-loop
|
||||||
|
(fn ()
|
||||||
|
(when (and (< pos src-len) (not (= (rb-cur) "\n")))
|
||||||
|
(do (rb-advance!) (rb-slc-loop)))))
|
||||||
|
(rb-slc-loop)))
|
||||||
|
(define rb-read-escape
|
||||||
|
(fn ()
|
||||||
|
(rb-advance!)
|
||||||
|
(let ((c (rb-cur)))
|
||||||
|
(cond
|
||||||
|
((= c "n") (do (rb-advance!) "\n"))
|
||||||
|
((= c "t") (do (rb-advance!) "\t"))
|
||||||
|
((= c "r") (do (rb-advance!) "\r"))
|
||||||
|
((= c "\\") (do (rb-advance!) "\\"))
|
||||||
|
((= c "'") (do (rb-advance!) "'"))
|
||||||
|
((= c "\"") (do (rb-advance!) "\""))
|
||||||
|
((= c "a") (do (rb-advance!) (char-from-code 7)))
|
||||||
|
((= c "b") (do (rb-advance!) (char-from-code 8)))
|
||||||
|
((= c "f") (do (rb-advance!) (char-from-code 12)))
|
||||||
|
((= c "v") (do (rb-advance!) (char-from-code 11)))
|
||||||
|
((= c "e") (do (rb-advance!) (char-from-code 27)))
|
||||||
|
((= c "s") (do (rb-advance!) " "))
|
||||||
|
((= c "0") (do (rb-advance!) (char-from-code 0)))
|
||||||
|
(:else (do (rb-advance!) (str "\\" c)))))))
|
||||||
|
(define rb-read-sq-string
|
||||||
|
(fn ()
|
||||||
|
(let ((parts (list)))
|
||||||
|
(rb-advance!)
|
||||||
|
(define rb-sq-loop
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((>= pos src-len) nil)
|
||||||
|
((= (rb-cur) "'") (rb-advance!))
|
||||||
|
((and (= (rb-cur) "\\")
|
||||||
|
(let ((n (rb-peek 1)))
|
||||||
|
(or (= n "\\") (= n "'"))))
|
||||||
|
(do
|
||||||
|
(rb-advance!)
|
||||||
|
(append! parts (rb-cur))
|
||||||
|
(rb-advance!)
|
||||||
|
(rb-sq-loop)))
|
||||||
|
(:else
|
||||||
|
(do
|
||||||
|
(append! parts (rb-cur))
|
||||||
|
(rb-advance!)
|
||||||
|
(rb-sq-loop))))))
|
||||||
|
(rb-sq-loop)
|
||||||
|
(join "" parts))))
|
||||||
|
(define rb-read-dq-string
|
||||||
|
(fn ()
|
||||||
|
(let ((parts (list)))
|
||||||
|
(rb-advance!)
|
||||||
|
(define rb-dq-loop
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((>= pos src-len) nil)
|
||||||
|
((= (rb-cur) "\"") (rb-advance!))
|
||||||
|
((= (rb-cur) "\\")
|
||||||
|
(do
|
||||||
|
(append! parts (rb-read-escape))
|
||||||
|
(rb-dq-loop)))
|
||||||
|
((and (= (rb-cur) "#") (= (rb-peek 1) "{"))
|
||||||
|
(do
|
||||||
|
(append! parts "#{")
|
||||||
|
(rb-advance-n! 2)
|
||||||
|
(let ((depth 1))
|
||||||
|
(define rb-interp-inner
|
||||||
|
(fn ()
|
||||||
|
(when (and (< pos src-len) (> depth 0))
|
||||||
|
(do
|
||||||
|
(let ((c (rb-cur)))
|
||||||
|
(cond
|
||||||
|
((= c "{")
|
||||||
|
(do
|
||||||
|
(set! depth (+ depth 1))
|
||||||
|
(append! parts c)
|
||||||
|
(rb-advance!)))
|
||||||
|
((= c "}")
|
||||||
|
(do
|
||||||
|
(set! depth (- depth 1))
|
||||||
|
(when (> depth 0)
|
||||||
|
(do (append! parts c) (rb-advance!)))))
|
||||||
|
(:else
|
||||||
|
(do (append! parts c) (rb-advance!)))))
|
||||||
|
(rb-interp-inner)))))
|
||||||
|
(rb-interp-inner))
|
||||||
|
(when (= (rb-cur) "}")
|
||||||
|
(do (append! parts "}") (rb-advance!)))
|
||||||
|
(rb-dq-loop)))
|
||||||
|
(:else
|
||||||
|
(do
|
||||||
|
(append! parts (rb-cur))
|
||||||
|
(rb-advance!)
|
||||||
|
(rb-dq-loop))))))
|
||||||
|
(rb-dq-loop)
|
||||||
|
(join "" parts))))
|
||||||
|
(define rb-read-percent-words
|
||||||
|
(fn ()
|
||||||
|
(rb-advance-n! 2)
|
||||||
|
(let ((open-ch (rb-cur)))
|
||||||
|
(let ((close-ch
|
||||||
|
(cond
|
||||||
|
((= open-ch "[") "]")
|
||||||
|
((= open-ch "(") ")")
|
||||||
|
((= open-ch "{") "}")
|
||||||
|
((= open-ch "<") ">")
|
||||||
|
(:else open-ch))))
|
||||||
|
(rb-advance!)
|
||||||
|
(let ((items (list)))
|
||||||
|
(define rb-pw-skip
|
||||||
|
(fn ()
|
||||||
|
(when (and (< pos src-len) (or (rb-space? (rb-cur)) (= (rb-cur) "\n")))
|
||||||
|
(do (rb-advance!) (rb-pw-skip)))))
|
||||||
|
(define rb-pw-word
|
||||||
|
(fn (wparts)
|
||||||
|
(if (or (>= pos src-len)
|
||||||
|
(rb-space? (rb-cur))
|
||||||
|
(= (rb-cur) "\n")
|
||||||
|
(= (rb-cur) close-ch))
|
||||||
|
(append! items (join "" wparts))
|
||||||
|
(do
|
||||||
|
(append! wparts (rb-cur))
|
||||||
|
(rb-advance!)
|
||||||
|
(rb-pw-word wparts)))))
|
||||||
|
(define rb-pw-loop
|
||||||
|
(fn ()
|
||||||
|
(rb-pw-skip)
|
||||||
|
(when (and (< pos src-len) (not (= (rb-cur) close-ch)))
|
||||||
|
(do
|
||||||
|
(rb-pw-word (list))
|
||||||
|
(rb-pw-loop)))))
|
||||||
|
(rb-pw-loop)
|
||||||
|
(when (= (rb-cur) close-ch) (rb-advance!))
|
||||||
|
items)))))
|
||||||
|
(define rb-read-ident-word
|
||||||
|
(fn ()
|
||||||
|
(let ((start pos))
|
||||||
|
(rb-read-while rb-ident-cont?)
|
||||||
|
(when (and (= (rb-cur) "?") (not (= (rb-peek 1) "=")))
|
||||||
|
(rb-advance!))
|
||||||
|
(when (and (= (rb-cur) "!") (not (or (= (rb-peek 1) "=") (= (rb-peek 1) "~"))))
|
||||||
|
(rb-advance!))
|
||||||
|
(substring src start pos))))
|
||||||
|
(define rb-read-number!
|
||||||
|
(fn (tok-line tok-col)
|
||||||
|
(let ((start pos))
|
||||||
|
(cond
|
||||||
|
((and (= (rb-cur) "0") (let ((p (rb-peek 1))) (or (= p "b") (= p "B"))))
|
||||||
|
(do
|
||||||
|
(rb-advance-n! 2)
|
||||||
|
(let ((bin-str (rb-read-while rb-binary-digit?)))
|
||||||
|
(rb-push! "int" (rb-parse-radix bin-str 2) tok-line tok-col))))
|
||||||
|
((and (= (rb-cur) "0") (let ((p (rb-peek 1))) (or (= p "o") (= p "O"))))
|
||||||
|
(do
|
||||||
|
(rb-advance-n! 2)
|
||||||
|
(let ((oct-str (rb-read-while rb-octal-digit?)))
|
||||||
|
(rb-push! "int" (rb-parse-radix oct-str 8) tok-line tok-col))))
|
||||||
|
((and (= (rb-cur) "0") (let ((p (rb-peek 1))) (or (= p "x") (= p "X"))))
|
||||||
|
(do
|
||||||
|
(rb-advance-n! 2)
|
||||||
|
(let ((hex-str (rb-read-while rb-hex-digit?)))
|
||||||
|
(rb-push! "int" (rb-parse-radix hex-str 16) tok-line tok-col))))
|
||||||
|
(:else
|
||||||
|
(do
|
||||||
|
(rb-read-while (fn (c) (or (rb-digit? c) (= c "_"))))
|
||||||
|
(let ((is-float false))
|
||||||
|
(when (and (= (rb-cur) ".") (rb-digit? (rb-peek 1)))
|
||||||
|
(do
|
||||||
|
(set! is-float true)
|
||||||
|
(rb-advance!)
|
||||||
|
(rb-read-while (fn (c) (or (rb-digit? c) (= c "_"))))))
|
||||||
|
(when (or (= (rb-cur) "e") (= (rb-cur) "E"))
|
||||||
|
(do
|
||||||
|
(set! is-float true)
|
||||||
|
(rb-advance!)
|
||||||
|
(when (or (= (rb-cur) "+") (= (rb-cur) "-"))
|
||||||
|
(rb-advance!))
|
||||||
|
(rb-read-while rb-digit?)))
|
||||||
|
(let ((num-str (rb-strip-underscores (substring src start pos))))
|
||||||
|
(if is-float
|
||||||
|
(rb-push! "float" num-str tok-line tok-col)
|
||||||
|
(rb-push! "int" (parse-int num-str) tok-line tok-col))))))))))
|
||||||
|
(define rb-read-op!
|
||||||
|
(fn (tok-line tok-col)
|
||||||
|
(let ((c0 (rb-cur)) (c1 (rb-peek 1)) (c2 (rb-peek 2)))
|
||||||
|
(cond
|
||||||
|
((and (= c0 "<") (= c1 "=") (= c2 ">"))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "op" "<=>" tok-line tok-col)))
|
||||||
|
((and (= c0 "=") (= c1 "=") (= c2 "="))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "op" "===" tok-line tok-col)))
|
||||||
|
((and (= c0 "*") (= c1 "*") (= c2 "="))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "op" "**=" tok-line tok-col)))
|
||||||
|
((and (= c0 "<") (= c1 "<") (= c2 "="))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "op" "<<=" tok-line tok-col)))
|
||||||
|
((and (= c0 ">") (= c1 ">") (= c2 "="))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "op" ">>=" tok-line tok-col)))
|
||||||
|
((and (= c0 "&") (= c1 "&") (= c2 "="))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "op" "&&=" tok-line tok-col)))
|
||||||
|
((and (= c0 "|") (= c1 "|") (= c2 "="))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "op" "||=" tok-line tok-col)))
|
||||||
|
((and (= c0 "*") (= c1 "*"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "**" tok-line tok-col)))
|
||||||
|
((and (= c0 "=") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "==" tok-line tok-col)))
|
||||||
|
((and (= c0 "!") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "!=" tok-line tok-col)))
|
||||||
|
((and (= c0 "<") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "<=" tok-line tok-col)))
|
||||||
|
((and (= c0 ">") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" ">=" tok-line tok-col)))
|
||||||
|
((and (= c0 "=") (= c1 "~"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "=~" tok-line tok-col)))
|
||||||
|
((and (= c0 "!") (= c1 "~"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "!~" tok-line tok-col)))
|
||||||
|
((and (= c0 "<") (= c1 "<"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "<<" tok-line tok-col)))
|
||||||
|
((and (= c0 ">") (= c1 ">"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" ">>" tok-line tok-col)))
|
||||||
|
((and (= c0 "&") (= c1 "&"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "&&" tok-line tok-col)))
|
||||||
|
((and (= c0 "|") (= c1 "|"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "||" tok-line tok-col)))
|
||||||
|
((and (= c0 "+") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "+=" tok-line tok-col)))
|
||||||
|
((and (= c0 "-") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "-=" tok-line tok-col)))
|
||||||
|
((and (= c0 "*") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "*=" tok-line tok-col)))
|
||||||
|
((and (= c0 "/") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "/=" tok-line tok-col)))
|
||||||
|
((and (= c0 "%") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "%=" tok-line tok-col)))
|
||||||
|
((and (= c0 "&") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "&=" tok-line tok-col)))
|
||||||
|
((and (= c0 "|") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "|=" tok-line tok-col)))
|
||||||
|
((and (= c0 "^") (= c1 "="))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "^=" tok-line tok-col)))
|
||||||
|
((and (= c0 "-") (= c1 ">"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "->" tok-line tok-col)))
|
||||||
|
((and (= c0 "=") (= c1 ">"))
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "op" "=>" tok-line tok-col)))
|
||||||
|
((and (= c0 "|") (nil? c1))
|
||||||
|
(do (rb-advance!) (rb-push! "pipe" "|" tok-line tok-col)))
|
||||||
|
((= c0 "|")
|
||||||
|
(do (rb-advance!) (rb-push! "pipe" "|" tok-line tok-col)))
|
||||||
|
(:else
|
||||||
|
(do (rb-advance!) (rb-push! "op" c0 tok-line tok-col)))))))
|
||||||
|
(define rb-scan!
|
||||||
|
(fn ()
|
||||||
|
(cond
|
||||||
|
((>= pos src-len) nil)
|
||||||
|
((rb-space? (rb-cur)) (do (rb-advance!) (rb-scan!)))
|
||||||
|
((= (rb-cur) "#") (do (rb-skip-line-comment!) (rb-scan!)))
|
||||||
|
((= (rb-cur) "\n")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(rb-advance!)
|
||||||
|
(rb-push! "newline" nil l c))
|
||||||
|
(rb-scan!)))
|
||||||
|
((rb-digit? (rb-cur))
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(rb-read-number! l c))
|
||||||
|
(rb-scan!)))
|
||||||
|
((rb-ident-start? (rb-cur))
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(let ((w (rb-read-ident-word)))
|
||||||
|
(if (rb-keyword? w)
|
||||||
|
(rb-push! "keyword" w l c)
|
||||||
|
(if (rb-upper? (substring w 0 1))
|
||||||
|
(rb-push! "const" w l c)
|
||||||
|
(rb-push! "ident" w l c)))))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "@")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(if (= (rb-peek 1) "@")
|
||||||
|
(do
|
||||||
|
(rb-advance-n! 2)
|
||||||
|
(let ((name (rb-read-while rb-ident-cont?)))
|
||||||
|
(rb-push! "cvar" (str "@@" name) l c)))
|
||||||
|
(do
|
||||||
|
(rb-advance!)
|
||||||
|
(let ((name (rb-read-while rb-ident-cont?)))
|
||||||
|
(rb-push! "ivar" (str "@" name) l c)))))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "$")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(rb-advance!)
|
||||||
|
(let ((name (rb-read-while rb-ident-cont?)))
|
||||||
|
(rb-push! "gvar" (str "$" name) l c)))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "\"")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(rb-push! "string" (rb-read-dq-string) l c))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "'")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(rb-push! "string" (rb-read-sq-string) l c))
|
||||||
|
(rb-scan!)))
|
||||||
|
((and (= (rb-cur) ":") (= (rb-peek 1) ":"))
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(rb-advance-n! 2)
|
||||||
|
(rb-push! "dcolon" "::" l c))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) ":")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(rb-advance!)
|
||||||
|
(cond
|
||||||
|
((= (rb-cur) "\"")
|
||||||
|
(rb-push! "symbol" (rb-read-dq-string) l c))
|
||||||
|
((= (rb-cur) "'")
|
||||||
|
(rb-push! "symbol" (rb-read-sq-string) l c))
|
||||||
|
((rb-ident-start? (rb-cur))
|
||||||
|
(let ((name (rb-read-ident-word)))
|
||||||
|
(rb-push! "symbol" name l c)))
|
||||||
|
(:else
|
||||||
|
(rb-push! "colon" ":" l c))))
|
||||||
|
(rb-scan!)))
|
||||||
|
((and (= (rb-cur) "%")
|
||||||
|
(let ((p (rb-peek 1)))
|
||||||
|
(or (= p "w") (= p "W") (= p "i") (= p "I"))))
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(let ((kind (rb-peek 1)))
|
||||||
|
(let ((items (rb-read-percent-words)))
|
||||||
|
(if (or (= kind "i") (= kind "I"))
|
||||||
|
(rb-push! "isymbols" items l c)
|
||||||
|
(rb-push! "words" items l c)))))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) ".")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col))
|
||||||
|
(cond
|
||||||
|
((and (= (rb-peek 1) ".") (= (rb-peek 2) "."))
|
||||||
|
(do (rb-advance-n! 3) (rb-push! "dotdotdot" "..." l c)))
|
||||||
|
((= (rb-peek 1) ".")
|
||||||
|
(do (rb-advance-n! 2) (rb-push! "dotdot" ".." l c)))
|
||||||
|
(:else
|
||||||
|
(do (rb-advance!) (rb-push! "dot" "." l c)))))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) ",")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "comma" "," l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) ";")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "semi" ";" l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "(")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "lparen" "(" l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) ")")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "rparen" ")" l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "[")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "lbracket" "[" l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "]")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "rbracket" "]" l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "{")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "lbrace" "{" l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((= (rb-cur) "}")
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-push! "rbrace" "}" l c) (rb-advance!))
|
||||||
|
(rb-scan!)))
|
||||||
|
((or (= (rb-cur) "+") (= (rb-cur) "-") (= (rb-cur) "*")
|
||||||
|
(= (rb-cur) "/") (= (rb-cur) "%") (= (rb-cur) "=")
|
||||||
|
(= (rb-cur) "!") (= (rb-cur) "<") (= (rb-cur) ">")
|
||||||
|
(= (rb-cur) "&") (= (rb-cur) "^") (= (rb-cur) "~")
|
||||||
|
(= (rb-cur) "|"))
|
||||||
|
(do
|
||||||
|
(let ((l line) (c col)) (rb-read-op! l c))
|
||||||
|
(rb-scan!)))
|
||||||
|
(:else (do (rb-advance!) (rb-scan!))))))
|
||||||
|
(rb-scan!)
|
||||||
|
(rb-push! "eof" nil line col)
|
||||||
|
tokens)))
|
||||||
@@ -50,20 +50,20 @@ Core mapping:
|
|||||||
## Roadmap
|
## Roadmap
|
||||||
|
|
||||||
### Phase 1 — reader + parser
|
### Phase 1 — reader + parser
|
||||||
- [x] Tokenizer: symbols (with package qualification `pkg:sym` / `pkg::sym`), numbers (int, float, ratio `1/3`, `#xFF`, `#b1010`, `#o17`), strings `"…"` with `\` escapes, characters `#\Space` `#\Newline` `#\a`, comments `;`, block comments `#| … |#`
|
- [ ] Tokenizer: symbols (with package qualification `pkg:sym` / `pkg::sym`), numbers (int, float, ratio `1/3`, `#xFF`, `#b1010`, `#o17`), strings `"…"` with `\` escapes, characters `#\Space` `#\Newline` `#\a`, comments `;`, block comments `#| … |#`
|
||||||
- [x] Reader: list, dotted pair, quote `'`, function `#'`, quasiquote `` ` ``, unquote `,`, splice `,@`, vector `#(…)`, uninterned `#:foo`, nil/t literals
|
- [ ] Reader: list, dotted pair, quote `'`, function `#'`, quasiquote `` ` ``, unquote `,`, splice `,@`, vector `#(…)`, uninterned `#:foo`, nil/t literals
|
||||||
- [x] Parser: lambda lists with `&optional` `&rest` `&key` `&aux` `&allow-other-keys`, defaults, supplied-p variables
|
- [ ] Parser: lambda lists with `&optional` `&rest` `&key` `&aux` `&allow-other-keys`, defaults, supplied-p variables
|
||||||
- [x] Unit tests in `lib/common-lisp/tests/read.sx`
|
- [ ] Unit tests in `lib/common-lisp/tests/read.sx`
|
||||||
|
|
||||||
### Phase 2 — sequential eval + special forms
|
### Phase 2 — sequential eval + special forms
|
||||||
- [x] `cl-eval-ast`: `quote`, `if`, `progn`, `let`, `let*`, `flet`, `labels`, `setq`, `setf` (subset), `function`, `lambda`, `the`, `locally`, `eval-when`
|
- [ ] `cl-eval-ast`: `quote`, `if`, `progn`, `let`, `let*`, `flet`, `labels`, `setq`, `setf` (subset), `function`, `lambda`, `the`, `locally`, `eval-when`
|
||||||
- [ ] `block` + `return-from` via captured continuation
|
- [ ] `block` + `return-from` via captured continuation
|
||||||
- [ ] `tagbody` + `go` via per-tag continuations
|
- [ ] `tagbody` + `go` via per-tag continuations
|
||||||
- [ ] `unwind-protect` cleanup frame
|
- [ ] `unwind-protect` cleanup frame
|
||||||
- [ ] `multiple-value-bind`, `multiple-value-call`, `multiple-value-prog1`, `values`, `nth-value`
|
- [ ] `multiple-value-bind`, `multiple-value-call`, `multiple-value-prog1`, `values`, `nth-value`
|
||||||
- [x] `defun`, `defparameter`, `defvar`, `defconstant`, `declaim`, `proclaim` (no-op)
|
- [ ] `defun`, `defparameter`, `defvar`, `defconstant`, `declaim`, `proclaim` (no-op)
|
||||||
- [ ] Dynamic variables — `defvar`/`defparameter` produce specials; `let` rebinds via parameterize-style scope
|
- [ ] Dynamic variables — `defvar`/`defparameter` produce specials; `let` rebinds via parameterize-style scope
|
||||||
- [x] 127 tests in `lib/common-lisp/tests/eval.sx`
|
- [ ] 60+ tests in `lib/common-lisp/tests/eval.sx`
|
||||||
|
|
||||||
### Phase 3 — conditions + restarts (THE SHOWCASE)
|
### Phase 3 — conditions + restarts (THE SHOWCASE)
|
||||||
- [ ] `define-condition` — class hierarchy rooted at `condition`/`error`/`warning`/`simple-error`/`simple-warning`/`type-error`/`arithmetic-error`/`division-by-zero`
|
- [ ] `define-condition` — class hierarchy rooted at `condition`/`error`/`warning`/`simple-error`/`simple-warning`/`type-error`/`arithmetic-error`/`division-by-zero`
|
||||||
@@ -114,10 +114,7 @@ Core mapping:
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
- 2026-04-25: Phase 2 eval — 127 tests, 299 total green. `lib/common-lisp/eval.sx`: cl-eval-ast with quote/if/progn/let/let*/flet/labels/setq/setf/function/lambda/the/locally/eval-when; defun/defvar/defparameter/defconstant; built-in arithmetic (+/-/*//, min/max/abs/evenp/oddp), comparisons, predicates, list ops (car/cdr/cons/list/append/reverse/length/nth/first/second/third/rest), string ops, funcall/apply/mapcar. Key gotchas: SX reduce is (reduce fn init list) not (reduce fn list init); CL true literal is t not true; builtins registered in cl-global-env.fns via wrapper dicts for #' syntax.
|
- _(none yet)_
|
||||||
- 2026-04-25: Phase 1 lambda-list parser — 31 new tests, 172 total green. `cl-parse-lambda-list` in `parser.sx` + `tests/lambda.sx`. Handles &optional/&rest/&body/&key/&aux/&allow-other-keys, defaults, supplied-p. Key gotchas: `(when (> (len items) 0) ...)` not `(when items ...)` (empty list is truthy); custom `cl-deep=` needed for dict/list structural equality in tests.
|
|
||||||
- 2026-04-25: Phase 1 reader/parser — 62 new tests, 141 total green. `lib/common-lisp/parser.sx`: cl-read/cl-read-all, lists, dotted pairs, quote/backquote/unquote/splice/#', vectors, #:uninterned, NIL→nil, T→true, reader macro wrappers.
|
|
||||||
- 2026-04-25: Phase 1 tokenizer — 79 tests green. `lib/common-lisp/reader.sx` + `tests/read.sx` + `test.sh`. Handles symbols (pkg:sym, pkg::sym), integers, floats, ratios, hex/binary/octal, strings, #\ chars, reader macros (#' #( #: ,@), line/block comments. Key gotcha: SX `str` for string concat (not `concat`), substring-based read-while.
|
|
||||||
|
|
||||||
## Blockers
|
## Blockers
|
||||||
|
|
||||||
|
|||||||
@@ -51,11 +51,11 @@ Core mapping:
|
|||||||
## Roadmap
|
## Roadmap
|
||||||
|
|
||||||
### Phase 1 — tokenizer + parser
|
### Phase 1 — tokenizer + parser
|
||||||
- [ ] Tokenizer: keywords (`def end class module if unless while until do return yield begin rescue ensure case when then else elsif`), identifiers (lowercase = local/method, `@` = ivar, `@@` = cvar, `$` = global, uppercase = constant), numbers (int, float, `0x` `0o` `0b`, `_` separators), strings (`"…"` interpolation, `'…'` literal, `%w[a b c]`, `%i[a b c]`), symbols `:foo` `:"…"`, operators (`+ - * / % ** == != < > <= >= <=> === =~ !~ << >> & | ^ ~ ! && || and or not`), `:: . , ; ( ) [ ] { } -> => |`, comments `#`
|
- [x] Tokenizer: keywords (`def end class module if unless while until do return yield begin rescue ensure case when then else elsif`), identifiers (lowercase = local/method, `@` = ivar, `@@` = cvar, `$` = global, uppercase = constant), numbers (int, float, `0x` `0o` `0b`, `_` separators), strings (`"…"` interpolation, `'…'` literal, `%w[a b c]`, `%i[a b c]`), symbols `:foo` `:"…"`, operators (`+ - * / % ** == != < > <= >= <=> === =~ !~ << >> & | ^ ~ ! && || and or not`), `:: . , ; ( ) [ ] { } -> => |`, comments `#`
|
||||||
- [ ] Parser: program is sequence of statements separated by newlines or `;`; method def `def name(args) … end`; class `class Foo < Bar … end`; module `module M … end`; block `do |a, b| … end` and `{ |a, b| … }`; call sugar (no parens), `obj.method`, `Mod::Const`; arg shapes (positional, default, splat `*args`, double-splat `**opts`, block `&blk`)
|
- [x] Parser: program is sequence of statements separated by newlines or `;`; method def `def name(args) … end`; class `class Foo < Bar … end`; module `module M … end`; block `do |a, b| … end` and `{ |a, b| … }`; call sugar (no parens), `obj.method`, `Mod::Const`; arg shapes (positional, default, splat `*args`, double-splat `**opts`, block `&blk`)
|
||||||
- [ ] If/while/case expressions (return values), `unless`/`until`, postfix modifiers
|
- [ ] If/while/case expressions (return values), `unless`/`until`, postfix modifiers
|
||||||
- [ ] Begin/rescue/ensure/retry, raise, raise with class+message
|
- [ ] Begin/rescue/ensure/retry, raise, raise with class+message
|
||||||
- [ ] Unit tests in `lib/ruby/tests/parse.sx`
|
- [x] Unit tests in `lib/ruby/tests/parse.sx`
|
||||||
|
|
||||||
### Phase 2 — object model + sequential eval
|
### Phase 2 — object model + sequential eval
|
||||||
- [ ] Class table bootstrap: `BasicObject`, `Object`, `Kernel`, `Module`, `Class`, `Numeric`, `Integer`, `Float`, `String`, `Symbol`, `Array`, `Hash`, `Range`, `NilClass`, `TrueClass`, `FalseClass`, `Proc`, `Method`
|
- [ ] Class table bootstrap: `BasicObject`, `Object`, `Kernel`, `Module`, `Class`, `Numeric`, `Integer`, `Float`, `String`, `Symbol`, `Array`, `Hash`, `Range`, `NilClass`, `TrueClass`, `FalseClass`, `Proc`, `Method`
|
||||||
@@ -117,7 +117,8 @@ Core mapping:
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
- _(none yet)_
|
- 2026-04-25: Phase 1 parser complete — `lib/ruby/parser.sx` (rb-parse/rb-parse-str) + `lib/ruby/tests/parse.sx` (83/83 tests). Program, method-def (all param shapes), class/module/sclass, blocks (do/brace), method calls (parens + no-parens + chains), const-path, assignment (=, op=, massign), binary/unary ops with precedence, array/hash literals, return/yield/break/next/redo/raise, indexing.
|
||||||
|
- 2026-04-25: Phase 1 tokenizer complete — `lib/ruby/tokenizer.sx` + `lib/ruby/tests/tokenizer.sx` (107/107 tests). Keywords, identifiers (@ivar @@cvar $gvar), numbers (dec/hex/octal/binary/float), strings (dq with interpolation kept raw, sq), symbols, %w/%i literals, operators (all compound forms), punctuation, comments, line/col tracking.
|
||||||
|
|
||||||
## Blockers
|
## Blockers
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user