Change syntax/module-reader to add a #%module-begin unless the reader

functions or wrapper1 function already adds it.

svn: r17184

collects/drscheme/private/tools.ss

@@ -316,6 +316,8 @@
        
        (let loop ([sexp full-sexp])
          (match sexp
+           [`((#%module-begin ,body ...))
+            (loop body)]
            [`((provide/doc (,x ,name ,ctc ,other ...) ...) ,rest ...)
             #`(let #,(map (λ (name ctc) 
                             (with-syntax ([name (datum->syntax #'tool-name name)]
@@ -331,7 +333,7 @@
            [`(,a . ,b) 
             (loop b)]
            [`()
-            (error 'tcl.ss "did not find provide/doc" full-sexp)])))]))
+            (error 'tcl.ss "did not find provide/doc: ~a" full-sexp)])))]))
 
 ;; invoke-tool : unit/sig string -> (values (-> void) (-> void))
 ;; invokes the tools and returns the two phase thunks.

collects/scribble/lp-include.ss

@@ -7,8 +7,8 @@
 (provide lp-include)
 
 (define-syntax (module stx)
-  (syntax-case stx ()
+  (syntax-case stx (#%module-begin)
-    [(module name base body ...)
+    [(module name base (#%module-begin body ...))
      (begin
        #'(begin body ...))]))
 

collects/syntax/module-reader.ss

@@ -141,6 +141,27 @@
 
   (define (wrap-internal lang port read whole? wrapper stx?
                          modpath src line col pos)
+    ;; Takes either a syntax object representing a list of expressions
+    ;; or a list of s-expressions, and checks to see if it's a single
+    ;; expression that begins with the literal #%module-begin.  If so,
+    ;; it just returns that expression, else it wraps with #%module-begin.
+    (define (wrap-#%module-begin exps stx?)
+      (define wrapped-exps 
+        (let ([wrapped `(#%module-begin . ,exps)])
+          (if stx?
+              (datum->syntax #f wrapped)
+              wrapped)))
+      (let ([exps (if stx? (syntax->list exps) exps)])
+        (cond
+          [(null? exps) wrapped-exps]
+          [(not (null? (cdr exps))) wrapped-exps]
+          [else (let ([exp (if stx? (syntax-e (car exps)) (car exps))])
+                  (cond
+                    [(not (pair? exp)) wrapped-exps]
+                    [(eq? '#%module-begin
+                          (if stx? (syntax-e (car exp)) (car exp)))
+                     (car exp)]
+                    [else wrapped-exps]))])))
     (let* ([lang (if stx? (datum->syntax #f lang modpath modpath) lang)]
            [body (lambda ()
                    (if whole?
@@ -170,7 +191,12 @@
                                         (- (or (syntax-position modpath) (add1 pos))
                                            pos)))
                           v))]
-           [r `(,(tag-src 'module) ,(tag-src name) ,lang . ,body)])
+           ;; Since there are users that wrap with #%module-begin in their reader
+           ;; or wrapper1 functions, we need to avoid double-wrapping.  Having to
+           ;; do this for #lang readers should be considered deprecated, and
+           ;; hopefully one day we'll move to just doing it unilaterally.
+           [wrapped-body (wrap-#%module-begin body stx?)]
+           [r `(,(tag-src 'module) ,(tag-src name) ,lang ,wrapped-body)])
       (if stx? (datum->syntax #f r all-loc) r)))
 
   (define (wrap lang port read modpath src line col pos)

collects/syntax/scribblings/module-reader.scrbl

@@ -46,7 +46,7 @@ into
 
 @schemeblock[
 (module _name-id module-path
-  ....)
+  (#%module-begin ....))
 ]
 
 where @scheme[_name-id] is derived from the name of the port used by
@@ -136,7 +136,13 @@ In some cases, the reader functions read the whole file, so there is
 no need to iterate them (e.g., Scribble's @scheme[read-inside] and
 @scheme[read-syntax-inside]).  In these cases you can specify
 @scheme[#:whole-body-readers?] as @scheme[#t] --- the readers are
-expected to return a list of expressions in this case.
+expected to return a list of expressions in this case.  If those
+reader functions return a list with a single expression that begins
+with @scheme[#%module-begin], then the @scheme[syntax/module-reader]
+language will not inappropriately add another.  This is to be
+backwards-compatible with older code, and adding @scheme[#%module-begin]
+in the reader functions or in the function specified by @scheme[#:wrapper1]
+should be considered deprecated behavior.
 
 In addition, the two wrappers can return a different value than the
 wrapped function.  This introduces two more customization points for

collects/tests/mzscheme/module-reader.ss

@@ -20,7 +20,7 @@
 ;; plain version
 (module r0 syntax/module-reader scheme/base)
 (test-both '(r0) "#reader '~s (define FoO #:bAr)"
-           '(module page scheme/base (define FoO #:bAr)))
+           '(module page scheme/base (#%module-begin (define FoO #:bAr))))
 
 ;; using a simple wrapper to get a case-insensitive reader
 (module r1 syntax/module-reader scheme/base
@@ -35,7 +35,7 @@
     (parameterize ([read-case-sensitive #f]) (apply reader args))))
 ;;
 (test-both '(r1 r2 r3) "#reader '~s (define FoO #:bAr)"
-           '(module page scheme/base (define foo #:bar)))
+           '(module page scheme/base (#%module-begin (define foo #:bar))))
 
 ;; add something to the result
 (module r4 syntax/module-reader zzz
@@ -45,7 +45,7 @@
   #:wrapper1 (lambda (t stx?) (cons (if stx? #'foo 'foo) (t))))
 ;;
 (test-both '(r4 r5) "#reader '~s (define foo #:bar)"
-           '(module page zzz foo (define foo #:bar)))
+           '(module page zzz (#%module-begin foo (define foo #:bar))))
 
 ;; make an empty module, after reading the contents
 (module r6 syntax/module-reader zzz
@@ -56,14 +56,14 @@
 ;; forget about the input -- just return a fixed empty input module
 (module r8 syntax/module-reader whatever
   #:wrapper2 (lambda (in rd)
-               (if (syntax? (rd in)) #'(module page zzz) '(module page zzz))))
+               (if (syntax? (rd in)) #'(module page zzz (#%module-begin)) '(module page zzz (#%module-begin)))))
 ;; the same, the easy way
 (module r9 syntax/module-reader
   #:language (lambda () 'zzz)
   #:wrapper1 (lambda (t) '()))
 ;;
 (test-both '(r6 r7 r8 r9) "#reader '~s (define foo #:bar)"
-           '(module page zzz))
+           '(module page zzz (#%module-begin)))
 
 ;; a module that uses the scribble syntax with a specified language
 (module r10 syntax/module-reader -ignored-
@@ -89,9 +89,9 @@
   (require scribble/reader))
 ;;
 (test-both '(r10 r11) "#reader '~s scheme/base (define foo 1)"
-           '(module page scheme/base (define foo 1)))
+           '(module page scheme/base (#%module-begin (define foo 1))))
 (test-both '(r10 r11) "#reader '~s scheme/base @define[foo]{one}"
-           '(module page scheme/base (define foo "one")))
+           '(module page scheme/base (#%module-begin (define foo "one"))))
 
 ;; ----------------------------------------