diff --git a/collects/drscheme/private/tools.ss b/collects/drscheme/private/tools.ss index 3e16767fcc..e446f0b925 100644 --- a/collects/drscheme/private/tools.ss +++ b/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. diff --git a/collects/scribble/lp-include.ss b/collects/scribble/lp-include.ss index dfc75496a8..09a3262180 100644 --- a/collects/scribble/lp-include.ss +++ b/collects/scribble/lp-include.ss @@ -7,8 +7,8 @@ (provide lp-include) (define-syntax (module stx) - (syntax-case stx () - [(module name base body ...) + (syntax-case stx (#%module-begin) + [(module name base (#%module-begin body ...)) (begin #'(begin body ...))])) diff --git a/collects/syntax/module-reader.ss b/collects/syntax/module-reader.ss index ad3f13e394..630adff4dc 100644 --- a/collects/syntax/module-reader.ss +++ b/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) diff --git a/collects/syntax/scribblings/module-reader.scrbl b/collects/syntax/scribblings/module-reader.scrbl index 378f19af64..395852dc16 100644 --- a/collects/syntax/scribblings/module-reader.scrbl +++ b/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 diff --git a/collects/tests/mzscheme/module-reader.ss b/collects/tests/mzscheme/module-reader.ss index a2d7e5660f..6a109b41a7 100644 --- a/collects/tests/mzscheme/module-reader.ss +++ b/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")))) ;; ----------------------------------------