From 8c6054643b6df5100d68c371b97d9be2f2d82595 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 19 Feb 2014 22:56:43 -0800 Subject: [PATCH] slower, but more consistent --- lang/doclang2_raw.rkt | 28 ------- main-helper.rkt => lang/lang-helper.rkt | 0 lang/reader.rkt | 16 +--- main-current.rkt | 106 ------------------------ main-imports.rkt | 21 ----- main-preproc-current.rkt | 36 -------- main-preproc-imports.rkt | 14 ---- main-preproc.rkt | 24 ------ main.rkt | 79 +++++++++++------- 9 files changed, 51 insertions(+), 273 deletions(-) delete mode 100755 lang/doclang2_raw.rkt rename main-helper.rkt => lang/lang-helper.rkt (100%) delete mode 100644 main-current.rkt delete mode 100644 main-imports.rkt delete mode 100644 main-preproc-current.rkt delete mode 100644 main-preproc-imports.rkt delete mode 100644 main-preproc.rkt diff --git a/lang/doclang2_raw.rkt b/lang/doclang2_raw.rkt deleted file mode 100755 index b850b98..0000000 --- a/lang/doclang2_raw.rkt +++ /dev/null @@ -1,28 +0,0 @@ -#lang racket/base - -;; A slightly nicer version of doclang where the parameters are keyword-based -;; rather than positional. Delegates off to the original doclang. - -(require (prefix-in doclang: "doclang_raw.rkt") - (for-syntax racket/base - syntax/parse)) - -(provide (except-out (all-from-out racket/base) #%module-begin) - (rename-out [*module-begin #%module-begin])) - -;; Module wrapper ---------------------------------------- - -(define-syntax (*module-begin stx) - (syntax-parse stx - [(_ (~or (~optional (~seq #:id id)) - (~optional (~seq #:post-process post-process)) - (~optional (~seq #:exprs exprs))) - ... - . body) - (with-syntax ([id (or (attribute id) - #'doc)] - [post-process (or (attribute post-process) - #'values)] - [exprs (or (attribute exprs) - #'())]) - #'(doclang:#%module-begin id post-process exprs . body))])) diff --git a/main-helper.rkt b/lang/lang-helper.rkt similarity index 100% rename from main-helper.rkt rename to lang/lang-helper.rkt diff --git a/lang/reader.rkt b/lang/reader.rkt index 463e1df..752866e 100644 --- a/lang/reader.rkt +++ b/lang/reader.rkt @@ -4,25 +4,15 @@ (provide (rename-out [pollen-read read] [pollen-read-syntax read-syntax]) read-inner) (define read-inner - (make-at-reader #:command-char #\◊ - #:syntax? #t - #:inside? #t)) + (make-at-reader #:command-char #\◊ #:syntax? #t #:inside? #t)) (define (pollen-read p) (syntax->datum (pollen-read-syntax (object-name p) p))) (define (make-output-datum i) - `(module pollen-lang-module pollen - ,@i)) - + `(module pollen-lang-module pollen ,@i)) (define (pollen-read-syntax path-string p) (define file-contents (read-inner path-string p)) - (define file-ext (car (regexp-match #px"\\w+$" (path->string path-string)))) - (datum->syntax file-contents - `(module pollen-lang-module ,(if (member file-ext (list "pd" "ptree")) - 'pollen/main - 'pollen/main-preproc) - ,@file-contents) - file-contents)) + (datum->syntax file-contents `(module pollen-lang-module pollen ,@file-contents) file-contents)) diff --git a/main-current.rkt b/main-current.rkt deleted file mode 100644 index 754af55..0000000 --- a/main-current.rkt +++ /dev/null @@ -1,106 +0,0 @@ -#lang racket/base -(require "main-imports.rkt") -(provide (except-out (all-from-out racket/base) #%module-begin) - (rename-out [module-begin #%module-begin])) - -(define-syntax-rule (module-begin expr ...) - (#%module-begin - - ;; this is here only so that dynamic-rerequire of a pollen module - ;; transitively reloads the extras also. - ;; if this isn't here, then dynamic-rerequire can't see them - ;; and thus they are not tracked for changes. - (require-extras) - - ;; We want our module language to support require & provide - ;; which are only supported at the module level, so ... - ;; create a submodule to contain the input - ;; and export as needed - - ;; doclang2_raw is a clone of scribble/doclang2 with decode disabled - ;; helpful because it collects & exports content via 'doc - (module pollen-inner pollen/lang/doclang2_raw - ;; use same requires as top of main.rkt - ;; (can't import them from surrounding module due to submodule rules) - ;; todo: how to keep these two lists in sync? - ;; and why doesn't this work: - ;; (require pollen/main-imports) - ;; (provide (all-from-out pollen/main-imports)) - (require pollen/tools pollen/main-helper pollen/top pollen/ptree sugar txexpr) - (require-and-provide-extras) ; brings in the project require files - - expr ... ; body of module - - ;; set up a hook for identifier 'here' - ;; (but under a different name to avoid macrofication) - (define inner-here-path here-path) - (provide (all-defined-out)) - (provide (all-from-out ; pollen file should bring its requires - pollen/tools))) - - (require 'pollen-inner) ; provides doc & #%top, among other things - - (define here ((bound/c path->pnode) inner-here-path)) - - ;; prepare the elements, and append inner-here-path as meta. - ;; put it first so it can be overridden by custom meta later on - (define all-elements (cons `(meta "here-path" ,inner-here-path) - (cons `(meta "here" ,here) - (cond - ;; doc is probably a list, but might be a single string - [(string? doc) (list doc)] - ;; if it's a single nx, just leave it - [(txexpr? doc) (list doc)] - ;; if it's nx content, splice it in - [(list? doc) doc])))) - - - ;; split out the metas now (in raw form) - (define-values (metas-raw main-raw) - ((bound/c split-tag-from-xexpr) 'meta (make-txexpr 'irrelevant-tag empty all-elements))) - - (define metas (make-meta-hash metas-raw)) - - ;; Policy: here in the core lang, do as little to main as possible. - ;; The point is just to set it up for further processing. - ;; Unlike Scribble, which insists on decoding, - ;; Pollen just passes through the minimally processed data. - ;; one exception: if file extension marks it as ptree, send it to the ptree decoder instead. - - ;; this tests inner-here (which is always the file name) - ;; rather than (get metas 'here) which might have been overridden. - ;; Because if it's overridden to something other than *.ptree, - ;; ptree processing will fail. - ;; This defeats rule that ptree file suffix triggers ptree decoding. - (define here-is-ptree? ((bound/c ptree-source?) ((bound/c ->path) inner-here-path))) - - (define main (apply (if here-is-ptree? - ;; ptree source files will go this way, - (bound/c ptree-source-decode) - ;; ... but other files, including pollen, will go this way. - ;; Root is treated as a function. - ;; If it's not defined elsewhere, - ;; it just hits #%top and becomes a txexpr. - root) ((bound/c get-elements) main-raw))) - - - (provide main metas here - (except-out (all-from-out 'pollen-inner) inner-here-path) ; everything from user - (rename-out (inner-here-path here-path))) ; change identifier back (now safe from macrofication) - - (module+ main - (displayln ";-------------------------") - (displayln (string-append "; pollen decoded 'main" (if here-is-ptree? " (as ptree)" ""))) - (displayln ";-------------------------") - main - (displayln "") - - (if here-is-ptree? - (displayln (format "(ptree? main) ~a" (ptree? main))) - (displayln (format "(txexpr? main) ~a" (txexpr? main)))) - (displayln "") - (displayln ";-------------------------") - (displayln "; pollen 'metas") - (displayln ";-------------------------") - metas - ))) diff --git a/main-imports.rkt b/main-imports.rkt deleted file mode 100644 index a7d4f6e..0000000 --- a/main-imports.rkt +++ /dev/null @@ -1,21 +0,0 @@ -#lang racket/base - -;; These are separated from main.rkt as a performance improvement: -;; so they can be imported into the render.rkt namespace -;; and cached for the benefit of the render eval function. - -(require racket/list - pollen/tools - pollen/main-helper - pollen/top - txexpr - sugar - (only-in pollen/ptree ptree-source-decode path->pnode ptree?)) - -(provide (all-from-out racket/list - pollen/tools - pollen/main-helper - pollen/top - txexpr - sugar - pollen/ptree)) \ No newline at end of file diff --git a/main-preproc-current.rkt b/main-preproc-current.rkt deleted file mode 100644 index e4eabed..0000000 --- a/main-preproc-current.rkt +++ /dev/null @@ -1,36 +0,0 @@ -#lang racket/base - -(require "main-preproc-imports.rkt") -(provide (except-out (all-from-out racket/base) #%module-begin) - (rename-out [module-begin #%module-begin])) - -(require (only-in scribble/text output) - (only-in racket/list flatten)) - -(define-syntax-rule (module-begin expr ...) - (#%module-begin - - ; We want our module language to support require & provide - ; which are only supported at the module level, so ... - ; create a submodule to contain the input - ; and export as needed - - ; doclang2_raw is a clone of scribble/doclang2 with decode disabled - ; helpful because it collects & exports content via 'doc - (module pollen-inner pollen/lang/doclang2_raw - (require pollen/tools pollen/main-helper pollen/top) - (require-and-provide-extras) ; brings in the project require files - - expr ...) ; body of module - - (require 'pollen-inner) ; provides 'doc - - ;; reduce text to simplest representation: a single ouput string - (define main (apply string-append (map ->string (flatten (trim (->list doc) whitespace?))))) - (provide main (all-from-out 'pollen-inner)) - - (module+ main -; (displayln ";-------------------------") -; (displayln (string-append "; pollen 'main")) -; (displayln ";-------------------------") - (display main)))) diff --git a/main-preproc-imports.rkt b/main-preproc-imports.rkt deleted file mode 100644 index 014c211..0000000 --- a/main-preproc-imports.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket/base - -;; These are separated from main-preproc.rkt as a performance improvement: -;; so they can be imported into the render.rkt namespace -;; and cached for the benefit of the render eval function. - -(require pollen/top - (only-in sugar ->list ->string trim) - (only-in pollen/predicates whitespace?)) - -(provide (all-from-out - pollen/top - sugar - pollen/predicates)) \ No newline at end of file diff --git a/main-preproc.rkt b/main-preproc.rkt deleted file mode 100644 index 8c24e0e..0000000 --- a/main-preproc.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket/base - -(provide (except-out (all-from-out racket/base) #%module-begin) - (rename-out [new-module-begin #%module-begin])) - -(define-syntax-rule (new-module-begin body ...) - (#%module-begin - (module inner pollen/lang/doclang_raw - main-raw - (λ(x) (apply string-append (cdr x))) ;; chop first linebreak with cdr - () - (require pollen/main-helper) - (require-project-require-files) - (provide (all-defined-out)) - - body ...) - - (require 'inner) - (define main main-raw) - (provide (all-from-out 'inner) main) - - (module+ main - (display main)))) - \ No newline at end of file diff --git a/main.rkt b/main.rkt index 15c45d8..5cc715b 100644 --- a/main.rkt +++ b/main.rkt @@ -5,52 +5,69 @@ (define-syntax-rule (new-module-begin body-exprs ...) (#%module-begin - ;; first three lines are positional arguments (module inner pollen/lang/doclang_raw - main-raw - (λ(x) (cdr x)) ;; chop first linebreak with cdr - () - (require pollen/main-helper pollen/top ) + ;; first three lines are positional arguments for doclang_raw + main-raw ; id of export + (λ(x) x) ; post-process function + () ; prepended exprs + + (require pollen/lang/lang-helper) (require-project-require-files) (provide (all-defined-out)) - ;; Build 'here - (define here-path (get-here-path)) - (require (only-in xml xexpr->string)) + ;; Change behavior of undefined identifiers + (require pollen/top) + (provide (all-from-out pollen/top)) + + ;; Build 'inner-here-path and 'inner-here + (define inner-here-path (get-here-path)) + (require (only-in pollen/world PROJECT_ROOT)) (require (only-in racket/path find-relative-path)) (require (only-in pollen/file-tools ->output-path)) - (require (only-in pollen/world PROJECT_ROOT)) - (define (path->pnode path) - (path->string (->output-path (find-relative-path PROJECT_ROOT path)))) - (define here (path->pnode here-path)) + (define inner-here (path->string (->output-path (find-relative-path PROJECT_ROOT inner-here-path)))) body-exprs ...) (require 'inner) - ;; function to split tag out of txexpr - (require txexpr) - - ;; split out the metas. Might include user-defined metas. - ;; But first, append here-path and here as meta. - ;; so they can be overridden by custom meta later - ;; 'root is the hook for the decoder function. - ;; If it's not defined elsewhere, it just hits #%top and becomes a txexpr. - - (define one-with-everything `(root - ,@(cons `(meta "here-path" ,here-path) - (cons `(meta "here" ,here) - main-raw)))) + ;; Split out the metas. We want to catch user-defined metas too. + ;; First, append "here-path" and "here" as metas. + ;; Because they might have been overridden by custom metas in the source. + (require txexpr) + (define one-with-everything `(placeholder-root + (meta "here-path" ,inner-here-path) + (meta "here" ,inner-here) + ,@(cdr main-raw))) ;; cdr strips initial linebreak (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (get-tag x))))) - (define-values (metas-raw main-without-metas) + (define-values (main-without-metas meta-elements) (splitf-txexpr one-with-everything is-meta-element?)) + (define meta-element->assoc (λ(x) (cons (cadr x) (caddr x)))) + (define metas (make-hash (map meta-element->assoc meta-elements))) + + + ;; set up the 'main export + (define here-ext (car (regexp-match #px"\\w+$" inner-here-path))) + (define wants-decoder? (member here-ext (list "pd" "ptree"))) + (define main (apply (if wants-decoder? + ;; 'root is the hook for the decoder function. + ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) + root + ;; for textual (preprocessor-style) output. Converts x-expressions to HTML. + (λ xs (apply string-append (map (dynamic-require 'xml 'xexpr->string) xs)))) + (cdr main-without-metas))) ;; cdr strips placeholder-root tag + - (define meta-element-to-pair (λ(x) (cons (cadr x) (caddr x)))) - (define metas (make-hash (map meta-element-to-pair metas-raw))) - (define main main-without-metas) + ;; derive 'here & 'here-path from the hash (because they might have been overridden in the source) + (define here (hash-ref metas "here")) + (define here-path (hash-ref metas "here-path")) - (provide (all-from-out 'inner) metas main) + (provide metas main here here-path + ;; hide the exports that were only for internal use + (except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top)) + ;; for output in DrRacket (module+ main - (print main)))) + (if wants-decoder? + (print main) + (display main)))))