From 776a9f90e8663eb532432c740c4932d0c7aba8c0 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 19 Feb 2014 16:36:33 -0800 Subject: [PATCH] accelerating preprocessor --- file-tools.rkt | 7 --- main-helper.rkt | 6 +-- main-preproc.rkt | 8 ++-- project-requires.rkt | 14 ++++++ render.rkt | 107 ++++++++++++++++++++----------------------- tools.rkt | 9 ---- 6 files changed, 70 insertions(+), 81 deletions(-) create mode 100644 project-requires.rkt diff --git a/file-tools.rkt b/file-tools.rkt index 919816b..8c32754 100644 --- a/file-tools.rkt +++ b/file-tools.rkt @@ -153,13 +153,6 @@ (let-values ([(dir name ignore) (split-path x)]) (equal? (get (->string name) 0) TEMPLATE_SOURCE_PREFIX)))) -;; predicate for files that are eligible to be required -;; from the project/require directory -;; todo: extend this beyond just racket files? -(define+provide/contract (project-require-file? x) - (any/c . -> . coerce/boolean?) - (and (pathish? x) (has-ext? x 'rkt))) - ;; todo: tighten these input contracts diff --git a/main-helper.rkt b/main-helper.rkt index 28f28d1..53a40ed 100644 --- a/main-helper.rkt +++ b/main-helper.rkt @@ -1,14 +1,12 @@ #lang racket/base -(require (for-syntax racket/base pollen/tools sugar)) +(require (for-syntax racket/base pollen/project-requires)) (require racket/contract/region) (provide (all-defined-out) (all-from-out racket/contract/region)) - (define-for-syntax (put-file-in-require-form file) - `(file ,(->string file))) - + `(file ,(path->string file))) (define-for-syntax (make-require-extras-syntax stx #:provide? [provide? #f]) (define project-require-files (get-project-require-files)) diff --git a/main-preproc.rkt b/main-preproc.rkt index 1af35e6..0f1459c 100644 --- a/main-preproc.rkt +++ b/main-preproc.rkt @@ -3,15 +3,17 @@ (provide (except-out (all-from-out racket/base) #%module-begin) (rename-out [module-begin #%module-begin])) -(define-syntax-rule (module-begin expr ...) +(define-syntax-rule (module-begin body ...) (#%module-begin (module inner pollen/lang/doclang_raw main - (λ(x) (apply string-append (cdr x))) ;; chop first linebreak off + (λ(x) (apply string-append (cdr x))) ;; chop first linebreak with cdr () + (require pollen/main-helper pollen/top) + (require-and-provide-extras) (provide (all-defined-out)) - expr ...) + body ...) (require 'inner) (provide (all-from-out 'inner)) diff --git a/project-requires.rkt b/project-requires.rkt new file mode 100644 index 0000000..8f7bddc --- /dev/null +++ b/project-requires.rkt @@ -0,0 +1,14 @@ +#lang racket/base +(provide (all-defined-out)) + +(define (project-require-file? path) + (define path-string (path->string path)) + (equal? (substring path-string (- (string-length path-string) 3) (string-length path-string)) "rkt")) + +;; list of all eligible requires in project require directory +(define (get-project-require-files) + (define extras-directory (build-path (current-directory) "pollen-require")) + (and (directory-exists? extras-directory) + ;; #:build? option returns complete paths (instead of just file names) + (let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))]) + (and (not (equal? '() files)) files)))) \ No newline at end of file diff --git a/render.rkt b/render.rkt index 30df435..b53fdb4 100644 --- a/render.rkt +++ b/render.rkt @@ -1,8 +1,5 @@ #lang racket/base (require racket/port racket/file racket/rerequire racket/contract racket/path) -;(require "world.rkt" ) - -;;todo: why is pollen/top operating in this file? (module+ test (require rackunit)) @@ -23,6 +20,8 @@ ;; between development sessions (prob a worthless optimization) (define mod-dates (make-hash)) + + (define/contract (make-mod-dates-key paths) ((listof path?) . -> . (listof path?)) (define project-require-files (or (get-project-require-files) empty)) @@ -113,7 +112,7 @@ ; (message "Dispatching render for" (->string (file-name-from-path path))) (cond ;; this will catch preprocessor files - [(needs-preproc? path) (render-preproc-source path #:force force)] + [(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)] @@ -142,45 +141,37 @@ (any/c . -> . void?) (message (->string (file-name-from-path path)) "is up to date, using cached copy")) - -(define/contract (render-preproc-source x #:force [force #f]) - (((and/c pathish? - (flat-named-contract 'file-exists - (λ(x) (file-exists? (->complete-path (->preproc-source-path x))))))) (#:force boolean?) . ->* . void?) - - ;; x might be either a preproc-source path or preproc-output path - (define source-path (->complete-path (->preproc-source-path x))) +(define (render-preproc-source source-path output-path) + ;; how we render: import 'main from preproc source file, + ;; which is rendered during source parsing, + ;; and write that to output path (define-values (source-dir source-name _) (split-path source-path)) - (define output-path (->complete-path (->output-path x))) + (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 + (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]) + ((pathish?) (#:force boolean?) . ->* . void?) - (define source-reloaded? (handle-source-rerequire source-path)) + ;; input-path might be either a preproc-source path or preproc-output path + ;; But the coercion functions will figure it out. + (define source-path (->complete-path (->preproc-source-path input-path))) + (define output-path (->complete-path (->output-path input-path))) - ;; Four conditions under which we render preproc sources: - (if (or - ;; 1) explicitly forced render: - force - ;; 2) output file doesn't exist (so it definitely won't appear in mod-dates) - ;; also, this is convenient for development: - ;; you can trigger a render just by deleting the file + (define render-needed? + (or + force-render (not (file-exists? output-path)) - ;; 3) file otherwise needs render (e.g., it changed) (mod-date-expired? source-path) - ;; 4) source had to be reloaded (some other change) - source-reloaded?) - - ;; how we render: import 'main from preproc source file, - ;; which is rendered during source parsing, - ;; and write that to output path - (begin - (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)))]) - (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)) - - ;; otherwise, skip file because there's no trigger for render + (let ([source-reloaded? (handle-source-rerequire source-path)]) + source-reloaded?))) + + (if render-needed? + (render-preproc-source source-path output-path) (up-to-date-message output-path))) ;; todo: write tests @@ -293,28 +284,29 @@ pollen/debug pollen/decode pollen/file-tools - pollen/main-imports - pollen/main-preproc-imports + ;; commented out so we don't get #%top in this file + ; pollen/main-imports + ; pollen/main-preproc-imports pollen/predicates pollen/ptree sugar pollen/template pollen/tools - pollen/world) + pollen/world + pollen/project-requires) (define original-ns (current-namespace)) (define/contract (render-through-eval base-dir eval-string) (directory-pathish? list? . -> . string?) (parameterize ([current-namespace (make-base-empty-namespace)] [current-directory (->complete-path base-dir)] - [current-output-port nowhere-port]) + [current-output-port (current-error-port)]) ;; attach already-imported modules ;; this is a performance optimization: this way, ;; the eval namespace doesn't have to re-import these ;; because otherwise, most of its time is spent traversing imports. - (map (λ(mod-name) (namespace-attach-module original-ns mod-name)) - '(racket/base - web-server/templates + (for-each (λ(mod-name) (namespace-attach-module original-ns mod-name)) + '(web-server/templates xml/path racket/port racket/file @@ -324,8 +316,8 @@ pollen/debug pollen/decode pollen/file-tools - pollen/main-imports - pollen/main-preproc-imports + ; pollen/main-imports + ; pollen/main-preproc-imports pollen/predicates pollen/ptree sugar @@ -333,7 +325,6 @@ pollen/tools pollen/world)) (namespace-require 'racket/base) ; use namespace-require for FIRST require, then eval after - (eval '(require (for-syntax racket/base))) (eval eval-string (current-namespace)))) (define/contract (render-source-with-template source-path template-path) @@ -350,16 +341,16 @@ (define string-to-eval `(begin - ;; for include-template (used below) - (require web-server/templates) - ;; for ptree navigation functions, and template commands - ;; todo: main-helper is here for #%top and bound/c — should they go elsewhere? - (require pollen/debug pollen/ptree pollen/template pollen/top) - ;; import source into eval space. This sets up main & metas - (require ,(->string source-name)) - (parameterize ([current-ptree (make-project-ptree ,PROJECT_ROOT)] - [current-url-context ,PROJECT_ROOT]) - (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))))) + ;; for include-template (used below) + (require web-server/templates) + ;; for ptree navigation functions, and template commands + ;; todo: main-helper is here for #%top and bound/c — should they go elsewhere? + (require pollen/debug pollen/ptree pollen/template pollen/top) + ;; import source into eval space. This sets up main & metas + (require ,(->string source-name)) + (parameterize ([current-ptree (make-project-ptree ,PROJECT_ROOT)] + [current-url-context ,PROJECT_ROOT]) + (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))))) (render-through-eval source-dir string-to-eval)) diff --git a/tools.rkt b/tools.rkt index 885ccb4..4f22c50 100644 --- a/tools.rkt +++ b/tools.rkt @@ -6,15 +6,6 @@ ;; setup for test cases (module+ test (require rackunit)) -;; list of all eligible requires in project require directory -(define+provide/contract (get-project-require-files) - (-> (or/c #f (listof complete-path?))) - (define extras-directory (build-path PROJECT_ROOT EXTRAS_DIR)) - (and (directory-exists? extras-directory) - ;; #:build? option returns complete paths (instead of just file names) - (let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))]) - (and (not (empty? files)) files)))) - ;; convert list of meta tags to a hash for export from pollen document. ;; every meta is form (meta "key" "value") (enforced by contract)