diff --git a/module/ice-9/match.scm b/module/ice-9/match.scm index 686539bd3..0384f69fc 100644 --- a/module/ice-9/match.scm +++ b/module/ice-9/match.scm @@ -57,3 +57,21 @@ ;; Note: Make sure to update `match.test.upstream' when updating this ;; file. (include-from-path "ice-9/match.upstream.scm") + +(define-syntax match + (syntax-rules () + ((match) + (match-syntax-error "missing match expression")) + ((match atom) + (match-syntax-error "no match clauses")) + ((match (app ...) (pat . body) ...) + (let ((v (app ...))) + (match-next v ((app ...) (set! (app ...))) (pat . body) ...))) + ((match #(vec ...) (pat . body) ...) + (let ((v #(vec ...))) + (match-next v (v (set! v)) (pat . body) ...))) + ((match atom (pat . body) ...) + (let ((v atom)) + (match-next v (atom (set! atom)) (pat . body) ...))) + )) + diff --git a/test-suite/tests/match.test b/test-suite/tests/match.test index 93358fc27..8b19ff702 100644 --- a/test-suite/tests/match.test +++ b/test-suite/tests/match.test @@ -102,6 +102,18 @@ (('one ('two x) ('three y ('and z '(and 5)))) (equal? (list x y z) '(2 3 4)))))) + (pass-if "and, unique names" + (let ((tree '(1 2))) + (match tree + ((and (a 2) (1 b)) + (equal? 3 (+ a b)))))) + + (pass-if "and, same names" + (let ((a '(1 2))) + (match a + ((and (a 2) (1 b)) + (equal? 3 (+ a b)))))) + (with-test-prefix "records" (pass-if "all slots, bind"