~ chicken-core (chicken-5) 9c04968eb45c0b14794326711620367af8a839f9


commit 9c04968eb45c0b14794326711620367af8a839f9
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Aug 15 21:49:20 2012 +0200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Thu Aug 16 19:02:04 2012 +0200

    Resolve type-variables when computing initial argument types.
    
    In "strict-types" mode, the initial types of procedure arguments are
    assumed to default to those found in existing declarations, but this
    did not detect and resolve type variables in "forall" types.
    
    Reported by Moritz, should fix #896.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 110eb399..425278f6 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -309,7 +309,7 @@
 	     (xptype `(procedure ,(make-list nargs '*) *))
 	     (typeenv (append-map type-typeenv actualtypes))
 	     (op #f))
-	(d "  call: ~a " actualtypes)
+	(d "  call: ~a, te: ~a" actualtypes typeenv)
 	(cond ((and (not pptype?) (not (match-types xptype ptype typeenv)))
 	       (report
 		loc
@@ -439,9 +439,11 @@
       (if (and dest 
 	       strict-variable-types
 	       (variable-mark dest '##compiler#declared-type))
-	  (let ((ptype (variable-mark dest '##compiler#type)))
+	  (let* ((ptype (variable-mark dest '##compiler#type))
+		 (typeenv (type-typeenv ptype)))
 	    (if (procedure-type? ptype)
-		(nth-value 0 (procedure-argument-types ptype argc '() #t))
+		(map (cut resolve <> typeenv)
+		     (nth-value 0 (procedure-argument-types ptype argc '() #t)))
 		(make-list argc '*)))
 	  (make-list argc '*)))
 
Trap