From 1da9a0c4b84ea15e608a83028c07c75885082b29 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 5 Jun 2008 21:36:45 +0000
Subject: [PATCH] Add namespace ops. Check if typecheck returned nothing for
 top-level form. Improve error message.

svn: r10160
---
 collects/typed-scheme/private/base-env.ss    |  3 +++
 collects/typed-scheme/private/tc-app-unit.ss | 13 +++++++++----
 collects/typed-scheme/typed-scheme.ss        |  1 +
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index e03ffa739c..898796f66f 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -478,6 +478,9 @@
      
      [exit (-> (Un))]
      
+     [module->namespace (-> -Sexp -Namespace)]
+     [current-namespace (-Param -Namespace -Namespace)]
+     
      ;; syntax operations
      
      [expand (-> (-Syntax Univ) (-Syntax Univ))]
diff --git a/collects/typed-scheme/private/tc-app-unit.ss b/collects/typed-scheme/private/tc-app-unit.ss
index 64f7a486d1..dd716d5867 100644
--- a/collects/typed-scheme/private/tc-app-unit.ss
+++ b/collects/typed-scheme/private/tc-app-unit.ss
@@ -233,13 +233,18 @@
                #;(if (false-effect? eff)
                      (ret (-val #f) eff)
                      (ret (car rngs) eff)))
-             (let loop ([doms* doms] [rngs rngs] [rests rests])
+             (let loop ([doms* doms] [rngs rngs] [rests* rests])
                (cond [(null? doms*) 
                       (tc-error/expr 
                        #:return (ret (Un))
-                       "no function domain matched - domains were: ~a arguments were ~a" doms argtypes)]
-                     [(subtypes/varargs argtypes (car doms*) (car rests)) (ret (car rngs))]
-                     [else (loop (cdr doms*) (cdr rngs) (cdr rests))])))]
+                       "no function domain matched - domains were:~n~a~narguments were ~a" 
+                       (stringify
+                        (for/list ([d doms] [r rests])
+                          (format "~a ~a*"(stringify d) r))
+                        "\n")
+                       argtypes)]
+                     [(subtypes/varargs argtypes (car doms*) (car rests*)) (ret (car rngs))]
+                     [else (loop (cdr doms*) (cdr rngs) (cdr rests*))])))]
         [(and rft (tc-result: (Poly: vars (Function: (list (arr: doms rngs #f thn-effs els-effs) ...)))))
          ;(printf "Typechecking poly app~nftype:          ~a~n" ftype)
          ;(printf "ftype again:    ~a~n" ftype)
diff --git a/collects/typed-scheme/typed-scheme.ss b/collects/typed-scheme/typed-scheme.ss
index 77d688f763..da552fea9d 100644
--- a/collects/typed-scheme/typed-scheme.ss
+++ b/collects/typed-scheme/typed-scheme.ss
@@ -118,6 +118,7 @@
               (free-identifier=? #'head #'require)
               (free-identifier=? #'head #'provide)
               (free-identifier=? #'head #'begin)
+              (void? type)
               (type-equal? -Void (tc-result-t type)))
           body2]
          ;; construct code to print the type