* Minor extension (#:wrapper2 can accept an stx? boolean too)
* Added a more sophisticated test (scribble syntax with an arbitrary language), based on documentation example * Documentation svn: r11502
This commit is contained in:
Eli Barzilay
parent
fa10d3f67c
commit
093fe73855
|
|
@ -48,30 +48,36 @@
|
|||
body ...
|
||||
(#%provide (rename *read read) (rename *read-syntax read-syntax))
|
||||
(define-values (*read *read-syntax)
|
||||
(let* ([rd -read]
|
||||
(let ([rd -read]
|
||||
[rds -read-syntax]
|
||||
[w1 -wrapper1]
|
||||
[w1-extra? (and w1 (procedure-arity-includes? w1 2))]
|
||||
[w1r (if w1-extra? (lambda (t) (w1 t #f)) w1)]
|
||||
[w1s (if w1-extra? (lambda (t) (w1 t #t)) w1)]
|
||||
[w2 (or -wrapper2 (lambda (in r) (r in)))])
|
||||
[w2 (let ([w -wrapper2])
|
||||
(cond [(not w) (lambda (in r _) (r in))]
|
||||
[(procedure-arity-includes? w 3) w]
|
||||
[else (lambda (in r _) (w in r))]))])
|
||||
(values
|
||||
(lambda (in modpath line col pos)
|
||||
(w2 in (lambda (in)
|
||||
(wrap-internal 'lib in rd w1r modpath #f
|
||||
line col pos))))
|
||||
(w2 in
|
||||
(lambda (in)
|
||||
(wrap-internal 'lib in rd w1 #f modpath #f
|
||||
line col pos))
|
||||
#f))
|
||||
(lambda (src in modpath line col pos)
|
||||
(w2 in (lambda (in)
|
||||
(w2 in
|
||||
(lambda (in)
|
||||
(wrap-internal 'lib in (lambda (in) (rds src in))
|
||||
w1s modpath src
|
||||
line col pos)))))))))))]))
|
||||
w1 #t modpath src
|
||||
line col pos))
|
||||
#t)))))))))]))
|
||||
|
||||
(define (wrap-internal lib port read wrapper modpath src line col pos)
|
||||
(define (wrap-internal lib port read wrapper stx? modpath src line col pos)
|
||||
(let* ([body (lambda ()
|
||||
(let loop ([a null])
|
||||
(let ([v (read port)])
|
||||
(if (eof-object? v) (reverse a) (loop (cons v a))))))]
|
||||
[body (if wrapper (wrapper body) (body))]
|
||||
[body (cond [(not wrapper) (body)]
|
||||
[(procedure-arity-includes? wrapper 2) (wrapper body stx?)]
|
||||
[else (wrapper body)])]
|
||||
[p-name (object-name port)]
|
||||
[name (if (path? p-name)
|
||||
(let-values ([(base name dir?) (split-path p-name)])
|
||||
|
|
@ -79,20 +85,17 @@
|
|||
(path->string (path-replace-suffix name #""))))
|
||||
'page)]
|
||||
[tag-src (lambda (v)
|
||||
(if (syntax? modpath)
|
||||
(datum->syntax #f v
|
||||
(vector src line col pos
|
||||
(- (or (syntax-position modpath)
|
||||
(add1 pos))
|
||||
(if stx?
|
||||
(datum->syntax
|
||||
#f v (vector src line col pos
|
||||
(- (or (syntax-position modpath) (add1 pos))
|
||||
pos)))
|
||||
v))]
|
||||
[lib-src (lambda (v)
|
||||
(if (syntax? modpath)
|
||||
(datum->syntax #f lib modpath modpath)
|
||||
v))])
|
||||
`(,(tag-src 'module) ,(tag-src name) ,(lib-src lib) . ,body)))
|
||||
[lib (if stx? (datum->syntax #f lib modpath modpath) lib)]
|
||||
[r `(,(tag-src 'module) ,(tag-src name) ,lib . ,body)])
|
||||
(if stx? (datum->syntax #f r) r)))
|
||||
|
||||
(define (wrap lib port read modpath src line col pos)
|
||||
(wrap-internal lib port read #f modpath src line col pos))
|
||||
(wrap-internal lib port read #f #f modpath src line col pos))
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -5,8 +5,9 @@
|
|||
scheme/contract))
|
||||
|
||||
(provide (all-from-out scribble/manual)
|
||||
(for-label (all-from-out scheme/base
|
||||
scheme/contract))
|
||||
(for-label (except-out (all-from-out scheme/base
|
||||
scheme/contract)
|
||||
#%module-begin))
|
||||
refman)
|
||||
|
||||
(define refman '(lib "scribblings/reference/reference.scrbl"))
|
||||
|
|
|
|||
|
|
@ -1,24 +1,31 @@
|
|||
#lang scribble/doc
|
||||
@(require "common.ss")
|
||||
|
||||
@(define-syntax-rule (go)
|
||||
(begin
|
||||
(require (for-label syntax/module-reader))
|
||||
@begin{
|
||||
@(require (for-label syntax/module-reader))
|
||||
|
||||
@title[#:tag "module-reader"]{Module Reader}
|
||||
|
||||
@defmodule[syntax/module-reader]
|
||||
|
||||
The @schememodname[syntax/module-reader] language provides support
|
||||
for defining @hash-lang[] readers.
|
||||
The @schememodname[syntax/module-reader] language provides support for
|
||||
defining @hash-lang[] readers. In its simplest form, the only thing
|
||||
that is needed in the body of a @schememodname[syntax/module-reader]
|
||||
is the name of the module that will be used in the language position
|
||||
of read modules; using keywords, the resulting readers can be
|
||||
customized in a number of ways.
|
||||
|
||||
@defform[(#%module-begin module-path)]{
|
||||
@defform*/subs[[(#%module-begin module-path)
|
||||
(#%module-begin module-path reader-option ... body ....)]
|
||||
([reader-option (code:line #:read read-expr)
|
||||
(code:line #:read-syntax read-syntax-expr)
|
||||
(code:line #:wrapper1 wrapper1-expr)
|
||||
(code:line #:wrapper2 wrapper2-expr)])]{
|
||||
|
||||
Causes a module written in the @schememodname[syntax/module-reader]
|
||||
language to define and provide @schemeidfont{read} and
|
||||
@schemeidfont{read-syntax} functions, making the module an
|
||||
implementation of a reader. In particular, the exported reader
|
||||
functions read all S-expressions until an end-of-file, and it packages
|
||||
functions read all S-expressions until an end-of-file, and package
|
||||
them into a new module in the @scheme[module-path] language.
|
||||
|
||||
That is, a module @scheme[_something]@scheme[/lang/reader] implemented
|
||||
|
|
@ -29,7 +36,7 @@ as
|
|||
module-path)
|
||||
]
|
||||
|
||||
creates a reader that converts @scheme[#, @hash-lang[] _something]
|
||||
creates a reader that converts @scheme[#,(hash-lang)_something]
|
||||
into
|
||||
|
||||
@schemeblock[
|
||||
|
|
@ -45,7 +52,120 @@ For example, @scheme[scheme/base/lang/reader] is implemented as
|
|||
@schemeblock[
|
||||
(module reader module-syntax/module-reader
|
||||
scheme/base)
|
||||
]}
|
||||
]
|
||||
|
||||
The reader functions can be customized in a number of ways, using
|
||||
keyword markers in the syntax of the reader module. A @scheme[#:read]
|
||||
and @scheme[#:read-syntax] keywords can be used to specify functions
|
||||
other than @scheme[read] and @scheme[read-syntax] to perform the
|
||||
reading. For example, you can implement a
|
||||
@secref[#:doc '(lib "scribblings/honu/honu.scrbl")]{Honu} reader
|
||||
using:
|
||||
|
||||
@schemeblock[
|
||||
(module reader module-syntax/module-reader
|
||||
honu
|
||||
#:read read-honu
|
||||
#:read-syntax read-honu-syntax)
|
||||
]
|
||||
|
||||
You can also use the (optional) module body to provide more
|
||||
definitions that might be needed to implement your reader functions.
|
||||
For example, here is a case-insensitive reader for the
|
||||
@scheme[scheme/base] language:
|
||||
|
||||
@schemeblock[
|
||||
(module insensitive syntax/module-reader
|
||||
scheme/base
|
||||
#:read (wrap read) #:read-syntax (wrap read-syntax)
|
||||
(define ((wrap reader) . args)
|
||||
(parameterize ([read-case-sensitive #f]) (apply reader args))))
|
||||
]
|
||||
|
||||
In many cases, however, the standard @scheme[read] and
|
||||
@scheme[read-syntax] are fine, as long as you can customize the
|
||||
dynamic context they're invoked at. For this, @scheme[#:wrapper1] can
|
||||
specify a function that can control the dynamic context in which the
|
||||
reader functions are called. It should evaluate to a function that
|
||||
consumes a thunk and invokes it in the right context. Here is an
|
||||
alternative definition of the case-insensitive language using
|
||||
@scheme[#:wrapper1]:
|
||||
|
||||
@schemeblock[
|
||||
(module insensitive syntax/module-reader
|
||||
scheme/base
|
||||
#:wrapper1 (lambda (t)
|
||||
(parameterize ([read-case-sensitive #f])
|
||||
(t))))
|
||||
]
|
||||
|
||||
Note that using a @tech[#:doc refman]{readtable}, you can implement
|
||||
languages that go beyond plain S-expressions.
|
||||
|
||||
In addition to this wrapper, there is also @scheme[#:wrapper2] that
|
||||
has more control over the resulting reader functions. If specified,
|
||||
this wrapper is handed the input port and a (one-argumet) reader
|
||||
function that expects the input port as an argument. This allows this
|
||||
wrapper to hand a different port value to the reader function, for
|
||||
example, it can divert the read to use different file (if given a port
|
||||
that corresponds to a file). Here is the case-insensitive implemented
|
||||
using this option:
|
||||
|
||||
@schemeblock[
|
||||
(module insensitive syntax/module-reader
|
||||
scheme/base
|
||||
#:wrapper2 (lambda (in r)
|
||||
(parameterize ([read-case-sensitive #f])
|
||||
(r in))))
|
||||
]
|
||||
|
||||
Finally, note that the two wrappers can return a different value than
|
||||
the wrapped function. This introduces two more customization points
|
||||
for the resulting readers:
|
||||
@itemize{
|
||||
@item{The thunk that is passed to a @scheme[#:wrapper1] function
|
||||
reads the file contents and returns a list of read expressions
|
||||
(either syntax values or S-expressions). For example, the
|
||||
following reader defines a ``language'' that ignores the contents
|
||||
of the file, and simply reads files as if they were empty:
|
||||
@schemeblock[
|
||||
(module ignored syntax/module-reader
|
||||
scheme/base
|
||||
#:wrapper1 (lambda (t) (t) '()))
|
||||
]
|
||||
Note that it is still performing the read, otherwise the module
|
||||
loader will complain about extra expressions.}
|
||||
@item{The reader function that is passed to a @scheme[#:wrapper2]
|
||||
function returns the final reault of the reader (a module
|
||||
expression). You can return a different value, for example,
|
||||
making it use a different language module.}}
|
||||
In some rare cases, it is more convenient to know whether a reader is
|
||||
invoked for a @scheme[read] or for a @scheme[read-syntax]. To
|
||||
accommodate these cases, both wrappers can accept an additional
|
||||
argument, and in this case, they will be handed a boolean value that
|
||||
indicates whether the reader is expected to read syntax (@scheme[#t])
|
||||
or not (@scheme[#f]). For example, here is a reader that uses the
|
||||
scribble syntax, and the first datum in the file determines the actual
|
||||
language (which means that the library specification is effectively
|
||||
ignored):
|
||||
@schemeblock[
|
||||
(module scribbled syntax/module-reader
|
||||
-ignored-
|
||||
#:wrapper2
|
||||
(lambda (in rd stx?)
|
||||
(let* ([lang (read in)]
|
||||
[mod (parameterize ([current-readtable (make-at-readtable)])
|
||||
(rd in))]
|
||||
[mod (if stx? mod (datum->syntax #f mod))]
|
||||
[r (syntax-case mod ()
|
||||
[(module name lang* . body)
|
||||
(with-syntax ([lang (datum->syntax
|
||||
#'lang* lang #'lang*)])
|
||||
(syntax/loc mod (module name lang . body)))])])
|
||||
(if stx? r (syntax->datum r))))
|
||||
(require scribble/reader))
|
||||
]
|
||||
}
|
||||
|
||||
@defproc[(wrap-read-all [mod-path module-path?]
|
||||
[in input-port?]
|
||||
|
|
@ -66,6 +186,3 @@ position of the module. The result is roughly
|
|||
@schemeblock[
|
||||
`(module ,_name-id ,mod-path ,@_lst)
|
||||
]}
|
||||
|
||||
}))
|
||||
@(go)
|
||||
|
|
|
|||
|
|
@ -43,6 +43,22 @@
|
|||
#:wrapper2 (lambda (in rd)
|
||||
(if (syntax? (rd in)) #'(module page zzz) '(module page zzz))))
|
||||
|
||||
;; a module that uses the scribble syntax with a specified language
|
||||
(module r9 syntax/module-reader -ignored-
|
||||
#:wrapper2
|
||||
(lambda (in rd stx?)
|
||||
(let* ([lang (read in)]
|
||||
[mod (parameterize ([current-readtable (make-at-readtable)])
|
||||
(rd in))]
|
||||
[mod (if stx? mod (datum->syntax #f mod))]
|
||||
[r (syntax-case mod ()
|
||||
[(module name lang* . body)
|
||||
(with-syntax ([lang (datum->syntax
|
||||
#'lang* lang #'lang*)])
|
||||
(syntax/loc mod (module name lang . body)))])])
|
||||
(if stx? r (syntax->datum r))))
|
||||
(require scribble/reader))
|
||||
|
||||
(define (from-string read str)
|
||||
(parameterize ([read-accept-reader #t])
|
||||
(read (open-input-string str))))
|
||||
|
|
@ -68,6 +84,11 @@
|
|||
(test-both "#reader 'r6 (define foo #:bar)"
|
||||
'(module page zzz))
|
||||
|
||||
(test-both "#reader 'r9 scheme/base (define foo 1)"
|
||||
'(module page scheme/base (define foo 1)))
|
||||
(test-both "#reader 'r9 scheme/base @define[foo]{one}"
|
||||
'(module page scheme/base (define foo "one")))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user