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

fixing bug when matching tail patterns against improper lists

Browse source
This commit is contained in:
Alex Shinn 2011-01-27 21:37:03 +09:00
parent 5850f2b6c1
commit d5bd3fa44d
2 changed files with 10 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -28,7 +28,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
;; ;;
;; 2010/09/26 - adding `..1' patterns (thanks to Ludovic Court<72>«²s) ;; 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 ;; 2010/09/07 - fixing identifier extraction in some `...' and `***' patterns
;; 2009/11/25 - adding `***' tree search patterns ;; 2009/11/25 - adding `***' tree search patterns
;; 2008/03/20 - fixing bug where (a ...) matched non-lists ;; 2008/03/20 - fixing bug where (a ...) matched non-lists
@ -320,8 +321,8 @@
r r
(let* ((tail-len (length 'r)) (let* ((tail-len (length 'r))
(ls v) (ls v)
(len (length ls))) (len (and (list? ls) (length ls))))
(if (< len tail-len) (if (or (not len) (< len tail-len))
fk fk
(let loop ((ls ls) (n len) (id-ls '()) ...) (let loop ((ls ls) (n len) (id-ls '()) ...)
(cond (cond

7
tests/match-tests.scm
View file

@ -1,5 +1,5 @@
(import (chibi match) (chibi test)) ;;(import (chibi match) (chibi test))
(test-begin "match") (test-begin "match")
@ -90,6 +90,11 @@
(match '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5)) (match '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5))
(((x . y) ... u v w) (list x y u v w)))) (((x . y) ... u v w) (list x y u v w))))
(test "tail against improper list" #f
(match '(a b c d e f . g)
((x ... y u v w) (list x y u v w))
(else #f)))
(test "Riastradh quasiquote" '(2 3) (test "Riastradh quasiquote" '(2 3)
(match '(1 2 3) (`(1 ,b ,c) (list b c)))) (match '(1 2 3) (`(1 ,b ,c) (list b c))))