From 035b2a34c87ca23eaeec55536e5959a655d60e54 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 23 Aug 2015 23:03:31 -0700 Subject: [PATCH] add compatibility with new macro expander --- main-base.rkt | 57 +++++++++++++++++++++++-------------------------- reader-base.rkt | 41 ++++++++++++++++++----------------- 2 files changed, 48 insertions(+), 50 deletions(-) diff --git a/main-base.rkt b/main-base.rkt index 4c9203e..b1e1504 100644 --- a/main-base.rkt +++ b/main-base.rkt @@ -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 \ No newline at end of file + [(_ 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 \ No newline at end of file diff --git a/reader-base.rkt b/reader-base.rkt index acd3fad..6e232f5 100644 --- a/reader-base.rkt +++ b/reader-base.rkt @@ -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)))))