From 4f75452dbd364ee6c8c6199c139cb9f2b9f56f6d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 7 Dec 2006 03:04:19 +0000
Subject: [PATCH] allow macros to expand to require in a-unit.ss

svn: r5055
---
 collects/mzlib/a-unit.ss | 91 +++++++++++++++++++++++++++++++++-------
 1 file changed, 76 insertions(+), 15 deletions(-)

diff --git a/collects/mzlib/a-unit.ss b/collects/mzlib/a-unit.ss
index 29ff65466a..532f2a9690 100644
--- a/collects/mzlib/a-unit.ss
+++ b/collects/mzlib/a-unit.ss
@@ -1,7 +1,6 @@
 (module a-unit mzscheme
-  (require-for-syntax "private/unit-compiletime.ss"
-                      "private/unit-syntax.ss")
   (require "unit.ss")
+  (require-for-syntax (lib "kerncase.ss" "syntax"))
   
   (provide (rename module-begin #%module-begin)
            (all-from-except mzscheme #%module-begin)
@@ -12,17 +11,79 @@
      (string-append (regexp-replace "-unit$" (symbol->string s) "")
                     "@")))
 
+  ;; Look for `import' and `export', and start processing the body:
   (define-syntax (module-begin stx)
-    (parameterize ((error-syntax stx))
-      (with-syntax ((name (make-name (syntax-property stx 'enclosing-module-name))))
-        (syntax-case stx ()
-          ((_ . x)
-           (with-syntax ((((reqs ...) . (body ...))
-                          (split-requires (checked-syntax->list #'x))))
-             (datum->syntax-object 
-              stx
-              (syntax-e #'(#%module-begin
-                           reqs ...
-                           (provide name)
-                           (define-unit name body ...)))
-              stx))))))))
+    (syntax-case stx ()
+      [(_ elem ...)
+       (with-syntax ([((elem ...) . (literal ...))
+                      (let loop ([elems (syntax->list #'(elem ...))]
+                                 [accum null])
+                        (syntax-case elems (import export)
+                          [((import . _1) (export . _2) . _3)
+                           (cons (reverse accum) elems)]
+                          [((import . _1) . _2)
+                           (raise-syntax-error
+                            #f
+                            "expected an `export' clause after `import'"
+                            stx)]
+                          [()
+                           (raise-syntax-error
+                            #f
+                            "missing an `import' clause"
+                            stx)]
+                          [_else
+                           (loop (cdr elems) (cons (car elems) accum))]))])
+         (with-syntax ((name (datum->syntax-object
+                              stx
+                              (make-name (syntax-property stx 'enclosing-module-name))
+                              stx))
+                       (orig-stx stx))
+           (datum->syntax-object
+            stx
+            (syntax-e
+             #'(#%module-begin (a-unit-module orig-stx finish-a-unit (import export) 
+                                              "original import form"
+                                              name (elem ...) (literal ...))))
+            stx
+            stx)))]))
+
+  ;; Process one `require' form (and make sure it's a require form):
+  (define-syntax (a-unit-module stx)
+    (syntax-case stx ()
+      [(_ orig-stx finish stops separator name (elem1 elem ...) (literal ...))
+       (let ([e (local-expand #'elem1
+                              'module
+                              (append
+                               (syntax->list #'stops)
+                               (list*
+                                #'require
+                                #'require-for-syntax
+                                #'require-for-template
+                                (kernel-form-identifier-list #'here))))])
+         (syntax-case e (begin)
+           [(req r ...)
+            (or (module-identifier=? #'req #'require)
+                (module-identifier=? #'req #'require-for-syntax)
+                (module-identifier=? #'req #'require-for-template))
+            #'(begin
+                (req r ...)
+                (a-unit-module orig-stx finish stops separator name (elem ...) (literal ...)))]
+           [(begin b ...)
+            #'(a-unit-module orig-stx finish stops separator name (b ... elem ...) (literal ...))]
+           [_else
+            (raise-syntax-error
+             #f
+             (format "non-require form before ~a" (syntax-e #'separator))
+             #'orig-stx
+             e)]))]
+      [(_ orig-stx finish stops separator name () (literal ...))
+       #'(finish orig-stx name literal ...)]))
+    
+  ;; All requires are done, so finish handling the unit:
+  (define-syntax (finish-a-unit stx)
+    (syntax-case stx (import export)
+      [(_ orig-stx name imports exports elem ...)
+       #'(begin
+           (provide name)
+           (define-unit name imports exports elem ...))])))
+