From 4e356b3d0491e1719bd2f1686a62c33997fd1d52 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 17 Feb 2014 21:52:43 -0800 Subject: [PATCH] update --- tools.rkt | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/tools.rkt b/tools.rkt index ad3d499..6d5bac5 100644 --- a/tools.rkt +++ b/tools.rkt @@ -30,3 +30,29 @@ (hash "foo" "haw"))) + +;; function to split tag out of tagged-xexpr +(define+provide/contract (split-tag-from-xexpr tag tx) + (xexpr-tag? tagged-xexpr? . -> . (values (listof xexpr-element?) tagged-xexpr? )) + (define matches '()) + (define (extract-tag x) + (cond + [(and (tagged-xexpr? x) (equal? tag (car x))) + ; stash matched tag but return empty value + (begin + (set! matches (cons x matches)) + empty)] + [(tagged-xexpr? x) (let-values([(tag attr body) (tagged-xexpr->values x)]) + (make-tagged-xexpr tag attr (extract-tag body)))] + [(xexpr-elements? x) (filter-not empty? (map extract-tag x))] + [else x])) + (define tx-extracted (extract-tag tx)) ;; do this first to fill matches + (values (reverse matches) tx-extracted)) + + +(module+ test + (define xx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2") + (em "goodnight" "moon" (meta "foo3" "bar3")))) + (check-equal? (call-with-values (λ() (split-tag-from-xexpr 'meta xx)) list) + (list '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")) + '(root "hello" "world" (em "goodnight" "moon"))))) \ No newline at end of file