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

committing sam th's fix

Browse Source 
svn: r7788
This commit is contained in:
Jacob Matthews 2007-11-20 19:59:44 +00:00
parent 34a5cdf8ed
commit 8007ec59d2
1 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,14 +17,33 @@
(raise-syntax-error 'read "bad min")) (raise-syntax-error 'read "bad min"))
(unless (or maj (not min)) (unless (or maj (not min))
(raise-syntax-error 'read "bad version number pair")) (raise-syntax-error 'read "bad version number pair"))
(spec->read-data (values
`(planet "lang/reader.ss" `(planet "lang/main.ss"
(,owner (,owner
,pkgname ,pkgname
,@(if maj `(,maj) '()) ,@(if maj `(,maj) '())
,@(if min `(,min) '())))))))) ,@(if min `(,min) '())))
(spec->read-data
(define (planet-read in) `(planet "lang/reader.ss"
(planet-read-fn in (λ (spec) ((dynamic-require spec 'read) in)))) (,owner
(define (planet-read-syntax srcname in) ,pkgname
(planet-read-fn in (λ (spec) ((dynamic-require spec 'read-syntax) srcname in)))) ,@(if maj `(,maj) '())
,@(if min `(,min) '())))))))))
(define (wrap port spec 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 ,spec
,body)))
(define (planet-read [inp (current-input-port)])
(define-values (spec r) (planet-read-fn inp (λ (spec) (dynamic-require spec 'read))))
(wrap inp spec (r inp)))
(define (planet-read-syntax [src #f] [port (current-input-port)])
(define-values (spec r) (planet-read-fn port (λ (spec) (dynamic-require spec 'read-syntax))))
(wrap port spec (r src port)))