From d1d211f93e0ae6d8ab3f395079710a3babd37872 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 10 Feb 2016 16:41:21 -0800 Subject: [PATCH] tidy core lang modules --- pollen/main.rkt | 11 +-- pollen/markdown.rkt | 11 +-- pollen/markup.rkt | 11 +-- pollen/pre.rkt | 11 +-- pollen/private/main-base.rkt | 110 +++++++++++---------- pollen/private/reader-base.rkt | 172 +++++++++++++++++---------------- pollen/private/ts.rktd | 2 +- pollen/ptree.rkt | 11 +-- 8 files changed, 166 insertions(+), 173 deletions(-) diff --git a/pollen/main.rkt b/pollen/main.rkt index 8ab2fb3..f8fca88 100644 --- a/pollen/main.rkt +++ b/pollen/main.rkt @@ -1,8 +1,5 @@ -#lang racket/base -(require "private/main-base.rkt") +(module main "private/main-base.rkt" + default-mode-preproc -(define+provide-module-begin-in-mode default-mode-preproc) ; because default mode in submodule is preproc - -(module reader racket/base - (require pollen/private/reader-base) - (define+provide-reader-in-mode default-mode-auto)) ; because default mode in file is auto + (module reader "private/reader-base.rkt" + default-mode-auto)) diff --git a/pollen/markdown.rkt b/pollen/markdown.rkt index 2d9c378..acbec9e 100644 --- a/pollen/markdown.rkt +++ b/pollen/markdown.rkt @@ -1,8 +1,5 @@ -#lang racket/base -(require "private/main-base.rkt") +(module markdown "private/main-base.rkt" + default-mode-markdown -(define+provide-module-begin-in-mode default-mode-markdown) - -(module reader racket/base - (require pollen/private/reader-base) - (define+provide-reader-in-mode default-mode-markdown)) + (module reader "private/reader-base.rkt" + default-mode-markdown)) diff --git a/pollen/markup.rkt b/pollen/markup.rkt index bed1538..4d9f4ea 100644 --- a/pollen/markup.rkt +++ b/pollen/markup.rkt @@ -1,8 +1,5 @@ -#lang racket/base -(require "private/main-base.rkt") +(module markup "private/main-base.rkt" + default-mode-markup -(define+provide-module-begin-in-mode default-mode-markup) - -(module reader racket/base - (require pollen/private/reader-base) - (define+provide-reader-in-mode default-mode-markup)) + (module reader "private/reader-base.rkt" + default-mode-markup)) diff --git a/pollen/pre.rkt b/pollen/pre.rkt index 4862faa..42710f4 100644 --- a/pollen/pre.rkt +++ b/pollen/pre.rkt @@ -1,8 +1,5 @@ -#lang racket/base -(require "private/main-base.rkt") +(module pre "private/main-base.rkt" + default-mode-preproc -(define+provide-module-begin-in-mode default-mode-preproc) - -(module reader racket/base - (require pollen/private/reader-base) - (define+provide-reader-in-mode default-mode-preproc)) + (module reader "private/reader-base.rkt" + default-mode-preproc)) diff --git a/pollen/private/main-base.rkt b/pollen/private/main-base.rkt index e5d5f38..c215b7d 100644 --- a/pollen/private/main-base.rkt +++ b/pollen/private/main-base.rkt @@ -1,55 +1,61 @@ #lang racket/base (require (for-syntax racket/base syntax/strip-context racket/syntax "../setup.rkt" "split-metas.rkt") - "to-string.rkt" "../pagetree.rkt" "splice.rkt" "../setup.rkt" ) ; need world here to resolve PARSER-MODE-ARG -(provide (all-defined-out)) + "to-string.rkt" "../pagetree.rkt" "splice.rkt" "../setup.rkt") +(require "../setup.rkt") +(provide (except-out (all-from-out racket/base) #%module-begin) + (all-from-out "../setup.rkt") + (rename-out [dialect-module-begin #%module-begin])) -(define-syntax-rule (define+provide-module-begin-in-mode PARSER-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 (... ...)) - (let-values ([(meta-hash expr-without-metas) (split-metas (syntax->datum #'(EXPR (... ...))) (setup:define-meta-name))]) - (with-syntax ([META-HASH (datum->syntax #'(EXPR (... ...)) meta-hash)] - [(EXPR-WITHOUT-METAS (... ...)) (datum->syntax #'(EXPR (... ...)) expr-without-metas)] - [METAS (format-id #'(EXPR (... ...)) "~a" (setup:meta-export))] - [META-MOD (format-symbol "~a" (setup:meta-export))] - [ROOT (format-id #'(EXPR (... ...)) "~a" (setup:main-root-node))] - [NEWLINE (datum->syntax #'(EXPR (... ...)) (setup:newline))] - [MODE-PAGETREE (datum->syntax #'(EXPR (... ...)) default-mode-pagetree)] - [MODE-MARKUP (datum->syntax #'(EXPR (... ...)) default-mode-markup)] - [MODE-MARKDOWN (datum->syntax #'(EXPR (... ...)) default-mode-markdown)] - [SPLICING_TAG (datum->syntax #'(EXPR (... ...)) (setup:splicing-tag))] - [DOC (format-id #'(EXPR (... ...)) "~a" (setup:main-export))] - [DOC-RAW (generate-temporary 'pollen-)]); prevents conflicts with other imported Pollen sources - (replace-context #'(EXPR (... ...)) - #'(#%module-begin - (module META-MOD racket/base - (provide METAS) - (define METAS META-HASH)) - - (module inner pollen/private/doclang-raw - DOC-RAW ; positional arg for doclang-raw that sets name of export. - (require pollen/top pollen/setup pollen/core) - (require (submod ".." META-MOD)) - (provide (all-defined-out) #%top (all-from-out (submod ".." META-MOD) pollen/core)) - EXPR-WITHOUT-METAS (... ...)) - - (require 'inner) - - (define DOC - (let* ([parser-mode-undefined? (procedure? inner:parser-mode)] ; if undefined, #%top makes it a procedure - [parser-mode (if parser-mode-undefined? PARSER-MODE-ARG inner:parser-mode)] - [proc (cond - [(eq? parser-mode 'MODE-PAGETREE) decode-pagetree] - [(eq? parser-mode 'MODE-MARKUP) (λ(xs) (apply ROOT xs))] ; if `root` undefined, it becomes a default tag function - [(eq? parser-mode 'MODE-MARKDOWN) - (λ(xs) (apply ROOT (map strip-empty-attrs ((dynamic-require 'markdown 'parse-markdown) (apply string-append (map to-string xs))))))] - [else (λ(xs) (apply string-append (map to-string xs)))])] ; string output for preprocessor - ;; drop leading newlines, as they're often the result of `defines` and `requires` - [doc-elements (or (memf (λ(ln) (not (equal? ln NEWLINE))) DOC-RAW) null)] - [doc-elements-spliced (splice doc-elements 'SPLICING_TAG)]) - (proc doc-elements-spliced))) - - (provide DOC METAS (except-out (all-from-out 'inner) DOC-RAW #%top))))))])))) ; hide internal exports \ No newline at end of file + +(define-syntax-rule (dialect-module-begin PARSER-MODE-IN OUTER-EXPR ...) + (#%module-begin + (require racket/base) + (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 (... ...)) + (let-values ([(meta-hash expr-without-metas) (split-metas (syntax->datum #'(EXPR (... ...))) (setup:define-meta-name))]) + (with-syntax ([META-HASH (datum->syntax #f meta-hash)] + [(EXPR-WITHOUT-METAS (... ...)) (datum->syntax #f expr-without-metas)] + [METAS (format-id #f "~a" (setup:meta-export))] + [META-MOD (format-symbol "~a" (setup:meta-export))] + [ROOT (format-id #f "~a" (setup:main-root-node))] + [NEWLINE (datum->syntax #f (setup:newline))] + [MODE-PAGETREE (datum->syntax #f default-mode-pagetree)] + [MODE-MARKUP (datum->syntax #f default-mode-markup)] + [MODE-MARKDOWN (datum->syntax #f default-mode-markdown)] + [SPLICING_TAG (datum->syntax #f (setup:splicing-tag))] + [DOC (format-id #f "~a" (setup:main-export))] + [DOC-RAW (generate-temporary 'pollen-)]); prevents conflicts with other imported Pollen sources + (replace-context #'(EXPR (... ...)) + #'(#%module-begin + (module META-MOD racket/base + (provide METAS) + (define METAS META-HASH)) + + (module inner pollen/private/doclang-raw + DOC-RAW ; positional arg for doclang-raw that sets name of export. + (require pollen/top pollen/setup pollen/core) + (require (submod ".." META-MOD)) + (provide (all-defined-out) #%top (all-from-out (submod ".." META-MOD) pollen/core)) + EXPR-WITHOUT-METAS (... ...)) + + (require 'inner) + + (define DOC + (let* ([parser-mode-undefined? (procedure? inner:parser-mode)] ; if undefined, #%top makes it a procedure + [parser-mode (if parser-mode-undefined? PARSER-MODE-IN inner:parser-mode)] + [proc (cond + [(eq? parser-mode 'MODE-PAGETREE) decode-pagetree] + [(eq? parser-mode 'MODE-MARKUP) (λ(xs) (apply ROOT xs))] ; if `root` undefined, it becomes a default tag function + [(eq? parser-mode 'MODE-MARKDOWN) + (λ(xs) (apply ROOT (map strip-empty-attrs ((dynamic-require 'markdown 'parse-markdown) (apply string-append (map to-string xs))))))] + [else (λ(xs) (apply string-append (map to-string xs)))])] ; string output for preprocessor + ;; drop leading newlines, as they're often the result of `defines` and `requires` + [doc-elements (or (memf (λ(ln) (not (equal? ln NEWLINE))) DOC-RAW) null)] + [doc-elements-spliced (splice doc-elements 'SPLICING_TAG)]) + (proc doc-elements-spliced))) + + (provide DOC METAS (except-out (all-from-out 'inner) DOC-RAW #%top))))))])) + OUTER-EXPR ...)) \ No newline at end of file diff --git a/pollen/private/reader-base.rkt b/pollen/private/reader-base.rkt index 828b8a1..237dade 100644 --- a/pollen/private/reader-base.rkt +++ b/pollen/private/reader-base.rkt @@ -1,91 +1,93 @@ #lang racket/base -(require racket/syntax syntax/strip-context racket/class) -(require (only-in scribble/reader make-at-reader) pollen/setup "project.rkt" racket/list) -(provide define+provide-reader-in-mode (all-from-out pollen/setup)) +(require racket/syntax syntax/strip-context racket/class (for-syntax racket/base)) +(require (only-in scribble/reader make-at-reader) "../setup.rkt" "project.rkt") +(provide (rename-out [reader-module-begin #%module-begin]) (all-from-out "../setup.rkt")) +(define (path-string->here-path path-string) + (cond + [(symbol? path-string) (symbol->string path-string)] + [(equal? path-string "unsaved editor") path-string] + [else (path->string path-string)])) -(define (make-custom-read custom-read-syntax-proc) - (λ(p) (syntax->datum (custom-read-syntax-proc (object-name p) p)))) +(define (infer-parser-mode reader-mode reader-here-path) + (if (eq? reader-mode default-mode-auto) + (let* ([file-ext-pattern (pregexp "\\w+$")] + [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))] + [auto-computed-mode (cond + [(eq? here-ext (setup:pagetree-source-ext)) default-mode-pagetree] + [(eq? here-ext (setup:markup-source-ext)) default-mode-markup] + [(eq? here-ext (setup:markdown-source-ext)) default-mode-markdown] + [else default-mode-preproc])]) + auto-computed-mode) + reader-mode)) -(define (make-custom-read-syntax reader-mode) - (λ (path-string p) - (define read-inner (make-at-reader - #:command-char (if (or (eq? reader-mode default-mode-template) - (and (string? path-string) - (regexp-match (pregexp (format "\\.~a$" (setup:template-source-ext))) path-string))) - (setup:template-command-char) - (setup:command-char)) - #:syntax? #t - #:inside? #t)) - (define source-stx (read-inner path-string p)) - (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 (eq? reader-mode default-mode-auto) - (let* ([file-ext-pattern (pregexp "\\w+$")] - [here-ext (string->symbol (car (regexp-match file-ext-pattern reader-here-path)))] - [auto-computed-mode (cond - [(eq? here-ext (setup:pagetree-source-ext)) default-mode-pagetree] - [(eq? here-ext (setup:markup-source-ext)) default-mode-markup] - [(eq? here-ext (setup:markdown-source-ext)) default-mode-markdown] - [else default-mode-preproc])]) - auto-computed-mode) - reader-mode)) - (define post-parser-syntax - (with-syntax ([HERE-KEY (format-id source-stx "~a" (setup:here-path-key))] - [HERE-PATH (datum->syntax source-stx reader-here-path)] - [POLLEN-MOD (format-symbol "~a" (gensym))] ; prevents conflicts with other imported Pollen sources - [PARSER-MODE-VALUE (format-symbol "~a" parser-mode)] - [DIRECTORY-REQUIRES (datum->syntax source-stx (require+provide-directory-require-files path-string))] - [(SOURCE-LINE ...) source-stx] - [DOC (format-id source-stx "~a" (setup:main-export))]) - (replace-context - source-stx - #'(module runtime-wrapper racket/base - (module POLLEN-MOD pollen - (define-meta HERE-KEY HERE-PATH) - (define parser-mode 'PARSER-MODE-VALUE) - (provide (except-out (all-defined-out) parser-mode) - (prefix-out inner: parser-mode)) ; avoids conflicts with importing modules - DIRECTORY-REQUIRES - SOURCE-LINE ...) - (require (submod pollen/private/runtime-config show) 'POLLEN-MOD) - (provide (all-from-out 'POLLEN-MOD)) - (show DOC inner:parser-mode HERE-PATH))))) ; HERE-PATH acts as "local" runtime config - (syntax-property post-parser-syntax - 'module-language - `#(pollen/private/language-info get-language-info ,reader-here-path)))) ; reader-here-path acts as "top" runtime config +(define (custom-read p) + (syntax->datum (custom-read-syntax (object-name p) p))) -(define-syntax-rule (define+provide-reader-in-mode mode) - (begin - (define reader-mode mode) - (define custom-read-syntax (make-custom-read-syntax reader-mode)) - (define custom-read (make-custom-read custom-read-syntax)) - (define (get-info in mod line col pos) - ;; DrRacket caches source file information per session, - ;; so we can do the same to avoid multiple searches for the command char. - (let ([command-char-cache (make-hash)]) - (λ (key default) - (case key - [(color-lexer drracket:toolbar-buttons) ; only do source-path searching if we have one of these keys - (define maybe-source-path (with-handlers ([exn:fail? (λ(exn) #f)]) - ;; Robert Findler does not endorse `get-filename` here, - ;; because it's sneaky and may not always work. - ;; OTOH Scribble relies on it, so IMO it's highly unlikely to change. - (let ([maybe-definitions-frame (object-name in)]) - (send maybe-definitions-frame get-filename)))) ; will be #f if unsaved file - (define my-command-char (hash-ref! command-char-cache maybe-source-path (λ _ (setup:command-char maybe-source-path)))) - (case key - [(color-lexer) - (define my-make-scribble-inside-lexer - (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #f))) - (cond [my-make-scribble-inside-lexer - (my-make-scribble-inside-lexer #:command-char my-command-char)] - [else default])] - [(drracket:toolbar-buttons) - (define my-make-drracket-buttons (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons)) - (my-make-drracket-buttons my-command-char)])] - [else default])))) - (provide (rename-out [custom-read read] [custom-read-syntax read-syntax]) get-info))) \ No newline at end of file + +(define (custom-read-syntax #:reader-mode [reader-mode #f] path-string p) + (define source-stx (let ([read-inner (make-at-reader + #:command-char (setup:command-char) + #:syntax? #t + #:inside? #t)]) + (read-inner path-string p))) + (define reader-here-path (path-string->here-path path-string)) + (define parser-mode (infer-parser-mode reader-mode reader-here-path)) + (define parsed-syntax + (with-syntax ([HERE-KEY (format-id #f "~a" (setup:here-path-key))] + [HERE-PATH (datum->syntax #f reader-here-path)] + [POLLEN-MOD (format-symbol "~a" (gensym))] ; prevents conflicts with other imported Pollen sources + [PARSER-MODE-VALUE (format-symbol "~a" parser-mode)] + [DIRECTORY-REQUIRES (datum->syntax #f (require+provide-directory-require-files path-string))] + [(SOURCE-LINE ...) source-stx] + [DOC (format-id #f "~a" (setup:main-export))]) + (replace-context + source-stx + #'(module runtime-wrapper racket/base + (module POLLEN-MOD pollen + (define-meta HERE-KEY HERE-PATH) + (define parser-mode 'PARSER-MODE-VALUE) + (provide (except-out (all-defined-out) parser-mode) + (prefix-out inner: parser-mode)) ; avoids conflicts with importing modules + DIRECTORY-REQUIRES + SOURCE-LINE ...) + (require (submod pollen/private/runtime-config show) 'POLLEN-MOD) + (provide (all-from-out 'POLLEN-MOD)) + (show DOC inner:parser-mode HERE-PATH))))) ; HERE-PATH acts as "local" runtime config + (syntax-property parsed-syntax + 'module-language + `#(pollen/private/language-info get-language-info ,reader-here-path))) ; reader-here-path acts as "top" runtime config + +(define (custom-get-info in mod line col pos) + ;; DrRacket caches source file information per session, + ;; so we can do the same to avoid multiple searches for the command char. + (let ([command-char-cache (make-hash)]) + (λ (key default) + (case key + [(color-lexer drracket:toolbar-buttons) ; only do source-path searching if we have one of these keys + (define maybe-source-path (with-handlers ([exn:fail? (λ(exn) #f)]) + ;; Robert Findler does not endorse `get-filename` here, + ;; because it's sneaky and may not always work. + ;; OTOH Scribble relies on it, so IMO it's highly unlikely to change. + (let ([maybe-definitions-frame (object-name in)]) + (send maybe-definitions-frame get-filename)))) ; will be #f if unsaved file + (define my-command-char (hash-ref! command-char-cache maybe-source-path (λ _ (setup:command-char maybe-source-path)))) + (case key + [(color-lexer) + (define my-make-scribble-inside-lexer + (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #f))) + (cond [my-make-scribble-inside-lexer + (my-make-scribble-inside-lexer #:command-char my-command-char)] + [else default])] + [(drracket:toolbar-buttons) + (define my-make-drracket-buttons (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons)) + (my-make-drracket-buttons my-command-char)])] + [else default])))) + +(define-syntax-rule (reader-module-begin mode expr-to-ignore ...) + (#%module-begin + (define cgi custom-get-info) ; stash hygienic references to local funcs with new identifiers + (define cr custom-read) + (define (crs ps p) (custom-read-syntax #:reader-mode mode ps p)) + (provide (rename-out [cr read][crs read-syntax][cgi get-info])))) \ No newline at end of file diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 68716a1..de88a86 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1455065350 +1455151281 diff --git a/pollen/ptree.rkt b/pollen/ptree.rkt index 7014d03..88cc0af 100644 --- a/pollen/ptree.rkt +++ b/pollen/ptree.rkt @@ -1,8 +1,5 @@ -#lang racket/base -(require "private/main-base.rkt") +(module ptree "private/main-base.rkt" + default-mode-pagetree -(define+provide-module-begin-in-mode default-mode-pagetree) - -(module reader racket/base - (require pollen/private/reader-base) - (define+provide-reader-in-mode default-mode-pagetree)) + (module reader "private/reader-base.rkt" + default-mode-pagetree))