From a5c24172b84559f2570ddbf06e219735e76a5e14 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 21 Apr 2009 16:13:00 +0000
Subject: [PATCH] Fix handling of filters that refer to out-of-scope vars

svn: r14574

original commit: 60325b670c25276dddcf904b801bbde922ca2302
---
 .../typed-scheme/unit-tests/typecheck-tests.ss | 18 +++++++++---------
 collects/typed-scheme/env/lexical-env.ss       |  6 +++---
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
index ee5a483b..ff39c7f1 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
@@ -87,7 +87,7 @@
                    (+ 1 (car x))
                    5))
          N]
-        
+        (tc-e (if (let ([y 12]) y) 3 4) -Integer)
         (tc-e 3 -Integer)
         (tc-e "foo" -String)
         (tc-e (+ 3 4) -Integer)
@@ -496,10 +496,10 @@
         [tc-e (raise-type-error 'foo "bar" 7 (list 5)) (Un)]
         
         #;[tc-e
-           (let ((x '(1 3 5 7 9)))
-             (do: : Number ((x : (list-of Number) x (cdr x))
-                            (sum : Number 0 (+ sum (car x))))
-                  ((null? x) sum)))
+           (let ((x '(1 3 5 7 9)))
+             (do: : Number ((x : (list-of Number) x (cdr x))
+                            (sum : Number 0 (+ sum (car x))))
+                  ((null? x) sum)))
            N]
         
         
@@ -541,10 +541,10 @@
         [tc-e `(4 ,@'(3)) (-pair N (-lst N))]
         
         [tc-e
-         (let ((x '(1 3 5 7 9)))
-           (do: : Number ((x : (Listof Number) x (cdr x))
-                          (sum : Number 0 (+ sum (car x))))
-                ((null? x) sum)))
+         (let ((x '(1 3 5 7 9)))
+           (do: : Number ((x : (Listof Number) x (cdr x))
+                          (sum : Number 0 (+ sum (car x))))
+                ((null? x) sum)))
          N]
         
         [tc-e (if #f 1 'foo) (-val 'foo)]
diff --git a/collects/typed-scheme/env/lexical-env.ss b/collects/typed-scheme/env/lexical-env.ss
index 9ade4f0a..659cd8b8 100644
--- a/collects/typed-scheme/env/lexical-env.ss
+++ b/collects/typed-scheme/env/lexical-env.ss
@@ -25,7 +25,7 @@
 
 ;; find the type of identifier i, looking first in the lexical env, then in the top-level env
 ;; identifer -> Type
-(define (lookup-type/lexical i)
+(define (lookup-type/lexical i [fail #f])
   (lookup (lexical-env) i 
           (lambda (i) (lookup-type 
                        i (lambda () 
@@ -33,7 +33,7 @@
                                   =>
                                   (lambda (a)
                                     (-lst (substitute Univ (cdr a) (car a))))]
-                                 [else (lookup-fail i)]))))))
+                                 [else ((or fail lookup-fail) i)]))))))
 
 ;; refine the type of i in the lexical env
 ;; (identifier type -> type) identifier -> environment
@@ -43,7 +43,7 @@
   (define (update f k env)
     (parameterize
         ([current-orig-stx k])
-      (let* ([v (lookup-type/lexical k)]
+      (let* ([v (lookup-type/lexical k (lambda _ Univ))]
              [new-v (f k v)]
              [new-env (extend env k new-v)])
         new-env)))