From 5e1b969e20004f49f1174346a612269c56d0d785 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 11 Jun 2013 15:29:25 +0200 Subject: racket: struggling with submodules Submodule (re)loading is not without pecularities. In particular, module[*+] submodules are not visited the first time one enters its parent, but once you load them once, they're revisited every time we load the parent afterwards--racket's native enter! exhibits the same behaviour, so i'm guessing we'll have to live with that. There is however a glitch in that submodules can only be reloaded then by loading the parent, so we need to confirm that this is expected behaviour and, if it is, automating the parent's load when the submodule's is requested. On the other hand, entering a module[*+] is not working in Geiser yet, and it does in plain racket, so this one is our fault. Working on it. --- scheme/racket/geiser/enter.rkt | 56 +++++++++++++++++++++++----------------- scheme/racket/geiser/modules.rkt | 2 +- scheme/racket/geiser/user.rkt | 4 +-- 3 files changed, 35 insertions(+), 27 deletions(-) (limited to 'scheme') diff --git a/scheme/racket/geiser/enter.rkt b/scheme/racket/geiser/enter.rkt index 101b5f4..0ef9ac5 100644 --- a/scheme/racket/geiser/enter.rkt +++ b/scheme/racket/geiser/enter.rkt @@ -15,7 +15,7 @@ (for-syntax racket/base) racket/path) -(provide get-namespace enter-module module-loader module-loaded?) +(provide get-namespace visit-module module-loader) (struct mod (name load-path timestamp depends) #:transparent) @@ -27,17 +27,19 @@ (define loaded (make-hash)) -(define (module-loaded? path) +(define (mod->path mod) (with-handlers ([exn? (lambda (_) #f)]) - (let ([rp (module-path-index-resolve (module-path-index-join path #f))]) - (hash-has-key? loaded (resolved-module-path-name rp))))) + (let ([rp (module-path-index-resolve (module-path-index-join mod #f))]) + (resolved-module-path-name rp)))) -(define (enter-module mod) - (dynamic-require mod #f) +(define (visit-module mod) + (parameterize ([current-load/use-compiled + (make-loader (current-load/use-compiled) #f)]) + (dynamic-require mod #f)) (check-latest mod)) (define (module-loader orig) - (enter-load/use-compiled orig #f)) + (make-loader orig #f)) (define inhibit-eval (make-parameter #f)) @@ -65,7 +67,9 @@ (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)) + (let* ([name (mod-name m)] + [pm (if (pair? name) (lambda (p) (cons p (cdr name))) (lambda (p) p))]) + (for-each (lambda (p) (hash-set! loaded (pm p) m)) ps))) (define (resolve-paths path) (define (find root rest) @@ -87,10 +91,20 @@ (define (module-name? name) (and name (not (and (pair? name) (not (car name)))))) -(define ((enter-load/use-compiled orig re?) path name) +(define (module-code re? name path) + (printf "Code for module ~a at ~a~%" name path) + (get-module-code path + "compiled" + (lambda (e) + (parameterize ([compile-enforce-module-constants #f]) + (compile e))) + (lambda (ext loader?) (load-extension ext) #f) + #:submodule-path (if (pair? name) (cdr name) '()) + #:notify (lambda (chosen) (notify re? chosen)))) + +(define ((make-loader orig re?) path name) (when (inhibit-eval) (raise (make-exn:fail "namespace not found" (current-continuation-marks)))) - (printf "Loading ~s: ~s~%" name path) (if (module-name? name) ;; Module load: (with-handlers ([(lambda (exn) @@ -98,13 +112,7 @@ ;; 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)))] + (let* ([code (module-code re? name path)] [dir (or (current-load-relative-directory) (current-directory))] [path (path->complete-path path dir)] [path (normal-case-path (simplify-path path))]) @@ -133,21 +141,21 @@ (define mpi (module-path-index-join mod #f)) (define done (make-hash)) (let loop ([mpi mpi]) - (define rpath (module-path-index-resolve mpi)) - (define path (let ([p (resolved-module-path-name rpath)]) - (if (pair? p) (car p) p))) + (define rindex (module-path-index-resolve mpi)) + (define rpath (resolved-module-path-name rindex)) + (define path (if (pair? rpath) (car rpath) rpath)) (when (path? path) (define npath (normal-case-path path)) (unless (hash-ref done npath #f) (hash-set! done npath #t) - (define mod (hash-ref loaded npath #f)) + (define mod (hash-ref loaded rpath #f)) (when mod (for-each loop (mod-depends mod)) (define-values (ts actual-path) (get-timestamp npath)) (when (> ts (mod-timestamp mod)) (define orig (current-load/use-compiled)) (parameterize ([current-load/use-compiled - (enter-load/use-compiled orig #f)] - [current-module-declare-name rpath] + (make-loader orig #f)] + [current-module-declare-name rindex] [current-module-declare-source actual-path]) - ((enter-load/use-compiled orig #t) npath (mod-name mod))))))))) + ((make-loader orig #t) npath (mod-name mod))))))))) diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt index a4fbd6f..93d8b79 100644 --- a/scheme/racket/geiser/modules.rkt +++ b/scheme/racket/geiser/modules.rkt @@ -47,7 +47,7 @@ (define (load-module spec (port #f) (ns #f)) (parameterize ([current-error-port (or port nowhere)]) - (enter-module (ensure-module-spec spec)) + (visit-module (ensure-module-spec spec)) (when (namespace? ns) (current-namespace ns)))) diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt index cd3fea6..31f789e 100644 --- a/scheme/racket/geiser/user.rkt +++ b/scheme/racket/geiser/user.rkt @@ -28,7 +28,7 @@ (define last-entered (make-parameter "")) (define (do-enter mod name) - (enter-module mod) + (visit-module mod) (current-namespace (module->namespace mod)) (last-entered name)) @@ -82,7 +82,7 @@ (let* ([mod (read)] [res (call-with-result (lambda () - (enter-module (cond [(file-mod? mod) mod] + (visit-module (cond [(file-mod? mod) mod] [(path-string? mod) `(file ,mod)] [(submod-path mod)] [else (module-error stx mod)])) -- cgit v1.2.3