make serialization work right when a module is dynamic-required using a (non-string) path

svn: r2321
This commit is contained in:
Matthew Flatt 2006-02-26 17:45:37 +00:00
parent c34a75443e
commit d9e3e1e267
3 changed files with 39 additions and 17 deletions

View File

@ -423,6 +423,18 @@
(void? v)
(date? v)
(arity-at-least? v)))
;; If a module is dynamic-required through a path,
;; then it can cause simplified module paths to be paths;
;; keep the literal path, but marshal it to bytes.
(define (protect-path p)
(if (path? p)
(path->bytes p)
p))
(define (unprotect-path p)
(if (bytes? p)
(bytes->path p)
p))
(define (mod-to-id info mod-map cache)
(let ([deserialize-id (serialize-info-deserialize-id info)])
@ -438,10 +450,11 @@
(and (list? b)
(if (symbol? (caddr b))
(caddr b)
(collapse-module-path-index
(caddr b)
`(file ,(build-path (serialize-info-dir info)
"here.ss")))))
(protect-path
(collapse-module-path-index
(caddr b)
(build-path (serialize-info-dir info)
"here.ss")))))
(syntax-e deserialize-id)))]
[(symbol? deserialize-id)
(cons #f deserialize-id)]
@ -449,10 +462,11 @@
(cons
(if (symbol? (cdr deserialize-id))
(cdr deserialize-id)
(collapse-module-path-index
(cdr deserialize-id)
`(file ,(build-path (serialize-info-dir info)
"here.ss"))))
(protect-path
(collapse-module-path-index
(cdr deserialize-id)
(build-path (serialize-info-dir info)
"here.ss"))))
(car deserialize-id))])])
(hash-table-get
mod-map path+name
@ -818,7 +832,8 @@
(unless (null? l)
(let* ([path+name (car l)]
[des (if (car path+name)
(dynamic-require (car path+name) (cdr path+name))
(dynamic-require (unprotect-path (car path+name))
(cdr path+name))
(namespace-variable-value (cdr path+name)))])
;; Register maker and struct type:
(vector-set! mod-map n des))

View File

@ -337,10 +337,10 @@ currently exist).
`ext-proc' is #f.
> (resolve-module-path module-path-v rel-to-path-string/thunk/#f) -
resolves a module path to filename path. The module path is
resolved relative to `rel-to-path-string/thunk/#f' if it is a string
(a filename path), to the directory result of calling the thunk if
it is a thunk, or to the current directory otherwise.
resolves a module path to filename path. The module path is resolved
relative to `rel-to-path-string/thunk/#f' if it is a path string, to
the directory result of calling the thunk if it is a thunk, or to
the current directory otherwise.
> (resolve-module-path-index module-path-index rel-to-path-string/thunk/#f)
- like `resolve-module-path' but the input is a module path index
@ -353,8 +353,13 @@ currently exist).
> (collapse-module-path module-path-v rel-to-module-path-v) - returns
a "simplified" module path by combining `module-path-v' with
`rel-to-module-path', where the latter must have the form '(lib
<relative-path> <collection>), '(file <path>), a relative path, or a
thunk to generate one of those.
<relative-path> <collection>), '(file <string>), a path, or a thunk
to generate one of those.
The result can be a path if `module-path-v' contains a path element
that is needed for the result, or if `rel-to-module-path-v' is a
non-string path that is needed for the result; otherwise, the result
is a printable "quoted" module path.
> (collapse-module-path-index module-path-index rel-to-module-path-v)
- like `collapse-module-path', but the input is a module path index

View File

@ -294,7 +294,7 @@
(define collapse-module-path
;; relto-mp should be a relative path, '(lib relative-path collection), or '(file path)
;; of a thunk that produces one of those
;; or a thunk that produces one of those
(lambda (s relto-mp)
(let ([combine-relative-elements
(lambda (elements)
@ -302,7 +302,9 @@
(set! relto-mp (relto-mp)))
(cond
[(path-string? relto-mp)
(bytes->string/locale
((if (path? relto-mp)
bytes->path
bytes->string/locale)
(apply
bytes-append
(let ([m (regexp-match re:path-only (if (path? relto-mp)