From 849731ab0ffd744ed7d365f0305a634fb41839b1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 2 Aug 2015 21:32:02 -0700 Subject: [PATCH] internalize 6.2 version of racket/rerequire --- cache.rkt | 2 +- render.rkt | 16 +++---- rerequire.rkt | 109 ++++++++++++++++++++++++++++++++++++++++++++++ server-routes.rkt | 4 +- 4 files changed, 117 insertions(+), 14 deletions(-) create mode 100644 rerequire.rkt diff --git a/cache.rkt b/cache.rkt index a3d129d..32a13cc 100644 --- a/cache.rkt +++ b/cache.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/file file/cache sugar/coerce "project.rkt" "world.rkt" racket/rerequire) +(require racket/file file/cache sugar/coerce "project.rkt" "world.rkt" "rerequire.rkt") ;; The cache is a hash with paths as keys. ;; The cache values are also hashes, with key/value pairs for that path. diff --git a/render.rkt b/render.rkt index 563de50..0d7dd59 100644 --- a/render.rkt +++ b/render.rkt @@ -1,7 +1,7 @@ #lang racket/base -(require racket/file racket/rerequire racket/path racket/match) +(require racket/file racket/path racket/match) (require sugar/coerce sugar/test sugar/define sugar/container sugar/file sugar/len) -(require "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "pagetree.rkt" "project.rkt" "template.rkt") +(require "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "pagetree.rkt" "project.rkt" "template.rkt" "rerequire.rkt") ;; used to track renders according to modification dates of component files (define mod-date-hash (make-hash)) @@ -227,15 +227,8 @@ (define/contract (file-needed-rerequire? source-path) (complete-path? . -> . boolean?) - (define-values (source-dir source-name _) (split-path source-path)) - ;; use dynamic-rerequire now to force render for cached-require later, - ;; otherwise the source file will get cached by compiler - (define port-for-catching-file-info (open-output-string)) - (parameterize ([current-directory source-dir] - [current-error-port port-for-catching-file-info]) - (dynamic-rerequire source-path)) - ;; if the file needed to be reloaded, there will be a message in the port - (> (len (get-output-string port-for-catching-file-info)) 0)) + ;; if the file needed to be reloaded, the dependency list will be > 0 + (> (len (dynamic-rerequire source-path)) 0)) ;; set up namespace for module caching @@ -277,6 +270,7 @@ pollen/main pollen/reader-base pollen/pagetree + pollen/rerequire pollen/tag pollen/template pollen/world diff --git a/rerequire.rkt b/rerequire.rkt new file mode 100644 index 0000000..af5ef58 --- /dev/null +++ b/rerequire.rkt @@ -0,0 +1,109 @@ +#lang racket/base + +(require syntax/modcode) + +(provide dynamic-rerequire) + +(define (dynamic-rerequire mod #:verbosity [verbosity 'reload]) + (unless (module-path? mod) + (raise-argument-error 'dynamic-rerequire "module-path?" mod)) + (unless (memq verbosity '(all reload none)) + (raise-argument-error 'dynamic-rerequire "(or/c 'all 'reload 'none)" verbosity)) + (rerequire mod verbosity)) + +(struct mod (name timestamp depends)) + +(define loaded (make-hash)) + +(define (rerequire mod verbosity) + (define loaded-paths '()) + (define (collect-loaded-path! path) (set! loaded-paths (cons path loaded-paths))) + ;; Collect dependencies while loading: + (parameterize ([current-load/use-compiled + (rerequire-load/use-compiled (current-load/use-compiled) + #f verbosity collect-loaded-path!)]) + (dynamic-require mod 0)) + ;; Reload anything that's not up to date: + (check-latest mod verbosity collect-loaded-path!) + ;; Return a list of the paths that were loaded this time, in order: + (reverse loaded-paths)) + +(define (rerequire-load/use-compiled orig re? verbosity path-collector) + (define notify + (if (or (eq? 'all verbosity) (and re? (eq? 'reload verbosity))) + (lambda (path) + (eprintf " ~aloading ~a\n" (if re? "re" "") path) + (path-collector path)) + path-collector)) + (lambda (path name) + (if (and name + (not (and (pair? name) + (not (car name))))) + ;; Module load: + (with-handlers ([(lambda (exn) + (and (pair? name) + (exn:get-module-code? exn))) + (lambda (exn) + ;; Load-handler protocol: quiet failure when a + ;; submodule is not found + (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 notify)] + [dir (or (current-load-relative-directory) (current-directory))] + [path (path->complete-path path dir)] + [path (normal-case-path (simplify-path path))]) + ;; Record module timestamp and dependencies: + (define-values (ts actual-path) (get-timestamp path)) + (let ([a-mod (mod name + ts + (if code + (apply append + (map cdr (module-compiled-imports code))) + null))]) + (hash-set! loaded path a-mod)) + ;; Evaluate the module: + (parameterize ([current-module-declare-source actual-path]) + (eval code)))) + ;; Not a module, or a submodule that we shouldn't load from source: + (begin (notify path) (orig path name))))) + +(define (get-timestamp path) + (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 verbosity path-collector) + (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 + (rerequire-load/use-compiled orig #f verbosity path-collector)] + [current-module-declare-name rpath] + [current-module-declare-source actual-path]) + ((rerequire-load/use-compiled orig #t verbosity path-collector) + npath (mod-name mod))))))))) diff --git a/server-routes.rkt b/server-routes.rkt index b0bd7d5..87dd770 100644 --- a/server-routes.rkt +++ b/server-routes.rkt @@ -1,11 +1,11 @@ #lang racket/base -(require racket/list racket/contract racket/rerequire racket/file racket/format xml racket/match racket/set racket/string racket/promise racket/path) +(require racket/list racket/contract racket/file racket/format xml racket/match racket/set racket/string racket/promise racket/path) (require web-server/http/xexpr web-server/dispatchers/dispatch) (require net/url) (require web-server/http/request-structs) (require web-server/http/response-structs) (require 2htdp/image) -(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt") +(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt" "rerequire.rkt") (module+ test (require rackunit))