summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2012-09-01 05:42:46 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2012-09-01 05:42:46 +0200
commitde61b6f6580be0daad3e7aa97acd1534c30fbedf (patch)
tree73e87f9b43e58cacf20c3287f23cd54b8b6fad07
parentbc21d274994eb40366d1c372fd1185483815b7ef (diff)
downloadgeiser-guile-de61b6f6580be0daad3e7aa97acd1534c30fbedf.tar.gz
geiser-guile-de61b6f6580be0daad3e7aa97acd1534c30fbedf.tar.bz2
Little cleanups
-rw-r--r--scheme/racket/geiser/enter.rkt112
1 files changed, 58 insertions, 54 deletions
diff --git a/scheme/racket/geiser/enter.rkt b/scheme/racket/geiser/enter.rkt
index e996527..d7802f5 100644
--- a/scheme/racket/geiser/enter.rkt
+++ b/scheme/racket/geiser/enter.rkt
@@ -19,6 +19,12 @@
(struct mod (name load-path timestamp depends))
+(define (make-mod name path ts code)
+ (let ([deps (if code
+ (apply append (map cdr (module-compiled-imports code)))
+ null)])
+ (mod name (path->string path) ts deps)))
+
(define loaded (make-hash))
(define (module-loaded? path)
@@ -81,62 +87,60 @@
(define ((enter-load/use-compiled orig re?) path name)
(when (inhibit-eval)
- (raise (make-exn:fail "namespace not found"
- (current-continuation-marks))))
+ (raise (make-exn:fail "namespace not found" (current-continuation-marks))))
(if 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)))]
- [path (normal-case-path
- (simplify-path
- (path->complete-path path
- (or (current-load-relative-directory)
- (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))])
- (add-paths! m (resolve-paths path)))
- ;; Evaluate the module:
- (parameterize ([current-module-declare-source path])
- (eval code)))
+ (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 path]) (eval code)))
;; Not a module:
- (begin
- (notify re? path)
- (orig path name))))
+ (begin (notify re? path) (orig path name))))
+
(define (get-timestamp path)
- (file-or-directory-modify-seconds path #f (lambda () -inf.0)))
-
-(define (check-latest mod)
- (let ([mpi (module-path-index-join mod #f)]
- [done (make-hash)])
- (let loop ([mpi mpi])
- (let* ([rpath (module-path-index-resolve mpi)]
- [path (resolved-module-path-name rpath)])
- (when (path? path)
- (let ([path (normal-case-path path)])
- (unless (hash-ref done path #f)
- (hash-set! done path #t)
- (let ([mod (hash-ref loaded path #f)])
- (when mod
- (for-each loop (mod-depends mod))
- (let ([ts (get-timestamp path)])
- (when (ts . > . (mod-timestamp mod))
- (let ([orig (current-load/use-compiled)])
- (parameterize ([current-load/use-compiled
- (enter-load/use-compiled orig #f)]
- [current-module-declare-name rpath])
- ((enter-load/use-compiled orig #t)
- path
- (mod-name mod)))))))))))))))
+ (let ([ts (file-or-directory-modify-seconds path #f (lambda () #f))])
+ (if ts
+ (values ts path)
+ (if (regexp-match? #rx#"[.]rkt$" (path->bytes path))
+ (let* ([alt-path (path-replace-suffix path #".ss")]
+ [ts (file-or-directory-modify-seconds alt-path
+ #f
+ (lambda () #f))])
+ (if ts
+ (values ts alt-path)
+ (values -inf.0 path)))
+ (values -inf.0 path)))))
+
+(define (check-latest mod flags)
+ (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)))
+ (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))
+ (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 flags)]
+ [current-module-declare-name rpath]
+ [current-module-declare-source actual-path])
+ ((enter-load/use-compiled orig #t flags)
+ npath (mod-name mod)))))))))