add local-require to racket/base

collects/racket/private/reqprov.rkt

@@ -14,7 +14,8 @@
              provide
              all-defined-out all-from-out
              rename-out except-out prefix-out struct-out combine-out
-             protect-out)
+             protect-out
+             local-require)
   
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; helpers
@@ -960,5 +961,61 @@
                     (export-orig-stx e)))
                  exports))]))))
 
+  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; rename-import : Import Identifier -> Import
+  ;; Creates a new import that binds the given identifier, but otherwise acts as
+  ;; the original import.
+  (define-for-syntax (rename-import i id)
+    (make-import id
+                 (import-src-sym i)
+                 (import-src-mod-path i)
+                 (import-mode i)
+                 (import-req-mode i)
+                 (import-orig-mode i)
+                 (import-orig-stx i)))
+
+  ;; import->raw-require-spec : Import -> Syntax
+  ;; Constructs a raw-require-spec (suitable for #%require) that should have the
+  ;; same behavior as a require-spec that produces the given import.
+  (define-for-syntax (import->raw-require-spec i)
+    (datum->syntax
+     (import-orig-stx i)
+     (list #'just-meta
+           (import-req-mode i)
+           (list #'for-meta
+                 (import-mode i)
+                 (list #'rename
+                       (import-src-mod-path i)
+                       (syntax-local-introduce (import-local-id i))
+                       (import-src-sym i))))
+     (import-orig-stx i)))
+
+  ;; (do-local-require rename spec ...)
+  ;; Lifts (require spec ...) to the (module) top level, and makes the imported
+  ;; bindings available in the current context via a renaming macro.
+  (define-syntax (local-require stx)
+    (when (eq? 'expression (syntax-local-context))
+      (raise-syntax-error #f "not allowed in an expression context" stx))
+    (syntax-case stx []
+      [(_ spec ...)
+       (let*-values ([(imports sources)
+                      (expand-import
+                       (datum->syntax
+                        stx
+                        (list* #'only-meta-in 0 (syntax->list #'(spec ...)))
+                        stx))]
+                     [(names) (map import-local-id imports)]
+                     [(reqd-names) 
+                      (let ([ctx (syntax-local-get-shadower (datum->syntax #f (gensym)))])
+                        (map (lambda (n) (datum->syntax ctx (syntax-e n) n)) names))]
+                     [(renamed-imports) (map rename-import imports reqd-names)]
+                     [(raw-specs) (map import->raw-require-spec renamed-imports)]
+                     [(lifts) (map syntax-local-lift-require raw-specs reqd-names)])
+         (with-syntax ([(name ...) names]
+                       [(lifted ...) lifts])
+           (syntax/loc stx (define-syntaxes (name ...)
+                             (values (make-rename-transformer #'lifted) ...)))))]))
+
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   )

collects/scheme/base.rkt

@@ -4,6 +4,7 @@
 (provide (except-out (all-from-out racket/base) 
                      struct
                      hash hasheq hasheqv
-                     in-directory)
+                     in-directory
+                     local-require)
          make-base-empty-namespace
          make-base-namespace)

collects/scribblings/reference/syntax.scrbl

@@ -652,6 +652,12 @@ original definition in the same module.  In a @tech{module context},
 an identifier can be either imported or defined for a given
 @tech{phase level}, but not both.}
 
+@defform[(local-require require-spec ...)]{
+
+Like @scheme[require], but for use in a local-definition context to
+import just into the local context. Only bindings from @tech{phase
+level} 0 are imported.}
+
 
 @guideintro["module-provide"]{@racket[provide]}
 

collects/scribblings/scheme/scheme.scrbl

@@ -1,11 +1,11 @@
 #lang scribble/manual
-@(require (for-syntax racket)
-          (for-label (only-in scheme/foreign unsafe! provide* define-unsafer)
+@(require (for-label (only-in scheme/foreign unsafe! provide* define-unsafer)
                      (only-in scheme/base make-base-namespace make-base-empty-namespace)
                      (only-in scheme/pretty pretty-print)
                      (only-in racket/pretty pretty-write)
                      (only-in scheme/class printable<%>)
                      (only-in racket/class writable<%>)
+                     (only-in racket/base struct hash hasheq hasheqv in-directory local-require)
                      scheme/gui/base
                      scheme/sandbox))
 
@@ -56,8 +56,8 @@ old name. A few @seclink["compat-exe"]{old executables} are also provided.
 
 @table-of-contents[]
 
-@compat-except[scheme racket]{, except that @schememodname[racket]'s
-@scheme[struct] is not exported, the @|unit-struct| from
+@compat-except[scheme racket]{, except based on @schememodname[scheme/base]
+instead of @schememodname[racket/base], the @|unit-struct| from
 @schememodname[scheme/unit] is exported, @schememodname[scheme/set] is
 not re-exported, @schememodname[scheme/system] is
 not re-exported, @racket[pretty-print] is re-directed in as
@@ -65,8 +65,9 @@ not re-exported, @racket[pretty-print] is re-directed in as
 re-exported}
 
 @compat-except[scheme/base racket/base]{, except that
-@schememodname[racket]'s @scheme[struct] is not exported, @scheme[in-directory]
-is not exported, and
+@schememodname[racket]'s @scheme[struct], @scheme[hash],
+@scheme[hasheq], @scheme[hasheqv], @scheme[in-directory], and
+@scheme[local-require] are not exported, and
 @scheme[make-base-namespace] and @scheme[make-base-empty-namespace]
 are different}