giles
eb14a7576b
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
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).
106 lines
3.5 KiB
Plaintext
106 lines
3.5 KiB
Plaintext
;; 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}))
|