From 29c4a84183f15c98093973fae3fe7ec20a9fd8a3 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 24 Nov 2009 17:10:44 +0000
Subject: [PATCH] checkpoint

svn: r17045
---
 collects/tests/typed-scheme/fail/back-and-forth.ss  | 7 ++++---
 collects/typed-scheme/ts-reference.scrbl            | 2 +-
 collects/typed-scheme/typecheck/provide-handling.ss | 8 ++------
 collects/typed-scheme/typecheck/tc-toplevel.ss      | 8 +++++---
 4 files changed, 12 insertions(+), 13 deletions(-)

diff --git a/collects/tests/typed-scheme/fail/back-and-forth.ss b/collects/tests/typed-scheme/fail/back-and-forth.ss
index b23c77032f..eac8be7dbc 100644
--- a/collects/tests/typed-scheme/fail/back-and-forth.ss
+++ b/collects/tests/typed-scheme/fail/back-and-forth.ss
@@ -1,18 +1,19 @@
 #;
-(exn-pred exn:fail:contract? #rx".*violator.*contract.*\\(-> Number Number\\).*")
+(exn-pred exn:fail:contract? #rx".*violator.*contract.*\\(-> Number Number\\).*f.*")
 
 #lang scheme/load
 
 (module m typed/scheme
   (: f (Number -> Number))
   (define (f x) (add1 x))
-  (provide f))
+  (define g 17)
+  (provide f g))
 
 (module violator scheme
   (require 'm)
   (f 'foo))
 
-(module o typed-scheme
+(module o typed/scheme
   (require 'violator))
 
 (require 'o)
diff --git a/collects/typed-scheme/ts-reference.scrbl b/collects/typed-scheme/ts-reference.scrbl
index f52c4a9804..7981ffe70d 100644
--- a/collects/typed-scheme/ts-reference.scrbl
+++ b/collects/typed-scheme/ts-reference.scrbl
@@ -228,7 +228,7 @@ This is legal only in expression contexts.}
 appropriate number of type variables. This is legal only in expression
 contexts.}
 
-@schemevarfont|{#{e @ t ...}}| This is identical to @scheme[(inst e t ...)].
+@litchar|{#{e @ t ...}}| This is identical to @scheme[(inst e t ...)].
 
 @subsection{Require}
 
diff --git a/collects/typed-scheme/typecheck/provide-handling.ss b/collects/typed-scheme/typecheck/provide-handling.ss
index 22c86fe915..8943cc5927 100644
--- a/collects/typed-scheme/typecheck/provide-handling.ss
+++ b/collects/typed-scheme/typecheck/provide-handling.ss
@@ -33,7 +33,7 @@
       (make-typed-renaming (syntax-property id 'not-free-identifier=? #t) alt)
       (make-rename-transformer (syntax-property id 'not-free-identifier=? #t))))
 
-(define (generate-prov stx-defs val-defs)
+(define (generate-prov stx-defs val-defs pos-blame-id)
   (define mapping (make-free-identifier-mapping))
   (lambda (form)
     (define (mem? i vd)
@@ -59,19 +59,15 @@
                     =>
                     (lambda (cnt)                                    
                       (with-syntax ([(export-id cnt-id) (generate-temporaries #'(id id))]
-                                    [module-source (generate-temporary 'module-source)]
-                                    ;; don't actually need to verify - this is generated
+                                    [module-source pos-blame-id]
                                     [the-contract (generate-temporary 'generated-contract)])
                         #`(begin 
-                            (define module-source (#%variable-reference))
                             (define the-contract #,cnt)
                             (define-syntax cnt-id
                               (make-provide/contract-transformer
                                (quote-syntax the-contract)
                                (quote-syntax id)
                                (quote-syntax module-source)))
-                            #;
-                            (define/contract cnt-id #,cnt id)
                             (define-syntax export-id
                               (if (unbox typed-context?)
                                   (renamer #'id #:alt #'cnt-id)
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.ss b/collects/typed-scheme/typecheck/tc-toplevel.ss
index 86023b30eb..1b2a000edb 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.ss
+++ b/collects/typed-scheme/typecheck/tc-toplevel.ss
@@ -3,7 +3,7 @@
 
 (require (rename-in "../utils/utils.ss" [infer r:infer]))
 (require syntax/kerncase
-	 unstable/list
+	 unstable/list unstable/syntax
          mzlib/etc
          scheme/match
          "signatures.ss"
@@ -253,9 +253,11 @@
     ;; report delayed errors
     (report-all-errors)
     ;; compute the new provides
-    (with-syntax
-        ([((new-provs ...) ...) (map (generate-prov stx-defs val-defs) provs)])
+    (with-syntax*
+        ([the-variable-reference (generate-temporary #'blame)]
+         [((new-provs ...) ...) (map (generate-prov stx-defs val-defs #'the-variable-reference) provs)])
       #`(begin
+          (define the-variable-reference (#%variable-reference))
            #,(env-init-code)
            #,(tname-env-init-code)
            #,(talias-env-init-code)