~ chicken-core (chicken-5) 639896ed406e57020a64e07f17c319718ee83978
commit 639896ed406e57020a64e07f17c319718ee83978
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Sun Dec 29 14:46:39 2013 +1300
Commit: Peter Bex <peter.bex@xs4all.nl>
CommitDate: Thu Jan 9 21:51:56 2014 +0100
Remove some redundant/unreachable cases in type matching
Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 0cdd4f23..d7b7dfa7 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1126,12 +1126,10 @@
((eq? t2 'vector) (match1 t1 '(vector-of *)))
((eq? t1 'null)
(and (not exact) (not all)
- (or (memq t2 '(null list))
- (and (pair? t2) (eq? 'list-of (car t2))))))
+ (pair? t2) (eq? 'list-of (car t2))))
((eq? t2 'null)
(and (not exact)
- (or (memq t1 '(null list))
- (and (pair? t1) (eq? 'list-of (car t1))))))
+ (pair? t1) (eq? 'list-of (car t1))))
((and (pair? t1) (pair? t2) (eq? (car t1) (car t2)))
(case (car t1)
((procedure)
@@ -1192,17 +1190,10 @@
typeenv
#t
(lambda (t) (match1 t1 t)))))
- ((pair)
- (let ((ct2 (canonicalize-list-type t2)))
- (and ct2 (match1 t1 ct2))))
(else #f)))))
((and (pair? t1) (eq? 'list (car t1)))
(and (pair? t2)
(case (car t2)
- ((pair)
- (and (pair? (cdr t1))
- (match1 (second t1) (second t2))
- (match1 t1 (third t2))))
((list-of)
(and (not exact)
(not all)
@@ -1213,22 +1204,6 @@
#t
(lambda (t) (match1 t t2))))))
(else #f))))
- ((and (pair? t2) (eq? 'list-of (car t2)))
- (and (not exact) ;XXX also check "all"?
- (or (eq? 'null t1)
- (and (pair? t1)
- (eq? 'pair (car t1)) ; list-of already handled above
- (let ((ct1 (canonicalize-list-type t1)))
- (and ct1 (match1 ct1 t2)))))))
- ((and (pair? t2) (eq? 'list (car t2)))
- (and (pair? t1)
- (case (car t1)
- ((pair)
- (and (pair? (cdr t2))
- (match1 (second t1) (second t2))
- (match1 (third t1) t2)))
- ;; t1 = list-of already handled above
- (else #f))))
((and (pair? t1) (eq? 'vector (car t1)))
(and (not exact) (not all)
(pair? t2)
Trap