Revert previous bad addition to trunk, forgot to switch first.
svn: r17147
This commit is contained in:
parent
a22d201d85
commit
53eb309b75
|
@ -316,8 +316,6 @@
|
|||
|
||||
(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)]
|
||||
|
@ -333,7 +331,7 @@
|
|||
[`(,a . ,b)
|
||||
(loop b)]
|
||||
[`()
|
||||
(error 'tcl.ss "did not find provide/doc: ~a" full-sexp)])))]))
|
||||
(error 'tcl.ss "did not find provide/doc" full-sexp)])))]))
|
||||
|
||||
;; invoke-tool : unit/sig string -> (values (-> void) (-> void))
|
||||
;; invokes the tools and returns the two phase thunks.
|
||||
|
|
|
@ -7,8 +7,8 @@
|
|||
(provide lp-include)
|
||||
|
||||
(define-syntax (module stx)
|
||||
(syntax-case stx (#%module-begin)
|
||||
[(module name base (#%module-begin body ...))
|
||||
(syntax-case stx ()
|
||||
[(module name base body ...)
|
||||
(begin
|
||||
#'(begin body ...))]))
|
||||
|
||||
|
|
|
@ -10,20 +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.
|
||||
(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))
|
||||
|
@ -184,15 +170,7 @@
|
|||
(- (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.
|
||||
[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)])
|
||||
[r `(,(tag-src 'module) ,(tag-src name) ,lang . ,body)])
|
||||
(if stx? (datum->syntax #f r all-loc) r)))
|
||||
|
||||
(define (wrap lang port read modpath src line col pos)
|
||||
|
|
|
@ -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,12 +136,7 @@ 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. 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.
|
||||
expected to return a list of expressions in this case.
|
||||
|
||||
In addition, the two wrappers can return a different value than the
|
||||
wrapped function. This introduces two more customization points for
|
||||
|
|
Loading…
Reference in New Issue
Block a user