~ 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 1Trap