diff --git a/pollen/private/command.rkt b/pollen/private/command.rkt index 59746cd..8b2af00 100644 --- a/pollen/private/command.rkt +++ b/pollen/private/command.rkt @@ -83,6 +83,7 @@ version print the version" (current-server-port) (make-publish-di (define make-project-pagetree (dynamic-require 'pollen/pagetree 'make-project-pagetree)) (define render-target-wanted (make-parameter (current-poly-target))) (define render-with-subdirs? (make-parameter #f)) + (define render-parallel? (make-parameter #f)) (define parsed-args (command-line #:program "raco pollen render" #:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'render' from the front @@ -92,6 +93,7 @@ version print the version" (current-server-port) (make-publish-di [("-r" "--recursive") "Render subdirectories recursively" (render-with-subdirs? 'recursive)] [("-s" "--subdir") "Render subdirectories nonrecursively" (render-with-subdirs? 'include)] + [("-p" "--parallel") "Render in parallel" (render-parallel? #true)] #:args other-args other-args)) (parameterize ([current-poly-target (render-target-wanted)]) ;; applies to both cases @@ -120,7 +122,7 @@ version print the version" (current-server-port) (make-publish-di [else (message (format "rendering preproc & pagetree files in directory ~a" dir)) (append preprocs static-pagetrees)]))) - (apply render-batch batch-to-render) + (keyword-apply render-batch '(#:parallel) (list (render-parallel?)) batch-to-render) (when (render-with-subdirs?) (for ([path (in-list dirlist)] #:when (and (directory-exists? path) @@ -128,7 +130,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) " "))) - (apply render-batch (map very-nice-path path-args))])))) + (keyword-apply render-batch '(#:parallel) (list (render-parallel?)) (map very-nice-path path-args))])))) (define (handle-start) (define launch-wanted #f) diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 321d7b9..9a07fcf 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1556040851 +1556041577 diff --git a/pollen/render.rkt b/pollen/render.rkt index a8f6df5..5cfaf08 100644 --- a/pollen/render.rkt +++ b/pollen/render.rkt @@ -2,10 +2,12 @@ (require racket/file racket/path racket/match + racket/place sugar/test sugar/define sugar/file sugar/coerce + sugar/list version/utils "private/file-utils.rkt" "cache.rkt" @@ -44,22 +46,59 @@ (define (list-of-pathish? x) (and (list? x) (andmap pathish? x))) -(define+provide/contract (render-batch . xs) - (() #:rest list-of-pathish? . ->* . void?) +(define+provide/contract (render-batch #:parallel [parallel? #false] . paths) + ((#:parallel any/c) #: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 xs)) + (reset-mod-date-hash!) + (cond + [parallel? + (define worker-places + (for/list ([i (in-range (processor-count))]) + (place ch + (let loop () + (define result + (with-handlers ([exn:fail? (λ (e) #false)]) + (render-from-source-or-output-path (place-channel-get ch)) + #true)) + (place-channel-put ch result) + (loop))))) -(define+provide/contract (render-pagenodes pagetree-or-path) - ((or/c pagetree? pathish?) . -> . void?) + (define flattened-paths + (filter file-exists? + (let loop ([paths paths]) + (if (null? paths) + null + (match (->complete-path (car paths)) + [(? pagetree-source? pt) (append (loop (pagetree->paths pt)) (loop (cdr paths)))] + [path (cons path (loop (cdr paths)))]))))) + + (for ([path-group (in-list (slice-at flattened-paths (length worker-places)))]) + (for ([path (in-list path-group)] + [(wp wpidx) (in-indexed worker-places)]) + (message (format "rendering parallel on core ~a /~a" (add1 wpidx) + (find-relative-path (current-project-root) (->source-path path)))) + (place-channel-put wp path)) + (for ([path (in-list path-group)] + [(wp wpidx) (in-indexed worker-places)]) + (message (format "rendered parallel on core ~a /~a" (add1 wpidx) + (find-relative-path (current-project-root) (->output-path path)))) + (place-channel-get wp)))] + [else + (for-each render-from-source-or-output-path paths)])) + +(define (pagetree->paths pagetree-or-path) (define pagetree (if (pagetree? pagetree-or-path) pagetree-or-path (cached-doc pagetree-or-path))) (parameterize ([current-directory (current-project-root)]) - (apply render-batch (map ->complete-path (pagetree->list pagetree))))) + (map ->complete-path (pagetree->list pagetree)))) + +(define+provide/contract (render-pagenodes pagetree-or-path) + ((or/c pagetree? pathish?) . -> . void?) + (apply render-batch (pagetree->paths pagetree-or-path))) (define+provide/contract (render-from-source-or-output-path so-pathish) (pathish? . -> . void?)