diff --git a/module/ice-9/match.scm b/module/ice-9/match.scm index 2753ebe4e..4b078c69f 100644 --- a/module/ice-9/match.scm +++ b/module/ice-9/match.scm @@ -52,27 +52,8 @@ ;; `match' doesn't support clauses of the form `(pat => exp)'. ;; Unmodified public domain code by Alex Shinn retrieved from -;; the Chibi-Scheme repository, commit 833:6daa2971f3fe. +;; the Chibi-Scheme repository, commit 876:528cdab3f818. ;; ;; Note: Make sure to update `match.test.upstream' when updating this ;; file. (include-from-path "ice-9/match.upstream.scm") - -;; Patch to work around . -(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/module/ice-9/match.upstream.scm b/module/ice-9/match.upstream.scm index 6fc01a6f3..978655667 100644 --- a/module/ice-9/match.upstream.scm +++ b/module/ice-9/match.upstream.scm @@ -1,5 +1,4 @@ -;;;; match.scm -- portable hygienic pattern matcher -;;;; -*- coding: utf-8 -*- +;;;; match.scm -- portable hygienic pattern matcher -*- coding: utf-8 -*- ;; ;; This code is written by Alex Shinn and placed in the ;; Public Domain. All warranties are disclaimed. @@ -211,6 +210,8 @@ ;; performance can be found at ;; http://synthcode.com/scheme/match-cond-expand.scm ;; +;; 2011/09/25 - fixing bug when directly matching an identifier repeated in +;; the pattern (thanks to Stefan Israelsson Tampe) ;; 2011/01/27 - fixing bug when matching tail patterns against improper lists ;; 2010/09/26 - adding `..1' patterns (thanks to Ludovic Courtès) ;; 2010/09/07 - fixing identifier extraction in some `...' and `***' patterns @@ -269,7 +270,8 @@ (let ((v #(vec ...))) (match-next v (v (set! v)) (pat . body) ...))) ((match atom (pat . body) ...) - (match-next atom (atom (set! atom)) (pat . body) ...)) + (let ((v atom)) + (match-next v (atom (set! atom)) (pat . body) ...))) )) ;; MATCH-NEXT passes each clause to MATCH-ONE in turn with its failure diff --git a/test-suite/tests/match.test.upstream b/test-suite/tests/match.test.upstream index 47bf44e72..e1e106e3b 100644 --- a/test-suite/tests/match.test.upstream +++ b/test-suite/tests/match.test.upstream @@ -27,6 +27,7 @@ (test "duplicate symbols pass" 'ok (match '(ok . ok) ((x . x) x))) (test "duplicate symbols fail" 'ok (match '(ok . bad) ((x . x) 'bad) (else 'ok))) (test "duplicate symbols samth" 'ok (match '(ok . ok) ((x . 'bad) x) (('ok . x) x))) +(test "duplicate symbols bound" 3 (let ((a '(1 2))) (match a ((and (a 2) (1 b)) (+ a b)) (_ #f)))) (test "ellipses" '((a b c) (1 2 3)) (match '((a . 1) (b . 2) (c . 3))