;; tests/cl-compat.lsp — exercises the CL compatibility shim.
;; Runs in both Python and C via make test-zoe-favorites.
(load "cl-compat.lsp")

(define *pass* 0)
(define *fail* 0)
(define (check name got expected)
  (cond ((equal? got expected)
         (set! *pass* (+ *pass* 1))
         (display "PASS: ") (display name) (newline))
        (else
         (set! *fail* (+ *fail* 1))
         (display "FAIL: ") (display name)
         (display " got=") (write got)
         (display " expected=") (write expected) (newline))))

;; ── constants ────────────────────────────────────────────────────
(check "t"        t  #t)
(check "nil"      nil #f)

;; ── predicates ───────────────────────────────────────────────────
(check "evenp-4"  (evenp 4)   #t)
(check "oddp-3"   (oddp 3)    #t)
(check "plusp-5"  (plusp 5)   #t)
(check "minusp-n" (minusp -5) #t)
(check "zerop-0"  (zerop 0)   #t)

;; ── arithmetic ───────────────────────────────────────────────────
(check "mod-10-3"  (mod 10 3) 1)
(check "ash-1-3"   (ash 1 3)    8)
(check "ash-8-n3"  (ash 8 -3)   1)
(check "ash-255-n4" (ash 255 -4) 15)

;; ── logbitp ──────────────────────────────────────────────────────
(check "logbitp-0-6" (logbitp 0 6) #f)
(check "logbitp-1-6" (logbitp 1 6) #t)
(check "logbitp-2-6" (logbitp 2 6) #t)
(check "logbitp-3-6" (logbitp 3 6) #f)

;; ── list ops ─────────────────────────────────────────────────────
(check "nreverse" (nreverse (list 1 2 3)) '(3 2 1))

;; ── cl-when / cl-unless ──────────────────────────────────────────
(check "cl-when-t"    (cl-when   #t 1 2 3) 3)
(check "cl-when-f"    (cl-when   #f 1 2 3) #f)
(check "cl-unless-t"  (cl-unless #t 1 2 3) #f)
(check "cl-unless-f"  (cl-unless #f 1 2 3) 3)

;; ── defun ────────────────────────────────────────────────────────
(defun square-it (x) (* x x))
(check "defun-basic" (square-it 7) 49)

(defun greet (who &optional (greeting "hello"))
  (list greeting who))
(check "defun-opt-default"  (greet 'world)           '("hello" world))
(check "defun-opt-provided" (greet 'world "bonjour") '("bonjour" world))

(defun maybe (x &optional y)
  (if (null? y) 'no-y (list x y)))
(check "defun-opt-nil"   (maybe 1)   'no-y)
(check "defun-opt-given" (maybe 1 2) '(1 2))

;; ── setf ─────────────────────────────────────────────────────────
(define x 10)
(setf x 20)
(check "setf-single" x 20)

(define a 1) (define b 2) (define c 3)
(setf a 100 b 200 c 300)
(check "setf-multi-a" a 100)
(check "setf-multi-b" b 200)
(check "setf-multi-c" c 300)

;; ── flet ─────────────────────────────────────────────────────────
(check "flet"
  (flet ((double (n) (* 2 n))
         (triple (n) (* 3 n)))
    (+ (double 5) (triple 5)))
  25)

;; ── multiple-value-bind ──────────────────────────────────────────
(check "mvb"
  (multiple-value-bind (q r) (values 7 3) (list q r))
  '(7 3))

;; ── cl-loop: 14 representative patterns ─────────────────────────

;; 1. while + do
(define counter 0)
(cl-loop while (< counter 5) do (setf counter (+ counter 1)))
(check "loop-while-do" counter 5)

;; 2. while + multi-setf
(define d 16) (define s 0)
(cl-loop while (evenp d) do (setf d (ash d -1) s (1+ s)))
(check "loop-while-multi-d" d 1)
(check "loop-while-multi-s" s 4)

;; 3. while + finally return
(define u 10)
(check "loop-while-finally"
  (cl-loop while (> u 0) do (setf u (- u 1)) finally (return u))
  0)

;; 4. repeat + simple-for + unless return + finally
(check "loop-repeat-simple-unless"
  (cl-loop repeat 5 for av = 3 unless (> av 0) return 'early finally (return 'done))
  'done)

;; 5. repeat + when return
(check "loop-repeat-when-return"
  (let ((k 0))
    (cl-loop repeat 10 do (setf k (+ k 1))
             when (= k 3) return 'got-three
             finally (return 'not-hit)))
  'got-three)

;; 6. repeat + then accumulator + finally
(check "loop-repeat-then"
  (cl-loop repeat 4 for sv of-type integer = 4 then (- (* sv sv) 2) finally (return sv))
  37634)

;; 7. range to + then accumulator
(check "loop-range-to-then"
  (cl-loop for i from 0 to 4 for j = 1 then (+ j (expt 2 i)) finally (return j))
  31)

;; 8. range below + do
(define acc '())
(cl-loop for i from 0 below 5 do (set! acc (cons i acc)))
(check "loop-range-below" (reverse acc) '(0 1 2 3 4))

;; 9. range downto + then accumulator
(check "loop-range-downto-then"
  (cl-loop for i from 4 downto 0 for sum = (expt 2 i) then (+ sum (expt 2 i)) finally (return sum))
  31)

;; 10. with + across + finally
(check "loop-with-across"
  (cl-loop with result = 0 for digit across (vector 1 2 3 4 5)
           do (setf result (+ (* result 10) digit))
           finally (return result))
  12345)

;; 11. simple-for (infinite) + when return
(check "loop-infinite-when"
  (let ((gen 0))
    (cl-loop for i = (begin (set! gen (+ gen 1)) gen)
             when (> i 3) return i))
  4)

;; 12. simple-for + until + finally (body variant)
(check "loop-simple-until-finally-body"
  (let ((found 0))
    (cl-loop for dv = (if (= found 0) #f 42)
             until dv
             do (set! found 1)
             finally (set! found (+ found 100)))
    found)
  101)

;; 13. declare (no-op) inside defun
(defun decl-fn (x)
  (declare (optimize (speed 3)) (type integer x))
  (* x x))
(check "declare-noop" (decl-fn 9) 81)

(display "══════════════════════════════") (newline)
(display "cl-compat: ") (display *pass*) (display " passed, ")
(display *fail*) (display " failed") (newline)
(if (> *fail* 0) (exit 1))
