New `make-at-reader' in the API, update docs, adapt tests.

svn: r15121

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

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 ***
 ))]))

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