From aba90ebcff3e37e73221401e26a1499d557aee2b Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@cs.indiana.edu>
Date: Mon, 3 Nov 2014 09:14:13 -0500
Subject: [PATCH] Fix `require/typed/provide` in `no-check` context.

Closes PR 14821.

original commit: 2221fa279c0c0425ad0f3c221021827a5feccd42
---
 .../typed/private/no-check-helper.rkt         | 84 +++++++++++--------
 1 file changed, 50 insertions(+), 34 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed/private/no-check-helper.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed/private/no-check-helper.rkt
index 98b2ff30..e57fc733 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed/private/no-check-helper.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed/private/no-check-helper.rkt
@@ -4,7 +4,7 @@
 
 (require
  (except-in typed-racket/base-env/prims
-            require/typed require/opaque-type require-typed-struct)
+            require/typed require/opaque-type require-typed-struct require/typed/provide)
  typed-racket/base-env/base-types-extra
  (for-syntax racket/base syntax/parse syntax/struct
              syntax/parse/experimental/template))
@@ -14,39 +14,55 @@
                        typed-racket/base-env/base-types-extra))
 
 
-(define-syntax (require/typed stx)
-  (define-syntax-class opt-rename
-    #:attributes (nm spec)
-    (pattern nm:id
-             #:with spec #'nm)
-    (pattern (orig-nm:id internal-nm:id)
-         #:with spec #'(orig-nm internal-nm)
-         #:with nm #'internal-nm))
-  (define-syntax-class simple-clause
-    #:attributes (nm ty)
-    (pattern [nm:opt-rename ty]))
-  (define-syntax-class struct-clause
-    #:attributes (nm (body 1) (opts 1))
-    (pattern [(~or #:struct (~datum struct)) nm:opt-rename (body ...)
-              opts:struct-option ...]))
-  (define-syntax-class opaque-clause
-    #:attributes (ty pred opt)
-    (pattern [(~or #:opaque (~datum opaque)) ty:id pred:id]
-             #:with opt #'())
-    (pattern [(~or #:opaque (~datum opaque)) ty:id pred:id #:name-exists]
-             #:with opt #'(#:name-exists)))
-  (define-splicing-syntax-class struct-option
-    (pattern (~seq #:constructor-name cname:id))
-    (pattern (~seq #:extra-constructor-name extra-cname:id)))
-  (syntax-parse stx
-    [(_ lib (~or sc:simple-clause strc:struct-clause oc:opaque-clause) ...)
-     (template
-      (begin
-       (require/opaque-type oc.ty oc.pred lib . oc.opt) ...
-       (require/typed sc.nm sc.ty lib) ...
-       (require-typed-struct strc.nm (strc.body ...) (?@ . strc.opts) ... lib) ...))]
-    [(_ nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...)
-     #'(require (only-in lib nm.spec))]))
+(define-syntaxes (require/typed require/typed/provide)
+  (let ()
+    (define-syntax-class opt-rename
+      #:attributes (nm spec)
+      (pattern nm:id
+               #:with spec #'nm)
+      (pattern (orig-nm:id internal-nm:id)
+               #:with spec #'(orig-nm internal-nm)
+               #:with nm #'internal-nm))
+    (define-syntax-class simple-clause
+      #:attributes (nm ty name)
+      (pattern [nm:opt-rename ty]
+               #:with name (attribute nm.nm)))
+    (define-syntax-class struct-clause
+      #:attributes (nm (body 1) (opts 1))
+      (pattern [(~or #:struct (~datum struct)) nm:opt-rename (body ...)
+                                               opts:struct-option ...]))
+    (define-syntax-class opaque-clause
+      #:attributes (ty pred opt)
+      (pattern [(~or #:opaque (~datum opaque)) ty:id pred:id]
+               #:with opt #'())
+      (pattern [(~or #:opaque (~datum opaque)) ty:id pred:id #:name-exists]
+               #:with opt #'(#:name-exists)))
+    (define-splicing-syntax-class struct-option
+      (pattern (~seq #:constructor-name cname:id))
+      (pattern (~seq #:extra-constructor-name extra-cname:id)))
+    (values
+     (syntax-parser 
+       [(_ lib (~or sc:simple-clause strc:struct-clause oc:opaque-clause) ...)
+        (template
+         (begin
+           (require/opaque-type oc.ty oc.pred lib . oc.opt) ...
+           (require/typed sc.nm sc.ty lib) ...
+           (require-typed-struct strc.nm (strc.body ...) (?@ . strc.opts) ... lib) ...))]
+       [(_ nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...)
+        #'(require (only-in lib nm.spec))]) 
+     (syntax-parser
+       [(_ lib (~or sc:simple-clause strc:struct-clause oc:opaque-clause) ...)
+        (template
+         (begin
+           (require/opaque-type oc.ty oc.pred lib . oc.opt) ...
+           (provide oc.pred) ...
+           (require/typed sc.nm sc.ty lib) ...
+           (provide sc.nm) ...
+           (require-typed-struct strc.nm (strc.body ...) (?@ . strc.opts) ... lib) ...
+           (provide (struct-out strc.nm)) ...))]
+       [(_ nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...)
+        #'(begin (require (only-in lib nm.spec))
+                 (provide nm.nm))]))))
 
 (define-syntax-rule (require/opaque-type ty pred lib . _)
   (require (only-in lib pred)))