slower, but more consistent

lang/doclang2_raw.rkt

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

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 #\◊
+  (make-at-reader #:command-char #\◊ #:syntax? #t #:inside? #t))
-                  #: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 
+  `(module pollen-lang-module pollen ,@i))
-     ,@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 pollen ,@file-contents) file-contents))
-  (datum->syntax file-contents 
-                 `(module pollen-lang-module ,(if (member file-ext (list "pd" "ptree")) 
-                                                  'pollen/main 
-                                                  'pollen/main-preproc) 
-                    ,@file-contents)
-                 file-contents))

main-current.rkt

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

main-imports.rkt

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

main-preproc-current.rkt

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

main-preproc-imports.rkt

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

main-preproc.rkt

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

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
+     ;; first three lines are positional arguments for doclang_raw
-     (λ(x) (cdr x)) ;; chop first linebreak with cdr
+     main-raw ; id of export
-     ()
+     (λ(x) x) ; post-process function
-     (require pollen/main-helper pollen/top )
+     () ; prepended exprs
+     
+     (require pollen/lang/lang-helper)
      (require-project-require-files)
      (provide (all-defined-out))
      
-     ;; Build 'here
+     ;; Change behavior of undefined identifiers
-     (define here-path (get-here-path))
+     (require pollen/top)
-     (require (only-in xml xexpr->string))
+     (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 inner-here (path->string (->output-path (find-relative-path PROJECT_ROOT inner-here-path))))
-     (define (path->pnode path)
-       (path->string (->output-path (find-relative-path PROJECT_ROOT path))))
-     (define here (path->pnode 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.
-   (require txexpr)
+   ;; First, append "here-path" and "here" as metas.
-   
+   ;; Because they might have been overridden by custom metas in the source.
-   ;; split out the metas. Might include user-defined metas.
+   (require txexpr)   
-   ;; But first, append here-path and here as meta.
+   (define one-with-everything `(placeholder-root 
-   ;;  so they can be overridden by custom meta later
+                                 (meta "here-path" ,inner-here-path)
-   ;; 'root is the hook for the decoder function.
+                                 (meta "here" ,inner-here)                         
-   ;; If it's not defined elsewhere, it just hits #%top and becomes a txexpr.
+                                 ,@(cdr main-raw))) ;; cdr strips initial linebreak
-   
-   (define one-with-everything `(root 
-                                 ,@(cons `(meta "here-path" ,here-path)
-                                         (cons `(meta "here" ,here)                         
-                                               main-raw))))
    
    (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))))
+   ;; derive 'here & 'here-path from the hash (because they might have been overridden in the source) 
-   (define metas (make-hash (map meta-element-to-pair metas-raw)))
+   (define here (hash-ref metas "here"))
-   (define main main-without-metas)
+   (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)))))