From 91a6a956980eef1dc12720f716c5ca64acc503f6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 29 May 2019 13:58:06 -0700 Subject: [PATCH] support expressions in meta values --- pollen/private/main-base.rkt | 6 ++++-- pollen/private/split-metas.rkt | 31 ++++++++++++++++--------------- 2 files changed, 20 insertions(+), 17 deletions(-) diff --git a/pollen/private/main-base.rkt b/pollen/private/main-base.rkt index ba34524..cd06c3d 100644 --- a/pollen/private/main-base.rkt +++ b/pollen/private/main-base.rkt @@ -36,7 +36,7 @@ (syntax-case stx () [(_ PARSER-MODE . EXPRS) (with-syntax ([EXPRS (replace-context #'here #'EXPRS)] - [META-HASH (split-metas #'EXPRS (setup:define-meta-name))] + [((META-KEY . META-VAL) ...) (split-metas #'EXPRS (setup:define-meta-name))] [METAS-ID (setup:meta-export)] [META-MOD-ID (setup:meta-export)] [ROOT-ID (setup:main-root-node)] @@ -51,7 +51,9 @@ (proc doc-elements))) ; positional arg for doclang-raw: post-processor (module META-MOD-ID racket/base (provide METAS-ID) - (define METAS-ID META-HASH)) + (define METAS-ID (for/hasheq ([k (in-list (list 'META-KEY ...))] + [v (in-list (list META-VAL ...))]) + (values k v)))) (require pollen/top pollen/core pollen/setup (submod "." META-MOD-ID)) (provide (all-defined-out) METAS-ID DOC-ID) (define prev-metas (current-metas)) diff --git a/pollen/private/split-metas.rkt b/pollen/private/split-metas.rkt index a77ed4b..ef27bfd 100644 --- a/pollen/private/split-metas.rkt +++ b/pollen/private/split-metas.rkt @@ -4,22 +4,23 @@ (provide (all-defined-out)) (define (split-metas x [meta-key 'define-meta]) - (apply hasheq - (let loop ([x ((if (syntax? x) syntax->datum values) x)]) - (match x - [(list (== meta-key eq?) key val) - (unless (symbol? key) - (raise-argument-error meta-key "valid meta key" key)) - (list key val)] - [(? list? xs) (append-map loop xs)] - [_ null])))) + (let loop ([x ((if (syntax? x) syntax->datum values) x)]) + (match x + [(list (== meta-key eq?) key) + (raise-argument-error meta-key "meta value missing" key)] + [(list (== meta-key eq?) key val) + (unless (symbol? key) + (raise-argument-error meta-key "valid meta key" key)) + (list (cons key val))] + [(? list? xs) (append-map loop xs)] + [_ null]))) (module+ test (require rackunit) - (check-equal? (split-metas 'root) (hasheq)) - (check-equal? (split-metas '(root)) (hasheq)) + (check-equal? (split-metas 'root) null) + (check-equal? (split-metas '(root)) null) (check-exn exn:fail:contract? (λ () (split-metas '(root (define-meta 42 "bar"))))) - (check-equal? (split-metas '(root (div #:kw #f (define-meta foo "bar") "hi") "zim" (define-meta foo "boing") "zam")) '#hasheq((foo . "boing"))) - (check-equal? (split-metas '(root (div #:kw #f (define-meta foo 'bar) "hi") "zim" (define-meta foo 'boing) "zam")) '#hasheq((foo . 'boing))) - (check-equal? (split-metas #'(root (define-meta dog "Roxy") (define-meta dog "Lex"))) '#hasheq((dog . "Lex"))) - (check-equal? (split-metas #'(root (define-meta dog "Roxy") (div (define-meta dog "Lex")))) '#hasheq((dog . "Lex")))) \ No newline at end of file + (check-equal? (split-metas '(root (div #:kw #f (define-meta foo "bar") "hi") "zim" (define-meta foo "boing") "zam")) '((foo . "bar") (foo . "boing"))) + (check-equal? (split-metas '(root (div #:kw #f (define-meta foo 'bar) "hi") "zim" (define-meta foo 'boing) "zam")) '((foo . 'bar) (foo . 'boing))) + (check-equal? (split-metas #'(root (define-meta dog "Roxy") (define-meta dog "Lex"))) '((dog . "Roxy") (dog . "Lex"))) + (check-equal? (split-metas #'(root (define-meta dog "Roxy") (div (define-meta dog "Lex")))) '((dog . "Roxy") (dog . "Lex")))) \ No newline at end of file