scheme: Phase 6a — define-syntax + syntax-rules (no ellipsis) + 12 tests

eval.sx adds macro infrastructure:
- {:scm-tag :macro :literals (LIT...) :rules ((PAT TMPL)...) :env E}
- scheme-macro? predicate
- scm-match / scm-match-list — pattern matching against literals,
  pattern variables, and structural list shapes
- scm-instantiate — template substitution with bindings
- scm-expand-rules — try each rule in order
- (syntax-rules (LITS) (PAT TMPL)...) → macro value
- (define-syntax NAME FORM) → bind macro in env
- scheme-eval: when head looks up to a macro, expand and re-eval

Pattern matching supports:
- _ → match anything, no bind
- literal symbols from the LITERALS list → must equal-match
- other symbols → pattern variables, bind to matched form
- list patterns → must be same length, each element matches

NO ellipsis (`...`) support yet — that's Phase 6b. NO hygiene
yet (introduced symbols can shadow caller bindings) — that's
Phase 6c, which will be the second consumer for
lib/guest/reflective/hygiene.sx.

12 tests cover: simple substitution, multi-rule selection,
nested macro use, swap-idiom (state mutation via set!), control-
flow wrappers, literal-keyword pattern matching, macros inside
lambdas.

249 total Scheme tests now (62 + 23 + 49 + 78 + 25 + 12).

lib/scheme/eval.sx

@@ -334,6 +334,140 @@
 (scheme-define-op! "or"
   (fn (args env) (scm-or-step args env)))
 
+;; ── syntax-rules / define-syntax (Phase 6a — no ellipsis yet) ────
+;;
+;; Macros are tagged values:
+;;   {:scm-tag :macro :literals (LIT...) :rules ((PAT TMPL)...) :env E}
+;;
+;; The pattern matcher binds pattern variables to matched sub-forms;
+;; the template instantiator substitutes those bindings back. No
+;; hygiene yet — introduced symbols can shadow caller bindings.
+;; Hygiene lands in a follow-up (Phase 6c — second consumer for
+;; lib/guest/reflective/hygiene.sx).
+
+(define scheme-macro?
+  (fn (v) (and (dict? v) (= (get v :scm-tag) :macro))))
+
+;; Pattern matching: returns a bindings dict or :scm-no-match.
+;; The first PATTERN element is the macro keyword and is skipped.
+(define scm-match
+  (fn (pat form literals)
+    (scm-match-step pat form literals {})))
+
+(define scm-match-step
+  (fn (pat form literals bindings)
+    (cond
+      ;; pat is `_` (any) — match anything, no binding
+      ((and (string? pat) (= pat "_"))
+        bindings)
+      ;; pat is a literal symbol from the literals list
+      ((and (string? pat) (scm-is-literal? pat literals))
+        (cond
+          ((and (string? form) (= form pat)) bindings)
+          (:else :scm-no-match)))
+      ;; pat is a pattern variable — bind
+      ((string? pat)
+        (cond
+          ((dict-has? bindings pat) :scm-no-match)  ;; non-linear
+          (:else (assoc bindings pat form))))
+      ;; pat is a list — match list-of-same-length
+      ((list? pat)
+        (cond
+          ((not (list? form)) :scm-no-match)
+          ((not (= (length pat) (length form))) :scm-no-match)
+          (:else (scm-match-list pat form literals bindings))))
+      ;; literal value: must equal
+      (:else
+        (cond ((= pat form) bindings) (:else :scm-no-match))))))
+
+(define scm-match-list
+  (fn (pats forms literals bindings)
+    (cond
+      ((or (nil? pats) (= (length pats) 0)) bindings)
+      (:else
+        (let ((sub (scm-match-step (first pats) (first forms)
+                                   literals bindings)))
+          (cond
+            ((= sub :scm-no-match) :scm-no-match)
+            (:else
+              (scm-match-list (rest pats) (rest forms)
+                              literals sub))))))))
+
+(define scm-is-literal?
+  (fn (name literals)
+    (cond
+      ((or (nil? literals) (= (length literals) 0)) false)
+      ((= (first literals) name) true)
+      (:else (scm-is-literal? name (rest literals))))))
+
+;; Template instantiation: walk the template, substituting pattern
+;; variables with their bindings; leave non-pattern-vars alone.
+(define scm-instantiate
+  (fn (tmpl bindings)
+    (cond
+      ((and (string? tmpl) (dict-has? bindings tmpl))
+        (get bindings tmpl))
+      ((list? tmpl)
+        (cond
+          ((= (length tmpl) 0) tmpl)
+          (:else (map (fn (t) (scm-instantiate t bindings)) tmpl))))
+      (:else tmpl))))
+
+;; Try each rule against the form; return the instantiated template
+;; or :scm-no-match if no rule matches.
+(define scm-expand
+  (fn (macro-val form)
+    (scm-expand-rules
+      (get macro-val :rules)
+      form
+      (get macro-val :literals))))
+
+(define scm-expand-rules
+  (fn (rules form literals)
+    (cond
+      ((or (nil? rules) (= (length rules) 0))
+        (error (str "macro: no matching rule for: " form)))
+      (:else
+        (let ((rule (first rules)))
+          (let ((bindings (scm-match (first rule) form literals)))
+            (cond
+              ((= bindings :scm-no-match)
+                (scm-expand-rules (rest rules) form literals))
+              (:else
+                (scm-instantiate (nth rule 1) bindings)))))))))
+
+;; (syntax-rules (LITERALS...) (PAT TMPL) ...) → macro value
+(scheme-define-op! "syntax-rules"
+  (fn (args env)
+    (cond
+      ((< (length args) 1)
+        (error "syntax-rules: expects (literals) (pat tmpl)..."))
+      ((not (list? (first args)))
+        (error "syntax-rules: first arg must be the literals list"))
+      (:else
+        {:scm-tag :macro
+         :literals (first args)
+         :rules (rest args)
+         :env env}))))
+
+;; (define-syntax NAME SYNTAX-RULES-FORM)
+(scheme-define-op! "define-syntax"
+  (fn (args env)
+    (cond
+      ((not (= (length args) 2))
+        (error "define-syntax: expects (name syntax-rules-form)"))
+      ((not (string? (first args)))
+        (error "define-syntax: name must be a symbol"))
+      (:else
+        (let ((macro-val (scheme-eval (nth args 1) env)))
+          (cond
+            ((not (scheme-macro? macro-val))
+              (error "define-syntax: value must be a macro"))
+            (:else
+              (begin
+                (scheme-env-bind! env (first args) macro-val)
+                macro-val))))))))
+
 ;; ── guard (R7RS exception clause-dispatch syntactic form) ────────
 ;; (guard (var (test1 body1) (test2 body2) ... [else body]) body...)
 ;;
@@ -437,6 +571,12 @@
               (cond
                 ((and (string? head) (scheme-syntactic-op? head))
                   ((get scheme-syntactic-ops head) rest-args env))
+                ;; Macro dispatch: head looks up to a macro value.
+                ((and (string? head)
+                      (scheme-env-has? env head)
+                      (scheme-macro? (scheme-env-lookup env head)))
+                  (scheme-eval (scm-expand (scheme-env-lookup env head) expr)
+                               env))
                 (:else
                   (let
                     ((proc (scheme-eval head env))

lib/scheme/tests/macros.sx

@@ -0,0 +1,105 @@
+;; 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)
+
+(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}))