tidier

pollen/private/reader-base.rkt

@@ -3,34 +3,38 @@
 (require (only-in scribble/reader make-at-reader) "../setup.rkt" "project.rkt" racket/function)
 (provide (rename-out [reader-module-begin #%module-begin]) (all-from-out "../setup.rkt"))
 
-(define current-reader-mode (make-parameter #f))
+(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 (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 (custom-read p)
   (syntax->datum (custom-read-syntax (object-name p) p)))
 
 
-(define (custom-read-syntax path-string p)
+(define (custom-read-syntax #:reader-mode [reader-mode #f] path-string p)
-  (define read-inner (make-at-reader 
+  (define source-stx (let ([read-inner (make-at-reader 
-                      #:command-char (setup:command-char)
+                                        #:command-char (setup:command-char)
-                      #:syntax? #t 
+                                        #:syntax? #t 
-                      #:inside? #t))
+                                        #:inside? #t)])
-  (define source-stx (read-inner path-string p))
+                       (read-inner path-string p)))
-  (define reader-here-path (cond
+  (define reader-here-path (path-string->here-path path-string))
-                             [(symbol? path-string) (symbol->string path-string)]
+  (define parser-mode (infer-parser-mode reader-mode reader-here-path))
-                             [(equal? path-string "unsaved editor") path-string]
+  (define parsed-syntax
-                             [else (path->string path-string)]))
-  (define parser-mode (if (eq? (current-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)
-                          (current-reader-mode)))
-  (define post-parser-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
@@ -51,7 +55,7 @@
            (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
+  (syntax-property parsed-syntax
                    'module-language
                    `#(pollen/private/language-info get-language-info ,reader-here-path))) ; reader-here-path acts as "top" runtime config
 
@@ -81,15 +85,9 @@
             (my-make-drracket-buttons my-command-char)])]
         [else default]))))
 
-(define-syntax (reader-module-begin stx)
+(define-syntax-rule (reader-module-begin mode expr-to-ignore ...)
-  (syntax-case stx ()
+  (#%module-begin
-    [(_ mode expr-to-ignore ...)
+   (define cgi custom-get-info) ; stash hygienic references to local funcs with new identifiers
-     (with-syntax ([cr (generate-temporary)]
+   (define cr custom-read)
-                   [crs (generate-temporary)]
+   (define (crs ps p) (custom-read-syntax #:reader-mode mode ps p))
-                   [cgi (generate-temporary)])
+   (provide (rename-out [cr read][crs read-syntax][cgi get-info]))))
-     #'(#%module-begin
-         (current-reader-mode mode)
-         (define cgi custom-get-info)
-         (define cr custom-read)
-         (define crs custom-read-syntax)
-         (provide (rename-out [cr read][crs read-syntax][cgi get-info]))))]))