tidy core lang modules
parent
3765a57be4
commit
d1d211f93e
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
(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 ...))
|
||||
@ -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)))
|
||||
|
||||
(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]))))
|
||||
@ -1 +1 @@
|
||||
1455065350
|
||||
1455151281
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue