modularize langs

pull/9/head
Matthew Butterick 11 years ago
parent a25118aa48
commit da689e4a51

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

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

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

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

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

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

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

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

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

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

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

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

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

Loading…
Cancel
Save