mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

get thunky

Browse Source
pull/218/head
Matthew Butterick 5 years ago
parent 2f663e4bf3
commit 16c11c6cda
2 changed files with 47 additions and 47 deletions
Show Stats Download Patch File Download Diff File

2
pollen/private/ts.rktd
Unescape Escape View File

@ -1 +1 @@
1581031670 1581033338

92
pollen/render.rkt
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save