giles
9a7ca54902
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
scm-match-list now detects `<pat> ...` at the END of a pattern list and binds <pat> (must be a symbol — single-variable rest) to the remaining forms as a list. Nested-list patterns under ellipsis and middle-of-list ellipses are NOT supported yet (rare in practice; deferred). scm-instantiate-list mirrors: when it encounters `<var> ... ` inside a list template, it splices the list-valued binding of <var> in place. Internal list-append-all helper for the splice. Removes the `(length pat) = (length form)` strict-equality check in scm-match-step's list case — that gate blocked ellipsis. The length-1-or-more relaxed check now lives in scm-match-list itself. 8 ellipsis tests cover: - Empty rest (my-list) - Non-empty rest (my-list 1 2 3 4) - my-when with multi-body - Variadic sum-em via fold-left - Recursive my-and pattern (short-circuit AND defined as macro) 257 total Scheme tests (62 + 23 + 49 + 78 + 25 + 20). Phase 6c (proper hygiene) is the next step and will be the **second consumer for lib/guest/reflective/hygiene.sx** — the deferred research-grade kit from the kernel-on-sx loop.
156 lines
5.0 KiB
Plaintext
156 lines
5.0 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)
|
|
|
|
;; ── 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}))
|