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

.

Browse Source 
svn: r7789
This commit is contained in:
Jacob Matthews 2007-11-20 20:03:54 +00:00
parent 8007ec59d2
commit 8ca7abe46c
1 changed files with 14 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/planet/lang/reader.ss
View File

@ -19,10 +19,10 @@
(raise-syntax-error 'read "bad version number pair")) (raise-syntax-error 'read "bad version number pair"))
(values (values
`(planet "lang/main.ss" `(planet "lang/main.ss"
(,owner (,owner
,pkgname ,pkgname
,@(if maj `(,maj) '()) ,@(if maj `(,maj) '())
,@(if min `(,min) '()))) ,@(if min `(,min) '())))
(spec->read-data (spec->read-data
`(planet "lang/reader.ss" `(planet "lang/reader.ss"
(,owner (,owner
@ -31,19 +31,18 @@
,@(if min `(,min) '()))))))))) ,@(if min `(,min) '())))))))))
(define (wrap port spec body) (define (wrap port spec body)
(let* ([p-name (object-name port)] (let* ([p-name (object-name port)]
[name (if (path? p-name) [name (if (path? p-name)
(let-values ([(base name dir?) (split-path p-name)]) (let-values ([(base name dir?) (split-path p-name)])
(string->symbol (path->string (path-replace-suffix name #"")))) (string->symbol (path->string (path-replace-suffix name #""))))
'page)] 'page)])
[id 'doc]) `(module ,name ,spec
`(module ,name ,spec ,body)))
,body)))
(define (planet-read [inp (current-input-port)]) (define (planet-read [inp (current-input-port)])
(define-values (spec r) (planet-read-fn inp (λ (spec) (dynamic-require spec 'read)))) (define-values (spec r) (planet-read-fn inp (λ (spec) (dynamic-require spec 'read))))
(wrap inp spec (r inp))) (wrap inp spec (r inp)))
(define (planet-read-syntax [src #f] [port (current-input-port)]) (define (planet-read-syntax [src #f] [inp (current-input-port)])
(define-values (spec r) (planet-read-fn port (λ (spec) (dynamic-require spec 'read-syntax)))) (define-values (spec r) (planet-read-fn inp (λ (spec) (dynamic-require spec 'read-syntax))))
(wrap port spec (r src port))) (wrap inp spec (r src inp)))