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

scribble reader interface and doc adjustments

Browse Source 
svn: r8257
This commit is contained in:
Matthew Flatt 2008-01-08 16:09:25 +00:00
parent 1d58054540
commit 4c1856f189
4 changed files with 68 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/scribble/comment-reader.ss
View File

@ -1,20 +1,20 @@
(module comment-reader mzscheme
(require (lib "kw.ss"))
(module comment-reader scheme/base
(provide (rename *read read)
(rename *read-syntax read-syntax))
(provide (rename-out [*read read]
[*read-syntax read-syntax])
make-comment-readtable)
(define/kw (*read #:optional [inp (current-input-port)])
(define (*read [inp (current-input-port)])
(parameterize ([current-readtable (make-comment-readtable)])
(read/recursive inp)))
(define/kw (*read-syntax #:optional src [port (current-input-port)])
(define (*read-syntax src [port (current-input-port)])
(parameterize ([current-readtable (make-comment-readtable)])
(read-syntax/recursive src port)))
(define (make-comment-readtable)
(make-readtable (current-readtable)
(define (make-comment-readtable #:readtable [rt (current-readtable)])
(make-readtable rt
#\; 'terminating-macro
(case-lambda
[(char port)
@ -22,7 +22,7 @@
[(char port src line col pos)
(let ([v (do-comment port (lambda () (read-syntax/recursive src port #\@)))])
(let-values ([(eline ecol epos) (port-next-location port)])
(datum->syntax-object
(datum->syntax
#f
v
(list src line col pos (and pos epos (- epos pos))))))])))

59
collects/scribble/reader.ss
View File

@ -1,9 +1,9 @@
;; ============================================================================
;; Implements the @-reader macro for embedding text in Scheme code.
(module reader mzscheme
(module reader scheme/base
(require (lib "kw.ss") (lib "string.ss") (lib "readerr.ss" "syntax"))
(require (lib "string.ss") (lib "readerr.ss" "syntax"))
;; --------------------------------------------------------------------------
;; utilities for syntax specifications below
@ -158,7 +158,7 @@
(define eol-token "\n")
(define (eol-syntax? x) (and (syntax? x) (eq? eol-token (syntax-e x))))
;; sanity check, in case this property gets violated in the future
(unless (eol-syntax? (datum->syntax-object #f eol-token))
(unless (eol-syntax? (datum->syntax #f eol-token))
(internal-error 'invalid-assumption))
;; --------------------------------------------------------------------------
@ -251,7 +251,7 @@
(unless (eol-syntax? eol)
(internal-error 'done-items))
(cons (syntax-property
(datum->syntax-object eol spaces eol)
(datum->syntax eol spaces eol)
'scribble 'indentation)
r)))]
;; can have special comment values from "@||"
@ -266,7 +266,7 @@
[1st (and (syntax? stx0) (syntax-e stx0))])
(if (and (string? 1st) (not (eq? eol-token 1st))
(string? 2nd) (not (eq? eol-token 2nd)))
(cons (datum->syntax-object stx0
(cons (datum->syntax stx0
(string-append 1st 2nd)
(list (syntax-source stx0)
(syntax-line stx0)
@ -297,7 +297,7 @@
;; `done-items' to finish the job
(define-values (line col pos) (port-next-location inp))
(define (make-stx sexpr)
(datum->syntax-object #f
(datum->syntax #f
(if (bytes? sexpr) (bytes->string/utf-8 sexpr) sexpr)
(list source-name line col pos (span-from pos))))
(cond
@ -415,7 +415,7 @@
[#",@" unquote-splicing]))
=> cadr]
[else (internal-error 'get-rprefixes)])])
(loop (cons (datum->syntax-object #f sym
(loop (cons (datum->syntax #f sym
(list source-name line col pos
(span-from pos)))
r))))]
@ -425,7 +425,7 @@
(cond
[start-inside?
(datum->syntax-object #f (get-lines* #f #f #f re:line-item-no-nests #f)
(datum->syntax #f (get-lines* #f #f #f re:line-item-no-nests #f)
(list source-name line-num col-num position (span-from position)))]
[(*skip re:whitespaces)
(read-error* "unexpected whitespace after ~a" ch:command)]
@ -458,7 +458,7 @@
(syntax-property
(if (syntax? stx)
stx
(datum->syntax-object #f stx
(datum->syntax #f stx
(list source-name line-num col-num position
(span-from position))))
'scribble (list 'form ds ls))
@ -470,7 +470,7 @@
(if (null? rpfxs)
stx
(loop (cdr rpfxs) (list (car rpfxs) stx))))])
(datum->syntax-object #f stx
(datum->syntax #f stx
(list source-name line-num col-num position
(span-from position))))]))
@ -496,12 +496,12 @@
;; readtable
(provide make-at-readtable)
(define/kw (make-at-readtable
#:key [readtable (current-readtable)]
[command-char ch:command]
[start-inside? #f]
[datum-readtable #t]
[syntax-post-processor values])
(define (make-at-readtable
#:readtable [readtable (current-readtable)]
#:command-char [command-char ch:command]
#:start-inside? [start-inside? #f]
#:datum-readtable [datum-readtable #t]
#:syntax-post-processor [syntax-post-processor values])
(define dispatcher
(make-dispatcher start-inside? command-char
(lambda () cmd-rt) (lambda () datum-rt)
@ -521,7 +521,7 @@
(unless m
(raise-read-error "unbalanced `|'" source-name
line-num col-num position #f))
(datum->syntax-object
(datum->syntax
#f (string->symbol (bytes->string/utf-8 (cadr m)))
(list source-name line-num col-num position
(add1 (bytes-length (car m)))))))))
@ -535,9 +535,11 @@
at-rt)
(provide use-at-readtable)
(define (use-at-readtable . args)
(port-count-lines! (current-input-port))
(current-readtable (apply make-at-readtable args)))
(define use-at-readtable
(make-keyword-procedure
(lambda (kws kw-args . rest)
(port-count-lines! (current-input-port))
(keyword-apply current-readtable kws kw-args rest))))
;; utilities for below
(define make-default-at-readtable
@ -565,28 +567,29 @@
(parameterize ([current-readtable (make-default-at-readtable)])
body ...)]))
(define/kw (*read #:optional [inp (current-input-port)])
(define (*read [inp (current-input-port)])
(with-at-reader (read inp)))
(define/kw (*read-syntax #:optional [src default-src]
[inp (current-input-port)])
(define (*read-syntax [src default-src]
[inp (current-input-port)])
(with-at-reader (read-syntax (src-name src inp) inp)))
(define/kw (read-inside #:optional [inp (current-input-port)])
(define (read-inside [inp (current-input-port)])
(let*-values ([(line col pos) (port-next-location inp)]
[(inside-dispatcher) (make-default-at-dispatcher/inside)])
(with-at-reader
(syntax-object->datum
(syntax->datum
(inside-dispatcher #f inp (object-name inp) line col pos)))))
(define/kw (read-inside-syntax #:optional [src default-src]
[inp (current-input-port)])
(define (read-inside-syntax [src default-src]
[inp (current-input-port)])
(let*-values ([(line col pos) (port-next-location inp)]
[(inside-dispatcher) (make-default-at-dispatcher/inside)])
(with-at-reader
(inside-dispatcher #f inp (src-name src inp) line col pos))))
(provide (rename *read read) (rename *read-syntax read-syntax)
(provide (rename-out [*read read]
[*read-syntax read-syntax])
read-inside read-inside-syntax)
)

1
collects/scribblings/quick/quick.scrbl
View File

@ -30,7 +30,6 @@
(lambda () (make-element #f (list))))))
@; ----------------------------------------------------------------------
@section{Why Pictures? Why DrScheme?}
This tutorial provides a brief introduction to the PLT Scheme
programming language by using one of its picture-drawing

67
collects/scribblings/scribble/reader.scrbl
View File

@ -757,23 +757,35 @@ Useful for implementing languages that are textual by default (see
@filepath{docreader.ss} for example).
}
@defform[(make-at-readtable [keyword-args ...])]{
@defproc[(make-at-readtable [#:readtable readtable readtable? (current-readtable)]
[#:command-char command-char character? #\@]
[#:start-inside? start-inside? any/c #f]
[#:datum-readtable datum-readtable
(or/c readtable? boolean?
(readtable? . -> . readtable?))
#t]
[#:syntax-post-processor syntax-post-proc (syntax? . -> . syntax?) values])
readtable?]{
Constructs an @"@"-readtable. The keyword arguments can customize the
resulting reader in several ways.
resulting reader in several ways:
@itemize{
@item{@scheme[#:readtable] --- a readtable to base the @"@"-readtable
on. Defaults to the current readtable.}
@item{@scheme[#:command-char] --- the character used for @"@"-forms;
defaults to @scheme[#\@].}
@item{@scheme[#:datum-readtable] --- determines the readtable used for
reading the datum part. The default (@scheme[#t]) is to use the
@item{@scheme[readtable] --- a readtable to base the @"@"-readtable
on.}
@item{@scheme[command-char] --- the character used for @"@"-forms.}
@item{@scheme[datum-readtable] --- determines the readtable used for
reading the datum part. A @scheme[#t] values uses the
@"@"-readtable, otherwise it can be a readtable, or a
readtable-to-readtable function that will construct one from the
@"@"-readtable. The idea is that you may want to have completely
different uses for the datum part, for example, introducing a
convenient @litchar["key=val"] syntax for attributes.}
@item{@scheme[#:syntax-post-processor] --- function that is applied on
@item{@scheme[syntax-post-proc] --- function that is applied on
each resulting syntax value after it has been parsed (but before it
is wrapped quoting punctuations). You can use this to further
control uses of @"@"-forms, for example, making the command be the
@ -786,41 +798,18 @@ resulting reader in several ways.
(syntax-case stx ()
[(cmd rest ...) #'(list 'cmd rest ...)]
[_else (error "@ forms must have a body")])))
]
]}
Beware that the syntax may contain placeholder values at this stage
(e.g: the command part), so you can `plant' your own form that will
do some plain processing later. For example, here's a setup that
uses a @schemeid[mk-] prefix for all command names:
@item{@scheme[start-inside?] --- if true, creates a readtable for
use starting in text mode, instead of S-expression mode.}
@schemeblock[
(use-at-readtable
#:syntax-post-processor
(lambda (stx)
(syntax-case stx ()
[(cmd rest ...) #'(add-mk cmd rest ...)]
[_else (error "@ forms must have a body")])))
(define-syntax (add-mk stx)
(syntax-case stx ()
[(_ cmd rest ...)
(identifier? #'cmd)
(with-syntax ([mk-cmd (datum->syntax-object
#'cmd
(string->symbol
(format "mk-~a" (syntax-e #'cmd)))
#'cmd)])
(syntax/loc stx (mk-cmd rest ...)))]))
]
}
@item{@scheme[#:start-inside?] --- used internally by the above
@schemeid[-inside] variants.}
}}
@defproc[(use-at-readtable ...) void?]{
Installs the Scribble readtable as the default. Useful for REPL
experimentation. (Note: enables line and column tracking.) The given
keyword arguments are used with `make-at-readtable'.
}
Passes all arguments to @scheme[make-at-readtable], and installs the
resulting readtable using @scheme[current-readtable]. It also enables
line counting for the current input-port via @scheme[port-count-lines!].}
@; *** End reader-import section ***
))])]