pull/5/head
Matthew Butterick 8 years ago
parent 7937a0734f
commit f2a96d8e9c

@ -148,6 +148,12 @@
[else (error 'validate-txexpr (format "~v: not an X-expression" x))])) [else (error 'validate-txexpr (format "~v: not an X-expression" x))]))
(define (txexpr-unsafe tag attrs elements)
(cons tag (if (empty? attrs)
elements
(cons attrs elements))))
(define (txexpr-base func-name tag attrs elements) (define (txexpr-base func-name tag attrs elements)
(unless (txexpr-tag? tag) (unless (txexpr-tag? tag)
(raise-argument-error func-name "txexpr-tag?" tag)) (raise-argument-error func-name "txexpr-tag?" tag))
@ -155,10 +161,7 @@
(raise-argument-error func-name "txexpr-attrs?" attrs)) (raise-argument-error func-name "txexpr-attrs?" attrs))
(unless (txexpr-elements? elements) (unless (txexpr-elements? elements)
(raise-argument-error func-name "txexpr-elements?" elements)) (raise-argument-error func-name "txexpr-elements?" elements))
(txexpr-unsafe tag attrs elements))
(cons tag (append (if (empty? attrs)
empty
(list attrs)) elements)))
(define+provide+safe (txexpr tag [attrs null] [elements null]) (define+provide+safe (txexpr tag [attrs null] [elements null])
@ -184,8 +187,7 @@
(define+provide+safe (txexpr->list x) (define+provide+safe (txexpr->list x)
(txexpr? . -> . list?) (txexpr? . -> . list?)
(define-values (tag attrs elements) (txexpr->values x)) (call-with-values (λ () (txexpr->values x)) list))
(list tag attrs elements))
;; convenience functions to retrieve only one part of txexpr ;; convenience functions to retrieve only one part of txexpr
@ -209,12 +211,12 @@
;; helpers. we are getting a string or symbol ;; helpers. we are getting a string or symbol
(define+provide+safe (->txexpr-attr-key x) (define+provide+safe (->txexpr-attr-key x)
(can-be-txexpr-attr-key? . -> . txexpr-attr-key?) (can-be-txexpr-attr-key? . -> . txexpr-attr-key?)
(->symbol x)) (if (string? x) (string->symbol x) x))
(define+provide+safe (->txexpr-attr-value x) (define+provide+safe (->txexpr-attr-value x)
(can-be-txexpr-attr-value? . -> . txexpr-attr-value?) (can-be-txexpr-attr-value? . -> . txexpr-attr-value?)
(->string x)) (if (symbol? x) (symbol->string x) x))
(define identity (λ (x) x)) (define identity (λ (x) x))
@ -299,7 +301,7 @@
(procedure? txexpr? . -> . txexpr?) (procedure? txexpr? . -> . txexpr?)
(proc (if (txexpr? x) (proc (if (txexpr? x)
(let-values ([(tag attrs elements) (txexpr->values x)]) (let-values ([(tag attrs elements) (txexpr->values x)])
(txexpr tag attrs (map (λ(e)(map-elements proc e)) elements))) (txexpr-unsafe tag attrs (map (λ(e)(map-elements proc e)) elements)))
x))) x)))
@ -352,5 +354,5 @@
->cdata ->cdata
loop)]) loop)])
;; a little faster than `txexpr` since we know the pieces are valid ;; a little faster than `txexpr` since we know the pieces are valid
(cons tag (append (list attrs) (map proc elements)))) (txexpr-unsafe tag attrs (map proc elements)))
x)))) x))))

Loading…
Cancel
Save