~ 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