blob: b81ba480d67c230a72bc1b8e9673c619b243c5c0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
;;; enter.ss -- custom module loaders
;; Copyright (C) 2010 Jose Antonio Ortega Ruiz
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the Modified BSD License. You should
;; have received a copy of the license along with this program. If
;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
;; Start date: Wed Mar 31, 2010 21:53
#lang scheme/base
(require syntax/modcode
(for-syntax scheme/base))
(provide get-namespace enter-module module-loader module-loaded?)
(define-struct mod (name timestamp depends))
(define loaded (make-hash))
(define (module-loaded? path)
(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)))))
(define (enter-module mod)
(dynamic-require mod #f)
(check-latest mod))
(define (module-loader orig)
(enter-load/use-compiled orig #f))
(define (notify re? path)
(when re?
(fprintf (current-error-port) " [re-loading ~a]\n" path)))
(define inhibit-eval (make-parameter #f))
(define (get-namespace mod)
(parameterize ([inhibit-eval #t])
(module->namespace mod)))
(define ((enter-load/use-compiled orig re?) path name)
(when (inhibit-eval)
(raise (make-exn:fail "namespace not found"
(current-continuation-marks))))
(if name
;; Module load:
(let ([code (get-module-code path "compiled" compile
(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 ([mod (make-mod name
(get-timestamp path)
(if code
(apply append
(map cdr (module-compiled-imports code)))
null))])
(hash-set! loaded path mod))
;; Evaluate the module:
(eval code))
;; Not a module:
(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)))))))))))))))
;;; enter.ss ends here
|
