fix raco setup handling of info.rkt by adding a namespace argument to get-info

This commit is contained in:
Matthew Flatt 2010-05-06 07:21:54 -06:00
parent c13d65d23d
commit 6027eb9627
3 changed files with 24 additions and 17 deletions

View File

@ -984,15 +984,17 @@ An @deftech{unpackable} is one of the following:
provides functions for accessing fields in @filepath{info.rkt}
files.}
@defproc[(get-info (collection-names (listof string?)))
@defproc[(get-info [collection-names (listof string?)]
[#:namespace namespace (or/c namespace? #f) #f])
(or/c
(symbol? [(-> any)] . -> . any)
false/c)]{
Accepts a list of strings naming a collection or sub-collection,
and calls @racket[get-info/full] with the full path corresponding to the
named collection.}
named collection and the @scheme[namespace] argument.}
@defproc[(get-info/full (path path?))
@defproc[(get-info/full [path path?]
[#:namespace namespace (or/c namespace? #f) #f])
(or/c
(symbol? [(-> any)] . -> . any)
false/c)]{
@ -1010,16 +1012,20 @@ An @deftech{unpackable} is one of the following:
case. If the name is not defined and no @racket[_thunk] is
provided, then an exception is raised.
@racket[get-info/full] returns @racket[#f] if there is
no @filepath{info.rkt} or @filepath{info.rkt} file in the directory. If there is a
@filepath{info.rkt} file that has the wrong shape (i.e., not a module
The @racket[get-info/full] function returns @racket[#f] if there is
no @filepath{info.rkt} or @filepath{info.ss} file in the directory. If there is a
@filepath{info.rkt} (or @filepath{info.ss}) file that has the wrong shape (i.e., not a module
using @racketmodname[setup/infotab] or @racket[(lib "infotab.rkt" "setup")]),
or if the @filepath{info.rkt} file fails to load, then an exception
is raised. If the @filepath{info.rkt} file loaded, @racket[get-info/full]
returns the @racket[get-info] file. If the @filepath{info.rkt} file does not exist,
then @racket[get-info/full] does
the same checks for the @filepath{info.rkt} file, either raising an exception
or returning the @racket[get-info] function from the @filepath{info.rkt} file.}
or returning the @racket[get-info] function from the @filepath{info.rkt} file.
The @filepath{info.rkt} (or @filepath{info.ss}) module is loaded
into @scheme[namespace] if it is not @scheme[#f], or a private,
weakly-held namespace otherwise.}
@defproc[(find-relevant-directories
(syms (listof symbol?))

View File

@ -8,10 +8,11 @@
(define user-infotable (get-planet-cache-path))
;; get-info : (listof path-or-string) -> info/#f
(define (get-info coll-path)
(define (get-info coll-path #:namespace [ns #f])
(get-info/full (apply collection-path
(map (lambda (x) (if (path? x) (path->string x) x))
coll-path))))
coll-path))
#:namespace ns))
;; HACK:
;; This require is not used. It just requires the file, since
@ -24,11 +25,11 @@
(require (prefix-in !!!HACK!!! setup/infotab/lang/reader))
;; get-info/full : path -> info/#f
(define (get-info/full dir)
(or (get-info/full/ext dir "rkt")
(get-info/full/ext dir "ss")))
(define (get-info/full dir #:namespace [ns #f])
(or (get-info/full/ext dir "rkt" ns)
(get-info/full/ext dir "ss" ns)))
(define (get-info/full/ext dir ext)
(define (get-info/full/ext dir ext ns)
(define file (build-path dir (format "info.~a" ext)))
(define (err fmt . args)
(apply error 'get-info (string-append "info file " fmt " in ~a")
@ -60,7 +61,7 @@
;; that is required).
;; We are, however, trusting that the bytecode form of the
;; file (if any) matches the source.
(parameterize ([current-namespace (info-namespace)])
(parameterize ([current-namespace (or ns (info-namespace))])
(dynamic-require file '#%info-lookup))]
[else (err "does not contain a module of the right shape")])))
@ -201,8 +202,8 @@
(provide/contract
(reset-relevant-directories-state! (-> any))
(get-info ((listof path-or-string?) . -> . (or/c info? boolean?)))
(get-info/full (path? . -> . (or/c info? boolean?)))
(get-info (((listof path-or-string?)) (#:namespace (or/c namespace? #f)) . ->* . (or/c info? boolean?)))
(get-info/full ((path?) (#:namespace (or/c namespace? #f)) . ->* . (or/c info? boolean?)))
(find-relevant-directories
(->* [(listof symbol?)]
[(lambda (x) (memq x '(preferred all-available)))]

View File

@ -41,7 +41,7 @@
[current-compile compile]
[current-load/use-compiled loader]
[use-compiled-file-paths paths])
(get-info/full path)))))
(get-info/full path #:namespace ns)))))
(provide setup@)