;; lib/scheme/tests/macros.sx — define-syntax + syntax-rules.

(define scm-mac-pass 0)
(define scm-mac-fail 0)
(define scm-mac-fails (list))

(define
  scm-mac-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! scm-mac-pass (+ scm-mac-pass 1))
      (begin
        (set! scm-mac-fail (+ scm-mac-fail 1))
        (append! scm-mac-fails {:name name :actual actual :expected expected})))))

(define
  scm-mac
  (fn
    (src)
    (scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))

;; ── Basic syntax-rules ──────────────────────────────────────────

(scm-mac-test
  "my-if true"
  (scm-mac
    "(define-syntax my-if (syntax-rules () ((_ c t e) (cond (c t) (else e)))))\n     (my-if #t 'yes 'no)")
  "yes")
(scm-mac-test
  "my-if false"
  (scm-mac
    "(define-syntax my-if (syntax-rules () ((_ c t e) (cond (c t) (else e)))))\n     (my-if #f 'yes 'no)")
  "no")
(scm-mac-test
  "double"
  (scm-mac
    "(define-syntax double (syntax-rules () ((_ x) (+ x x))))\n     (double 21)")
  42)
(scm-mac-test
  "nested macro use"
  (scm-mac
    "(define-syntax double (syntax-rules () ((_ x) (+ x x))))\n     (double (double 5))")
  20)

;; ── Macro with multiple rules ───────────────────────────────────

(scm-mac-test
  "multi-rule: matches first"
  (scm-mac
    "(define-syntax twin (syntax-rules () ((_ a) a) ((_ a b) (+ a b))))\n     (twin 7)")
  7)
(scm-mac-test
  "multi-rule: matches second"
  (scm-mac
    "(define-syntax twin (syntax-rules () ((_ a) a) ((_ a b) (+ a b))))\n     (twin 3 4)")
  7)

;; ── Macros wrapping control flow ────────────────────────────────

(scm-mac-test
  "swap idiom"
  (scm-mac
    "(define-syntax swap! (syntax-rules () ((_ a b) (let ((tmp a)) (set! a b) (set! b tmp)))))\n     (define x 1) (define y 2)\n     (swap! x y)\n     (list x y)")
  (list 2 1))

;; ── Macros that expand to expressions, not values ──────────────

(scm-mac-test
  "my-unless: true → empty"
  (scm-mac
    "(define-syntax my-unless (syntax-rules () ((_ c body) (if c 'skipped body))))\n     (my-unless #t 99)")
  "skipped")
(scm-mac-test
  "my-unless: false → body"
  (scm-mac
    "(define-syntax my-unless (syntax-rules () ((_ c body) (if c 'skipped body))))\n     (my-unless #f 99)")
  99)

;; ── Macro with literal keyword ─────────────────────────────────

(scm-mac-test
  "literal: => recognised"
  (scm-mac
    "(define-syntax tag-arrow (syntax-rules (=>) ((_ a => b) (list 'arrow a b))))\n     (tag-arrow 1 => 2)")
  (list "arrow" 1 2))

;; ── Macro keyword passed through unevaluated ────────────────────

(scm-mac-test
  "list expansion preserves arg order"
  (scm-mac
    "(define-syntax tuple (syntax-rules () ((_ a b c) (list a b c))))\n     (tuple 1 2 3)")
  (list 1 2 3))

;; ── Macros + lambdas ────────────────────────────────────────────

(scm-mac-test
  "macro inside lambda"
  (scm-mac
    "(define-syntax sq (syntax-rules () ((_ x) (* x x))))\n     (define (f n) (+ (sq n) 1))\n     (f 5)")
  26)

;; ── Ellipsis patterns (Phase 6b — tail-rest single-variable) ────
(scm-mac-test "ellipsis: empty rest"
  (scm-mac
    "(define-syntax my-list (syntax-rules () ((_ xs ...) (list xs ...))))
     (my-list)")
  (list))
(scm-mac-test "ellipsis: list of values"
  (scm-mac
    "(define-syntax my-list (syntax-rules () ((_ xs ...) (list xs ...))))
     (my-list 1 2 3 4)")
  (list 1 2 3 4))
(scm-mac-test "ellipsis: my-when truthy"
  (scm-mac
    "(define-syntax my-when (syntax-rules () ((_ c body ...) (if c (begin body ...)))))
     (my-when #t 1 2 3)")
  3)
(scm-mac-test "ellipsis: my-when falsy returns nil"
  (scm-mac
    "(define-syntax my-when (syntax-rules () ((_ c body ...) (if c (begin body ...)))))
     (my-when #f 1 2 3)")
  nil)
(scm-mac-test "ellipsis: begin-rebuild"
  (scm-mac
    "(define-syntax my-begin (syntax-rules () ((_ body ...) (let () body ...))))
     (my-begin (define x 5) (define y 10) (+ x y))")
  15)
(scm-mac-test "ellipsis: variadic sum-em via fold"
  (scm-mac
    "(define-syntax sum-em (syntax-rules () ((_ xs ...) (fold-left + 0 (list xs ...)))))
     (sum-em 1 2 3 4 5)")
  15)
(scm-mac-test "ellipsis: recursive my-and"
  (scm-mac
    "(define-syntax my-and
       (syntax-rules ()
         ((_) #t)
         ((_ x) x)
         ((_ x xs ...) (if x (my-and xs ...) #f))))
     (my-and 1 2 3)")
  3)
(scm-mac-test "ellipsis: my-and short-circuits"
  (scm-mac
    "(define-syntax my-and
       (syntax-rules ()
         ((_) #t)
         ((_ x) x)
         ((_ x xs ...) (if x (my-and xs ...) #f))))
     (my-and 1 #f 3)")
  false)

(define scm-mac-tests-run! (fn () {:total (+ scm-mac-pass scm-mac-fail) :passed scm-mac-pass :failed scm-mac-fail :fails scm-mac-fails}))