Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-08 13:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

fixing bug in (let ((x ...)) (match x (x ...)))

Browse source
This commit is contained in:
Alex Shinn 2011-09-25 15:52:39 +09:00
parent 93696841ed
commit 1320856d40
2 changed files with 6 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lib/chibi/match/match.scm
View file

@ -1,5 +1,4 @@
;;;; match.scm -- portable hygienic pattern matcher ;;;; match.scm -- portable hygienic pattern matcher -*- coding: utf-8 -*-
;;;; -*- coding: utf-8 -*-
;; ;;
;; This code is written by Alex Shinn and placed in the ;; This code is written by Alex Shinn and placed in the
;; Public Domain. All warranties are disclaimed. ;; Public Domain. All warranties are disclaimed.
@ -211,6 +210,8 @@
;; performance can be found at ;; performance can be found at
;; http://synthcode.com/scheme/match-cond-expand.scm ;; 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 ;; 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/26 - adding `..1' patterns (thanks to Ludovic Courtès)
;; 2010/09/07 - fixing identifier extraction in some `...' and `***' patterns ;; 2010/09/07 - fixing identifier extraction in some `...' and `***' patterns
@ -269,7 +270,8 @@
(let ((v #(vec ...))) (let ((v #(vec ...)))
(match-next v (v (set! v)) (pat . body) ...))) (match-next v (v (set! v)) (pat . body) ...)))
((match atom (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 ;; MATCH-NEXT passes each clause to MATCH-ONE in turn with its failure

1
tests/match-tests.scm
View file

@ -27,6 +27,7 @@
(test "duplicate symbols pass" 'ok (match '(ok . ok) ((x . x) x))) (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 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 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)) (test "ellipses" '((a b c) (1 2 3))
(match '((a . 1) (b . 2) (c . 3)) (match '((a . 1) (b . 2) (c . 3))