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

slower, but more consistent

Browse Source
pull/9/head
Matthew Butterick 11 years ago
parent 925aeadfb1
commit 8c6054643b
9 changed files with 51 additions and 273 deletions
Show Stats Download Patch File Download Diff File

28
lang/doclang2_raw.rkt
Unescape Escape View File

@ -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))]))

0
main-helper.rkt → lang/lang-helper.rkt
Unescape Escape View File

16
lang/reader.rkt
Unescape Escape View File

@ -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))

106
main-current.rkt
Unescape Escape View File

@ -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
)))

21
main-imports.rkt
Unescape Escape View File

@ -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))

36
main-preproc-current.rkt
Unescape Escape View File

@ -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))))

14
main-preproc-imports.rkt
Unescape Escape View File

@ -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))

24
main-preproc.rkt
Unescape Escape View File

@ -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))))

77
main.rkt
Unescape Escape View File

@ -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
;; 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)
;; 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))))
(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)))))

Write Preview
Loading…
Cancel
Save