All readers now use syntax/module-reader

svn: r11506

collects/s-exp/lang/reader.ss

@@ -1,26 +1,8 @@
-(module reader scheme/base
+(module reader syntax/module-reader
-
+  -ignored-
-  (provide (rename-out [*read read]
+  #:wrapper2
-                       [*read-syntax read-syntax]))
+  (lambda (in rd stx?)
-  
+    (let* ([mod* (rd in)]
-  (define (*read in)
+           [mod  (if stx? (syntax->list mod*) mod*)]
-    (wrap in read))
+           [mod  `(,(car mod) ,(cadr mod) ,@(cdddr mod))])
-  
+      (if stx? (datum->syntax mod* mod) mod))))
-  (define (*read-syntax src in)
-    (wrap in (lambda (in)
-               (read-syntax src in))))
-  
-  (define (wrap port read)
-    (let ([body
-           (let loop ([a null])
-             (let ([v (read port)])
-               (if (eof-object? v)
-                   (reverse a)
-                   (loop (cons v a)))))])
-      (let* ([p-name (object-name port)]
-             [name (if (path? p-name)
-                       (let-values ([(base name dir?) (split-path p-name)])
-                         (string->symbol (path->string (path-replace-suffix name #""))))
-                       'page)]
-             [id 'doc])
-        `(module ,name . ,body)))))

collects/scribble/doc/reader.ss

@@ -1,22 +1,23 @@
-#lang scheme/base
+#lang s-exp syntax/module-reader
+
+scribble/doclang
+
+;; `read-inside' reads the whole body, so make wrapper1 return null so
+;; we get the right syntax, and then make wrapper2 do the actual
+;; reading.  This might seem extreme, but I think that it's still
+;; better to use module-reader for the subtleties it deals with.
+
+#:wrapper1 (lambda (t) '())
+
+#:wrapper2
+(lambda (in read stx?)
+  (let* ([skeleton (read in)]
+         [skeleton (if stx? (syntax->list skeleton) skeleton)]
+         [body (if stx?
+                 (scribble:read-syntax-inside (object-name in) in)
+                 (scribble:read-inside in))]
+         [mod  `(,(car skeleton) ,(cadr skeleton) ,(caddr skeleton)
+                 (#%module-begin doc () . ,body))])
+    (if stx? (datum->syntax #f mod) mod)))
 
 (require (prefix-in scribble: "../reader.ss"))
-
-(provide (rename-out [*read read])
-         (rename-out [*read-syntax read-syntax]))
-
-(define (*read [inp (current-input-port)])
-  (wrap inp (scribble:read-inside inp)))
-
-(define (*read-syntax [src #f] [port (current-input-port)])
-  (wrap port (scribble:read-syntax-inside src port)))
-
-(define (wrap port body)
-  (let* ([p-name (object-name port)]
-         [name (if (path? p-name)
-                 (let-values ([(base name dir?) (split-path p-name)])
-                   (string->symbol (path->string (path-replace-suffix name #""))))
-                 'page)]
-         [id 'doc])
-    `(module ,name scribble/doclang
-       (#%module-begin ,id () . ,body))))