shored up pmap-decode

main.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 (require racket/list)
 (require (planet mb/pollen/tools) (planet mb/pollen/main-helper))
-(require (only-in (planet mb/pollen/pmap) pmap-decode))
+(require (only-in (planet mb/pollen/pmap-decode) pmap-source-decode))
 (require (only-in (planet mb/pollen/predicates) pmap?))
 (require (only-in (planet mb/pollen/pollen-file-tools) has-ext?))
 (require (only-in (planet mb/pollen/world) POLLEN_MAP_EXT))
@@ -76,16 +76,17 @@
    ;; Unlike Scribble, which insists on decoding,
    ;; Pollen just passes through the minimally processed data.
    ;; one exception: if file extension marks it as pmap, send it to the pmap decoder instead.
-   (define source-is-pmap? 
+   (define pmap-source? 
    ;; this tests inner-here (which is always the file name)
      ;; rather than (get metas 'here) which might have been overridden.
      ;; Because if it's overridden to something other than *.pmap, 
      ;; pmap processing will fail.
      ;; This defeats rule that pmap file suffix triggers pmap decoding.
      ((->path inner-here) . has-ext? . POLLEN_MAP_EXT))
-   (define main (apply (if source-is-pmap?
+   (define main (apply (if pmap-source?
-                           pmap-decode
+                           ;; pmap source files will go this way,
-                           ;; most files will go this way.
+                           pmap-source-decode
+                           ;; ... but other files, including pollen, will go this way.
                            ;; Root is treated as a function. 
                            ;; If it's not defined elsewhere, 
                            ;; it just hits #%top and becomes a tagged-xexpr.

pmap-decode.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+(require racket/list racket/string racket/contract racket/match racket/set)
+(require "tools.rkt" "world.rkt" "decode.rkt")
+
+(module+ test (require rackunit))
+
+(provide (all-defined-out))
+
+;; These functions need to be separated so that they can be accessed by pollen parser (in main.rkt)
+;; Other pmap functions are in pmap.rkt.
+;; pmap decoder takes pmap source and returns a full pmap structure.
+
+;; recursively processes map, converting map locations & their parents into xexprs of this shape:
+;; '(location ((parent "parent")))
+(define/contract (add-parents x [parent empty])
+  ((tagged-xexpr?) (xexpr-tag?) . ->* . pmap?)
+  (match x
+    ;; this pattern signifies next level in hierarchy 
+    ;; where first element is new parent, and rest are children.
+    [(list (? xexpr-tag? next-parent) children ...)
+     (let-values ([(tag attr _) (break-tagged-xexpr (add-parents next-parent parent))])
+       ;; xexpr with tag as name, parent as attr, children as elements with tag as next parent
+       (make-tagged-xexpr tag attr (map (λ(c) (add-parents c tag)) children)))]
+    ;; single map entry: convert to xexpr with parent
+    [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr POLLEN_MAP_PARENT_KEY (->string parent)))]))
+
+(module+ test
+  (define test-pmap-main `(pmap-main "foo" "bar" (one (two "three"))))
+  (check-equal? (pmap-root->pmap test-pmap-main) 
+                `(pmap-main ((,POLLEN_MAP_PARENT_KEY "")) (foo ((,POLLEN_MAP_PARENT_KEY "pmap-main"))) (bar ((,POLLEN_MAP_PARENT_KEY "pmap-main"))) (one ((,POLLEN_MAP_PARENT_KEY "pmap-main")) (two ((,POLLEN_MAP_PARENT_KEY "one")) (three ((,POLLEN_MAP_PARENT_KEY "two"))))))))
+
+
+;; this sets default input for following functions
+(define/contract (pmap-root->pmap tx)
+  (tagged-xexpr? . -> . pmap?)
+  (add-parents tx))
+
+
+(define/contract (pmap-source-decode . elements)
+  (() #:rest (and/c
+              ;; todo: how to put these contracts under a let?
+              ;; all elements must be valid pmap keys
+              (flat-named-contract 'valid-pmap-keys
+                                   (λ(e) (andmap (λ(x) (pmap-key? #:loud #t x)) 
+                                                 (filter-not whitespace? (flatten e)))))
+              ;; they must also be unique
+              (flat-named-contract 'unique-pmap-keys
+                                   (λ(e) (elements-unique? #:loud #t 
+                                                           (map ->string ; to make keys comparable
+                                                                (filter-not whitespace? (flatten e)))))))
+      . ->* . pmap?)
+  (pmap-root->pmap (decode (cons 'pmap-root elements)
+                      #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))
+                      )))
+
+

pmap.rkt

@@ -1,63 +1,25 @@
 #lang racket/base
 (require xml xml/path racket/list racket/string racket/contract racket/match racket/set)
-(require "tools.rkt" "world.rkt" "decode.rkt")
+(require "tools.rkt" "world.rkt" "pmap-decode.rkt")
 
 (module+ test (require rackunit))
 
 (provide (all-defined-out))
 
 ;; get the values out of the file, or make them up
-(define pmap-file (build-path START_DIR DEFAULT_POLLEN_MAP))
+(define pmap 
-(define pmap-main empty)
+  (let ([pmap-source (build-path START_DIR DEFAULT_POLLEN_MAP)])
-
+    (if (file-exists? pmap-source)
-;; todo next: why doesn't this line work?
+        ;; Load it from default path.
-(report (dynamic-require pmap-file 'main))
+        ;; dynamic require of a pmap source file gets you a full pmap. 
-
+        (dynamic-require pmap-source POLLEN_ROOT)
-(error 'stop)
+        ;; ... or else synthesize it
-
+        ;; get list of all files
-
+        (let* ([files (directory-list START_DIR)]
-;; todo: this ain't a function
+               ;; filter it to those with pollen extensions
-(if (file-exists? pmap-file)
+               [files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_SOURCE_EXT)) files))])
-    ; load it ....
+          ;; make a 'pmap-root structure and convert it to a full pmap
-    (set! pmap-main (dynamic-require pmap-file POLLEN_ROOT)) 
+          (pmap-root->pmap (make-tagged-xexpr 'pmap-root empty (map path->string files)))))))
-    ; ... or else synthesize it
-    (let ([files (directory-list START_DIR)])
-      (set! files (map remove-ext (filter (λ(x) (has-ext? x POLLEN_SOURCE_EXT)) files)))
-      (set! pmap-main (make-tagged-xexpr 'pmap-root empty (map path->string files)))))
-
-
-
-;; recursively processes map, converting map locations & their parents into xexprs of this shape:
-;; '(location ((parent "parent")))
-(define/contract (add-parents x [parent empty])
-  ((tagged-xexpr?) (xexpr-tag?) . ->* . pmap?)
-  ; disallow map-main as parent tag
-  ;  (when (equal? parent 'map-main) (set! parent empty)) 
-  (match x
-    ;; this pattern signifies next level in hierarchy 
-    ;; where first element is new parent, and rest are children.
-    [(list (? xexpr-tag? next-parent) children ...)
-     (let-values ([(tag attr _) (break-tagged-xexpr (add-parents next-parent parent))])
-       ;; xexpr with tag as name, parent as attr, children as elements with tag as next parent
-       (make-tagged-xexpr tag attr (map (λ(c) (add-parents c tag)) children)))]
-    ;; single map entry: convert to xexpr with parent
-    [else (make-tagged-xexpr (->symbol x) (make-xexpr-attr POLLEN_MAP_PARENT_KEY (->string parent)))]))
-
-(module+ test
-  (define test-pmap-main `(pmap-main "foo" "bar" (one (two "three"))))
-  (check-equal? (main->pmap test-pmap-main) 
-                `(pmap-main ((,POLLEN_MAP_PARENT_KEY "")) (foo ((,POLLEN_MAP_PARENT_KEY "pmap-main"))) (bar ((,POLLEN_MAP_PARENT_KEY "pmap-main"))) (one ((,POLLEN_MAP_PARENT_KEY "pmap-main")) (two ((,POLLEN_MAP_PARENT_KEY "one")) (three ((,POLLEN_MAP_PARENT_KEY "two"))))))))
-
-
-
-;; this sets default input for following functions
-(define/contract (main->pmap tx)
-  (tagged-xexpr? . -> . pmap?)
-  (add-parents tx))
-
-(define pmap (main->pmap pmap-main))
-
-
 
 
 ;; remove parents from map (i.e., just remove attrs)
@@ -74,7 +36,7 @@
 
 (module+ test
   (let ([sample-main `(pmap-root "foo" "bar" (one (two "three")))])
-    (check-equal? (main->pmap sample-main) 
+    (check-equal? (pmap-root->pmap sample-main) 
                   `(pmap-root ((,POLLEN_MAP_PARENT_KEY "")) (foo ((,POLLEN_MAP_PARENT_KEY "pmap-root"))) (bar ((,POLLEN_MAP_PARENT_KEY "pmap-root"))) (one ((,POLLEN_MAP_PARENT_KEY "pmap-root")) (two ((,POLLEN_MAP_PARENT_KEY "one")) (three ((,POLLEN_MAP_PARENT_KEY "two")))))))))
 
 
@@ -88,7 +50,8 @@
 
 
 (module+ test
-  (define test-pmap (main->pmap test-pmap-main))
+  (define test-pmap-main `(pmap-main "foo" "bar" (one (two "three"))))
+  (define test-pmap (pmap-root->pmap test-pmap-main))
   (check-equal? (parent 'three test-pmap) "two")
   (check-equal? (parent "three" test-pmap) "two")
   (check-false (parent 'nonexistent-name test-pmap)))
@@ -246,24 +209,4 @@
 
 
 
-(define/contract (pmap-decode . elements)
+
-  (() #:rest (and/c
-              ;; todo: how to put these contracts under a let?
-              ;; all elements must be valid pmap keys
-              (flat-named-contract 'valid-pmap-keys
-                                   (λ(e) (andmap (λ(x) (pmap-key? #:loud #t x)) 
-                                                 (filter-not whitespace? (flatten e)))))
-              ;; they must also be unique
-              (flat-named-contract 'unique-pmap-keys
-                                   (λ(e) (elements-unique? #:loud #t 
-                                                           (map ->string ; to make keys comparable
-                                                                (filter-not whitespace? (flatten e)))))))
-      . ->* . pmap?)
-  (main->pmap (decode (cons 'pmap-root elements)
-                      ;          #:exclude-xexpr-tags 'em
-                      ;          #:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)]
-                      ;          #:xexpr-attr-proc [xexpr-attr-proc (λ(x)x)]
-                      #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))
-                      ; #:block-xexpr-proc block-xexpr-proc
-                      ;          #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
-                      )))