summaryrefslogtreecommitdiff
path: root/scheme/racket
diff options
context:
space:
mode:
Diffstat (limited to 'scheme/racket')
-rw-r--r--scheme/racket/geiser/enter.rkt48
-rw-r--r--scheme/racket/geiser/modules.rkt47
2 files changed, 66 insertions, 29 deletions
diff --git a/scheme/racket/geiser/enter.rkt b/scheme/racket/geiser/enter.rkt
index 9705ec3..dbad12b 100644
--- a/scheme/racket/geiser/enter.rkt
+++ b/scheme/racket/geiser/enter.rkt
@@ -12,11 +12,12 @@
#lang racket/base
(require syntax/modcode
- (for-syntax scheme/base))
+ (for-syntax racket/base)
+ racket/path)
(provide get-namespace enter-module module-loader module-loaded?)
-(struct mod (name timestamp depends))
+(struct mod (name load-path timestamp depends))
(define loaded (make-hash))
@@ -39,8 +40,44 @@
(define inhibit-eval (make-parameter #f))
(define (get-namespace mod)
- (parameterize ([inhibit-eval #t])
- (module->namespace mod)))
+ (let ([mod (cond [(symbol? mod) mod]
+ [(string? mod) (find-module! (string->path mod) mod)]
+ [(path? mod) (find-module! mod (path->string mod))]
+ [else mod])])
+ (and mod
+ (with-handlers ([exn? (lambda (_) #f)])
+ (parameterize ([inhibit-eval #t])
+ (module->namespace mod))))))
+
+(define (find-module! path path-str)
+ (let ([m (or (hash-ref loaded path #f)
+ (let loop ([ps (remove path (resolve-paths path))]
+ [seen '()])
+ (cond [(null? ps) #f]
+ [(hash-ref loaded (car ps) #f) =>
+ (lambda (m)
+ (add-paths! m (cdr ps))
+ (add-paths! m (cons path seen))
+ m)]
+ [else (loop (cdr ps) (cons (car ps) seen))])))])
+ (list 'file (or (and m (mod-load-path m)) path-str))))
+
+(define (add-paths! m ps)
+ (for-each (lambda (p) (hash-set! loaded p m)) ps))
+
+(define (resolve-paths path)
+ (define (find root rest)
+ (let* ([alt-root (resolve-path root)]
+ [same? (equal? root alt-root)])
+ (cond [(null? rest) (cons root (if same? '() `(,alt-root)))]
+ [else (let* ([c (car rest)]
+ [cs (cdr rest)]
+ [rps (find (build-path root c) cs)])
+ (if same?
+ rps
+ (append rps (find (build-path alt-root c) cs))))])))
+ (let ([cmps (explode-path path)])
+ (find (car cmps) (cdr cmps))))
(define ((enter-load/use-compiled orig re?) path name)
(when (inhibit-eval)
@@ -61,13 +98,14 @@
(current-directory)))))])
;; Record module timestamp and dependencies:
(let ([m (mod name
+ (path->string path)
(get-timestamp path)
(if code
(apply append
(map cdr
(module-compiled-imports code)))
null))])
- (hash-set! loaded path m))
+ (add-paths! m (resolve-paths path)))
;; Evaluate the module:
(eval code))
;; Not a module:
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 5022891..0ab372a 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -27,17 +27,15 @@
[(not (string? spec)) #f]
[else `(file ,spec)]))
-(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))])
- (and lang
- (begin
- (load-module lang #f (current-namespace))
- (module->namespace lang)))))])
- (or (and spec
- (with-handlers ([exn? try-lang]) (get-namespace spec)))
- (if no-current #f (current-namespace)))))
+(define (module-spec->namespace spec (lang #f) (current #t))
+ (define (try-lang)
+ (and lang
+ (with-handlers ([exn? (const #f)])
+ (load-module lang #f (current-namespace))
+ (module->namespace lang))))
+ (or (get-namespace spec)
+ (try-lang)
+ (and current (current-namespace))))
(define nowhere (open-output-nowhere))
@@ -58,7 +56,7 @@
(or (get-path spec)
(register-path spec
(namespace->module-path-name
- (module-spec->namespace spec) #f #t)))))
+ (module-spec->namespace spec) #f #f)))))
(define (module-path-name->name path)
(cond [(path? path)
@@ -92,24 +90,25 @@
(let ([ext (filename-extension path)])
(and ext
(or (bytes=? ext #"rkt") (bytes=? ext #"ss"))
+ (not (bytes=? (bytes-append #"main" ext) (path->bytes path)))
(let* ([path (path->string path)]
[len (- (string-length path) (bytes-length ext) 1)])
(substring path 0 len)))))
(define (visit-module-path path kind acc)
+ (define (register e p)
+ (register-path (string->symbol e) (build-path (current-directory) p))
+ (cons e acc))
+ (define (find-main ext)
+ (let ([m (build-path path (string-append "main." ext))])
+ (and (file-exists? m) m)))
(case kind
- [(file) (let ((entry (path->entry path)))
- (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")))
- (cons (path->string path) acc))
- (else acc))]
+ [(file) (let ([entry (path->entry path)])
+ (if (not entry) acc (register entry path)))]
+ [(dir) (cond [(skippable-dir? path) (values acc #f)]
+ [(or (find-main "rkt") (find-main "ss")) =>
+ (curry register (path->string path))]
+ [else acc])]
[else acc]))
(define (find-modules path acc)