diff --git a/collects/s-exp/lang/reader.ss b/collects/s-exp/lang/reader.ss index d52664d17e..f89321f4e1 100644 --- a/collects/s-exp/lang/reader.ss +++ b/collects/s-exp/lang/reader.ss @@ -1,26 +1,8 @@ -(module reader scheme/base - - (provide (rename-out [*read read] - [*read-syntax read-syntax])) - - (define (*read in) - (wrap in read)) - - (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))))) +(module reader syntax/module-reader + -ignored- + #:wrapper2 + (lambda (in rd stx?) + (let* ([mod* (rd in)] + [mod (if stx? (syntax->list mod*) mod*)] + [mod `(,(car mod) ,(cadr mod) ,@(cdddr mod))]) + (if stx? (datum->syntax mod* mod) mod)))) diff --git a/collects/scribble/doc/reader.ss b/collects/scribble/doc/reader.ss index 26113a90e7..2e9c33423d 100644 --- a/collects/scribble/doc/reader.ss +++ b/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))))