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

add compatibility with new macro expander

Browse Source
pull/84/head
Matthew Butterick 9 years ago
parent 90200c30dc
commit 035b2a34c8
2 changed files with 48 additions and 50 deletions
Show Stats Download Patch File Download Diff File

57
main-base.rkt
Unescape Escape View File

@ -9,33 +9,30 @@
(rename-out [pollen-module-begin #%module-begin])) (rename-out [pollen-module-begin #%module-begin]))
(define-syntax (pollen-module-begin stx) (define-syntax (pollen-module-begin stx)
(syntax-case stx () (syntax-case stx ()
[(_ EXPR (... ...)) [(_ expr (... ...))
(with-syntax ([DOC (datum->syntax stx (world:current-main-export))] (with-syntax ([EXPRS #'(expr (... ...))])
[INNER (datum->syntax stx ''inner)]) (datum->syntax #'EXPRS
#'(#%module-begin `(#%module-begin
(module inner pollen/doclang-raw ; exports result as doc-raw (module inner pollen/doclang-raw ; exports result as doc-raw
(require pollen/top pollen/world) (require pollen/top pollen/world)
(provide #%top (all-defined-out) (all-from-out pollen/world)) (provide #%top (all-defined-out) (all-from-out pollen/world))
EXPR (... ...)) ,@(syntax->datum #'EXPRS))
(require 'inner)
(require INNER 'inner) ; import inner twice: INNER for external use, 'inner for internal (define ,(world:current-main-export)
(let* ([parser-mode-undefined? (procedure? inner:parser-mode)] ; if undefined, #%top makes it a procedure
(define DOC [parser-mode (if parser-mode-undefined?
(let* ([parser-mode-undefined? (procedure? inner:parser-mode)] ; if undefined, #%top makes it a procedure MODE-ARG
[parser-mode (if parser-mode-undefined? inner:parser-mode)]
MODE-ARG [proc (cond
inner:parser-mode)] [(eq? parser-mode world:mode-pagetree) (λ xs (decode-pagetree xs))]
[proc (cond [(eq? parser-mode world:mode-markup) root] ; if `root` undefined, it becomes a default tag function
[(eq? parser-mode world:mode-pagetree) (λ xs (decode-pagetree xs))] [(eq? parser-mode world:mode-markdown)
[(eq? parser-mode world:mode-markup) root] ; if `root` undefined, it becomes a default tag function (λ xs (apply root (apply (compose1 parse-markdown string-append)
[(eq? parser-mode world:mode-markdown) (map to-string xs))))]
(λ xs (apply root (apply (compose1 parse-markdown string-append) [else ; for preprocessor output, just make a string
(map to-string xs))))] (λ xs (apply string-append (map to-string xs)))])]
[else ; for preprocessor output, just make a string [doc-elements (if (list? doc-raw) ; discard all newlines at front of multi-line file
(λ xs (apply string-append (map to-string xs)))])] (dropf doc-raw (λ(ln) (equal? ln "\n")))
[doc-elements (if (list? doc-raw) ; discard all newlines at front of multi-line file doc-raw)]) ; single line
(dropf doc-raw (λ(ln) (equal? ln "\n"))) (apply proc doc-elements)))
doc-raw)]) ; single line (provide ,(world:current-main-export) (except-out (all-from-out 'inner) doc-raw #%top))) #'EXPRS))])))) ; hide internal exports
(apply proc doc-elements)))
(provide DOC (except-out (all-from-out INNER) doc-raw #%top))))])))) ; hide internal exports

37
reader-base.rkt
Unescape Escape View File

@ -55,27 +55,28 @@
reader-mode)) reader-mode))
(define meta-keys-plus-here (cons (world:current-here-path-key) meta-keys)) ; here-path at front so it can be overridden (define meta-keys-plus-here (cons (world:current-here-path-key) meta-keys)) ; here-path at front so it can be overridden
(define meta-values-plus-here (cons reader-here-path meta-values)) (define meta-values-plus-here (cons reader-here-path meta-values))
(with-syntax ([(KEY ...) (datum->syntax source-stx meta-keys-plus-here)] (with-syntax* ([(KEY ...) (datum->syntax source-stx meta-keys-plus-here)]
[(VALUE ...) (datum->syntax source-stx meta-values-plus-here)]) [(VALUE ...) (datum->syntax source-stx meta-values-plus-here)]
[KVS #'(append (list 'KEY VALUE) ...)])
(syntax-property (syntax-property
(replace-context source-stx (datum->syntax source-stx
#`(module runtime-wrapper racket/base `(module runtime-wrapper racket/base
(module metas racket/base (module metas racket/base
(provide (all-defined-out)) (provide (all-defined-out))
(define #,(world:current-meta-export) (apply hash (append (list 'KEY VALUE) ...)))) (define ,(world:current-meta-export) (apply hash ,(syntax->datum #'KVS))))
(module pollen-lang-module pollen (module pollen-lang-module pollen
(define parser-mode '#,parser-mode) ; change names of exports for local use, to avoid conflicts (define parser-mode ',parser-mode) ; change names of exports for local use, to avoid conflicts
(provide (except-out (all-defined-out) parser-mode) (provide (except-out (all-defined-out) parser-mode)
(prefix-out inner: parser-mode)) (prefix-out inner: parser-mode))
#,(require+provide-directory-require-files path-string) ,(require+provide-directory-require-files path-string)
(require (submod ".." ".." metas)) ; get metas from adjacent submodule (require (submod ".." ".." metas)) ; get metas from adjacent submodule
(provide (all-from-out (submod ".." ".." metas))) (provide (all-from-out (submod ".." ".." metas)))
#,@meta-free-file-data) ,@meta-free-file-data)
(require (submod pollen/runtime-config show) 'pollen-lang-module) (require (submod pollen/runtime-config show) 'pollen-lang-module)
(provide (all-from-out 'pollen-lang-module)) (provide (all-from-out 'pollen-lang-module))
(show #,(world:current-main-export) inner:parser-mode))) (show ,(world:current-main-export) inner:parser-mode)) source-stx)
'module-language 'module-language
'#(pollen/language-info get-language-info #f))))) '#(pollen/language-info get-language-info #f)))))

Write Preview
Loading…
Cancel
Save