add make-default-tag-function

pull/27/head
Matthew Butterick 10 years ago
parent c704a85b13
commit 9bfc19e8f1

@ -1,8 +1,8 @@
#lang racket/base
(require txexpr sugar/define)
(provide make-tag-function)
(define (make-tag-function . ids)
(define/contract+provide (make-default-tag-function . ids)
(() #:rest (listof txexpr-tag?) . ->* . procedure?)
(define (make-one-tag id)
(λ x
(define reversed-pieces ; list of attribute pairs, and last element holds a list of everything else, then reversed
@ -26,4 +26,13 @@
`(,id ,@(if (equal? attrs null) null (list (reverse attrs))) ,@body)))
(apply compose1 (map make-one-tag ids)))
(apply compose1 (map make-one-tag ids)))
(define/contract+provide (split-attributes parts)
(list? . -> . (values txexpr-attrs? txexpr-elements?))
(define dummy-tag (gensym))
(define dummy-txexpr (apply (make-default-tag-function dummy-tag) parts))
(define-values (tag attrs elements) (txexpr->values dummy-txexpr))
(values attrs elements))

@ -13,7 +13,7 @@
(define-syntax (top~ stx)
(syntax-case stx ()
[(_ . id) #'(make-tag-function 'id)]))
[(_ . id) #'(make-default-tag-function 'id)]))
(define-syntax (def/c stx)
(syntax-case stx ()

Loading…
Cancel
Save