diff --git a/lib/scheme/eval.sx b/lib/scheme/eval.sx index 3b41b002..f0df7b48 100644 --- a/lib/scheme/eval.sx +++ b/lib/scheme/eval.sx @@ -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: ( ... ) — currently Phase 6b only + ;; supports a single ellipsis at the END of the pattern list. + ;; 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))) + ;; ( ...) 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 ` ...` pair splices the list-valued binding +;; of 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)) + ;; ... → splice the list-valued binding of . + ((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 diff --git a/lib/scheme/tests/macros.sx b/lib/scheme/tests/macros.sx index 992de7ee..b8f68906 100644 --- a/lib/scheme/tests/macros.sx +++ b/lib/scheme/tests/macros.sx @@ -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}))