add lazy-require-syntax

racket/collects/racket/lazy-require.rkt

@@ -3,16 +3,22 @@
          compiler/cm-accomplice
          racket/runtime-path
          racket/promise)
-(provide lazy-require)
+(provide lazy-require
+         lazy-require-syntax)
 
 (define-syntax (lazy-require stx)
   (syntax-case stx ()
-    [(lazy-require [modpath (thing ...)] ...)
+    [(lazy-require [modpath (import ...)] ...)
-     #`(begin (lazy-require1 modpath (thing ...) #,stx) ...)]))
+     #`(begin (lazy-require1 modpath (import ...) #,stx) ...)]))
-
-(define-for-syntax counter 0)
 
 (begin-for-syntax
+
+ (define counter 0)
+
+ (define (gen-aux-mod-name phase)
+   (begin0 (string->symbol (format "lazy-require-aux-~a-~a" phase counter))
+     (set! counter (add1 counter))))
+
  ;; like (collapse-module-path modpath '(submod "..")), but avoids
  ;; the dependencies of syntax/modcollapse
  (define (module-path-add-submod-up modpath)
@@ -33,40 +39,38 @@
                      modpath]))]
            [else
             ;; wasn't a submod module-path
-            modpath]))))
+            modpath])))
 
-(define-syntax (lazy-require1 stx)
+ (define (process-imports ctx imports)
-  (syntax-case stx ()
+   (for/list ([import (in-list imports)])
-    [(lazy-require1 modpath (thing ...) orig-stx)
+     (syntax-case import ()
-     (with-syntax ([((exp-name bind-name) ...)
-                    (for/list ([thing-stx (in-list (syntax->list #'(thing ...)))])
-                      (syntax-case thing-stx ()
        [name
         (identifier? #'name)
         (list #'name #'name)]
        [[exp-name bind-name]
         (begin
           (unless (identifier? #'exp-name)
-                             (raise-syntax-error #f "expected identifier"
+            (raise-syntax-error #f "expected identifier" #'orig-stx #'exp-name))
-                                                 #'orig-stx #'exp-name))
           (unless (identifier? #'bind-name)
-                             (raise-syntax-error #f "expected identifier"
+            (raise-syntax-error #f "expected identifier" #'orig-stx #'bind-name))
-                                                 #'orig-stx #'bind-name))
           (list #'exp-name #'bind-name))]
-                        [_
+       [bad
         (raise-syntax-error #f "expected identifier or pair of identifiers"
-                                             #'orig-stx thing-stx)]))]
+                            #'orig-stx #'bad)])))
+ )
+
+(define-syntax (lazy-require1 stx)
+  (syntax-case stx ()
+    [(lazy-require1 modpath (import ...) orig-stx)
+     (with-syntax ([((exp-name bind-name) ...)
+                    (process-imports #'orig-stx (syntax->list #'(import ...)))]
                    [mpi-var-defn
                     (let ([phase (sub1 (variable-reference->phase (#%variable-reference)))])
                       (if (zero? phase)
                           ;; `define-runtime-module-path-index' works right at phase-level 0:
                           #'(define-runtime-module-path-index mpi-var (quote modpath))
                           ;; need a submodule:
-                          (with-syntax ([lazy-require-path-n
+                          (with-syntax ([lazy-require-path-n (gen-aux-mod-name phase)]
-                                         (string->symbol
-                                          (format "lazy-require-path-~a-~a" 
-                                                  phase
-                                                  counter))]
                                         ;; May need to adjust modpath, since we're interpreting it
                                         ;; relative to a *submodule* of the original context.
                                         ;; ie, module-path interpretation is not hygienic!
@@ -111,3 +115,81 @@
                  (variable-reference->resolved-module-path vr))))])
     (when (path? path)
       (register-external-module path #:indirect? #t))))
+
+;; ----
+
+(define-syntax (lazy-require-syntax stx)
+  (syntax-case stx ()
+    [(_ [modpath (import ...)] ...)
+     #`(begin (lazy-require-syntax1/rename modpath (import ...) #,stx) ...)]))
+
+#|
+;; Implementation 1: syntax-local-value to get macro transformer
+
+;; This version only works for "standard" macros. It doesn't work with
+;; set!-transformers. It only supports the macro-nature of syntax
+;; bindings like struct names (you can use them as constructors, but not
+;; as match patterns).
+
+(define-syntax (lazy-require-syntax1/transformer stx)
+  (syntax-case stx ()
+    [(_ modpath (import ...) orig-stx)
+     (with-syntax ([modpath* (module-path-add-submod-up #'modpath)]
+                   [((exp-name bind-name) ...)
+                    (process-imports #'orig-stx (syntax->list #'(import ...)))]
+                   [aux-mod1 (gen-aux-mod-name '*)]
+                   [aux-mod2 (gen-aux-mod-name '*)])
+       (with-syntax ([(get-tx ...) (generate-temporaries #'(exp-name ...))])
+         #'(begin
+             (module aux-mod1 racket/base
+               (require (only-in (for-template modpath*) exp-name ...))
+               (define (get-tx) (syntax-local-value (quote-syntax exp-name))) ...
+               (provide get-tx ...))
+             (module aux-mod2 racket/base
+               (require (only-in racket/lazy-require lazy-require))
+               (lazy-require [(submod ".." aux-mod1) (get-tx ...)])
+               (provide get-tx ...))
+             (require (for-syntax (only-in (submod "." aux-mod2) [get-tx get-tx] ...)))
+             (define-syntax (bind-name stx) ((get-tx) stx)) ...)))]))
+|#
+
+;; Implementation 2: lazy rename-transformers
+
+;; This version is more flexible, since rename-transformers support
+;; ordinary variables and syntax bindings other than or more than macros
+;; (eg struct information).
+
+(begin-for-syntax
+  (struct lazy-rename-transformer (get-id)
+    #:property prop:rename-transformer
+    (lambda (self)
+      (syntax-property ((lazy-rename-transformer-get-id self))
+                       'not-free-identifier=? #t))))
+
+(define-syntax (lazy-require-syntax1/rename stx)
+  (syntax-case stx ()
+    [(_ modpath (import ...) orig-stx)
+     (with-syntax ([modpath* (module-path-add-submod-up #'modpath)]
+                   [((exp-name bind-name) ...)
+                    (process-imports #'orig-stx (syntax->list #'(import ...)))]
+                   [aux-mod1 (gen-aux-mod-name '*)]
+                   [aux-mod2 (gen-aux-mod-name '*)])
+       (with-syntax ([(get-id ...) (generate-temporaries #'(exp-name ...))]
+                     [(bind-aux ...) (generate-temporaries #'(bind-name ...))])
+         #'(begin
+             (module aux-mod1 racket/base
+               (#%require (for-template (only modpath* exp-name ...)))
+               (define (get-id) (quote-syntax exp-name)) ...
+               (provide get-id ...))
+             (module aux-mod2 racket/base
+               (require (only-in racket/lazy-require lazy-require))
+               (lazy-require [(submod ".." aux-mod1) (get-id ...)])
+               (provide get-id ...))
+             (require (for-syntax (only-in (submod "." aux-mod2) [get-id get-id] ...)))
+             ;; Use extra indirection (bind-name -> bind-aux) so that (provide bind-name)
+             ;; doesn't force (get-id) trying to decide whether to bypass renamer.
+             (define-syntax bind-aux (lazy-rename-transformer get-id)) ...
+             (define-syntax bind-name
+               (make-rename-transformer
+                (syntax-property (quote-syntax bind-aux) 'not-free-identifier=? #t)))
+             ...)))]))