summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2013-06-09 00:47:28 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2013-06-09 00:47:28 +0200
commit2c72e754cc0f988056c0cae2c7a35fedccf02c2b (patch)
treea036f4cc27e1f686a4eeee4c081d76b42e378dc8
parentc548baba9c4c708f697dfde9c33c2fb92f707e93 (diff)
downloadgeiser-chez-2c72e754cc0f988056c0cae2c7a35fedccf02c2b.tar.gz
geiser-chez-2c72e754cc0f988056c0cae2c7a35fedccf02c2b.tar.bz2
racket: handling correctly submodules in load handler during ,enter
That is, complying to the submodule loading protocol (cf. racket's own enter!).
-rw-r--r--scheme/racket/geiser/enter.rkt39
1 files changed, 24 insertions, 15 deletions
diff --git a/scheme/racket/geiser/enter.rkt b/scheme/racket/geiser/enter.rkt
index 6da8c7a..aadf5af 100644
--- a/scheme/racket/geiser/enter.rkt
+++ b/scheme/racket/geiser/enter.rkt
@@ -84,25 +84,34 @@
(define (notify re? path)
(when re? (fprintf (current-error-port) " [re-loading ~a]\n" path)))
+(define (module-name? name)
+ (and name (not (and (pair? name) (not (car name))))))
+
(define ((enter-load/use-compiled orig re?) path name)
(when (inhibit-eval)
(raise (make-exn:fail "namespace not found" (current-continuation-marks))))
- ;; (printf "Loading ~s: ~s~%" name path)
- (if (and name (not (list? name)))
+ (printf "Loading ~s: ~s~%" name path)
+ (if (module-name? name)
;; Module load:
- (let* ([code (get-module-code
- path "compiled"
- (lambda (e)
- (parameterize ([compile-enforce-module-constants #f])
- (compile e)))
- (lambda (ext loader?) (load-extension ext) #f)
- #:notify (lambda (chosen) (notify re? chosen)))]
- [dir (or (current-load-relative-directory) (current-directory))]
- [path (path->complete-path path dir)]
- [path (normal-case-path (simplify-path path))])
- (define-values (ts real-path) (get-timestamp path))
- (add-paths! (make-mod name path ts code) (resolve-paths path))
- (parameterize ([current-module-declare-source real-path]) (eval code)))
+ (with-handlers ([(lambda (exn)
+ (and (pair? name) (exn:get-module-code? exn)))
+ ;; Load-handler protocol: quiet failure when a
+ ;; submodule is not found
+ (lambda (exn) (void))])
+ (let* ([code (get-module-code
+ path "compiled"
+ (lambda (e)
+ (parameterize ([compile-enforce-module-constants #f])
+ (compile e)))
+ (lambda (ext loader?) (load-extension ext) #f)
+ #:notify (lambda (chosen) (notify re? chosen)))]
+ [dir (or (current-load-relative-directory) (current-directory))]
+ [path (path->complete-path path dir)]
+ [path (normal-case-path (simplify-path path))])
+ (define-values (ts real-path) (get-timestamp path))
+ (add-paths! (make-mod name path ts code) (resolve-paths path))
+ (parameterize ([current-module-declare-source real-path])
+ (eval code))))
;; Not a module:
(begin (notify re? path) (orig path name))))