implement ram cache for pm source files

cache.rkt

@@ -0,0 +1,49 @@
+#lang racket/base
+(require racket/rerequire racket/contract)
+(require "debug.rkt" sugar/coerce)
+
+(provide current-cache make-cache cached-require get-cache-hash)
+
+(define current-cache (make-parameter #f))
+
+(define/contract (path-string->path path-string)
+  (path-string? . -> . complete-path?)
+  (->complete-path (if (string? path-string) (string->path path-string) path-string)))
+
+(define/contract (make-cache)
+  ( ->  hash?)
+  (make-hash))
+
+(define/contract (get-cache-hash path-string)
+  (path-string? . -> . hash?)
+  (hash-ref (current-cache) (path-string->path path-string)))
+
+(define/contract (cache-ref path sym)
+  (path? symbol? . -> . any/c)
+  (hash-ref (get-cache-hash path) sym))
+
+(define/contract (cached-require path-string sym)
+  (path-string? symbol? . -> . any/c)
+  (when (not (current-cache)) (error "cached-require: No cache set up."))
+  
+  (define path (path-string->path path-string))
+  
+  (define (cache path)
+    (dynamic-rerequire path)
+    (hash-set! (current-cache) path (make-hash))
+    (define cache-hash (hash-ref (current-cache) 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 'metas (dynamic-require path 'metas))
+    (hash-set! cache-hash 'here (dynamic-require path 'here))
+    (hash-set! cache-hash 'here-path (dynamic-require path 'here-path))
+    (void))
+  
+  (when (or (not (hash-has-key? (current-cache) path))
+            (> (file-or-directory-modify-seconds path) (hash-ref (hash-ref (current-cache) path) 'mod-time)))
+    (cache path))
+  
+  (cache-ref path sym))
+
+
+

file-tools.rkt

@@ -182,7 +182,7 @@
 
 (define+provide/contract (project-files-with-ext ext)
   (coerce/symbol? . -> . (listof complete-path?))
-  (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list PROJECT_ROOT))))
+  (map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list (CURRENT_PROJECT_ROOT)))))
 
 ;; to identify unsaved sources in DrRacket
 (define (unsaved-source? path-string)

main.rkt

@@ -25,7 +25,7 @@
      
      ;; Build 'inner-here-path and 'inner-here
      (define (here-path->here here-path)
-       (path->string (path-replace-suffix (pollen-find-relative-path PROJECT_ROOT here-path) "")))
+       (path->string (path-replace-suffix (pollen-find-relative-path (CURRENT_PROJECT_ROOT) here-path) "")))
      (define inner-here-path (get-here-path))
      (define inner-here (here-path->here inner-here-path))
      
@@ -42,13 +42,13 @@
      (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
      (define-values (main-without-metas meta-elements) 
        (splitf-txexpr tx is-meta-element?))
-     (define meta-element->assoc (λ(x) (cons (cadr x) (caddr x))))
+     (define meta-element->assoc (λ(x) (let ([key (car (caadr x))][value (cadr (caadr x))]) (cons key value))))
      (define metas (make-hash (map meta-element->assoc meta-elements)))
      (values main-without-metas metas))
    
    (define main-txexpr `(placeholder-root 
-                         ,@(cons `(meta "here" ,inner-here) 
+                         ,@(cons (meta 'here: inner-here) 
-                                 (cons `(meta "here-path" ,inner-here-path) 
+                                 (cons (meta 'here-path: inner-here-path) 
                                        ;; cdr strips initial linebreak, but make sure main-raw isn't blank
                                        (if (and (list? main-raw) (> 0 (length main-raw))) (cdr main-raw) main-raw))))) 
    (define-values (main-without-metas metas) (split-metas-to-hash main-txexpr))
@@ -70,8 +70,8 @@
    
    
    ;; derive 'here & 'here-path from the hash (because they might have been overridden in the source) 
-   (define here (hash-ref metas "here"))
+   (define here (hash-ref metas 'here))
-   (define here-path (hash-ref metas "here-path"))
+   (define here-path (hash-ref metas 'here-path))
    
    (provide metas main here here-path
             ;; hide the exports that were only for internal use.

ptree.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 (require (for-syntax racket/base))
 (require racket/path racket/bool racket/rerequire racket/contract)
-(require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr)
+(require "tools.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt")
 
 (module+ test (require rackunit))
 
@@ -48,9 +48,7 @@
 (define+provide/contract (file->ptree p)
   (pathish? . -> . ptree?)
   (define path (->path p))
-;;  (message "Loading ptree file" (->string (file-name-from-path path)))
+  (cached-require path MAIN_POLLEN_EXPORT))
-  (dynamic-rerequire path)
-  (dynamic-require path MAIN_POLLEN_EXPORT))
 
 (define+provide/contract (directory->ptree dir)
   (directory-pathish? . -> . ptree?)
@@ -61,13 +59,7 @@
 (define+provide/contract (make-project-ptree project-dir)
   (directory-pathish? . -> . ptree?)
   (define ptree-source (build-path project-dir DEFAULT_PTREE))
-  (if (file-exists? ptree-source)
+  (cached-require ptree-source 'main))
-      (if (not-modified-since-last-pass? ptree-source)
-          (hash-ref ptree-cache ptree-source)
-          (begin
-            (hash-set! ptree-source-mod-dates ptree-source (file-or-directory-modify-seconds ptree-source))
-            (hash-ref! ptree-cache ptree-source (file->ptree ptree-source))))
-      (directory->ptree project-dir)))
 
 
 (module+ test
@@ -230,14 +222,14 @@
 
 
 (define current-ptree (make-parameter `(,PTREE_ROOT_NODE)))
-(define current-url-context (make-parameter PROJECT_ROOT))
+(define current-url-context (make-parameter (CURRENT_PROJECT_ROOT)))
 (provide current-ptree current-url-context)
 
 
 ;; used to convert here-path into here
 (define+provide/contract (path->pnode path)
   (pathish? . -> . pnode?)
-  (->string (->output-path (find-relative-path PROJECT_ROOT (->path path)))))
+  (->string (->output-path (find-relative-path (CURRENT_PROJECT_ROOT) (->path path)))))
 
 
 #|

render.rkt

@@ -1,10 +1,22 @@
 #lang racket/base
-(require racket/port racket/file racket/rerequire racket/contract racket/path)
+(require (for-syntax racket/base))
+(require racket/port racket/file racket/rerequire racket/path)
 (require sugar)
 
 (module+ test (require rackunit))
 
-(provide render render-batch)
+(define-syntax (define+provide+safe stx)
+  (syntax-case stx ()
+    [(_ (proc arg ... . rest-arg) contract body ...)
+     #'(define+provide+safe proc contract
+         (λ(arg ... . rest-arg) body ...))]
+    [(_ name contract body ...)
+     #'(begin
+         (define name body ...)
+         (provide name)
+         (module+ safe 
+           (provide (contract-out [name contract]))))]))
+
 
 ;; for shared use by eval & system
 (define nowhere-port (open-output-nowhere))
@@ -12,48 +24,26 @@
 
 ;; mod-dates is a hash that takes lists of paths as keys,
 ;; and lists of modification times as values.
-;; Reason: a templated page is a combination of two source files.
-;; Because templates have a one-to-many relationship with source files,
-;; Need to track template mod-date for each source file.
-;; Otherwise a changed template will get reloaded only once, 
-;; and after that get reported as being up to date.
-;; Possible: store hash on disk so mod records are preserved 
-;; between development sessions (prob a worthless optimization)
 (define mod-dates (make-hash))
 
 
-
+(define (make-mod-dates-key paths)
-(define/contract (make-mod-dates-key paths)
+  ;; project require files are appended to the mod-date path key.
-  ((listof path?) . -> . (listof path?))
+  ;; Why? So a change in a require file will trigger a render 
   (define project-require-files (or (get-project-require-files) empty))
   (flatten (append paths project-require-files)))
 
-;; convert a path to a modification date value
+
-(define/contract (path->mod-date-value path)
+(define (path->mod-date-value path)
-  (path? . -> . (or/c exact-integer? #f))
   (and (file-exists? path) ; returns #f if a file doesn't exist
        (file-or-directory-modify-seconds path)))
 
 
 (module+ test
-  (check-false (path->mod-date-value (->path "foobarfoo.rkt")))
+  (check-false (path->mod-date-value (->path "nonexistent-file-is-false.rkt"))))
-  (check-true (exact-integer? (path->mod-date-value (build-path (current-directory) (string->path "render.rkt"))))))
+
-
+
-;; put list of paths into mod-dates
+(define (store-render-in-mod-dates . rest-paths)
-;; need list as input (rather than individual path)
-;; because hash key needs to be a list
-;; so it's convenient to use a rest argument
-;; therefore, use function by just listing out the paths
-(define/contract (store-render-in-mod-dates . rest-paths)
-  (() #:rest (listof path?) . ->* . void?)
-  ;; project require files are appended to the mod-date key.
-  ;; Why? So a change in a require file will trigger a render 
-  ;; (which is the right thing to do, since pollen files are 
-  ;; dependent on those requires)
-  ;; It's convenient for development, because otherwise
-  ;; you'd need to restart the server when you change a require
-  ;; or explicitly use the force parameter.
-  ;; This way, require files and pollen files have the same behavior.
   (define key (make-mod-dates-key rest-paths))
   (hash-set! mod-dates key (map path->mod-date-value key)))
 
@@ -63,11 +53,11 @@
   (check-true (= (len mod-dates) 1))
   (reset-mod-dates))
 
+
 ;; when you want to generate everything fresh, 
 ;; but without having to #:force everything.
 ;; render functions will always go when no mod-date is found.
-(define/contract (reset-mod-dates)
+(define (reset-mod-dates)
-  (-> void?)
   (set! mod-dates (make-hash)))
 
 (module+ test 
@@ -76,10 +66,8 @@
   (reset-mod-dates)
   (check-true (= (len mod-dates) 0)))
 
-;; how to know whether a certain combination of paths needs a render
+
-;; use rest argument here so calling pattern matches store-render
+(define (mod-date-expired? . rest-paths)
-(define/contract (mod-date-expired? . rest-paths)
-  (() #:rest (listof path?) . ->* . boolean?)
   (define key (make-mod-dates-key rest-paths))
   (or (not (key . in? . mod-dates))  ; no stored mod date
       (not (equal? (map path->mod-date-value key) (get mod-dates key))))) ; data has changed
@@ -93,8 +81,7 @@
     (check-true (mod-date-expired? path))))
 
 
-;; convenience function for external modules to use
+(define+provide/contract (render-batch . xs)
-(define/contract (render-batch . xs)
   (() #:rest (listof pathish?) . ->* . void?)
   ;; This will trigger rendering of all files.
   ;; Why not pass #:force #t through with render?
@@ -105,21 +92,15 @@
   (reset-mod-dates) 
   (for-each render xs))
 
-;; dispatches path to the right rendering function
+
-;; use #:force to render regardless of cached state
+(define+provide/contract (render #:force [force #f] . xs)
-(define/contract (render #:force [force #f] . xs)
   (() (#:force boolean?) #:rest (listof pathish?) . ->* . void?)
   (define (&render x) 
     (let ([path (->complete-path x)])              
-      ;   (message "Dispatching render for" (->string (file-name-from-path path)))
       (cond
-        ;; this will catch preprocessor files
         [(needs-preproc? path) (render-preproc-source-if-needed path #:force force)]
-        ;; this will catch pollen source files, 
-        ;; and files without extension that correspond to p files
         [(needs-template? path) (render-with-template path #:force force)]
-        ;; this will catch ptree files
+        [(ptree-source? path) (let ([ptree (cached-require path 'main)])
-        [(ptree-source? path) (let ([ptree (dynamic-require path 'main)])
                                 (render-files-in-ptree ptree #:force force))]
         [(equal? FALLBACK_TEMPLATE (->string (file-name-from-path path)))
          (message "Render: using fallback template")]
@@ -129,35 +110,28 @@
 ;; todo: write tests
 
 
-(define/contract (rendering-message path)
+(define (rendering-message path)
-  (any/c . -> . void?)
-  ;; you can actually stuff whatever string you want into path —
-  ;; if it's not really a path, file-name-from-path won't choke
   (message "Rendering" (->string (file-name-from-path path))))
 
-(define/contract (rendered-message path)
+(define (rendered-message path)
-  (any/c . -> . void?)
   (message "Rendered" (->string (file-name-from-path path))))
 
-(define/contract (up-to-date-message path)
+(define (up-to-date-message path)
-  (any/c . -> . void?)
   (message (->string (file-name-from-path path)) "is up to date, using cached copy"))
 
 (define (render-preproc-source source-path output-path)
   ;; how we render: import 'main from preproc source file, 
-  ;; which is rendered during source parsing,
+  ;; which is rendered during source parsing, and write that to output path
-  ;; and write that to output path
   (define-values (source-dir source-name _) (split-path source-path))
   (rendering-message (format "~a from ~a" 
                              (file-name-from-path output-path)
                              (file-name-from-path source-path)))
-  (let ([main (time (render-through-eval source-dir `(dynamic-require ,source-path 'main)))]) ;; todo: how to use world global here? Wants an identifier, not a value
+  (let ([main (time (render-through-eval source-dir `(begin (require pollen/cache)(cached-require ,source-path 'main))))]) ;; todo: how to use world global here? Wants an identifier, not a value
     (display-to-file main output-path #:exists 'replace))
   (store-render-in-mod-dates source-path) ; don't store mod date until render has completed!
   (rendered-message output-path))
 
-(define/contract (render-preproc-source-if-needed input-path #:force [force-render #f])
+(define (render-preproc-source-if-needed input-path #:force [force-render #f])
-  ((pathish?) (#:force boolean?) . ->* . void?)
   
   ;; input-path might be either a preproc-source path or preproc-output path
   ;; But the coercion functions will figure it out.
@@ -179,92 +153,55 @@
 ;; todo: write tests
 
 
-;; utility function for render-with-template
+(define (handle-source-rerequire source-path)
-(define/contract (handle-source-rerequire source-path)
-  ((and/c path? file-exists?) . -> . boolean?)
-  
-  ;; dynamic-rerequire watches files to see if they change.
-  ;; if so, then it reloads them.
-  ;; therefore, it's useful in a development environment
-  ;; because it reloads as needed, but otherwise not.
-  
   (define-values (source-dir source-name _) (split-path source-path))
-  ;; need to require source file (to retrieve template name, which is in metas)
+  ;; use dynamic-rerequire now to force render for cached-require later,
-  ;; but use dynamic-rerequire now to force render for dynamic-require later,
+  ;; otherwise the source file will get cached by compiler
-  ;; otherwise the source file will cache
-  ;; by default, rerequire reports reloads to error port.
-  ;; set up a port to catch messages from dynamic-rerequire
-  ;; and then examine this message to find out if anything was reloaded. 
   (define port-for-catching-file-info (open-output-string))
-  
-  ;; parameterize needed because source files have relative requires in project directory
-  ;; parameterize is slow, IIRC
   (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
-  ;; this becomes the return value
   (->boolean (> (len (get-output-string port-for-catching-file-info)) 0)))
 
+
 (define (complete-decoder-source-path x)
   (->complete-path (->decoder-source-path (->path x))))
 
-;; apply template
+
-(define/contract (render-with-template x [template-name #f] #:force [force #f]) 
+(define (render-with-template x [template-name #f] #:force [force-render #f]) 
-  (((and/c pathish? 
-           (flat-named-contract 'file-exists
-                                (λ(x) (file-exists? (complete-decoder-source-path x))))))
-   (path? #:force boolean?) . ->* . void?)
-  
-  ;; set up information about source
   (define source-path (complete-decoder-source-path x))
   ;; todo: this won't work with source files nested down one level
   (define-values (source-dir ignored also-ignored) (split-path source-path))
   
-  
   ;; Then the rest: 
-  ;; set the template, render the source file with template, and catch the output.
   ;; 1) Set the template. 
   (define template-path 
     (or 
-     ;; Build the possible paths and use the first one  
+     ;; Build the possible paths and use the first one that either exists, or has a preproc source that exists.
-     ;; that either exists, or has a preproc source that exists.
      (ormap (λ(p) (if (ormap file-exists? (list p (->preproc-source-path p))) p #f)) 
-            (filter (λ(x) (->boolean x)) ;; if any of the possibilities below are invalid, they return #f 
+            (filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f 
-                    (list
+                    (list                     
-                     ;; path based on template-name
+                     (and template-name (build-path source-dir template-name)) ; path based on template-name
-                     (and template-name (build-path source-dir template-name))
+                     (parameterize ([current-directory (CURRENT_PROJECT_ROOT)])
-                     ;; path based on metas. Need to parameterize a source file for it to find pollen-requires.
+                       (let ([source-metas (cached-require source-path 'metas)])
-                     ;; If you want standard behavior, requires can be declared explicitly.
-                     (parameterize ([current-directory PROJECT_ROOT])
-                       (let ([source-metas (dynamic-require source-path 'metas)])
                          (and (TEMPLATE_META_KEY . in? . source-metas)
-                              (build-path source-dir (get source-metas TEMPLATE_META_KEY)))))
+                              (build-path source-dir (get source-metas TEMPLATE_META_KEY))))) ; path based on metas
-                     ;; path using default template name =
+                     (build-path source-dir 
-                     ;; "-main" + extension from output path (e.g. foo.xml.p -> -main.xml)
+                                 (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path))))))) ; path using default template
-                     (build-path source-dir (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path)))))))
+     (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)]) ; if none of these work, make fallback template file
-     ;; if none of these work, make fallback template file
-     (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)])
        (display-to-file fallback-template-data ft-path #:exists 'replace)
        ft-path)))
   
-  
+  (render template-path #:force force-render) ; bc template might have its own preprocessor source
-  ;; render template (it might have its own preprocessor file)
-  (render template-path #:force force)
-  
-  ;; calculate new path for generated file
   (define output-path (->output-path source-path))
   
   ;; 2) Render the source file with template, if needed.
-  ;; Render is expensive, so we avoid it when we can.
+  ;; Render is expensive, so we avoid it when we can. Four conditions where we render:
-  ;; Four conditions where we render:
+  (if (or force-render ; a) it's explicitly demanded
-  (if (or force ; a) it's explicitly demanded
           (not (file-exists? output-path)) ; b) output file does not exist
-          ;; c) mod-dates indicates render is needed
+          (mod-date-expired? source-path template-path) ; c) mod-dates indicates render is needed
-          (mod-date-expired? source-path template-path) 
+          (let ([source-reloaded? (handle-source-rerequire source-path)]) ; d) dynamic-rerequire says refresh needed
-          ;; d) dynamic-rerequire indicates the source had to be reloaded
-          (let ([source-reloaded? (handle-source-rerequire source-path)])
             source-reloaded?))
       (begin
         (message "Rendering source" (->string (file-name-from-path source-path)) 
@@ -275,8 +212,7 @@
           (rendered-message output-path)))
       (up-to-date-message output-path))
   
-  ;; delete fallback template if needed
+  (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)]) ; delete fallback template if needed
-  (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE)])
     (when (file-exists? ft-path) (delete-file ft-path))))
 
 ;; cache some modules inside this namespace so they can be shared by namespace for eval
@@ -292,10 +228,11 @@
          pollen/debug
          pollen/decode
          pollen/file-tools
-         pollen/main
+         ;; not pollen/main, because it brings in pollen/top
          pollen/lang/inner-lang-helper
          pollen/predicates
          pollen/ptree
+         pollen/cache
          sugar
          txexpr
          pollen/template
@@ -306,12 +243,11 @@
 (define original-ns (current-namespace))
 
 (define (render-through-eval base-dir eval-string)
-  ; (directory-pathish? list? . -> . string?)
   (parameterize ([current-namespace (make-base-namespace)]
                  [current-directory (->complete-path base-dir)]
                  [current-output-port (current-error-port)]
-                 [current-ptree (make-project-ptree PROJECT_ROOT)]
+                 [current-ptree (make-project-ptree (CURRENT_PROJECT_ROOT))]
-                 [current-url-context PROJECT_ROOT])
+                 [current-url-context (CURRENT_PROJECT_ROOT)])
     (for-each (λ(mod-name) (namespace-attach-module original-ns mod-name)) 
               '(web-server/templates 
                 xml
@@ -324,10 +260,10 @@
                 pollen/debug
                 pollen/decode
                 pollen/file-tools
-                pollen/main
                 pollen/lang/inner-lang-helper
                 pollen/predicates
                 pollen/ptree
+                pollen/cache
                 sugar
                 txexpr
                 pollen/template
@@ -338,29 +274,42 @@
 
 
 (define (render-source-with-template source-path template-path)
-  ;  (file-exists? file-exists? . -> . string?)
   
   (match-define-values (source-dir source-name _) (split-path source-path))
   (match-define-values (_ template-name _) (split-path template-path))
   
+  (set! source-name (->string source-name))
   (define string-to-eval 
     `(begin 
        (require (for-syntax racket/base))
-       (require web-server/templates)
+       (require web-server/templates pollen/cache)
-       (require pollen/debug pollen/ptree pollen/template pollen/top)
+       ;; we could require the source-name directly,
-       (require ,(->string source-name))
+       ;; and get its exports and also the project-requires transitively.
-       (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))))
+       ;; but this is slow.
+       ;; So do it separately: require the project require files on their own,
+       ;; then fetch the other exports out of the cache.
+       (require pollen/lang/inner-lang-helper)
+       (require-project-require-files) 
+       (let ([main (cached-require ,source-name 'main)]
+             [metas (cached-require ,source-name 'metas)]
+             [here (cached-require ,source-name 'here)]
+             [here-path (cached-require ,source-name 'here-path)])
+         (local-require pollen/debug pollen/ptree pollen/template pollen/top)
+         (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)))))
   
   (render-through-eval source-dir string-to-eval))
 
+(module+ main
+  (parameterize ([current-cache (make-cache)]
+                 [CURRENT_PROJECT_ROOT (string->path "/Users/mb/git/bpt")])
+    (render-source-with-template
+     (string->path "/Users/mb/git/bpt/test.html.pm")
+     (string->path "/Users/mb/git/bpt/-test.html"))))
+
 
-;; render files listed in a ptree file
+(define (render-files-in-ptree ptree #:force [force #f])    
-(define/contract (render-files-in-ptree ptree #:force [force #f])
-  ((ptree?) (#:force boolean?) . ->* . void?)    
-  ;; pass force parameter through 
   (for-each (λ(i) (render i #:force force)) 
-            ;; use dynamic-require to avoid requiring ptree.rkt every time render.rkt is required
+            ((cached-require "ptree.rkt" 'all-pages) ptree)))
-            ((dynamic-require "ptree.rkt" 'all-pages) ptree)))
 
 
 

server-routes.rkt

@@ -48,7 +48,7 @@
   (procedure? . -> . procedure?)
   (λ(req . string-args) 
     (logger req) 
-    (define path (apply build-path PROJECT_ROOT (flatten string-args)))
+    (define path (apply build-path (CURRENT_PROJECT_ROOT) (flatten string-args)))
     (response/xexpr (route-proc path))))
 
 
@@ -86,7 +86,7 @@
   (pathish? . -> . xexpr?)
   (define path (->complete-path p))
   (define img (bitmap/file path))
-  (define relative-path (->string (find-relative-path PROJECT_ROOT path)))
+  (define relative-path (->string (find-relative-path (CURRENT_PROJECT_ROOT) path)))
   (define img-url (format "/~a" relative-path))
   `(div  
     (p "filename =" ,(->string relative-path))
@@ -100,7 +100,7 @@
 (define (handle-zip-path p)
   (pathish? . -> . xexpr?)
   (define path (->path p))
-  (define relative-path (->string (find-relative-path PROJECT_ROOT path)))
+  (define relative-path (->string (find-relative-path (CURRENT_PROJECT_ROOT) path)))
   (define ziplist (zip-directory-entries (read-zip-directory path)))
   `(div  
     (p "filename =" ,(->string relative-path))
@@ -141,7 +141,7 @@
 (define (dashboard dashfile)
   (define dir (get-enclosing-dir dashfile))
   (define (in-project-root?)
-    (directories-equal? dir PROJECT_ROOT))
+    (directories-equal? dir (CURRENT_PROJECT_ROOT)))
   (define parent-dir (and (not (in-project-root?)) (get-enclosing-dir dir)))
   (define empty-cell (cons #f #f))
   (define (make-link-cell href+text)
@@ -152,7 +152,7 @@
                                   text)))))
   (define (make-parent-row) 
     (if parent-dir
-        (let* ([url-to-parent-dashboard (format "/~a" (find-relative-path PROJECT_ROOT (build-path parent-dir DASHBOARD_NAME)))]
+        (let* ([url-to-parent-dashboard (format "/~a" (find-relative-path (CURRENT_PROJECT_ROOT) (build-path parent-dir DASHBOARD_NAME)))]
                [url-to-parent (string-replace url-to-parent-dashboard DASHBOARD_NAME "")])
           `(tr (th ((colspan "3")) (a ((href ,url-to-parent-dashboard)) ,(format "up to ~a" url-to-parent))))) 
         `(tr (th ((colspan "3")(class "root")) "Pollen root"))))
@@ -219,7 +219,7 @@
 
 (define/contract (req->path req)
   (request? . -> . path?)
-  (reroot-path (url->path (request-uri req)) PROJECT_ROOT))
+  (reroot-path (url->path (request-uri req)) (CURRENT_PROJECT_ROOT)))
 
 ;; default route
 (define (route-default req)  

server.rkt

@@ -4,7 +4,8 @@
 (require "server-routes.rkt" 
          "debug.rkt" 
          "world.rkt"
-         "file-tools.rkt")
+         "file-tools.rkt"
+         "cache.rkt")
 
 (define-values (pollen-servlet _)
   (dispatch-rules
@@ -15,7 +16,7 @@
    [else route-default]))
 
 (message (format "Welcome to Pollen ~a" POLLEN_VERSION) (format "(Racket ~a)" (version)))
-(message (format "Project root is ~a" PROJECT_ROOT))
+(message (format "Project root is ~a" (CURRENT_PROJECT_ROOT)))
 
 (define server-name (format "http://localhost:~a" SERVER_PORT))
 (message (format "Project server is ~a" server-name) "(Ctrl-C to exit)")
@@ -26,10 +27,11 @@
 (define MODULE_ROOT (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
 (define SERVER_EXTRAS_DIR (build-path MODULE_ROOT "pollen-server-extras"))
 
-(serve/servlet pollen-servlet
+(parameterize ([current-cache (make-cache)])
-               #:port SERVER_PORT
+  (serve/servlet pollen-servlet
-               #:listen-ip #f
+                 #:port SERVER_PORT
-               #:servlet-regexp #rx"" ; respond to top level
+                 #:listen-ip #f
-               #:command-line? #t
+                 #:servlet-regexp #rx"" ; respond to top level
-               #:file-not-found-responder route-404
+                 #:command-line? #t
-               #:extra-files-paths (list SERVER_EXTRAS_DIR PROJECT_ROOT))
+                 #:file-not-found-responder route-404
+                 #:extra-files-paths (list SERVER_EXTRAS_DIR (CURRENT_PROJECT_ROOT))))

template.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 (require racket/contract racket/string xml xml/path)
-(require "tools.rkt" "ptree.rkt" sugar txexpr)
+(require "tools.rkt" "ptree.rkt" "cache.rkt" sugar txexpr)
 
 ;; setup for test cases
 (module+ test (require rackunit racket/path))
@@ -11,7 +11,7 @@
 
 ;; todo: better fallback template
 
-(define fallback-template-data "FALLBACK! ◊(put-as-html main)")
+(define fallback-template-data "FALLBACK! ◊(main)")
 
 ;; todo: docstrings for this subsection
 
@@ -34,8 +34,8 @@
   (cond
     ;; Using put has no effect on txexprs. It's here to make the idiom smooth.
     [(txexpr? x) x] 
-    [(has-decoder-source? x) (dynamic-require (->decoder-source-path x) 'main)]
+    [(has-decoder-source? x) (cached-require (->decoder-source-path x) 'main)]
-    [(has-decoder-source? (pnode->url x)) (dynamic-require (->decoder-source-path (pnode->url x)) 'main)]))
+    [(has-decoder-source? (pnode->url x)) (cached-require (->decoder-source-path (pnode->url x)) 'main)]))
 
 #|(module+ test
   (check-equal? (put '(foo "bar")) '(foo "bar"))
@@ -61,14 +61,14 @@
 (define/contract (find-in-metas px key)
   (puttable-item? query-key? . -> . (or/c #f txexpr-elements?))
   (and (has-decoder-source? px)
-       (let ([metas (dynamic-require (->decoder-source-path px) 'metas)]
+       (let ([metas (cached-require (->decoder-source-path px) 'metas)]
              [key (->string key)])
          (and (key . in? . metas ) (->list (get metas key))))))
 
 #|(module+ test
   (parameterize ([current-directory "tests/template"])
     (check-equal? (find-in-metas "put" "foo") (list "bar"))
-    (let* ([metas (dynamic-require (->decoder-source-path 'put) 'metas)]
+    (let* ([metas (cached-require (->decoder-source-path 'put) 'metas)]
            [here (find-in-metas 'put 'here)])     
       (check-equal? here (list "tests/template/put")))))
 |#

world.rkt

@@ -45,7 +45,7 @@
   (map string->path (list COMMAND_FILE (path->string EXTRAS_DIR) "poldash.css" "compiled")))
 
 
-(define PROJECT_ROOT (current-directory))
+(define CURRENT_PROJECT_ROOT (make-parameter (current-directory)))
 
 (define SERVER_PORT 8088)