pull/9/head
Matthew Butterick 11 years ago
parent 20d83be366
commit e066829a76

@ -1,44 +1,46 @@
#lang racket/base #lang racket/base
(require racket/rerequire) (require racket/rerequire)
;(require racket/contract)
(require "debug.rkt" sugar/coerce) (require "debug.rkt" sugar/coerce)
(provide current-cache make-cache cached-require get-cache-hash) ;; The cache is a hash with paths as keys.
;; The cache values are also hashes, with key/value pairs for that path.
(provide current-cache make-cache cached-require cache-ref)
;; Don't initialize a cache when the module is loaded. This induces reliance.
;; The cache only makes sense if a single one is used across a whole session (e.g., via parameterize).
(define current-cache (make-parameter #f)) (define current-cache (make-parameter #f))
(define (make-cache) (define (make-cache) (make-hash))
; ( -> hash?)
(make-hash))
(define (get-cache-hash path-string) (define (cache-ref path-string)
; (path-string? . -> . hash?)
(hash-ref (current-cache) (->complete-path path-string))) (hash-ref (current-cache) (->complete-path path-string)))
(define (cache-ref path sym) (define (cache-has-key? path)
; (path? symbol? . -> . any/c) (hash-has-key? (current-cache) path))
(hash-ref (get-cache-hash path) sym))
(define (cached-require path-string sym) (define (cached-require path-string key)
; (path-string? symbol? . -> . any/c)
(when (not (current-cache)) (error "cached-require: No cache set up.")) (when (not (current-cache)) (error "cached-require: No cache set up."))
(define path (->complete-path path-string)) (define path
(with-handlers ([exn:fail? (λ(exn) (displayln (format "cached-require: ~a is not a valid path" path-string)))])
(->complete-path path-string)))
(define (cache path) (define (cache path)
(dynamic-rerequire path) (dynamic-rerequire path)
(hash-set! (current-cache) path (make-hash)) (hash-set! (current-cache) path (make-hash))
(define cache-hash (hash-ref (current-cache) path)) (define cache-hash (cache-ref path))
(hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path)) (hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path))
(hash-set! cache-hash 'main (dynamic-require path 'main)) (hash-set! cache-hash 'main (dynamic-require path 'main))
(hash-set! cache-hash 'metas (dynamic-require path 'metas)) (hash-set! cache-hash 'metas (dynamic-require path 'metas))
(void)) (void))
(when (or (not (hash-has-key? (current-cache) path)) (when (or (not (cache-has-key? path))
(> (file-or-directory-modify-seconds path) (hash-ref (hash-ref (current-cache) path) 'mod-time))) (> (file-or-directory-modify-seconds path) (hash-ref (cache-ref path) 'mod-time)))
(cache path)) (cache path))
(cache-ref path sym)) (hash-ref (cache-ref path) key))

@ -73,3 +73,6 @@
(make-message-logger-functions warning) (make-message-logger-functions warning)
(make-message-logger-functions info) (make-message-logger-functions info)
(make-message-logger-functions debug) (make-message-logger-functions debug)
(define+provide (message . items)
(displayln (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))
Loading…
Cancel
Save