add compatibility with new macro expander

pull/84/head
Matthew Butterick 9 years ago
parent 90200c30dc
commit 035b2a34c8

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

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

Loading…
Cancel
Save