rose-ash/lib/common-lisp/tests/macros.sx

;; lib/common-lisp/tests/macros.sx — Phase 5: defmacro, gensym, LOOP tests
;;
;; Depends on: runtime.sx, eval.sx, loop.sx already loaded.
;; Tests via (ev "...") using the CL evaluator.

(define ev (fn (src) (cl-eval-str src (cl-make-env))))
(define evall (fn (src) (cl-eval-all-str src (cl-make-env))))

(define passed 0)
(define failed 0)
(define failures (list))

(define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))

;; ── defmacro basics ──────────────────────────────────────────────────────────

(check
  "defmacro returns name"
  (ev "(defmacro my-or (a b) (list 'if a a b))")
  "MY-OR")

(check
  "defmacro expansion works"
  (ev "(progn (defmacro my-inc (x) (list '+ x 1)) (my-inc 5))")
  6)

(check
  "defmacro with &rest"
  (ev "(progn (defmacro my-list (&rest xs) (cons 'list xs)) (my-list 1 2 3))")
  (list 1 2 3))

(check
  "nested macro expansion"
  (ev "(progn (defmacro sq (x) (list '* x x)) (sq 7))")
  49)

(check
  "macro in conditional"
  (ev
    "(progn (defmacro my-when (c &rest body) (list 'if c (cons 'progn body) nil)) (my-when t 10 20))")
  20)

(check
  "macro returns nil branch"
  (ev
    "(progn (defmacro my-when (c &rest body) (list 'if c (cons 'progn body) nil)) (my-when nil 42))")
  nil)

;; ── macroexpand ───────────────────────────────────────────────────────────────

(check
  "macroexpand returns expanded form"
  (ev "(progn (defmacro double (x) (list '+ x x)) (macroexpand '(double 5)))")
  (list "+" 5 5))

;; ── gensym ────────────────────────────────────────────────────────────────────

(check "gensym returns string" (ev "(stringp (gensym))") true)

(check
  "gensym prefix"
  (ev "(let ((g (gensym \"MY\"))) (not (= g nil)))")
  true)

(check "gensyms are unique" (ev "(not (= (gensym) (gensym)))") true)

;; ── swap! macro with gensym ───────────────────────────────────────────────────

(check
  "swap! macro"
  (evall
    "(defmacro swap! (a b) (let ((tmp (gensym))) (list 'let (list (list tmp a)) (list 'setq a b) (list 'setq b tmp)))) (defvar *a* 10) (defvar *b* 20) (swap! *a* *b*) (list *a* *b*)")
  (list 20 10))

;; ── LOOP: basic repeat and collect ────────────────────────────────────────────

(check
  "loop repeat collect"
  (ev "(loop repeat 3 collect 99)")
  (list 99 99 99))

(check
  "loop for-in collect"
  (ev "(loop for x in '(1 2 3) collect (* x x))")
  (list 1 4 9))

(check
  "loop for-from-to collect"
  (ev "(loop for i from 1 to 5 collect i)")
  (list 1 2 3 4 5))

(check
  "loop for-from-below collect"
  (ev "(loop for i from 0 below 4 collect i)")
  (list 0 1 2 3))

(check
  "loop for-downto collect"
  (ev "(loop for i from 5 downto 1 collect i)")
  (list 5 4 3 2 1))

(check
  "loop for-by collect"
  (ev "(loop for i from 0 to 10 by 2 collect i)")
  (list 0 2 4 6 8 10))

;; ── LOOP: sum, count, maximize, minimize ─────────────────────────────────────

(check "loop sum" (ev "(loop for i from 1 to 5 sum i)") 15)

(check
  "loop count"
  (ev "(loop for x in '(1 2 3 4 5) count (> x 3))")
  2)

(check
  "loop maximize"
  (ev "(loop for x in '(3 1 4 1 5 9 2 6) maximize x)")
  9)

(check
  "loop minimize"
  (ev "(loop for x in '(3 1 4 1 5 9 2 6) minimize x)")
  1)

;; ── LOOP: while and until ─────────────────────────────────────────────────────

(check
  "loop while"
  (ev "(loop for i from 1 to 10 while (< i 5) collect i)")
  (list 1 2 3 4))

(check
  "loop until"
  (ev "(loop for i from 1 to 10 until (= i 5) collect i)")
  (list 1 2 3 4))

;; ── LOOP: when / unless ───────────────────────────────────────────────────────

(check
  "loop when filter"
  (ev "(loop for i from 0 below 8 when (evenp i) collect i)")
  (list 0 2 4 6))

(check
  "loop unless filter"
  (ev "(loop for i from 0 below 8 unless (evenp i) collect i)")
  (list 1 3 5 7))

;; ── LOOP: append ─────────────────────────────────────────────────────────────

(check
  "loop append"
  (ev "(loop for x in '((1 2) (3 4) (5 6)) append x)")
  (list 1 2 3 4 5 6))

;; ── LOOP: always, never, thereis ─────────────────────────────────────────────

(check
  "loop always true"
  (ev "(loop for x in '(2 4 6) always (evenp x))")
  true)

(check
  "loop always false"
  (ev "(loop for x in '(2 3 6) always (evenp x))")
  false)

(check "loop never" (ev "(loop for x in '(1 3 5) never (evenp x))") true)

(check "loop thereis" (ev "(loop for x in '(1 2 3) thereis (> x 2))") true)

;; ── LOOP: for = then (general iteration) ─────────────────────────────────────

(check
  "loop for = then doubling"
  (ev "(loop repeat 5 for x = 1 then (* x 2) collect x)")
  (list 1 2 4 8 16))

;; ── summary ────────────────────────────────────────────────────────────────

(define macro-passed passed)
(define macro-failed failed)
(define macro-failures failures)