;; 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))