suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
functions or wrapper1 function already adds it.

svn: r17184
This commit is contained in:
Stevie Strickland 2009-12-04 21:04:49 +00:00
commit a9b6f0e575
5 changed files with 47 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drscheme/private/tools.ss
View File

@ -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.

4
collects/scribble/lp-include.ss
View File

@ -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 ...))]))

28
collects/syntax/module-reader.ss
View File

@ -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)

10
collects/syntax/scribblings/module-reader.scrbl
View File

@ -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

14
collects/tests/mzscheme/module-reader.ss
View File

@ -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"))))
;; ----------------------------------------