scheme: Phase 6b — syntax-rules ellipsis (tail-rest) + 8 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
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.
This commit is contained in:
@@ -370,11 +370,11 @@
|
||||
(cond
|
||||
((dict-has? bindings pat) :scm-no-match) ;; non-linear
|
||||
(:else (assoc bindings pat form))))
|
||||
;; pat is a list — match list-of-same-length
|
||||
;; pat is a list — delegate to scm-match-list, which itself
|
||||
;; handles ellipsis tail patterns where the lengths differ.
|
||||
((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
|
||||
@@ -383,7 +383,30 @@
|
||||
(define scm-match-list
|
||||
(fn (pats forms literals bindings)
|
||||
(cond
|
||||
((or (nil? pats) (= (length pats) 0)) bindings)
|
||||
((or (nil? pats) (= (length pats) 0))
|
||||
(cond
|
||||
((or (nil? forms) (= (length forms) 0)) bindings)
|
||||
(:else :scm-no-match)))
|
||||
;; Ellipsis: (<pat> ... <rest>) — currently Phase 6b only
|
||||
;; supports a single ellipsis at the END of the pattern list.
|
||||
;; <pat> binds to the rest of the forms as a LIST.
|
||||
((and (>= (length pats) 2)
|
||||
(string? (nth pats 1))
|
||||
(= (nth pats 1) "..."))
|
||||
(cond
|
||||
((not (= (length pats) 2))
|
||||
;; Tail-ellipsis only for now; nested or middle deferred.
|
||||
:scm-no-match)
|
||||
((not (string? (first pats)))
|
||||
;; (<list-pat> ...) needs richer support — defer.
|
||||
:scm-no-match)
|
||||
(:else
|
||||
;; Bind first-pat to the remaining forms as a list.
|
||||
(let ((name (first pats)))
|
||||
(cond
|
||||
((dict-has? bindings name) :scm-no-match)
|
||||
(:else (assoc bindings name forms)))))))
|
||||
((or (nil? forms) (= (length forms) 0)) :scm-no-match)
|
||||
(:else
|
||||
(let ((sub (scm-match-step (first pats) (first forms)
|
||||
literals bindings)))
|
||||
@@ -402,6 +425,8 @@
|
||||
|
||||
;; Template instantiation: walk the template, substituting pattern
|
||||
;; variables with their bindings; leave non-pattern-vars alone.
|
||||
;; Inside a list, a `<var> ...` pair splices the list-valued binding
|
||||
;; of <var> in place — matches the tail-ellipsis pattern shape.
|
||||
(define scm-instantiate
|
||||
(fn (tmpl bindings)
|
||||
(cond
|
||||
@@ -410,9 +435,32 @@
|
||||
((list? tmpl)
|
||||
(cond
|
||||
((= (length tmpl) 0) tmpl)
|
||||
(:else (map (fn (t) (scm-instantiate t bindings)) tmpl))))
|
||||
(:else (scm-instantiate-list tmpl bindings))))
|
||||
(:else tmpl))))
|
||||
|
||||
(define scm-instantiate-list
|
||||
(fn (tmpl bindings)
|
||||
(cond
|
||||
((or (nil? tmpl) (= (length tmpl) 0)) (list))
|
||||
;; <var> ... → splice the list-valued binding of <var>.
|
||||
((and (>= (length tmpl) 2)
|
||||
(string? (nth tmpl 1))
|
||||
(= (nth tmpl 1) "...")
|
||||
(string? (first tmpl))
|
||||
(dict-has? bindings (first tmpl)))
|
||||
(scm-list-append-all
|
||||
(get bindings (first tmpl))
|
||||
(scm-instantiate-list (rest (rest tmpl)) bindings)))
|
||||
(:else
|
||||
(cons (scm-instantiate (first tmpl) bindings)
|
||||
(scm-instantiate-list (rest tmpl) bindings))))))
|
||||
|
||||
(define scm-list-append-all
|
||||
(fn (xs ys)
|
||||
(cond
|
||||
((or (nil? xs) (= (length xs) 0)) ys)
|
||||
(:else (cons (first xs) (scm-list-append-all (rest xs) ys))))))
|
||||
|
||||
;; Try each rule against the form; return the instantiated template
|
||||
;; or :scm-no-match if no rule matches.
|
||||
(define scm-expand
|
||||
|
||||
@@ -102,4 +102,54 @@
|
||||
"(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}))
|
||||
|
||||
Reference in New Issue
Block a user