From 2ee1d2b5962343cd86e520879e88b7e092cf3bb7 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 22 May 2009 20:07:36 +0000
Subject: [PATCH] Untyped top-level variables are not an internal error. Handle
 latent filter of LBot in values->tc-results when there are no formals. Use
 check-below properly in tc/mono-lambda/type

svn: r14935
---
 .../typed-scheme/typecheck/tc-lambda-unit.ss  |  2 +-
 .../typecheck/tc-metafunctions.ss             | 24 ++++++++++++++-----
 collects/typed-scheme/types/utils.ss          |  2 +-
 3 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-lambda-unit.ss b/collects/typed-scheme/typecheck/tc-lambda-unit.ss
index 3fb1baae4e..aaceea3d68 100644
--- a/collects/typed-scheme/typecheck/tc-lambda-unit.ss
+++ b/collects/typed-scheme/typecheck/tc-lambda-unit.ss
@@ -209,7 +209,7 @@
 (define (tc/mono-lambda/type formals bodies expected)
   (define t (make-Function (map lam-result->type (tc/mono-lambda formals bodies expected))))
   (if expected 
-      (check-below t expected)
+      (and (check-below (ret t true-filter) expected) t)
       t))
 
 ;; tc/plambda syntax syntax-list syntax-list type -> Poly
diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.ss b/collects/typed-scheme/typecheck/tc-metafunctions.ss
index 1a1d17c22a..bda76ab6c1 100644
--- a/collects/typed-scheme/typecheck/tc-metafunctions.ss
+++ b/collects/typed-scheme/typecheck/tc-metafunctions.ss
@@ -149,9 +149,15 @@
     [(ValuesDots: (list (Result: ts lfs los) ...) dty dbound)
      (ret ts
           (for/list ([lf lfs]) 
-            (merge-filter-sets
-             (for/list ([x formals] [i (in-naturals)])
-               (apply-filter (split-lfilters lf i) Univ (make-Path null x)))))
+            (or
+             (and (null? formals)
+                  (match lf
+                    [(LFilterSet: lf+ lf-)
+                     (combine (if (memq (make-LBot) lf+) (list (make-Bot)) (list))
+                              (if (memq (make-LBot) lf-) (list (make-Bot)) (list)))]))
+             (merge-filter-sets
+              (for/list ([x formals] [i (in-naturals)])
+                (apply-filter (split-lfilters lf i) Univ (make-Path null x))))))
           (for/list ([lo los])
             (or 
              (for/or ([x formals] [i (in-naturals)])
@@ -163,9 +169,15 @@
     [(Values: (list (Result: ts lfs los) ...))
      (ret ts
           (for/list ([lf lfs]) 
-            (merge-filter-sets
-             (for/list ([x formals] [i (in-naturals)])
-               (apply-filter (split-lfilters lf i) Univ (make-Path null x)))))
+            (or
+             (and (null? formals)
+                  (match lf
+                    [(LFilterSet: lf+ lf-)
+                     (combine (if (memq (make-LBot) lf+) (list (make-Bot)) (list))
+                              (if (memq (make-LBot) lf-) (list (make-Bot)) (list)))]))
+             (merge-filter-sets
+              (for/list ([x formals] [i (in-naturals)])
+                (apply-filter (split-lfilters lf i) Univ (make-Path null x))))))
           (for/list ([lo los])
             (or 
              (for/or ([x formals] [i (in-naturals)])
diff --git a/collects/typed-scheme/types/utils.ss b/collects/typed-scheme/types/utils.ss
index 2a768e0fb0..6f4504c392 100644
--- a/collects/typed-scheme/types/utils.ss
+++ b/collects/typed-scheme/types/utils.ss
@@ -290,7 +290,7 @@
 (define (lookup-fail e) 
   (match (identifier-binding e)
     ['lexical (int-err "untyped lexical variable ~a" (syntax-e e))]
-    [#f (int-err "untyped top-level variable ~a" (syntax-e e))]
+    [#f (tc-error/expr "untyped top-level identifier ~a" (syntax-e e))]
     [(list _ _ nominal-source-mod nominal-source-id _ _ _)
      (let-values ([(x y) (module-path-index-split nominal-source-mod)])
        (cond [(and (not x) (not y))