From 4240ac8cfc99fed7b4c453b767936b70633da49d Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 8 Jun 2009 16:43:01 +0000 Subject: [PATCH] New `make-at-reader' in the API, update docs, adapt tests. svn: r15121 --- collects/scribble/reader.ss | 65 ++++++++++++++++------ collects/scribblings/scribble/reader.scrbl | 24 +++++++- collects/tests/scribble/reader.ss | 29 +++++++--- 3 files changed, 92 insertions(+), 26 deletions(-) diff --git a/collects/scribble/reader.ss b/collects/scribble/reader.ss index a7e58fc825..e3539b4e49 100644 --- a/collects/scribble/reader.ss +++ b/collects/scribble/reader.ss @@ -508,14 +508,20 @@ (get-datum-readtable) syntax-post-processor))) ;; ---------------------------------------------------------------------------- -;; readtable - -(provide make-at-readtable make-at-reader/inside) +;; minor utilities for the below (define default-src (gensym 'scribble-reader)) (define (src-name src port) (if (eq? src default-src) (object-name port) src)) +(define-syntax-rule (named-lambda (name . args) . body) + (let ([name (lambda args . body)]) name)) + +;; ---------------------------------------------------------------------------- +;; readtable and reader + +(provide make-at-readtable make-at-reader) + (define ((make-at-readtable-or-inside-reader inside-reader?) readtable command-char datum-readtable syntax-post-processor) (define dispatcher @@ -525,11 +531,12 @@ (define dispatcher (make-dispatcher #t command-char (lambda () cmd-rt) (lambda () datum-rt) syntax-post-processor)) - (define (inside-reader [src default-src] [inp (current-input-port)]) + ;; use a name consistent with `make-at-reader' + (named-lambda (at-read-syntax/inside [src default-src] + [inp (current-input-port)]) (define-values [line col pos] (port-next-location inp)) (parameterize ([current-readtable at-rt]) - (dispatcher #f inp (src-name src inp) line col pos))) - inside-reader) + (dispatcher #f inp (src-name src inp) line col pos)))) (define at-rt (make-readtable readtable command-char 'non-terminating-macro dispatcher)) (define cmd-rt @@ -560,20 +567,43 @@ (if inside-reader? (make-inside-reader) at-rt)) (define (make-at-readtable - #:readtable [readtable (current-readtable)] - #:command-char [command-char ch:command] - #:datum-readtable [datum-readtable #t] + #:readtable [readtable (current-readtable)] + #:command-char [command-char ch:command] + #:datum-readtable [datum-readtable #t] #:syntax-post-processor [syntax-post-processor values]) ((make-at-readtable-or-inside-reader #f) readtable command-char datum-readtable syntax-post-processor)) -(define (make-at-reader/inside - #:readtable [readtable (current-readtable)] - #:command-char [command-char ch:command] - #:datum-readtable [datum-readtable #t] - #:syntax-post-processor [syntax-post-processor values]) - ((make-at-readtable-or-inside-reader #t) - readtable command-char datum-readtable syntax-post-processor)) +(define (make-at-reader + #:readtable [readtable (current-readtable)] + #:command-char [command-char ch:command] + #:datum-readtable [datum-readtable #t] + #:syntax-post-processor [syntax-post-processor values] + #:syntax? [syntax-reader? #t] + #:inside? [inside-reader? #f]) + (let ([r ((make-at-readtable-or-inside-reader inside-reader?) + readtable command-char datum-readtable syntax-post-processor)]) + ;; the result can be a readtable or a syntax reader, depending on inside?, + ;; convert it now to the appropriate reader + (if inside-reader? + ;; if it's a function, then it already is a syntax reader, convert it to + ;; a plain reader if needed (note: this only happens when r is a reader) + (if syntax-reader? + r + (named-lambda (at-read/inside [in (current-input-port)]) + ;; can't be eof, since it returns a list of expressions (as a syntax) + (syntax->datum (r (object-name in) in)))) + ;; if it's a readtable, then just wrap the standard functions + (if syntax-reader? + (named-lambda (at-read-syntax [src default-src] + [inp (current-input-port)]) + (parameterize ([current-readtable r]) + (read-syntax src inp))) + (named-lambda (at-read [inp (current-input-port)]) + (parameterize ([current-readtable r]) + (let ([r (read-syntax (object-name inp) inp)]) + ;; it might be eof + (if (syntax? r) (syntax->datum r) r)))))))) (provide use-at-readtable) (define use-at-readtable @@ -587,7 +617,8 @@ (define make-default-at-readtable (readtable-cached (lambda (rt) (make-at-readtable #:readtable rt)))) (define make-default-at-reader/inside - (readtable-cached (lambda (rt) (make-at-reader/inside #:readtable rt)))) + (readtable-cached + (lambda (rt) (make-at-reader #:inside? #t #:readtable rt)))) ;; ---------------------------------------------------------------------------- ;; readers diff --git a/collects/scribblings/scribble/reader.scrbl b/collects/scribblings/scribble/reader.scrbl index f0e5df5882..7112b862d3 100644 --- a/collects/scribblings/scribble/reader.scrbl +++ b/collects/scribblings/scribble/reader.scrbl @@ -879,7 +879,7 @@ provides direct Scribble reader functionality for advanced needs.} (or/c syntax? eof-object?)]{ These procedures implement the Scribble reader. They do so by constructing a reader table based on the current one, and using that -in reading. +for reading. } @defproc[(read-inside [in input-port? (current-input-port)]) any]{} @@ -939,11 +939,31 @@ resulting reader in several ways: ]} +@defproc[(make-at-reader [#:syntax? syntax? #t] [#:inside? inside? #f] ...) + procedure?]{ +Constructs a variant of a @"@"-readtable. The arguments are the same +as in @scheme[make-at-readtable], with two more that determine the +kind of reader function that will be created: @scheme[syntax?] chooses +between a @scheme[read]- or @scheme[read-syntax]-like function, and +@scheme[inside?] chooses a plain reader or an @schemeid[-inside] +variant. + +Note that the resulting function has a different contract and action +based on these inputs. The expected inputs are as in @scheme[read] or +@scheme[read-syntax] depending on @scheme[syntax?]; the function will +read a single expression or, if @scheme[inside?] is true, the whole +input; it will return a syntactic list of expressions rather than a +single one in this case. + +Note also that @scheme[syntax] defaults to @scheme[#t].} + @defproc[(use-at-readtable ...) void?]{ 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!].} +line counting for the current input-port via @scheme[port-count-lines!]. + +This is mostly useful for playing with the Scribble syntax on the REPL.} @; *** End reader-import section *** ))])) diff --git a/collects/tests/scribble/reader.ss b/collects/tests/scribble/reader.ss index 968d6c1990..c84ded7372 100644 --- a/collects/tests/scribble/reader.ss +++ b/collects/tests/scribble/reader.ss @@ -727,6 +727,25 @@ foo -@e-> "foo\n bar" --- +;; -------------------- empty input tests +--- + +-@-> + +--- + +-@i-> + +--- + +-\-> + +--- + +-\i-> + +--- + END-OF-TESTS ) @@ -743,14 +762,10 @@ END-OF-TESTS (let ([x (reader i)]) (if (eof-object? x) '() (cons x (loop))))))) -(define (read/BS i) - (parameterize ([current-readtable - (scr:make-at-readtable #:command-char #\\)]) - (read i))) +(define read/BS (scr:make-at-reader #:command-char #\\ #:syntax? #f)) -(define (read-inside/BS i) - (syntax->datum ((scr:make-at-reader/inside #:command-char #\\) - (object-name i) i))) +(define read-inside/BS + (scr:make-at-reader #:inside? #t #:command-char #\\ #:syntax? #f)) (define (x . -@-> . y) (values (read-all x scr:read) (read-all y read)))