diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index bbdb94b..0e660a8 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1581031670 +1581033338 diff --git a/pollen/render.rkt b/pollen/render.rkt index 68874a4..08eeda8 100644 --- a/pollen/render.rkt +++ b/pollen/render.rkt @@ -55,12 +55,11 @@ [pcjs null]) ([source-path (in-list source-paths-in)]) (match (let/ec exit - (define exiter (λ () (exit 'cache-miss))) (define output-path (or (->output-path source-path) #false)) (define template-path - (cache-ref! (template-cache-key source-path output-path) exiter)) - (render-to-file-if-needed source-path template-path output-path exiter)) - ['cache-miss (values (cons source-path usps) pcjs)] + (cache-ref! (template-cache-key source-path output-path) (λ () (exit 'template-miss)))) + (render-to-file-if-needed source-path template-path output-path (λ () (exit 'render-miss)))) + [(? symbol? sym) (values (cons source-path usps) pcjs)] [_ (values usps (cons (cons source-path #true) pcjs))]))) (define job-count @@ -74,22 +73,22 @@ ;; initialize the workers (define worker-evts (for/list ([wpidx (in-range job-count)]) - (define wp (place ch - (let loop () - (match-define (cons path poly-target) - (place-channel-put/get ch (list 'wants-job))) - (parameterize ([current-poly-target poly-target]) - (place-channel-put/get ch (list 'wants-lock (->output-path path))) - ;; trap any exceptions and pass them back as crashed jobs. - ;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck. - (with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job path #f)))]) - (match-define-values (_ _ ms _) - ;; we don't use `render-to-file-if-needed` because we've already checked the render cache - ;; if we reached this point, we know we need a render - (time-apply render-to-file (list path))) - (place-channel-put ch (list 'finished-job path ms)))) - (loop)))) - (handle-evt wp (λ (val) (list* wpidx wp val))))) + (define wp (place ch + (let loop () + (match-define (cons path poly-target) + (place-channel-put/get ch (list 'wants-job))) + (parameterize ([current-poly-target poly-target]) + (place-channel-put/get ch (list 'wants-lock (->output-path path))) + ;; trap any exceptions and pass them back as crashed jobs. + ;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck. + (with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job path #f)))]) + (match-define-values (_ _ ms _) + ;; we don't use `render-to-file-if-needed` because we've already checked the render cache + ;; if we reached this point, we know we need a render + (time-apply render-to-file (list path))) + (place-channel-put ch (list 'finished-job path ms)))) + (loop)))) + (handle-evt wp (λ (val) (list* wpidx wp val))))) (define poly-target (current-poly-target)) @@ -127,7 +126,7 @@ ;; crashed jobs are completed jobs that weren't finished (for/list ([(path finished?) (in-dict completed-jobs)] #:unless finished?) - path)] + path)] [else (match (apply sync worker-evts) [(list wpidx wp 'wants-job) @@ -208,7 +207,7 @@ [(and sp op) (render-to-file-if-needed sp #false op)] [(pagetree-source? so-path) (render-pagenodes so-path)])) -(define render-ram-cache (make-hash)) +(define ram-cache (make-hash)) ;; note that output and template order is reversed from typical (define (render-to-file-base caller @@ -241,16 +240,17 @@ (cond [render-cache-activated? (define key (paths->key 'output source-path template-path output-path)) - (hash-ref! render-ram-cache + (hash-ref! ram-cache ;; within a session, this will prevent repeat players like "template.html.p" ;; from hitting the file cache repeatedly key - (cache-ref! key - render-thunk - #:notify-cache-use - (λ (str) - (message (format "from cache /~a" - (find-relative-path (current-project-root) output-path))))))] + (λ () + (cache-ref! key + render-thunk + #:notify-cache-use + (λ (str) + (message (format "from cache /~a" + (find-relative-path (current-project-root) output-path)))))))] [else (render-thunk)])) (unless (current-null-output?) (display-to-file render-result @@ -381,7 +381,7 @@ (define (file-exists-or-has-source? path) ; path could be #f (and path (for/first ([proc (in-list (list values ->preproc-source-path ->null-source-path))] #:when (file-exists? (proc path))) - path))) + path))) (define (get-template-from-metas source-path output-path-ext) (with-handlers ([exn:fail:contract? (λ (e) #f)]) ; in case source-path doesn't work with cached-require @@ -404,7 +404,6 @@ (build-path (current-server-extras-path) (add-ext (setup:fallback-template-prefix source-path) output-path-ext)))) -(define template-ram-cache (make-hash)) (define (template-cache-key source-path output-path) (paths->key 'template source-path (current-poly-target) output-path)) @@ -415,24 +414,25 @@ [(->output-path source-path)] [else #false])) (define key (template-cache-key source-path output-path)) - (hash-ref! template-ram-cache + (hash-ref! ram-cache ;; within a session, this will prevent repeat players like "template.html.p" ;; from hitting the file cache repeatedly key - (cache-ref! key - (λ () - (match source-path - [(or (? markup-source?) (? markdown-source?)) - ;; output-path may not have an extension - (define output-path-ext (cond - [(get-ext output-path)] - [(current-poly-target)] - [else #false])) - (for/or ([proc (list get-template-from-metas - get-default-template - get-fallback-template)]) - (file-exists-or-has-source? (proc source-path output-path-ext)))] - [_ #false]))))) + (λ () + (cache-ref! key + (λ () + (match source-path + [(or (? markup-source?) (? markdown-source?)) + ;; output-path may not have an extension + (define output-path-ext (cond + [(get-ext output-path)] + [(current-poly-target)] + [else #false])) + (for/or ([proc (list get-template-from-metas + get-default-template + get-fallback-template)]) + (file-exists-or-has-source? (proc source-path output-path-ext)))] + [_ #false])))))) (module-test-external (require pollen/setup sugar/file sugar/coerce)