From ae8122ce9bf7584f9bad05d5e5b7bf9526de5b04 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 8 Nov 2019 12:25:13 -0800 Subject: [PATCH] make parallel & non-parallel render accounting more consistent --- pollen/private/command.rkt | 19 +++++-------- pollen/private/ts.rktd | 2 +- pollen/render.rkt | 57 +++++++++++++++++--------------------- 3 files changed, 34 insertions(+), 44 deletions(-) diff --git a/pollen/private/command.rkt b/pollen/private/command.rkt index 21c59a3..634e73a 100644 --- a/pollen/private/command.rkt +++ b/pollen/private/command.rkt @@ -116,9 +116,7 @@ version print the version" (current-server-port) (make-publish-di other-args)) (define (handle-batch-render paths) - (if (dry-run?) - (for-each message paths) - (apply render-batch paths #:parallel (render-parallel?)))) + (apply render-batch (map very-nice-path paths) #:parallel (render-parallel?) #:dry-run (dry-run?))) (parameterize ([current-poly-target (render-target-wanted)]) ;; applies to both cases (let loop ([args parsed-args]) @@ -134,19 +132,16 @@ version print the version" (current-server-port) (make-publish-di [(recursive) dir] [else top-dir])]) (define dirlist (directory-list dir)) - (define preprocs (filter preproc-source? dirlist)) - (define static-pagetrees (filter pagetree-source? dirlist)) - ;; if there are no static pagetrees, use make-project-pagetree - ;; (which will synthesize a pagetree if needed, which includes all sources) (define paths-to-render - (map very-nice-path - (match static-pagetrees + (match (filter pagetree-source? dirlist) + ;; if there are no static pagetrees, use make-project-pagetree + ;; (which will synthesize a pagetree if needed, which includes all sources) [(? null?) (message (format "rendering generated pagetree for directory ~a" dir)) (cdr (make-project-pagetree dir))] - [_ + [pagetree-sources (message (format "rendering preproc & pagetree files in directory ~a" dir)) - (append preprocs static-pagetrees)]))) + (append (filter preproc-source? dirlist) pagetree-sources)])) (handle-batch-render paths-to-render) (when (render-with-subdirs?) (for ([path (in-list dirlist)] @@ -154,7 +149,7 @@ version print the version" (current-server-port) (make-publish-di (render-one-dir (->complete-path path)))))))] [path-args ;; path mode (message (format "rendering ~a" (string-join (map ->string path-args) " "))) - (handle-batch-render (map very-nice-path path-args))])))) + (handle-batch-render path-args)])))) (define (handle-start) (define launch-wanted #f) diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 2aae4fc..278d236 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1573240379 +1573244713 diff --git a/pollen/render.rkt b/pollen/render.rkt index 9dedf0d..347fc23 100644 --- a/pollen/render.rkt +++ b/pollen/render.rkt @@ -48,15 +48,7 @@ (define (list-of-pathish? x) (and (list? x) (andmap pathish? x))) -(define (parallel-render paths-in job-count-arg) - (define source-paths - (let loop ([paths paths-in] [acc null]) - (match (and (pair? paths) (->complete-path (car paths))) - [#false (remove-duplicates acc)] - [(? pagetree-source? pt) (loop (append (pagetree->paths pt) (cdr paths)) acc)] - [(app ->source-path (and (not #false) (? file-exists?) sp)) (loop (cdr paths) (cons sp acc))] - [_ (loop (cdr paths) acc)]))) - +(define (parallel-render source-paths job-count-arg) (define job-count (min (length source-paths) @@ -78,7 +70,7 @@ ;; 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 _) - (time-apply render-from-source-or-output-path (list path))) + (time-apply render-to-file-if-needed (list path))) (place-channel-put ch (list 'finished-job path ms)))) (loop)))) (handle-evt wp (λ (val) (list* wpidx wp val))))) @@ -86,8 +78,7 @@ (define poly-target (current-poly-target)) ;; `locks` and `blocks` are (listof (cons/c evt? path?)) - (define starting-source-paths (sort source-paths stringstring)) - (let loop ([source-paths starting-source-paths] + (let loop ([source-paths source-paths] [locks-in null] [blocks-in null] ;; `completed-jobs` is (listof (cons/c path? boolean?)) @@ -106,7 +97,7 @@ (place-channel-put wp 'lock-approved) (values (cons block locks) blocks)]))) (cond - [(eq? completed-job-count (length starting-source-paths)) + [(eq? completed-job-count (length source-paths)) ;; second bite at the apple for crashed jobs. ;; 1) many crashes that arise in parallel rendering are ;; a result of concurrency issues (e.g. shared files not being readable at the right moment). @@ -152,17 +143,30 @@ [(list wpidx wp 'wants-lock path) (loop source-paths locks (append blocks (list (cons wp path))) completed-jobs completed-job-count)])]))) -(define+provide/contract (render-batch #:parallel [wants-parallel-render #false] . paths-in) - ((#:parallel any/c) #:rest list-of-pathish? . ->* . void?) +(define+provide/contract (render-batch #:parallel [wants-parallel-render? #false] + #:dry-run [wants-dry-run? #false] . paths-in) + ((#:parallel any/c) (#:dry-run boolean?) #:rest list-of-pathish? . ->* . void?) ;; Why not just (for-each render ...)? ;; Because certain files will pass through multiple times (e.g., templates) ;; And with render, they would be rendered repeatedly. ;; Using reset-modification-dates is sort of like session control. (reset-mod-date-hash!) - (for-each render-from-source-or-output-path (if wants-parallel-render - ;; returns crashed jobs for serial rendering - (parallel-render paths-in wants-parallel-render) - paths-in))) + (define expanded-source-paths + (let loop ([paths paths-in] [acc null]) + (match (and (pair? paths) (->complete-path (car paths))) + [#false (sort (remove-duplicates acc) stringstring)] + [(? pagetree-source? pt) (loop (append (pagetree->paths pt) (cdr paths)) acc)] + [(app ->source-path (and (not #false) (? file-exists?) sp)) (loop (cdr paths) (cons sp acc))] + [_ (loop (cdr paths) acc)]))) + (cond + [wants-dry-run? (if (null? expanded-source-paths) + (message "[no paths to render]") + (for-each message expanded-source-paths))] + [else (for-each render-to-file-if-needed + (match wants-parallel-render? + ;; returns crashed jobs for serial rendering + [#false expanded-source-paths] + [jobs-arg (parallel-render expanded-source-paths jobs-arg)]))])) (define (pagetree->paths pagetree-or-path) (define pagetree (if (pagetree? pagetree-or-path) @@ -177,18 +181,9 @@ (define+provide/contract (render-from-source-or-output-path so-pathish) (pathish? . -> . void?) - (define so-path (->complete-path so-pathish)) ; so-path = source or output path (could be either) - (cond - [(for/or ([pred (in-list (list has/is-null-source? - has/is-preproc-source? - has/is-markup-source? - has/is-scribble-source? - has/is-markdown-source?))]) - (pred so-path)) - (define-values (source-path output-path) (->source+output-paths so-path)) - (render-to-file-if-needed source-path #f output-path)] - [(pagetree-source? so-path) (render-pagenodes so-path)]) - (void)) + (match (->complete-path so-pathish) + [(app ->source-path (and (not #false) source-path)) (render-to-file-if-needed source-path)] + [(? pagetree-source? pt) (render-pagenodes pt)])) (define render-ram-cache (make-hash))