1 ;;; enter.rkt -- custom module loaders
3 ;; Copyright (C) 2010, 2012 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Start date: Wed Mar 31, 2010 21:53
14 (require syntax/modcode
15 (for-syntax racket/base)
18 (provide get-namespace enter-module module-loader module-loaded?)
20 (struct mod (name load-path timestamp depends))
22 (define (make-mod name path ts code)
24 (apply append (map cdr (module-compiled-imports code)))
26 (mod name (path->string path) ts deps)))
28 (define loaded (make-hash))
30 (define (module-loaded? path)
31 (with-handlers ([exn? (lambda (_) #f)])
32 (let ([rp (module-path-index-resolve (module-path-index-join path #f))])
33 (hash-has-key? loaded (resolved-module-path-name rp)))))
35 (define (enter-module mod)
36 (dynamic-require mod #f)
39 (define (module-loader orig)
40 (enter-load/use-compiled orig #f))
42 (define (notify re? path)
44 (fprintf (current-error-port) " [re-loading ~a]\n" path)))
46 (define inhibit-eval (make-parameter #f))
48 (define (get-namespace mod)
49 (let ([mod (cond [(symbol? mod) mod]
50 [(string? mod) (find-module! (string->path mod) mod)]
51 [(path? mod) (find-module! mod (path->string mod))]
54 (with-handlers ([exn? (lambda (_) #f)])
55 (parameterize ([inhibit-eval #t])
56 (module->namespace mod))))))
58 (define (find-module! path path-str)
59 (let ([m (or (hash-ref loaded path #f)
60 (let loop ([ps (remove path (resolve-paths path))]
63 [(hash-ref loaded (car ps) #f) =>
65 (add-paths! m (cdr ps))
66 (add-paths! m (cons path seen))
68 [else (loop (cdr ps) (cons (car ps) seen))])))])
69 (list 'file (or (and m (mod-load-path m)) path-str))))
71 (define (add-paths! m ps)
72 (for-each (lambda (p) (hash-set! loaded p m)) ps))
74 (define (resolve-paths path)
75 (define (find root rest)
76 (let* ([alt-root (resolve-path root)]
77 [same? (equal? root alt-root)])
78 (cond [(null? rest) (cons root (if same? '() `(,alt-root)))]
79 [else (let* ([c (car rest)]
81 [rps (find (build-path root c) cs)])
84 (append rps (find (build-path alt-root c) cs))))])))
85 (let ([cmps (explode-path path)])
86 (find (car cmps) (cdr cmps))))
88 (define ((enter-load/use-compiled orig re?) path name)
90 (raise (make-exn:fail "namespace not found" (current-continuation-marks))))
91 (if (and name (or (not (list? name)) (car name))) ;; submodule names are lists
93 (let* ([code (get-module-code
96 (parameterize ([compile-enforce-module-constants #f])
98 (lambda (ext loader?) (load-extension ext) #f)
99 #:notify (lambda (chosen) (notify re? chosen)))]
100 [dir (or (current-load-relative-directory) (current-directory))]
101 [path (path->complete-path path dir)]
102 [path (normal-case-path (simplify-path path))])
103 (define-values (ts real-path) (get-timestamp path))
104 (add-paths! (make-mod name path ts code) (resolve-paths path))
105 (parameterize ([current-module-declare-source real-path]) (eval code)))
107 (begin (notify re? path) (orig path name))))
110 (define (get-timestamp path)
111 (let ([ts (file-or-directory-modify-seconds path #f (lambda () #f))])
114 (if (regexp-match? #rx#"[.]rkt$" (path->bytes path))
115 (let* ([alt-path (path-replace-suffix path #".ss")]
116 [ts (file-or-directory-modify-seconds alt-path
121 (values -inf.0 path)))
122 (values -inf.0 path)))))
124 (define (check-latest mod)
125 (define mpi (module-path-index-join mod #f))
126 (define done (make-hash))
127 (let loop ([mpi mpi])
128 (define rpath (module-path-index-resolve mpi))
129 (define path (let ([p (resolved-module-path-name rpath)])
130 (if (pair? p) (car p) p)))
132 (define npath (normal-case-path path))
133 (unless (hash-ref done npath #f)
134 (hash-set! done npath #t)
135 (define mod (hash-ref loaded npath #f))
137 (for-each loop (mod-depends mod))
138 (define-values (ts actual-path) (get-timestamp npath))
139 (when (ts . > . (mod-timestamp mod))
140 (define orig (current-load/use-compiled))
141 (parameterize ([current-load/use-compiled
142 (enter-load/use-compiled orig #f)]
143 [current-module-declare-name rpath]
144 [current-module-declare-source actual-path])
145 ((enter-load/use-compiled orig #t) npath (mod-name mod)))))))))