rose-ash/spec/tests/test-macros.sx

;; ==========================================================================
;; test-macros.sx — Tests for macros and quasiquote
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: eval.sx (defmacro, quasiquote, unquote, splice-unquote)
;;
;; Platform functions required (beyond test framework):
;;   sx-parse-one  (source)  -> first AST expression from source string
;;   equal?        (a b)     -> deep equality comparison
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Quasiquote basics
;; --------------------------------------------------------------------------

(defsuite "quasiquote-basics"
  (deftest "quasiquote with no unquotes is like quote"
    ;; `(a b c) returns a list of three symbols — same as '(a b c)
    (assert-true (equal? '(a b c) `(a b c)))
    (assert-length 3 `(a b c)))

  (deftest "quasiquote preserves numbers and strings as-is"
    (assert-equal (list 1 "hello" true) `(1 "hello" true)))

  (deftest "quasiquote returns literal list"
    ;; Without unquotes, the result is a plain list — not evaluated
    (let ((result `(+ 1 2)))
      (assert-type "list" result)
      (assert-length 3 result)))

  (deftest "unquote substitutes value"
    ;; `(a ,x b) with x=42 should yield the list (a 42 b)
    ;; Compare against the parsed AST of "(a 42 b)"
    (let ((x 42))
      (assert-true (equal? (sx-parse-one "(a 42 b)") `(a ,x b)))))

  (deftest "unquote evaluates its expression"
    ;; ,expr evaluates expr — not just symbol substitution
    (let ((x 3))
      (assert-equal (list 1 2 6 4) `(1 2 ,(* x 2) 4))))

  (deftest "unquote-splicing flattens list into quasiquote"
    ;; ,@xs splices the elements of xs in-place
    (let ((xs (list 1 2 3)))
      (assert-equal (list 0 1 2 3 4) `(0 ,@xs 4))))

  (deftest "unquote-splicing with multiple elements"
    ;; Verify splice replaces the ,@xs slot with each element individually
    (let ((xs (list 2 3 4)))
      (assert-true (equal? (sx-parse-one "(a 2 3 4 b)") `(a ,@xs b)))))

  (deftest "unquote-splicing empty list leaves no elements"
    (let ((empty (list)))
      (assert-equal (list 1 2) `(1 ,@empty 2))))

  (deftest "multiple unquotes in one template"
    (let ((a 10) (b 20))
      (assert-equal (list 10 20 30) `(,a ,b ,(+ a b)))))

  (deftest "quasiquote with only unquote-splicing"
    (let ((items (list 7 8 9)))
      (assert-equal (list 7 8 9) `(,@items)))))


;; --------------------------------------------------------------------------
;; defmacro basics
;; --------------------------------------------------------------------------

(defsuite "defmacro-basics"
  (deftest "simple macro transforms code"
    ;; A macro that wraps its argument in (do ...)
    (defmacro wrap-do (expr)
      `(do ,expr))
    (assert-equal 42 (wrap-do 42))
    (assert-equal "hello" (wrap-do "hello")))

  (deftest "macro with multiple args"
    ;; my-if is structurally the same as if
    (defmacro my-if (condition then else)
      `(if ,condition ,then ,else))
    (assert-equal "yes" (my-if true "yes" "no"))
    (assert-equal "no" (my-if false "yes" "no"))
    (assert-equal "yes" (my-if (> 5 3) "yes" "no")))

  (deftest "macro using quasiquote and unquote"
    ;; inc1 expands to (+ x 1)
    (defmacro inc1 (x)
      `(+ ,x 1))
    (assert-equal 6 (inc1 5))
    (assert-equal 1 (inc1 0))
    (let ((n 10))
      (assert-equal 11 (inc1 n))))

  (deftest "macro using unquote-splicing for rest body"
    ;; progn evaluates a sequence, returning the last value
    (defmacro progn (&rest body)
      `(do ,@body))
    (assert-equal 3 (progn 1 2 3))
    (assert-equal "last" (progn "first" "middle" "last")))

  (deftest "macro with rest body side effects"
    ;; All body forms execute, not just the first
    (define counter 0)
    (defmacro progn2 (&rest body)
      `(do ,@body))
    (progn2
      (set! counter (+ counter 1))
      (set! counter (+ counter 1))
      (set! counter (+ counter 1)))
    (assert-equal 3 counter))

  (deftest "macro expansion happens before evaluation"
    ;; The macro sees raw AST — its body arg is the symbol x, not a value
    ;; This verifies that macro args are not evaluated before expansion
    (defmacro quote-arg (x)
      `(quote ,x))
    ;; (quote-arg foo) should expand to (quote foo), returning the symbol foo
    (let ((result (quote-arg foo)))
      (assert-true (equal? (sx-parse-one "foo") result))))

  (deftest "macro can build new list structure"
    ;; Macro that builds a let binding from two args
    (defmacro bind-to (name val body)
      `(let ((,name ,val)) ,body))
    (assert-equal 10 (bind-to x 10 x))
    (assert-equal 20 (bind-to y 10 (* y 2)))))


;; --------------------------------------------------------------------------
;; Common macro patterns
;; --------------------------------------------------------------------------

(defsuite "macro-patterns"
  (deftest "unless macro — opposite of when"
    (defmacro unless (condition &rest body)
      `(when (not ,condition) ,@body))
    ;; Runs body when condition is false
    (assert-equal "ran" (unless false "ran"))
    (assert-nil (unless true "should-not-run"))
    ;; Works with compound conditions
    (assert-equal "done" (unless (> 1 2) "done"))
    (assert-nil (unless (= 1 1) "nope")))

  (deftest "swap-vals! macro — exchange two bindings"
    ;; Swaps values of two variables using a temp binding
    (defmacro swap-vals! (a b)
      `(let ((tmp ,a))
         (set! ,a ,b)
         (set! ,b tmp)))
    (define p 1)
    (define q 2)
    (swap-vals! p q)
    (assert-equal 2 p)
    (assert-equal 1 q))

  (deftest "with-default macro — provide fallback for nil"
    ;; (with-default expr default) returns expr unless it is nil
    (defmacro with-default (expr fallback)
      `(or ,expr ,fallback))
    (assert-equal "hello" (with-default "hello" "fallback"))
    (assert-equal "fallback" (with-default nil "fallback"))
    (assert-equal "fallback" (with-default false "fallback")))

  (deftest "when2 macro — two-arg version with implicit body"
    ;; Like when, but condition and body are explicit
    (defmacro when2 (cond-expr body-expr)
      `(if ,cond-expr ,body-expr nil))
    (assert-equal 42 (when2 true 42))
    (assert-nil (when2 false 42)))

  (deftest "dotimes macro — simple counted loop"
    ;; Executes body n times, binding loop var to 0..n-1
    ;; Uses for-each over range instead of named-let (avoids set! scope issue)
    (defmacro dotimes (binding &rest body)
      (let ((var (first binding))
            (n   (first (rest binding))))
        `(for-each (fn (,var) ,@body) (range 0 ,n))))
    (define total 0)
    (dotimes (i 5)
      (set! total (+ total i)))
    ;; 0+1+2+3+4 = 10
    (assert-equal 10 total))

  (deftest "and2 macro — two-arg short-circuit and"
    (defmacro and2 (a b)
      `(if ,a ,b false))
    (assert-equal "b" (and2 "a" "b"))
    (assert-false (and2 false "b"))
    (assert-false (and2 "a" false)))

  (deftest "macro calling another macro"
    ;; nand is defined in terms of and2 (which is itself a macro)
    (defmacro and2b (a b)
      `(if ,a ,b false))
    (defmacro nand (a b)
      `(not (and2b ,a ,b)))
    (assert-true (nand false false))
    (assert-true (nand false true))
    (assert-true (nand true false))
    (assert-false (nand true true))))


;; --------------------------------------------------------------------------
;; Macro hygiene
;; --------------------------------------------------------------------------

(defsuite "macro-hygiene"
  (deftest "macro-introduced bindings do not leak to caller scope"
    ;; The macro uses a local let binding named `tmp`.
    ;; That binding must not appear in the caller's environment after expansion.
    (defmacro double-add (x)
      `(let ((tmp (* ,x 2)))
         (+ tmp 1)))
    (assert-equal 11 (double-add 5))
    (assert-equal 21 (double-add 10))
    ;; Verify the let scope is isolated: evaluate two calls and confirm
    ;; results are independent (no shared `tmp` leaking between calls)
    (assert-equal (list 11 21) (list (double-add 5) (double-add 10))))

  (deftest "caller bindings are visible inside macro expansion"
    ;; The macro emits code that references `scale` — a name that must be
    ;; looked up in the caller's environment at expansion evaluation time.
    (defmacro scale-add (x)
      `(+ ,x scale))
    (let ((scale 100))
      (assert-equal 105 (scale-add 5))))

  (deftest "nested macro expansion"
    ;; Outer macro expands to a call of an inner macro.
    ;; The inner macro's expansion must also be fully evaluated.
    (defmacro inner-mac (x)
      `(* ,x 2))
    (defmacro outer-mac (x)
      `(inner-mac (+ ,x 1)))
    ;; outer-mac 4 → (inner-mac (+ 4 1)) → (inner-mac 5) → (* 5 2) → 10
    (assert-equal 10 (outer-mac 4)))

  (deftest "macro does not evaluate args — sees raw AST"
    ;; Passing an expression that would error if evaluated; macro must not
    ;; force evaluation of args it doesn't use.
    (defmacro first-arg (a b)
      `(quote ,a))
    ;; b = (/ 1 0) would be a runtime error if evaluated, but macro ignores b
    (assert-true (equal? (sx-parse-one "hello") (first-arg hello (/ 1 0)))))

  (deftest "macro expansion in let body"
    ;; Macros must expand correctly when used inside a let body,
    ;; not just at top level.
    (defmacro triple (x)
      `(* ,x 3))
    (let ((n 4))
      (assert-equal 12 (triple n))))

  (deftest "macro in higher-order position — map over macro results"
    ;; Macros can't be passed as first-class values, but their expansions
    ;; can produce lambdas that are passed. Verify that using a macro to
    ;; build a lambda works correctly.
    (defmacro make-adder (n)
      `(fn (x) (+ x ,n)))
    (let ((add5 (make-adder 5))
          (add10 (make-adder 10)))
      (assert-equal 8  (add5 3))
      (assert-equal 13 (add10 3))
      (assert-equal (list 6 7 8)
        (map (make-adder 5) (list 1 2 3))))))