diff --git a/tag.rkt b/tag.rkt index 4f3b834..17f9e6d 100644 --- a/tag.rkt +++ b/tag.rkt @@ -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))) \ No newline at end of file + (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)) \ No newline at end of file diff --git a/top.rkt b/top.rkt index ac8a4ad..800c628 100644 --- a/top.rkt +++ b/top.rkt @@ -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 ()