diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2013-06-09 00:47:28 +0200 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2013-06-09 00:47:28 +0200 |
commit | 2c72e754cc0f988056c0cae2c7a35fedccf02c2b (patch) | |
tree | a036f4cc27e1f686a4eeee4c081d76b42e378dc8 | |
parent | c548baba9c4c708f697dfde9c33c2fb92f707e93 (diff) | |
download | geiser-guile-2c72e754cc0f988056c0cae2c7a35fedccf02c2b.tar.gz geiser-guile-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.rkt | 39 |
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)))) |