[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/geiser-racket 26ba1f2 011/191: Racket: improvements in mod
From: |
Philip Kaludercic |
Subject: |
[nongnu] elpa/geiser-racket 26ba1f2 011/191: Racket: improvements in module lookups. |
Date: |
Sun, 1 Aug 2021 18:31:50 -0400 (EDT) |
branch: elpa/geiser-racket
commit 26ba1f28d366627aed5345709518404477b215ad
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>
Racket: improvements in module lookups.
- We now correctly register submodules and handle main files.
- We contemplate the possibility that a module is accessed using
different paths.
---
geiser/enter.rkt | 48 +++++++++++++++++++++++++++++++++++++++++++-----
geiser/modules.rkt | 47 +++++++++++++++++++++++------------------------
2 files changed, 66 insertions(+), 29 deletions(-)
diff --git a/geiser/enter.rkt b/geiser/enter.rkt
index 9705ec3..dbad12b 100644
--- a/geiser/enter.rkt
+++ b/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/geiser/modules.rkt b/geiser/modules.rkt
index 5022891..0ab372a 100644
--- a/geiser/modules.rkt
+++ b/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)
- [nongnu] branch elpa/geiser-racket created (now 22e56ce), Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket ac0f055 002/191: Racket: PLT implementation renamed to Racket., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 6b02ac9 019/191: Truncating lines in documentation browser., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 0a35180 024/191: Racket: better stack traces using errortrace, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 45fdb13 003/191: Elisp: misc little bugs (revealed by the byte compiler) fixed., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 54d4b8d 017/191: Racket: indentation for typed binding forms., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 7f8b4b7 014/191: Better switch/import REPL commands., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 7a16f5a 012/191: Racket: using `_' for naming unknown args in autodoc., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 130c38e 028/191: Racket: support for gracket-text, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket cd122ff 021/191: Tweaks to scheme implementation selection, and docs for it., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 26ba1f2 011/191: Racket: improvements in module lookups.,
Philip Kaludercic <=
- [nongnu] elpa/geiser-racket c03596d 013/191: Wee refactoring., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket c6c6bba 026/191: Support for evaluation warnings, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket c07a42d 034/191: Racket: using meta-commands instead of dynamic-require (#30347), Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket d8076a5 029/191: Couple nits, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket de36aed 027/191: Better REPL exit command, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 15cb8fb 006/191: Racket: providing error contexts, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 739aaec 010/191: Racket: improvements in non-loaded module location., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 912e318 020/191: Racket: catching errors during contract retrieval., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket b53aba6 036/191: Racket: , eval -> , geiser-eval, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/geiser-racket 2ef38a5 037/191: Racket: , eval -> , geiser-eval, Philip Kaludercic, 2021/08/01