modularize langs

lang/reader.rkt

@@ -1,4 +1,4 @@
 #lang racket/base
 (require pollen/lang/reader-base)
 
-(make-reader-with-mode world:reader-mode-auto)
+(make-reader-with-mode world:mode-auto)

main-base.rkt

@@ -0,0 +1,101 @@
+#lang racket/base
+(require (for-syntax racket/base racket/syntax) "world.rkt")
+
+(provide (all-defined-out) (all-from-out "world.rkt"))
+
+(define-syntax (make-new-module-begin stx)
+  (syntax-case stx ()
+    [(_ mode-arg)
+     (with-syntax ([new-module-begin (format-id stx "new-module-begin")])
+       #`(define-syntax (new-module-begin stx-arg)
+           (syntax-case stx-arg ()
+             [(_ body-exprs (... ...))
+              (syntax-protect 
+               #`(#%module-begin
+                  (module inner pollen/lang/doclang-raw
+                    ;; doclang_raw is a version of scribble/doclang with the decoder disabled
+                    ;; first three lines are positional arguments for doclang-raw
+                    doc-raw ; id of export
+                    (λ(x) x) ; post-process function
+                    () ; prepended exprs
+                    
+                    ;; Change behavior of undefined identifiers with #%top
+                    ;; Get project values from world
+                    (require pollen/top pollen/world)
+                    (provide (all-from-out pollen/top pollen/world))
+                    
+                    ;; for anything defined in pollen source file
+                    (provide (all-defined-out))
+                    
+                    body-exprs (... ...))
+                  
+                  (require 'inner)
+                  
+                  
+                  ;; if reader-here-path is undefined, it will become a proc courtesy of #%top
+                  ;; therefore that's how we can detect if it's undefined
+                  (define here-path (if (procedure? reader-here-path) "anonymous-module" reader-here-path))
+
+                  
+                  ;; set the parser mode based on reader mode
+                  ;; todo: this won't work with inline submodules
+                  (define parser-mode 
+                    (if (not (procedure? reader-mode))
+                      (if (equal? reader-mode world:mode-auto)
+                          (let* ([file-ext-pattern (pregexp "\\w+$")]
+                                 [here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))])
+                            (cond
+                              [(equal? here-ext world:pagetree-source-ext) world:mode-pagetree]
+                              [(equal? here-ext world:markup-source-ext) world:mode-markup]
+                              [(equal? here-ext world:markdown-source-ext) world:mode-markdown]
+                              [else world:mode-preproc]))
+                          reader-mode)
+                      mode-arg))
+                  
+                  
+                  ;; Split out the metas.   
+                  (require txexpr)   
+                  (define (split-metas-to-hash tx) ; helper function
+                    ;; return tx without metas, and meta hash
+                    (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
+                    (define-values (doc-without-metas meta-elements) 
+                      (splitf-txexpr tx is-meta-element?))
+                    (define meta-element->assoc (λ(x) (let ([key (car (caadr x))][value (cadr (caadr x))]) (cons key value))))
+                    (define metas (make-hash (map meta-element->assoc meta-elements)))
+                    (values doc-without-metas metas))
+                  
+                  
+                  (define doc-txexpr 
+                    (let ([doc-raw (if (equal? parser-mode world:mode-markdown)
+                                       (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw)
+                                       doc-raw)])
+                      `(placeholder-root 
+                        ,@(cons (meta 'here-path: here-path) 
+                                ;; cdr strips initial linebreak, but make sure doc-raw isn't blank
+                                (if (and (list? doc-raw) (> 0 (length doc-raw))) (cdr doc-raw) doc-raw))))) 
+                  
+                  (define-values (doc-without-metas metas) (split-metas-to-hash doc-txexpr))
+                  
+                  
+                  ;; set up the 'doc export
+                  (require pollen/decode)
+                  (define doc (apply (cond
+                                       [(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))]
+                                       ;; 'root is the hook for the decoder function.
+                                       ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
+                                       [(or (equal? parser-mode world:mode-markup)
+                                            (equal? parser-mode world:mode-markdown)) root]
+                                       ;; for preprocessor output, just make a string.
+                                       [else (λ xs (apply string-append (map to-string xs)))])
+                                     (cdr doc-without-metas))) ;; cdr strips placeholder-root tag
+                  
+                  
+                  (provide metas doc
+                           ;; hide the exports that were only for internal use.
+                           (except-out (all-from-out 'inner) doc-raw #%top))
+                  
+                  ;; for output in DrRacket
+                  (module+ main
+                    (if (equal? parser-mode world:mode-preproc)
+                        (display doc)
+                        (print doc)))))])))]))

main.rkt

@@ -1,95 +1,8 @@
 #lang racket/base
 (require (for-syntax racket/base))
+(require "main-base.rkt")
 
 (provide (except-out (all-from-out racket/base) #%module-begin)
          (rename-out [new-module-begin #%module-begin]))
 
-
-(define-syntax (new-module-begin stx)
-  (syntax-case stx ()
-    [(_ body-exprs ...)
-     (syntax-protect 
-      #`(#%module-begin
-         (module inner pollen/lang/doclang-raw
-           ;; doclang_raw is a version of scribble/doclang with the decoder disabled
-           ;; first three lines are positional arguments for doclang-raw
-           doc-raw ; id of export
-           (λ(x) x) ; post-process function
-           () ; prepended exprs
-           
-           ;; Change behavior of undefined identifiers with #%top
-           ;; Get project values from world
-           (require pollen/top pollen/world)
-           (provide (all-from-out pollen/top pollen/world))
-           
-           ;; for anything defined in pollen source file
-           (provide (all-defined-out))
-           
-           body-exprs ...)
-         
-         (require 'inner)
-        
-           
-         ;; if reader-here-path is undefined, it will become a proc courtesy of #%top
-         ;; therefore that's how we can detect if it's undefined
-         (define here-path (if (procedure? reader-here-path) "anonymous-module" reader-here-path))
-         
-         ;; set the parser mode based on reader mode
-         ;; todo: this won't work with inline submodules
-         (define parser-mode (if (equal? reader-mode world:reader-mode-auto)
-                                 (let* ([file-ext-pattern (pregexp "\\w+$")]
-                                        [here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))])
-                                   (cond
-                                     [(equal? here-ext world:pagetree-source-ext) world:reader-mode-pagetree]
-                                     [(equal? here-ext world:markup-source-ext) world:reader-mode-markup]
-                                     [(equal? here-ext world:markdown-source-ext) world:reader-mode-markdown]
-                                     [else world:reader-mode-preproc]))
-                                 reader-mode))
-         
-         
-         ;; Split out the metas.   
-         (require txexpr)   
-         (define (split-metas-to-hash tx) ; helper function
-           ;; return tx without metas, and meta hash
-           (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
-           (define-values (doc-without-metas meta-elements) 
-             (splitf-txexpr tx is-meta-element?))
-           (define meta-element->assoc (λ(x) (let ([key (car (caadr x))][value (cadr (caadr x))]) (cons key value))))
-           (define metas (make-hash (map meta-element->assoc meta-elements)))
-           (values doc-without-metas metas))
-         
-         
-         (define doc-txexpr 
-           (let ([doc-raw (if (equal? parser-mode world:reader-mode-markdown)
-                              (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw)
-                              doc-raw)])
-             `(placeholder-root 
-               ,@(cons (meta 'here-path: here-path) 
-                       ;; cdr strips initial linebreak, but make sure doc-raw isn't blank
-                       (if (and (list? doc-raw) (> 0 (length doc-raw))) (cdr doc-raw) doc-raw))))) 
-         
-         (define-values (doc-without-metas metas) (split-metas-to-hash doc-txexpr))
-         
-         
-         ;; set up the 'doc export
-         (require pollen/decode)
-         (define doc (apply (cond
-                              [(equal? parser-mode world:reader-mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))]
-                              ;; 'root is the hook for the decoder function.
-                              ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
-                              [(or (equal? parser-mode world:reader-mode-markup)
-                                   (equal? parser-mode world:reader-mode-markdown)) root]
-                              ;; for preprocessor output, just make a string.
-                              [else (λ xs (apply string-append (map to-string xs)))])
-                            (cdr doc-without-metas))) ;; cdr strips placeholder-root tag
-         
-         
-         (provide metas doc
-                  ;; hide the exports that were only for internal use.
-                  (except-out (all-from-out 'inner) doc-raw #%top))
-         
-         ;; for output in DrRacket
-         (module+ main
-           (if (equal? parser-mode world:reader-mode-preproc)
-               (display doc)
-               (print doc)))))]))
+(make-new-module-begin world:mode-preproc)

markdown.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require (for-syntax racket/base))
+(require "main-base.rkt")
+
+(provide (except-out (all-from-out racket/base) #%module-begin)
+         (rename-out [new-module-begin #%module-begin]))
+
+(make-new-module-begin world:mode-markdown)

markdown/lang/reader.rkt

@@ -1,4 +1,4 @@
 #lang racket/base
 (require pollen/lang/reader-base)
 
-(make-reader-with-mode world:reader-mode-markdown)
+(make-reader-with-mode world:mode-markdown)

markup.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require (for-syntax racket/base))
+(require "main-base.rkt")
+
+(provide (except-out (all-from-out racket/base) #%module-begin)
+         (rename-out [new-module-begin #%module-begin]))
+
+(make-new-module-begin world:mode-markup)

markup/lang/reader.rkt

@@ -1,4 +1,4 @@
 #lang racket/base
 (require pollen/lang/reader-base)
 
-(make-reader-with-mode world:reader-mode-markup)
+(make-reader-with-mode world:mode-markup)

pagetree/lang/reader.rkt

@@ -1,4 +1,4 @@
 #lang racket/base
 (require pollen/lang/reader-base)
 
-(make-reader-with-mode world:reader-mode-pagetree)
+(make-reader-with-mode world:mode-pagetree)

pre.rkt

@@ -1,4 +1,8 @@
 #lang racket/base
+(require (for-syntax racket/base))
+(require "main-base.rkt")
 
-(require "main.rkt")
-(provide (all-from-out "main.rkt"))
+(provide (except-out (all-from-out racket/base) #%module-begin)
+         (rename-out [new-module-begin #%module-begin]))
+
+(make-new-module-begin world:mode-preproc)

pre/lang/reader.rkt

@@ -1,4 +1,4 @@
 #lang racket/base
 (require pollen/lang/reader-base)
 
-(make-reader-with-mode world:reader-mode-preproc)
+(make-reader-with-mode world:mode-preproc)

ptree.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require (for-syntax racket/base))
+(require "main-base.rkt")
+
+(provide (except-out (all-from-out racket/base) #%module-begin)
+         (rename-out [new-module-begin #%module-begin]))
+
+(make-new-module-begin world:mode-pagetree)

tests/test-langs.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+
+
+
+(module test-default pollen
+  "hello world")
+
+(require (prefix-in default: 'test-default))
+
+default:doc ; should be "hello world"
+
+
+(module test-pre pollen/pre
+  "hello world")
+
+(require (prefix-in pre: 'test-pre))
+
+pre:doc  ; should be "hello world"
+
+
+(module test-markup pollen/markup
+  "hello world")
+
+(require (prefix-in markup: 'test-markup))
+
+markup:doc ; should be '(root "hello world")
+
+(module test-markdown pollen/markdown
+  "hello world")
+
+(require (prefix-in markdown: 'test-markdown))
+
+markdown:doc ; should be '(root (p "hello world"))
+
+
+(module test-ptree pollen/ptree
+  '(index (brother sister)))
+
+(require (prefix-in ptree: 'test-ptree))
+
+ptree:doc ; should be '(pagetree-root (index (brother sister)))
+
+
+(begin 
+ (require racket/rerequire)
+  (dynamic-rerequire (string->path "/Users/mb/git/bpt/test.html.pm") #:verbosity 'reload)
+  (dynamic-require (string->path "/Users/mb/git/bpt/test.html.pm") 'doc))
+
+
+
+(eval 
+ '(begin 
+    (require racket/rerequire)
+    (dynamic-rerequire (string->path "/Users/mb/git/bpt/test.html.pm") #:verbosity 'reload)
+    (dynamic-require (string->path "/Users/mb/git/bpt/test.html.pm") 'doc)) (make-base-namespace))
+

world.rkt

@@ -13,11 +13,11 @@
 (define scribble-source-ext 'scrbl)
 
 
-(define reader-mode-auto 'auto)
-(define reader-mode-preproc 'pre)
-(define reader-mode-markup 'markup)
-(define reader-mode-markdown 'markdown)
-(define reader-mode-pagetree 'ptree)
+(define mode-auto 'auto)
+(define mode-preproc 'pre)
+(define mode-markup 'markup)
+(define mode-markdown 'markdown)
+(define mode-pagetree 'ptree)
 
 (define decodable-extensions (list markup-source-ext pagetree-source-ext))