From dfdc10c353200e6420c2b007de035523c6c16b37 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 16 Aug 2015 17:12:31 -0700 Subject: [PATCH] remove brain damage & cruft from #lang core; add runtime-config --- language-info.rkt | 7 +++ main-base.rkt | 127 +++++++++++++++++++++----------------------- reader-base.rkt | 79 +++++++++++++-------------- runtime-config.rkt | 22 ++++++++ test/test-langs.rkt | 3 +- 5 files changed, 129 insertions(+), 109 deletions(-) create mode 100644 language-info.rkt create mode 100644 runtime-config.rkt diff --git a/language-info.rkt b/language-info.rkt new file mode 100644 index 0000000..c7e14f6 --- /dev/null +++ b/language-info.rkt @@ -0,0 +1,7 @@ +#lang racket/base +(provide get-language-info) +(define (get-language-info data) + (lambda (key default) + (case key + [(configure-runtime) '(#(pollen/runtime-config configure #f))] + [else default]))) \ No newline at end of file diff --git a/main-base.rkt b/main-base.rkt index 9175199..5399e17 100644 --- a/main-base.rkt +++ b/main-base.rkt @@ -3,69 +3,64 @@ (provide (all-defined-out) (all-from-out pollen/world)) -(define-syntax (define+provide-module-begin-in-mode stx) - (syntax-case stx () - [(_ mode-arg) - (with-syntax ([new-module-begin (format-id stx "new-module-begin")]) - #'(begin - (provide (except-out (all-from-out racket/base) #%module-begin) - (rename-out [new-module-begin #%module-begin])) - (define-syntax (new-module-begin stx-arg) - (syntax-case stx-arg () - [(_ body-exprs (... ...)) - (with-syntax ([local-meta-tag-name (format-id stx-arg (symbol->string (world:current-meta-tag-name)))] - [local-doc-export-name (format-id stx-arg (symbol->string (world:current-main-export)))] - [local-metas-export-name (format-id stx-arg (symbol->string (world:current-meta-export)))]) - (syntax-protect - #'(#%module-begin - (module inner pollen/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-defined-out) (all-from-out pollen/top pollen/world)) - - body-exprs (... ...)) - - (require 'inner racket/list pollen/metas) - - ;; in an inline module, reader-here-path and parser-mode are undefined - ;; (because there's no reader) - ;; but they'll become tag functions courtesy of #%top - ;; so that's how we can detect if they are undefined - (define here-path (if (procedure? inner:reader-here-path) - "anonymous-module" - inner:reader-here-path)) - (define parser-mode (if (procedure? inner:parser-mode) - mode-arg - inner:parser-mode)) - - (define doc-with-metas - `(placeholder-root - ,@(cons `(local-meta-tag-name (here-path ,here-path)) - (if (list? doc-raw) - (dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file - doc-raw)))) - (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) ; split out the metas - - ;; 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 ...) - [(equal? parser-mode world:mode-markup) root] - [(equal? parser-mode world:mode-markdown) (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) (map to-string xs))))] - ;; for preprocessor output, just make a string. - [else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish - (cdr doc-without-metas))) ;; cdr strips placeholder-root tag - - ;; hide the exports that were only for internal use. - (provide (rename-out [metas local-metas-export-name]) - (rename-out [doc local-doc-export-name]) - (except-out (all-from-out 'inner) doc-raw #%top)))))]))))])) +(define-syntax-rule (define+provide-module-begin-in-mode MODE-ARG) + (begin + (provide (except-out (all-from-out racket/base) #%module-begin) + (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))] + [METAS (datum->syntax stx (world:current-meta-export))] + [META (datum->syntax stx (world:current-meta-tag-name))] + [INNER (datum->syntax stx ''inner)]) + #'(#%module-begin + (module inner pollen/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-defined-out) (all-from-out pollen/top pollen/world)) + EXPR (... ...)) + + (require INNER 'inner pollen/metas) ; import inner twice: INNER for external use, 'inner for internal + + ;; in an inline module, reader-here-path and parser-mode are undefined + ;; (because there's no reader) + ;; but they'll become tag functions courtesy of #%top + ;; so that's how we can detect if they are undefined + (define here-path (if (procedure? inner:reader-here-path) + "anonymous-module" + inner:reader-here-path)) + (define parser-mode (if (procedure? inner:parser-mode) + MODE-ARG + inner:parser-mode)) + + ;; set up the DOC export + (define doc-elements (if (list? doc-raw) ; discard all newlines at front of file + ((dynamic-require 'racket/list 'dropf) doc-raw (λ(i) (equal? i "\n"))) + doc-raw)) ; single line + (define doc-with-metas (list* 'placeholder-root `(META (here-path ,here-path)) doc-elements)) + (define-values (doc-without-metas METAS) (split-metas-to-hash doc-with-metas)) + (define DOC + (let ([proc (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 ...) + [(equal? parser-mode world:mode-markup) root] + [(equal? parser-mode world:mode-markdown) + (λ xs (apply root (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) + (map (dynamic-require 'pollen/decode 'to-string) xs))))] + ;; for preprocessor output, just make a string. + [else (λ xs (apply string-append (map (dynamic-require 'pollen/decode 'to-string) xs)))])] + [doc-elements-without-metas (cdr doc-without-metas)]) + (apply proc doc-elements-without-metas))) + + ;; hide the exports that were only for internal use. + (provide DOC METAS (except-out (all-from-out INNER) doc-raw #%top))))])))) diff --git a/reader-base.rkt b/reader-base.rkt index 2e42f01..3ba6bf9 100644 --- a/reader-base.rkt +++ b/reader-base.rkt @@ -1,61 +1,56 @@ #lang racket/base (require (only-in scribble/reader make-at-reader) pollen/world racket/path pollen/project) - (provide define+provide-reader-in-mode (all-from-out pollen/world)) (define (make-custom-read custom-read-syntax-proc) - (λ(p) - (syntax->datum - (custom-read-syntax-proc (object-name p) p)))) - + (λ(p) (syntax->datum (custom-read-syntax-proc (object-name p) p)))) +(require sugar/debug) (define (make-custom-read-syntax reader-mode) (λ (path-string p) (define read-inner (make-at-reader #:command-char (if (or (equal? reader-mode world:mode-template) - (and (string? path-string) (regexp-match (pregexp (format "\\.~a$" (world:current-template-source-ext))) path-string))) + (and (string? path-string) + (regexp-match (pregexp (format "\\.~a$" (world:current-template-source-ext))) path-string))) (world:current-template-command-char) (world:current-command-char)) #:syntax? #t #:inside? #t)) (define file-contents (read-inner path-string p)) - (datum->syntax file-contents - `(module repl-wrapper racket/base - (module pollen-lang-module pollen - (define reader-mode ',reader-mode) - (define reader-here-path ,(cond - [(symbol? path-string) (symbol->string path-string)] - [(equal? path-string "unsaved editor") path-string] - [else (path->string path-string)])) - (define parser-mode - (if (equal? reader-mode world:mode-auto) - (let* ([file-ext-pattern (pregexp "\\w+$")] - [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))]) - (cond - [(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree] - [(equal? here-ext (world:current-markup-source-ext)) world:mode-markup] - [(equal? here-ext (world:current-markdown-source-ext)) world:mode-markdown] - [else world:mode-preproc])) - reader-mode)) - ;; change names of exports for local use - ;; so they don't conflict if this source is imported into another - (provide (except-out (all-defined-out) reader-here-path reader-mode parser-mode) - (prefix-out inner: reader-here-path) - (prefix-out inner: reader-mode) - (prefix-out inner: parser-mode)) - - ,(require+provide-directory-require-files path-string) - ,@file-contents) - (require 'pollen-lang-module) - (provide (all-from-out 'pollen-lang-module)) - (module+ main - (require txexpr racket/string) - (if (or (equal? inner:parser-mode world:mode-preproc) (equal? inner:parser-mode world:mode-template)) - (display ,(world:current-main-export)) - (print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| (string-join (cdr (string-split (exn-message exn) ": ")) ": "))))]) - (validate-txexpr ,(world:current-main-export))))))) - file-contents))) + (syntax-property + (datum->syntax file-contents + `(module runtime-wrapper racket/base + (module pollen-lang-module pollen + (define reader-mode ',reader-mode) + (define reader-here-path ,(cond + [(symbol? path-string) (symbol->string path-string)] + [(equal? path-string "unsaved editor") path-string] + [else (path->string path-string)])) + (define parser-mode + (if (equal? reader-mode world:mode-auto) + (let* ([file-ext-pattern (pregexp "\\w+$")] + [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))]) + (cond + [(equal? here-ext (world:current-pagetree-source-ext)) world:mode-pagetree] + [(equal? here-ext (world:current-markup-source-ext)) world:mode-markup] + [(equal? here-ext (world:current-markdown-source-ext)) world:mode-markdown] + [else world:mode-preproc])) + reader-mode)) + ;; change names of exports for local use + ;; so they don't conflict if this source is imported into another + (provide (except-out (all-defined-out) reader-here-path reader-mode parser-mode) + (prefix-out inner: reader-here-path) + (prefix-out inner: reader-mode) + (prefix-out inner: parser-mode)) + ,(require+provide-directory-require-files path-string) + ,@file-contents) + (require (submod pollen/runtime-config show) 'pollen-lang-module) + (provide (all-from-out 'pollen-lang-module)) + (show ,(world:current-main-export) inner:parser-mode)) + file-contents) + 'module-language + '#(pollen/language-info get-language-info #f)))) (define-syntax-rule (define+provide-reader-in-mode mode) diff --git a/runtime-config.rkt b/runtime-config.rkt new file mode 100644 index 0000000..c0c8cb7 --- /dev/null +++ b/runtime-config.rkt @@ -0,0 +1,22 @@ +#lang racket/base +(provide configure) + +(module show racket/base + (require pollen/world) + (provide show show-enabled) + + (define show-enabled (make-parameter #f)) + + (define (show doc parser-mode) + (when (show-enabled) + (if (or (equal? parser-mode world:mode-preproc) + (equal? parser-mode world:mode-template)) + (display doc) + (print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| ((dynamic-require 'racket/string 'string-join) (cdr ((dynamic-require 'racket/string 'string-split) (exn-message exn) ": ")) ": "))))]) + ((dynamic-require 'txexpr 'validate-txexpr) doc))))))) + +(require 'show) + +(define (configure data) + (show-enabled #t)) + diff --git a/test/test-langs.rkt b/test/test-langs.rkt index 25c8064..d345faa 100644 --- a/test/test-langs.rkt +++ b/test/test-langs.rkt @@ -48,7 +48,8 @@ (with-output-to-string (λ() (system cmd-string)))) (check-equal? (run test.ptree) "'(pagetree-root test ====)") (check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")}) - (check-equal? (run test-import.html.pm) @string-append{'(root "test" "\n" "====" "\n" (root "This is sample 01."))}) + ;; todo: this one's a little weird. Pollen-to-Pollen require prints the result of required file on import. + (check-equal? (run test-import.html.pm) @string-append{'(root "This is sample 01.")'(root "test" "\n" "====" "\n" (root "This is sample 01."))}) (check-equal? (run test.html.pmd) "'(root (h1 ((id \"test\")) \"test\"))") (check-equal? (run test.html.pp) "test\n====") (check-equal? (run test.no-ext) "test\n===="))