summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-09 00:41:22 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-09 00:41:22 +0200
commit61cb8d659399a942fa74947749b3a23a88bda04f (patch)
treed46de44105698f7dcf06940455fdd706aea8c271
parente9b0f1aaa810c15dbdffc4147f2956851c4f1782 (diff)
downloadgeiser-chez-61cb8d659399a942fa74947749b3a23a88bda04f.tar.gz
geiser-chez-61cb8d659399a942fa74947749b3a23a88bda04f.tar.bz2
Racket: improvements in non-loaded module location.
-rw-r--r--scheme/racket/geiser/modules.rkt42
1 files changed, 29 insertions, 13 deletions
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 299baee..5022891 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -27,7 +27,7 @@
[(not (string? spec)) #f]
[else `(file ,spec)]))
-(define (module-spec->namespace spec (lang #f))
+(define (module-spec->namespace spec (lang #f) (no-current #f))
(let ([spec (ensure-module-spec spec)]
[try-lang (lambda (_)
(with-handlers ([exn? (const (current-namespace))])
@@ -37,7 +37,7 @@
(module->namespace lang)))))])
(or (and spec
(with-handlers ([exn? try-lang]) (get-namespace spec)))
- (current-namespace))))
+ (if no-current #f (current-namespace)))))
(define nowhere (open-output-nowhere))
@@ -54,22 +54,24 @@
(resolved-module-path-name rmp))))
(define (module-spec->path-name spec)
- (with-handlers ([exn? (lambda (_) #f)])
- (let ([ns (module-spec->namespace (ensure-module-spec spec))])
- (namespace->module-path-name ns))))
+ (and (symbol? spec)
+ (or (get-path spec)
+ (register-path spec
+ (namespace->module-path-name
+ (module-spec->namespace spec) #f #t)))))
(define (module-path-name->name path)
(cond [(path? path)
- (let* ((path (path->string path))
- (cpaths (map (compose path->string path->directory-path)
- (current-library-collection-paths)))
- (prefix-len (lambda (p)
+ (let* ([path (path->string path)]
+ [cpaths (map (compose path->string path->directory-path)
+ (current-library-collection-paths))]
+ [prefix-len (lambda (p)
(let ((pl (string-length p)))
(if (= pl (string-prefix-length p path))
pl
- 0))))
- (lens (map prefix-len cpaths))
- (real-path (substring path (apply max lens))))
+ 0)))]
+ [lens (map prefix-len cpaths)]
+ [real-path (substring path (apply max lens))])
(if (absolute-path? real-path)
(call-with-values (lambda () (split-path path))
(lambda (_ basename __) (path->string basename)))
@@ -97,7 +99,12 @@
(define (visit-module-path path kind acc)
(case kind
[(file) (let ((entry (path->entry path)))
- (if entry (cons entry acc) acc))]
+ (if (not entry)
+ acc
+ (begin
+ (register-path (string->symbol entry)
+ (build-path (current-directory) path))
+ (cons entry acc))))]
[(dir) (cond ((skippable-dir? path) (values acc #f))
((or (file-exists? (build-path path "main.rkt"))
(file-exists? (build-path path "main.ss")))
@@ -114,7 +121,16 @@
(define (known-modules)
(sort (foldl find-modules '() (current-library-collection-paths)) string<?))
+(define registered (make-hash))
+
+(define (get-path mod) (hash-ref registered mod #f))
+
+(define (register-path mod path)
+ (hash-set! registered mod path)
+ path)
+
(define module-cache #f)
+
(define (update-module-cache)
(when (not module-cache) (set! module-cache (known-modules))))