add pollen/pre, pollen/ptree, pollen/markup semantics to #lang pollen

pull/9/head
Matthew Butterick 11 years ago
parent ffc9bc3cb5
commit d1cbe7c813

@ -1,18 +1,9 @@
#lang racket/base #lang racket/base
(require (only-in scribble/reader make-at-reader))
(provide (rename-out [pollen-read read] [pollen-read-syntax read-syntax]) read-inner) (require pollen/reader-base)
(define read-inner
(make-at-reader #:command-char #\◊ #:syntax? #t #:inside? #t))
(define (pollen-read p) (provide (rename-out [pollen-read read] [pollen-read-syntax read-syntax]) read-inner)
(syntax->datum
(pollen-read-syntax (object-name p) p)))
(define (make-output-datum i)
`(module pollen-lang-module pollen ,@i))
(define (pollen-read-syntax path-string p) (define reader-mode 'auto)
(define file-contents (read-inner path-string p)) (define pollen-read-syntax (make-pollen-read-syntax reader-mode))
(datum->syntax file-contents `(module pollen-lang-module pollen ,@file-contents) file-contents)) (define pollen-read (make-pollen-read pollen-read-syntax))

@ -6,8 +6,8 @@
(define-syntax-rule (new-module-begin body-exprs ...) (define-syntax-rule (new-module-begin body-exprs ...)
(#%module-begin (#%module-begin
(module inner pollen/lang/doclang-raw (module inner pollen/lang/doclang-raw
;; first three lines are positional arguments for doclang-raw
;; doclang_raw is a version of scribble/doclang with the decoder disabled ;; doclang_raw is a version of scribble/doclang with the decoder disabled
;; first three lines are positional arguments for doclang-raw
main-raw ; id of export main-raw ; id of export
(λ(x) x) ; post-process function (λ(x) x) ; post-process function
() ; prepended exprs () ; prepended exprs
@ -51,19 +51,31 @@
(cons (meta 'here-path: inner-here-path) (cons (meta 'here-path: inner-here-path)
;; cdr strips initial linebreak, but make sure main-raw isn't blank ;; cdr strips initial linebreak, but make sure main-raw isn't blank
(if (and (list? main-raw) (> 0 (length main-raw))) (cdr main-raw) main-raw))))) (if (and (list? main-raw) (> 0 (length main-raw))) (cdr main-raw) main-raw)))))
(define-values (main-without-metas metas) (split-metas-to-hash main-txexpr)) (define-values (main-without-metas metas) (split-metas-to-hash main-txexpr))
;; set up the 'main export ;; set up the 'main export
(require pollen/decode) (require pollen/decode)
(define here-ext (car (regexp-match #px"\\w+$" inner-here-path)))
(define wants-decoder? (member here-ext (map to-string DECODABLE_EXTENSIONS))) ;; set the parser mode based on reader mode
(define parser-mode
(if (reader-mode . equal? . 'auto)
(let* ([file-ext-pattern (pregexp "\\w+$")]
[here-ext (car (regexp-match file-ext-pattern inner-here-path))])
(cond
[(equal? here-ext (symbol->string PTREE_SOURCE_EXT)) 'ptree]
[(equal? here-ext (symbol->string DECODER_SOURCE_EXT)) 'markup]
[else 'pre]))
reader-mode))
(define main (apply (cond (define main (apply (cond
[(equal? here-ext "ptree") (λ xs (decode (cons PTREE_ROOT_NODE xs) [(equal? parser-mode 'ptree)
(λ xs (decode (cons PTREE_ROOT_NODE xs)
#:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))] #:xexpr-elements-proc (λ(xs) (filter (compose1 not (def/c whitespace?)) xs))))]
;; 'root is the hook for the decoder function. ;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[wants-decoder? root] [(equal? parser-mode 'markup) root]
;; for preprocessor output, just make a string. ;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))]) [else (λ xs (apply string-append (map to-string xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag (cdr main-without-metas))) ;; cdr strips placeholder-root tag
@ -75,6 +87,6 @@
;; for output in DrRacket ;; for output in DrRacket
(module+ main (module+ main
(if wants-decoder? (if (equal? parser-mode 'pre)
(print main) (display main)
(display main))))) (print main)))))

@ -0,0 +1,9 @@
#lang racket/base
(require pollen/reader-base)
(provide (rename-out [pollen-read read] [pollen-read-syntax read-syntax]) read-inner)
(define reader-mode 'markup)
(define pollen-read-syntax (make-pollen-read-syntax reader-mode))
(define pollen-read (make-pollen-read pollen-read-syntax))

@ -0,0 +1,9 @@
#lang racket/base
(require pollen/reader-base)
(provide (rename-out [pollen-read read] [pollen-read-syntax read-syntax]) read-inner)
(define reader-mode 'pre)
(define pollen-read-syntax (make-pollen-read-syntax reader-mode))
(define pollen-read (make-pollen-read pollen-read-syntax))

@ -0,0 +1,9 @@
#lang racket/base
(require pollen/reader-base)
(provide (rename-out [pollen-read read] [pollen-read-syntax read-syntax]) read-inner)
(define reader-mode 'ptree)
(define pollen-read-syntax (make-pollen-read-syntax reader-mode))
(define pollen-read (make-pollen-read pollen-read-syntax))

@ -0,0 +1,22 @@
#lang racket/base
(require (only-in scribble/reader make-at-reader)
pollen/world)
(provide (all-defined-out))
(define read-inner
(make-at-reader #:command-char EXPRESSION_DELIMITER #:syntax? #t #:inside? #t))
(define (make-pollen-read pollen-read-syntax-proc)
(λ(p)
(syntax->datum
(pollen-read-syntax-proc (object-name p) p))))
(define (make-pollen-read-syntax reader-mode)
(λ (path-string p)
(define file-contents (read-inner path-string p))
(datum->syntax file-contents
`(module pollen-lang-module pollen
(define reader-mode ',reader-mode)
,@file-contents)
file-contents)))
Loading…
Cancel
Save