From f410bcf3a288f9c41b836495d12f8867060802ec Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 1 May 2008 22:52:39 +0000
Subject: [PATCH] Fix namespace issues with compile-time expand. Fix error
 reporting.

svn: r9576
---
 collects/typed-scheme/private/base-env.ss                | 4 ++--
 collects/typed-scheme/private/tc-app-unit.ss             | 2 +-
 collects/typed-scheme/private/type-effect-convenience.ss | 1 +
 3 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index 3a73645b63..c5742d5e91 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -412,12 +412,12 @@
       string-constants/string-constant]
      ;; make-promise 
      
-     [(cadr (syntax->list (expand #'(delay 3)))) 
+     [(cadr (syntax->list (expand '(delay 3))))
       (-poly (a) (-> (-> a) (-Promise a)))
       scheme/promise]
      ;; qq-append
      
-     [(cadr (syntax->list (expand #'`(,@'() 1)))) 
+     [(cadr (syntax->list (expand '`(,@'() 1)))) 
       (-poly (a b) 
              (cl->*
               (-> (-lst a) (-val '()) (-lst a))
diff --git a/collects/typed-scheme/private/tc-app-unit.ss b/collects/typed-scheme/private/tc-app-unit.ss
index cc4be6cca3..2cf6d9ab42 100644
--- a/collects/typed-scheme/private/tc-app-unit.ss
+++ b/collects/typed-scheme/private/tc-app-unit.ss
@@ -303,7 +303,7 @@
          (match-let ([(list (tc-result: ts) ...) (map (lambda (f) (outer-loop 
                                                                    (ret f e1 e2) argtypes arg-thn-effs arg-els-effs args)) fs)])
            (ret (apply Un ts)))]
-        [(tc-result: f-ty _ _) (tc-error #:return (ret (Un)) "Cannot apply expression of type ~a, since it is not a function type" f-ty)]))))
+        [(tc-result: f-ty _ _) (tc-error/expr #:return (ret (Un)) "Cannot apply expression of type ~a, since it is not a function type" f-ty)]))))
 
 ;(trace tc/funapp)
 
diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss
index 1746342bec..9b7e4b97ff 100644
--- a/collects/typed-scheme/private/type-effect-convenience.ss
+++ b/collects/typed-scheme/private/type-effect-convenience.ss
@@ -204,6 +204,7 @@
                                                                ns)
                                       ns)])
                                (parameterize ([current-namespace new-ns])
+                                 (namespace-require 'scheme/base)
                                  (namespace-require 'extra-mods) ...
                                  e))
                              ty)]))