~ chicken-core (chicken-5) 3c65c402cb77a1516d4ff7212987d06869ee7fbf
commit 3c65c402cb77a1516d4ff7212987d06869ee7fbf
Author: megane <meganeka@gmail.com>
AuthorDate: Sun Dec 2 18:23:44 2018 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 13 15:44:38 2018 +0100
Fix renaming issue with typevars
The 'subst' in simplify-type was not checking what it was renaming so
bad things happened as the new test case shows.
* scrutinizer.scm (simplify-type): No need to call subst as the
typevars are renamed during walking (the "(assq t typeenv) =>"
case).
* tests/typematch-tests.scm: Add test
Signed-off-by: Evan Hanson <evhan@foldling.org>
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/scrutinizer.scm b/scrutinizer.scm
index bbc3b5a9..840cda3d 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1213,13 +1213,6 @@
(let ((typeenv '()) ; ((VAR1 . NEWVAR1) ...)
(constraints '()) ; ((VAR1 TYPE1) ...)
(used '()))
- (define (subst x)
- (cond ((symbol? x)
- (cond ((assq x typeenv) => cdr)
- (else x)))
- ((pair? x)
- (cons (subst (car x)) (subst (cdr x))))
- (else x)))
(define (simplify t)
;;(dd "simplify/rec: ~s" t)
(call/cc
@@ -1351,7 +1344,7 @@
(list v (simplify (cadr c)))))
(else v)))))
typeenv)
- ,(subst t2))))
+ ,t2)))
(dd "simplify: ~a -> ~a" t t2)
t2)))
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 97b83289..821ef731 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -399,6 +399,9 @@
(length a) ; refine (or pair null) with list (= (list-of *))
(infer list a))
+(compiler-typecase (the (list (struct foo) symbol) (the 'a 1))
+ ;; The tv "foo" and "foo" in struct should have no relation
+ ((forall (foo) (list (struct foo) foo)) 'ok))
(assert
(compiler-typecase 1
Trap