make it possible to use pollen on inline submodule

main-base.rkt

@@ -1,8 +1,26 @@
 #lang racket/base
-(require (for-syntax racket/base syntax/strip-context racket/syntax pollen/world) pollen/decode pollen/pagetree racket/list pollen/world markdown)
+(require (for-syntax racket/base syntax/strip-context racket/syntax pollen/world racket/list) pollen/decode pollen/pagetree racket/list pollen/world markdown)
 
 (provide (all-defined-out) (all-from-out pollen/world))
 
+(define-for-syntax (split-metas tree)
+  (define (meta-matcher x) ; meta has form (define-meta key value)
+    (and (list? x) (>= (length x) 3) (eq? (first x) (world:current-define-meta-name))))
+  (define matches empty)
+  (define rest
+    (let loop ([x tree])
+      (cond
+        [(meta-matcher x)
+         (set! matches (cons x matches))
+         (loop empty)]
+        [(list? x)
+         (define-values (new-matches rest) (partition meta-matcher x))
+         (set! matches (append new-matches matches))
+         (map loop rest)]
+        [else x])))
+  (let ([meta-key second][meta-value third])
+    (values (map meta-key matches) (map meta-value matches) rest)))
+
 (define-syntax-rule (define+provide-module-begin-in-mode PARSER-MODE-ARG)
   (begin
     (provide (except-out (all-from-out racket/base) #%module-begin)
@@ -10,25 +28,36 @@
     (define-syntax (pollen-module-begin stx)
       (syntax-case stx ()
         [(_ EXPR (... ...))
-         (with-syntax ([DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))])
+         (let-values ([(meta-keys meta-values expr-without-metas) (split-metas (syntax->datum #'(EXPR (... ...))))])
-           (replace-context #'(EXPR (... ...))
+           (with-syntax ([(EXPR-WITHOUT-METAS (... ...)) (datum->syntax #'(EXPR (... ...)) expr-without-metas)]
-                            #'(#%module-begin
+                         [(KEY (... ...)) (datum->syntax #'(EXPR (... ...)) meta-keys)]
-                               (module inner pollen/doclang-raw ; exports result as doc-raw
+                         [(VALUE (... ...)) (datum->syntax #'(EXPR (... ...)) meta-values)]
-                                 (require pollen/top pollen/world)
+                         [METAS (format-id #'(EXPR (... ...)) "~a" (world:current-meta-export))]
-                                 (provide #%top (all-defined-out) (all-from-out pollen/world))
+                         [META-MOD (format-symbol "~a" (world:current-meta-export))]
-                                 EXPR (... ...))
+                         [DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))])
-                               (require 'inner)
+             (replace-context #'(EXPR (... ...))
-                               (define DOC
+                              #'(#%module-begin
-                                 (let* ([parser-mode-undefined? (procedure? inner:parser-mode)] ; if undefined, #%top makes it a procedure
+                                 (module META-MOD racket/base
-                                        [parser-mode (if parser-mode-undefined? PARSER-MODE-ARG inner:parser-mode)]
+                                   (provide (all-defined-out))
-                                        [proc (cond
+                                   (define METAS (apply hash (append (list 'KEY VALUE) (... ...)))))
-                                                [(eq? parser-mode world:mode-pagetree) (λ xs (decode-pagetree xs))]
+                                 
-                                                [(eq? parser-mode world:mode-markup) root] ; if `root` undefined, it becomes a default tag function
+                                 (module inner pollen/doclang-raw ; exports result as doc-raw
-                                                [(eq? parser-mode world:mode-markdown)
+                                   (require pollen/top pollen/world)
-                                                 (λ xs (apply root (apply (compose1 parse-markdown string-append) (map to-string xs))))]
+                                   (provide #%top (all-defined-out) (all-from-out pollen/world))
-                                                [else ; for preprocessor output, just make a string
+                                   EXPR-WITHOUT-METAS (... ...))
-                                                 (λ xs (apply string-append (map to-string xs)))])]
+                                 
-                                        ;; drop leading newlines, as they're often the result of `defines` and `requires`
+                                 (require 'inner 'META-MOD)
-                                        [doc-elements (dropf doc-raw (λ(ln) (equal? ln "\n")))])
+                                 (define DOC
-                                   (apply proc doc-elements)))
+                                   (let* ([parser-mode-undefined? (procedure? inner:parser-mode)] ; if undefined, #%top makes it a procedure
-                               (provide DOC (except-out (all-from-out 'inner) doc-raw #%top)))))])))) ; hide internal exports
+                                          [parser-mode (if parser-mode-undefined? PARSER-MODE-ARG inner:parser-mode)]
+                                          [proc (cond
+                                                  [(eq? parser-mode world:mode-pagetree) (λ xs (decode-pagetree xs))]
+                                                  [(eq? parser-mode world:mode-markup) root] ; if `root` undefined, it becomes a default tag function
+                                                  [(eq? parser-mode world:mode-markdown)
+                                                   (λ xs (apply root (apply (compose1 parse-markdown string-append) (map to-string xs))))]
+                                                  [else ; for preprocessor output, just make a string
+                                                   (λ xs (apply string-append (map to-string xs)))])]
+                                          ;; drop leading newlines, as they're often the result of `defines` and `requires`
+                                          [doc-elements (dropf doc-raw (λ(ln) (equal? ln "\n")))])
+                                     (apply proc doc-elements)))
+                                 (provide DOC METAS (except-out (all-from-out 'inner) doc-raw #%top))))))])))) ; hide internal exports

reader-base.rkt

@@ -8,25 +8,6 @@
   (λ(p) (syntax->datum (custom-read-syntax-proc (object-name p) p))))
 
 
-(define (split-metas tree)
-  (define (meta-matcher x) ; meta has form (define-meta key value)
-    (and (list? x) (>= (length x) 3) (eq? (first x) (world:current-define-meta-name))))
-  (define matches empty)
-  (define rest
-    (let loop ([x tree])
-      (cond
-        [(meta-matcher x)
-         (set! matches (cons x matches))
-         (loop empty)]
-        [(list? x)
-         (define-values (new-matches rest) (partition meta-matcher x))
-         (set! matches (append new-matches matches))
-         (map loop rest)]
-        [else x])))
-  (let ([meta-key second][meta-value third])
-    (values (map meta-key matches) (map meta-value matches) rest)))
-
-
 (define (make-custom-read-syntax reader-mode)
   (λ (path-string p)
     (define read-inner (make-at-reader 
@@ -38,7 +19,6 @@
                         #:syntax? #t 
                         #:inside? #t))
     (define source-stx (read-inner path-string p))
-    (define-values (meta-keys meta-values meta-free-file-data) (split-metas (syntax->datum source-stx)))
     (define reader-here-path (cond
                                [(symbol? path-string) (symbol->string path-string)]
                                [(equal? path-string "unsaved editor") path-string]
@@ -53,34 +33,24 @@
                                                          [else world:mode-preproc])])
                               auto-computed-mode)
                             reader-mode))
-    (define meta-keys-plus-here (cons (world:current-here-path-key) meta-keys)) ; here-path at front so it can be overridden
-    (define meta-values-plus-here (cons reader-here-path meta-values))
     (define post-parser-syntax
-      (with-syntax ([(KEY ...) (datum->syntax source-stx meta-keys-plus-here)]
+      (with-syntax ([HERE-KEY (format-id source-stx "~a" (world:current-here-path-key))]
-                    [(VALUE ...) (datum->syntax source-stx meta-values-plus-here)]
+                    [HERE-PATH (datum->syntax source-stx reader-here-path)]
-                    [METAS (format-id source-stx "~a" (world:current-meta-export))]
-                    [META-MOD (format-symbol "~a" (world:current-meta-export))]
                     [POLLEN-MOD (format-symbol "~a" 'pollen-lang-module)]
-                    [DOC (format-id source-stx "~a" (world:current-main-export))]
                     [PARSER-MODE-VALUE (format-symbol "~a" parser-mode)]
                     [DIRECTORY-REQUIRES (datum->syntax source-stx (require+provide-directory-require-files path-string))]
-                    [(SOURCE-LINE ...) (datum->syntax source-stx meta-free-file-data)])
+                    [(SOURCE-LINE ...) source-stx]
+                    [DOC (format-id source-stx "~a" (world:current-main-export))])
         (replace-context
          source-stx
          #'(module runtime-wrapper racket/base
-             (module META-MOD racket/base
-               (provide (all-defined-out))
-               (define METAS (apply hash (append (list 'KEY VALUE) ...))))
-             
              (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
-               (require (submod ".." ".." META-MOD)) ; get metas from adjacent submodule
-               (provide (all-from-out (submod ".." ".." META-MOD)))
                SOURCE-LINE ...)
-             
              (require (submod pollen/runtime-config show) 'POLLEN-MOD)
              (provide (all-from-out 'POLLEN-MOD))
              (show DOC inner:parser-mode)))))

test/test-inline-submodule.rkt

@@ -0,0 +1,23 @@
+#lang racket/base
+
+(module inline pollen
+  (define-meta foo 42)
+  "Zut Alors")
+
+(module test-main racket/base
+  (require rackunit)
+  (require (submod ".." inline))
+  (check-equal? doc "Zut Alors")
+  (check-equal? metas (hash 'foo 42)))
+
+(module test-metas-submod racket/base
+  (require rackunit)
+  (require (submod ".." inline metas))
+  (let ()
+    (define-syntax-rule (#%top . xs)
+      'unbound-identifier)
+    (check-equal? doc 'unbound-identifier))
+  (check-equal? metas (hash 'foo 42)))
+
+(require 'test-main)
+(require 'test-metas-submod)