From 75803d488132e6824e27c443370d7ff60eaf4011 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 1 Dec 2009 20:39:58 +0000 Subject: [PATCH 1/7] Here's the changes that accidentally went to trunk first. svn: r17150 --- collects/drscheme/private/tools.ss | 4 +++- collects/scribble/lp-include.ss | 4 ++-- collects/syntax/module-reader.ss | 24 ++++++++++++++++++- .../syntax/scribblings/module-reader.scrbl | 9 +++++-- 4 files changed, 35 insertions(+), 6 deletions(-) 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..a84fb571a4 100644 --- a/collects/syntax/module-reader.ss +++ b/collects/syntax/module-reader.ss @@ -10,6 +10,20 @@ (define ar? procedure-arity-includes?) + ;; 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. + (define (contains-#%module-begin exps) + (let ([exps (if (syntax? exps) (syntax->list exps) exps)]) + (and exps + (pair? exps) + (null? (cdr exps)) + (let ([exp (car exps)]) + (let ([lst (if (syntax? exp) (syntax->list exp) exp)]) + (and lst + (let ([head (if (syntax? (car lst)) (syntax-e (car lst)) (car lst))]) + (eq? '#%module-begin head)))))))) + (define-syntax (provide-module-reader stx) (define (err str [sub #f]) (raise-syntax-error 'syntax/module-reader str sub)) @@ -170,7 +184,15 @@ (- (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, + ;; we need to avoid double-wrapping. + [wrapped-body (if (contains-#%module-begin body) + body + (let ([wrapped `(#%module-begin . ,body)]) + (if stx? + (datum->syntax #f wrapped all-loc) + wrapped)))] + [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..624f717ed5 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,12 @@ 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 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 From d113d2d19a425ae11bba08ba244b2fbe3c938322 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 1 Dec 2009 20:44:27 +0000 Subject: [PATCH 2/7] Specifically mention #:wrapper1 as well, since that's also a common place for doing this. svn: r17151 --- collects/syntax/scribblings/module-reader.scrbl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/collects/syntax/scribblings/module-reader.scrbl b/collects/syntax/scribblings/module-reader.scrbl index 624f717ed5..395852dc16 100644 --- a/collects/syntax/scribblings/module-reader.scrbl +++ b/collects/syntax/scribblings/module-reader.scrbl @@ -141,7 +141,8 @@ 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 should be considered deprecated behavior. +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 From 39689ae4e7c482c92b8bf4ba6ac41279532c00c3 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 1 Dec 2009 21:14:24 +0000 Subject: [PATCH 3/7] Elaborate in this comment. svn: r17152 --- collects/syntax/module-reader.ss | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/collects/syntax/module-reader.ss b/collects/syntax/module-reader.ss index a84fb571a4..a66b1248cb 100644 --- a/collects/syntax/module-reader.ss +++ b/collects/syntax/module-reader.ss @@ -184,8 +184,10 @@ (- (or (syntax-position modpath) (add1 pos)) pos))) v))] - ;; Since there are users that wrap with #%module-begin in their reader, - ;; we need to avoid double-wrapping. + ;; 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 (if (contains-#%module-begin body) body (let ([wrapped `(#%module-begin . ,body)]) From a24dd4affb74fad2e3704eb3f66e6b4f4ae74e57 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 1 Dec 2009 21:27:55 +0000 Subject: [PATCH 4/7] Have to handle the fact that "body" is a (possibly syntax) list of expressions here. Could also pull out the car of said list and just return that, but eh. This code is going to be crap until (if) we can ever remove the need to be backwards compatible. svn: r17153 --- collects/syntax/module-reader.ss | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/collects/syntax/module-reader.ss b/collects/syntax/module-reader.ss index a66b1248cb..1908e90f45 100644 --- a/collects/syntax/module-reader.ss +++ b/collects/syntax/module-reader.ss @@ -192,9 +192,9 @@ body (let ([wrapped `(#%module-begin . ,body)]) (if stx? - (datum->syntax #f wrapped all-loc) - wrapped)))] - [r `(,(tag-src 'module) ,(tag-src name) ,lang ,wrapped-body)]) + (list (datum->syntax #f wrapped all-loc)) + (list wrapped))))] + [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) From 4c61aabea04fba12037203821caaa97e1619d82a Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 1 Dec 2009 21:58:58 +0000 Subject: [PATCH 5/7] Actually, just have the descender return the #%module-begin expression, if it finds one, and otherwise do the wrapping appropriately. svn: r17154 --- collects/syntax/module-reader.ss | 39 +++++++++++++++++--------------- 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/collects/syntax/module-reader.ss b/collects/syntax/module-reader.ss index 1908e90f45..d96afb82ee 100644 --- a/collects/syntax/module-reader.ss +++ b/collects/syntax/module-reader.ss @@ -12,17 +12,25 @@ ;; 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. - (define (contains-#%module-begin exps) - (let ([exps (if (syntax? exps) (syntax->list exps) exps)]) - (and exps - (pair? exps) - (null? (cdr exps)) - (let ([exp (car exps)]) - (let ([lst (if (syntax? exp) (syntax->list exp) exp)]) - (and lst - (let ([head (if (syntax? (car lst)) (syntax-e (car lst)) (car lst))]) - (eq? '#%module-begin head)))))))) + ;; 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]))]))) (define-syntax (provide-module-reader stx) (define (err str [sub #f]) @@ -188,13 +196,8 @@ ;; 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 (if (contains-#%module-begin body) - body - (let ([wrapped `(#%module-begin . ,body)]) - (if stx? - (list (datum->syntax #f wrapped all-loc)) - (list wrapped))))] - [r `(,(tag-src 'module) ,(tag-src name) ,lang . ,wrapped-body)]) + [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) From 152ea3c6c848bfb5cedba776d14abed3991e1d46 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 1 Dec 2009 22:00:43 +0000 Subject: [PATCH 6/7] Move it into the only place it's used. svn: r17155 --- collects/syntax/module-reader.ss | 43 ++++++++++++++++---------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/collects/syntax/module-reader.ss b/collects/syntax/module-reader.ss index d96afb82ee..630adff4dc 100644 --- a/collects/syntax/module-reader.ss +++ b/collects/syntax/module-reader.ss @@ -10,28 +10,6 @@ (define ar? procedure-arity-includes?) - ;; 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]))]))) - (define-syntax (provide-module-reader stx) (define (err str [sub #f]) (raise-syntax-error 'syntax/module-reader str sub)) @@ -163,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? From 5650cb96479e93d90671ccbbccb7a466df45fd88 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Fri, 4 Dec 2009 20:18:14 +0000 Subject: [PATCH 7/7] Fix the module-reader tests. svn: r17183 --- collects/tests/mzscheme/module-reader.ss | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) 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")))) ;; ----------------------------------------