set appripriate reader parameters for info.ss and .sxref files

svn: r11349
This commit is contained in:
Matthew Flatt 2008-08-20 01:15:22 +00:00
parent d1d68c1aed
commit 9137d5367e
2 changed files with 10 additions and 5 deletions

View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require scheme/match scheme/contract planet/cachepath) (require scheme/match scheme/contract planet/cachepath syntax/modread)
;; in addition to infodomain/compiled/cache.ss, getinfo will look in this ;; in addition to infodomain/compiled/cache.ss, getinfo will look in this
;; file to find mappings. PLaneT uses this to put info about installed ;; file to find mappings. PLaneT uses this to put info about installed
@ -29,9 +29,10 @@
x)]) x)])
(with-input-from-file file (with-input-from-file file
(lambda () (lambda ()
(begin0 (read) (begin0
(unless (eof-object? (read)) (with-module-reading-parameterization read)
(err "has multiple expressions"))))))) (unless (eof-object? (read))
(err "has multiple expressions")))))))
(and (file-exists? file) (and (file-exists? file)
(match (contents) (match (contents)
[(list 'module 'info [(list 'module 'info

View File

@ -10,6 +10,7 @@
scheme/file scheme/file
scheme/fasl scheme/fasl
scheme/serialize scheme/serialize
syntax/modread
scribble/base-render scribble/base-render
scribble/struct scribble/struct
scribble/basic scribble/basic
@ -323,6 +324,9 @@
(define (read-out-sxref) (define (read-out-sxref)
(fasl->s-exp (current-input-port))) (fasl->s-exp (current-input-port)))
(define (normalized-read)
(with-module-reading-parameterization read))
(define (make-sci-cached sci info-out-file setup-printf) (define (make-sci-cached sci info-out-file setup-printf)
(when (verbose) (when (verbose)
(fprintf (current-error-port) " [Lazy ~a]\n" info-out-file)) (fprintf (current-error-port) " [Lazy ~a]\n" info-out-file))
@ -395,7 +399,7 @@
auto-user? with-record-error auto-user? with-record-error
setup-printf) setup-printf)
doc))]) doc))])
(let* ([v-in (with-input-from-file info-in-file read)] (let* ([v-in (with-input-from-file info-in-file normalized-read)]
[v-out (with-input-from-file info-out-file read-out-sxref)]) [v-out (with-input-from-file info-out-file read-out-sxref)])
(unless (and (equal? (car v-in) (list vers (doc-flags doc))) (unless (and (equal? (car v-in) (list vers (doc-flags doc)))
(equal? (car v-out) (list vers (doc-flags doc)))) (equal? (car v-out) (list vers (doc-flags doc))))