chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-hackers] [PATCH] Handle type-variables in initial argument type


From: Felix
Subject: [Chicken-hackers] [PATCH] Handle type-variables in initial argument types
Date: Wed, 15 Aug 2012 21:56:34 +0200 (CEST)

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.


cheers,
felix
>From 38b6bf689e82eb50db2f81088de62c66d0d7e987 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Wed, 15 Aug 2012 21:49:20 +0200
Subject: [PATCH] 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.
---
 scrutinizer.scm |    8 +++++---
 1 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 37eefbc..9e4accd 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 '*)))
 
-- 
1.7.0.4


reply via email to

[Prev in Thread] Current Thread [Next in Thread]