gnupdate: Remove unneeded file.

* maintainers/scripts/gnu/sxml-match.scm: Remove.

svn path=/nixpkgs/trunk/; revision=22075

1 files changed, 0 insertions, 1227 deletions

diff --git a/maintainers/scripts/gnu/sxml-match.scm b/maintainers/scripts/gnu/sxml-match.scm
deleted file mode 100644
index 48d8c91b4b1f0..0000000000000
--- a/maintainers/scripts/gnu/sxml-match.scm
+++ /dev/null
@@ -1,1227 +0,0 @@
-;; Library: sxml-match
-;; Author: Jim Bender
-;; Version: 1.1, version for PLT Scheme
-;;
-;; Copyright 2005-9, Jim Bender
-;; sxml-match is released under the MIT License
-;;
-
-(define-module (sxml-match)
-  #:export (sxml-match
-            sxml-match-let
-            sxml-match-let*)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11))
-
-
-;;;
-;;; PLT compatibility layer.
-;;;
-
-(define-syntax syntax-object->datum
-  (syntax-rules ()
-    ((_ stx)
-     (syntax->datum stx))))
-
-(define-syntax void
-  (syntax-rules ()
-    ((_) *unspecified*)))
-
-(define-syntax call/ec
-  ;; aka. `call-with-escape-continuation'
-  (syntax-rules ()
-    ((_ proc)
-     (let ((prompt (gensym)))
-       (call-with-prompt prompt
-                         (lambda ()
-                           (proc (lambda args
-                                   (apply abort-to-prompt
-                                          prompt args))))
-                         (lambda (k . args)
-                           (apply values args)))))))
-
-(define-syntax let/ec
-  (syntax-rules ()
-    ((_ cont body ...)
-     (call/ec (lambda (cont) body ...)))))
-
-(define (raise-syntax-error x msg obj sub)
-  (throw 'sxml-match-error x msg obj sub))
-
-
-;;;
-;;; Body, unmodified from
-;;; http://planet.plt-scheme.org/package-source/jim/sxml-match.plt/1/1/sxml-match.ss
-;;; except for:
-;;;
-;;;   1. The PLT-specific `module' form.
-;;;
-;;;   2. In `sxml-match1', ESCAPE is called with `call-with-values' instead
-;;;      of being called "normally", such that the example below returns the
-;;;      values `x' and `y' instead of just `x':
-;;;
-;;;      (sxml-match '(foo) ((bar) (values 'p 'q)) ((foo) (values 'x 'y)))
-;;;
-
-(define (nodeset? x)
-  (or (and (pair? x) (not (symbol? (car x)))) (null? x)))
-
-(define (xml-element-tag s)
-  (if (and (pair? s) (symbol? (car s)))
-      (car s)
-      (error 'xml-element-tag "expected an xml-element, given" s)))
-
-(define (xml-element-attributes s)
-  (if (and (pair? s) (symbol? (car s)))
-      (fold-right (lambda (a b)
-                    (if (and (pair? a) (eq? '@ (car a)))
-                        (if (null? b)
-                            (filter (lambda (i) (not (and (pair? i) (eq? '@ (car i))))) (cdr a))
-                            (fold-right (lambda (c d)
-                                          (if (and (pair? c) (eq? '@ (car c)))
-                                              d
-                                              (cons c d)))
-                                        b (cdr a)))
-                        b))
-                  '()
-                  (cdr s))
-      (error 'xml-element-attributes "expected an xml-element, given" s)))
-
-(define (xml-element-contents s)
-  (if (and (pair? s) (symbol? (car s)))
-      (filter (lambda (i)
-                (not (and (pair? i) (eq? '@ (car i)))))
-              (cdr s))
-      (error 'xml-element-contents "expected an xml-element, given" s)))
-
-(define (match-xml-attribute key l)
-  (if (not (pair? l))
-      #f
-      (if (eq? (car (car l)) key)
-          (car l)
-          (match-xml-attribute key (cdr l)))))
-
-(define (filter-attributes keys lst)
-  (if (null? lst)
-      '()
-      (if (member (caar lst) keys)
-          (filter-attributes keys (cdr lst))
-          (cons (car lst) (filter-attributes keys (cdr lst))))))
-
-(define-syntax compile-clause
-  (lambda (stx)
-    (letrec
-        ([sxml-match-syntax-error
-          (lambda (msg exp sub)
-            (raise-syntax-error #f msg (with-syntax ([s exp]) (syntax (sxml-match s))) sub))]
-         [ellipsis?
-          (lambda (stx)
-            (and (identifier? stx) (eq? '... (syntax->datum stx))))]
-         [literal?
-          (lambda (stx)
-            (let ([x (syntax->datum stx)])
-              (or (string? x)
-                  (char? x)
-                  (number? x)
-                  (boolean? x))))]
-         [keyword?
-          (lambda (stx)
-            (and (identifier? stx)
-                 (let ([str (symbol->string (syntax->datum stx))])
-                   (char=? #\: (string-ref str (- (string-length str) 1))))))]
-         [extract-cata-fun
-          (lambda (cf)
-            (syntax-case cf ()
-              [#f #f]
-              [other cf]))]
-         [add-pat-var
-          (lambda (pvar pvar-lst)
-            (define (check-pvar lst)
-              (if (null? lst)
-                  (void)
-                  (if (bound-identifier=? (car lst) pvar)
-                      (sxml-match-syntax-error "duplicate pattern variable not allowed"
-                                               stx
-                                               pvar)
-                      (check-pvar (cdr lst)))))
-            (check-pvar pvar-lst)
-            (cons pvar pvar-lst))]
-         [add-cata-def
-          (lambda (depth cvars cfun ctemp cdefs)
-            (cons (list depth cvars cfun ctemp) cdefs))]
-         [process-cata-exp
-          (lambda (depth cfun ctemp)
-            (if (= depth 0)
-                (with-syntax ([cf cfun]
-                              [ct ctemp])
-                  (syntax (cf ct)))
-                (let ([new-ctemp (car (generate-temporaries (list ctemp)))])
-                  (with-syntax ([ct ctemp]
-                                [nct new-ctemp]
-                                [body (process-cata-exp (- depth 1) cfun new-ctemp)])
-                    (syntax (map (lambda (nct) body) ct))))))]
-         [process-cata-defs
-          (lambda (cata-defs body)
-            (if (null? cata-defs)
-                body
-                (with-syntax ([(cata-binding ...)
-                               (map (lambda (def)
-                                      (with-syntax ([bvar (cadr def)]
-                                                    [bval (process-cata-exp (car def)
-                                                                            (caddr def)
-                                                                            (cadddr def))])
-                                        (syntax (bvar bval))))
-                                    cata-defs)]
-                              [body-stx body])
-                  (syntax (let-values (cata-binding ...)
-                            body-stx)))))]
-         [cata-defs->pvar-lst
-          (lambda (lst)
-            (if (null? lst)
-                '()
-                (let iter ([items (cadr (car lst))])
-                  (syntax-case items ()
-                    [() (cata-defs->pvar-lst (cdr lst))]
-                    [(fst . rst) (cons (syntax fst) (iter (syntax rst)))]))))]
-         [process-output-action
-          (lambda (action dotted-vars)
-            (define (finite-lst? lst)
-              (syntax-case lst ()
-                (item
-                 (identifier? (syntax item))
-                 #f)
-                (()
-                 #t)
-                ((fst dots . rst)
-                 (ellipsis? (syntax dots))
-                 #f)
-                ((fst . rst)
-                 (finite-lst? (syntax rst)))))
-            (define (expand-lst lst)
-              (syntax-case lst ()
-                [() (syntax '())]
-                [item
-                 (identifier? (syntax item))
-                 (syntax item)]
-                [(fst dots . rst)
-                 (ellipsis? (syntax dots))
-                 (with-syntax ([exp-lft (expand-dotted-item
-                                         (process-output-action (syntax fst)
-                                                                dotted-vars))]
-                               [exp-rgt (expand-lst (syntax rst))])
-                   (syntax (append exp-lft exp-rgt)))]
-                [(fst . rst)
-                 (with-syntax ([exp-lft (process-output-action (syntax fst)
-                                                               dotted-vars)]
-                               [exp-rgt (expand-lst (syntax rst))])
-                   (syntax (cons exp-lft exp-rgt)))]))
-            (define (member-var? var lst)
-              (let iter ([lst lst])
-                (if (null? lst)
-                    #f
-                    (if (or (bound-identifier=? var (car lst))
-                            (free-identifier=? var (car lst)))
-                        #t
-                        (iter (cdr lst))))))
-            (define (dotted-var? var)
-              (member-var? var dotted-vars))
-            (define (merge-pvars lst1 lst2)
-              (if (null? lst1)
-                  lst2
-                  (if (member-var? (car lst1) lst2)
-                      (merge-pvars (cdr lst1) lst2)
-                      (cons (car lst1) (merge-pvars (cdr lst1) lst2)))))
-            (define (select-dotted-vars x)
-              (define (walk-quasi-body y)
-                (syntax-case y (unquote unquote-splicing)
-                  [((unquote a) . rst)
-                   (merge-pvars (select-dotted-vars (syntax a))
-                                (walk-quasi-body (syntax rst)))]
-                  [((unquote-splicing a) . rst)
-                   (merge-pvars (select-dotted-vars (syntax a))
-                                (walk-quasi-body (syntax rst)))]
-                  [(fst . rst)
-                   (merge-pvars (walk-quasi-body (syntax fst))
-                                (walk-quasi-body (syntax rst)))]
-                  [other
-                   '()]))
-              (syntax-case x (quote quasiquote)
-                [(quote . rst) '()]
-                [(quasiquote . rst) (walk-quasi-body (syntax rst))]
-                [(fst . rst)
-                 (merge-pvars (select-dotted-vars (syntax fst))
-                              (select-dotted-vars (syntax rst)))]
-                [item
-                 (and (identifier? (syntax item))
-                      (dotted-var? (syntax item)))
-                 (list (syntax item))]
-                [item '()]))
-            (define (expand-dotted-item item)
-              (let ([dvars (select-dotted-vars item)])
-                (syntax-case item ()
-                  [x
-                   (identifier? (syntax x))
-                   (syntax x)]
-                  [x (with-syntax ([(dv ...) dvars])
-                       (syntax (map (lambda (dv ...) x) dv ...)))])))
-            (define (expand-quasiquote-body x)
-              (syntax-case x (unquote unquote-splicing quasiquote)
-                [(quasiquote . rst) (process-quasiquote x)]
-                [(unquote item)
-                 (with-syntax ([expanded-item (process-output-action (syntax item)
-                                                                     dotted-vars)])
-                   (syntax (unquote expanded-item)))]
-                [(unquote-splicing item)
-                 (with-syntax ([expanded-item (process-output-action (syntax item)
-                                                                     dotted-vars)])
-                   (syntax (unquote-splicing expanded-item)))]
-                [((unquote item) dots . rst)
-                 (ellipsis? (syntax dots))
-                 (with-syntax ([expanded-item (expand-dotted-item
-                                               (process-output-action (syntax item)
-                                                                      dotted-vars))]
-                               [expanded-rst (expand-quasiquote-body (syntax rst))])
-                   (syntax ((unquote-splicing expanded-item) . expanded-rst)))]
-                [(item dots . rst)
-                 (ellipsis? (syntax dots))
-                 (with-syntax ([expanded-item (expand-dotted-item
-                                               (process-output-action (syntax (quasiquote item))
-                                                                      dotted-vars))]
-                               [expanded-rst (expand-quasiquote-body (syntax rst))])
-                   (syntax ((unquote-splicing expanded-item) . expanded-rst)))]
-                [(fst . rst)
-                 (with-syntax ([expanded-fst (expand-quasiquote-body (syntax fst))]
-                               [expanded-rst (expand-quasiquote-body (syntax rst))])
-                   (syntax (expanded-fst . expanded-rst)))]
-                [other x]))
-            (define (process-quasiquote x)
-              (syntax-case x ()
-                [(quasiquote term) (with-syntax ([expanded-body (expand-quasiquote-body (syntax term))])
-                                     (syntax (quasiquote expanded-body)))]
-                [else (sxml-match-syntax-error "bad quasiquote-form"
-                                               stx
-                                               x)]))
-            (syntax-case action (quote quasiquote)
-              [(quote . rst) action]
-              [(quasiquote . rst) (process-quasiquote action)]
-              [(fst . rst) (if (finite-lst? action)
-                               (with-syntax ([exp-lft (process-output-action (syntax fst) dotted-vars)]
-                                             [exp-rgt (process-output-action (syntax rst) dotted-vars)])
-                                 (syntax (exp-lft . exp-rgt)))
-                               (with-syntax ([exp-lft (process-output-action (syntax fst)
-                                                                             dotted-vars)]
-                                             [exp-rgt (expand-lst (syntax rst))])
-                                 (syntax (apply exp-lft exp-rgt))))]
-              [item action]))]
-         [compile-element-pat
-          (lambda (ele exp nextp fail-k pvar-lst depth cata-fun cata-defs dotted-vars)
-            (syntax-case ele (@)
-              [(tag (@ . attr-items) . items)
-               (identifier? (syntax tag))
-               (let ([attr-exp (car (generate-temporaries (list exp)))]
-                     [body-exp (car (generate-temporaries (list exp)))])
-                 (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (compile-attr-list (syntax attr-items)
-                                                  (syntax items)
-                                                  attr-exp
-                                                  body-exp
-                                                  '()
-                                                  nextp
-                                                  fail-k
-                                                  pvar-lst
-                                                  depth
-                                                  cata-fun
-                                                  cata-defs
-                                                  dotted-vars)])
-                   (values (with-syntax ([x exp]
-                                         [ax attr-exp]
-                                         [bx body-exp]
-                                         [body tests]
-                                         [fail-to fail-k])
-                             (syntax (if (and (pair? x) (eq? 'tag (xml-element-tag x)))
-                                         (let ([ax (xml-element-attributes x)]
-                                               [bx (xml-element-contents x)])
-                                           body)
-                                         (fail-to))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              [(tag . items)
-               (identifier? (syntax tag))
-               (let ([body-exp (car (generate-temporaries (list exp)))])
-                 (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (compile-item-list (syntax items)
-                                                  body-exp
-                                                  nextp
-                                                  fail-k
-                                                  #t
-                                                  pvar-lst
-                                                  depth
-                                                  cata-fun
-                                                  cata-defs
-                                                  dotted-vars)])
-                   (values (with-syntax ([x exp]
-                                         [bx body-exp]
-                                         [body tests]
-                                         [fail-to fail-k])
-                             (syntax (if (and (pair? x) (eq? 'tag (xml-element-tag x)))
-                                         (let ([bx (xml-element-contents x)])
-                                           body)
-                                         (fail-to))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]))]
-         [compile-end-element
-          (lambda (exp nextp fail-k pvar-lst cata-defs dotted-vars)
-            (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                          (nextp pvar-lst cata-defs dotted-vars)])
-              (values (with-syntax ([x exp]
-                                    [body next-tests]
-                                    [fail-to fail-k])
-                        (syntax (if (null? x) body (fail-to))))
-                      new-pvar-lst
-                      new-cata-defs
-                      new-dotted-vars)))]
-         [compile-attr-list
-          (lambda (attr-lst body-lst attr-exp body-exp attr-key-lst nextp fail-k pvar-lst depth cata-fun cata-defs dotted-vars)
-            (syntax-case attr-lst (unquote ->)
-              [(unquote var)
-               (identifier? (syntax var))
-               (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                             (compile-item-list body-lst
-                                                body-exp
-                                                nextp
-                                                fail-k
-                                                #t
-                                                (add-pat-var (syntax var) pvar-lst)
-                                                depth
-                                                cata-fun
-                                                cata-defs
-                                                dotted-vars)])
-                 (values (with-syntax ([ax attr-exp]
-                                       [matched-attrs attr-key-lst]
-                                       [body tests])
-                           (syntax (let ([var (filter-attributes 'matched-attrs ax)])
-                                     body)))
-                         new-pvar-lst
-                         new-cata-defs
-                         new-dotted-vars))]
-              [((atag [(unquote [cata -> cvar ...]) default]) . rst)
-               (identifier? (syntax atag))
-               (let ([ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                 (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (compile-attr-list (syntax rst)
-                                                  body-lst
-                                                  attr-exp
-                                                  body-exp
-                                                  (cons (syntax atag) attr-key-lst)
-                                                  nextp
-                                                  fail-k
-                                                  (add-pat-var ctemp pvar-lst)
-                                                  depth
-                                                  cata-fun
-                                                  (add-cata-def depth
-                                                                (syntax [cvar ...])
-                                                                (syntax cata)
-                                                                ctemp
-                                                                cata-defs)
-                                                  dotted-vars)])
-                   (values (with-syntax ([ax attr-exp]
-                                         [ct ctemp]
-                                         [body tests])
-                             (syntax (let ([binding (match-xml-attribute 'atag ax)])
-                                       (let ([ct (if binding
-                                                     (cadr binding)
-                                                     default)])
-                                         body))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              [((atag [(unquote [cvar ...]) default]) . rst)
-               (identifier? (syntax atag))
-               (let ([ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                 (if (not cata-fun)
-                     (sxml-match-syntax-error "sxml-match pattern: catamorphism not allowed in this context"
-                                              stx
-                                              (syntax [cvar ...])))
-                 (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (compile-attr-list (syntax rst)
-                                                  body-lst
-                                                  attr-exp
-                                                  body-exp
-                                                  (cons (syntax atag) attr-key-lst)
-                                                  nextp
-                                                  fail-k
-                                                  (add-pat-var ctemp pvar-lst)
-                                                  depth
-                                                  cata-fun
-                                                  (add-cata-def depth
-                                                                (syntax [cvar ...])
-                                                                cata-fun
-                                                                ctemp
-                                                                cata-defs)
-                                                  dotted-vars)])
-                   (values (with-syntax ([ax attr-exp]
-                                         [ct ctemp]
-                                         [body tests])
-                             (syntax (let ([binding (match-xml-attribute 'atag ax)])
-                                       (let ([ct (if binding
-                                                     (cadr binding)
-                                                     default)])
-                                         body))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              [((atag [(unquote var) default]) . rst)
-               (and (identifier? (syntax atag)) (identifier? (syntax var)))
-               (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                             (compile-attr-list (syntax rst)
-                                                body-lst
-                                                attr-exp
-                                                body-exp
-                                                (cons (syntax atag) attr-key-lst)
-                                                nextp
-                                                fail-k
-                                                (add-pat-var (syntax var) pvar-lst)
-                                                depth
-                                                cata-fun
-                                                cata-defs
-                                                dotted-vars)])
-                 (values (with-syntax ([ax attr-exp]
-                                       [body tests])
-                           (syntax (let ([binding (match-xml-attribute 'atag ax)])
-                                     (let ([var (if binding
-                                                    (cadr binding)
-                                                    default)])
-                                       body))))
-                         new-pvar-lst
-                         new-cata-defs
-                         new-dotted-vars))]
-              [((atag (unquote [cata -> cvar ...])) . rst)
-               (identifier? (syntax atag))
-               (let ([ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                 (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (compile-attr-list (syntax rst)
-                                                  body-lst
-                                                  attr-exp
-                                                  body-exp
-                                                  (cons (syntax atag) attr-key-lst)
-                                                  nextp
-                                                  fail-k
-                                                  (add-pat-var ctemp pvar-lst)
-                                                  depth
-                                                  cata-fun
-                                                  (add-cata-def depth
-                                                                (syntax [cvar ...])
-                                                                (syntax cata)
-                                                                ctemp
-                                                                cata-defs)
-                                                  dotted-vars)])
-                   (values (with-syntax ([ax attr-exp]
-                                         [ct ctemp]
-                                         [body tests]
-                                         [fail-to fail-k])
-                             (syntax (let ([binding (match-xml-attribute 'atag ax)])
-                                       (if binding
-                                           (let ([ct (cadr binding)])
-                                             body)
-                                           (fail-to)))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              [((atag (unquote [cvar ...])) . rst)
-               (identifier? (syntax atag))
-               (let ([ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                 (if (not cata-fun)
-                     (sxml-match-syntax-error "sxml-match pattern: catamorphism not allowed in this context"
-                                              stx
-                                              (syntax [cvar ...])))
-                 (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (compile-attr-list (syntax rst)
-                                                  body-lst
-                                                  attr-exp
-                                                  body-exp
-                                                  (cons (syntax atag) attr-key-lst)
-                                                  nextp
-                                                  fail-k
-                                                  (add-pat-var ctemp pvar-lst)
-                                                  depth
-                                                  cata-fun
-                                                  (add-cata-def depth
-                                                                (syntax [cvar ...])
-                                                                cata-fun
-                                                                ctemp
-                                                                cata-defs)
-                                                  dotted-vars)])
-                   (values (with-syntax ([ax attr-exp]
-                                         [ct ctemp]
-                                         [body tests]
-                                         [fail-to fail-k])
-                             (syntax (let ([binding (match-xml-attribute 'atag ax)])
-                                       (if binding
-                                           (let ([ct (cadr binding)])
-                                             body)
-                                           (fail-to)))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              [((atag (unquote var)) . rst)
-               (and (identifier? (syntax atag)) (identifier? (syntax var)))
-               (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                             (compile-attr-list (syntax rst)
-                                                body-lst
-                                                attr-exp
-                                                body-exp
-                                                (cons (syntax atag) attr-key-lst)
-                                                nextp
-                                                fail-k
-                                                (add-pat-var (syntax var) pvar-lst)
-                                                depth
-                                                cata-fun
-                                                cata-defs
-                                                dotted-vars)])
-                 (values (with-syntax ([ax attr-exp]
-                                       [body tests]
-                                       [fail-to fail-k])
-                           (syntax (let ([binding (match-xml-attribute 'atag ax)])
-                                     (if binding
-                                         (let ([var (cadr binding)])
-                                           body)
-                                         (fail-to)))))
-                         new-pvar-lst
-                         new-cata-defs
-                         new-dotted-vars))]
-              [((atag (i ...)) . rst)
-               (identifier? (syntax atag))
-               (sxml-match-syntax-error "bad attribute pattern"
-                                        stx
-                                        (syntax (kwd (i ...))))]
-              [((atag i) . rst)
-               (and (identifier? (syntax atag)) (identifier? (syntax i)))
-               (sxml-match-syntax-error "bad attribute pattern"
-                                        stx
-                                        (syntax (kwd i)))]
-              [((atag literal) . rst)
-               (and (identifier? (syntax atag)) (literal? (syntax literal)))
-               (let-values ([(tests new-pvar-lst new-cata-defs new-dotted-vars)
-                             (compile-attr-list (syntax rst)
-                                                body-lst
-                                                attr-exp
-                                                body-exp
-                                                (cons (syntax atag) attr-key-lst)
-                                                nextp
-                                                fail-k
-                                                pvar-lst
-                                                depth
-                                                cata-fun
-                                                cata-defs
-                                                dotted-vars)])
-                 (values (with-syntax ([ax attr-exp]
-                                       [body tests]
-                                       [fail-to fail-k])
-                           (syntax (let ([binding (match-xml-attribute 'atag ax)])
-                                     (if binding
-                                         (if (equal? (cadr binding) literal)
-                                             body
-                                             (fail-to))
-                                         (fail-to)))))
-                         new-pvar-lst
-                         new-cata-defs
-                         new-dotted-vars))]
-              [()
-               (compile-item-list body-lst
-                                  body-exp
-                                  nextp
-                                  fail-k
-                                  #t
-                                  pvar-lst
-                                  depth
-                                  cata-fun
-                                  cata-defs
-                                  dotted-vars)]))]
-         [compile-item-list
-          (lambda (lst exp nextp fail-k ellipsis-allowed? pvar-lst depth cata-fun cata-defs dotted-vars)
-            (syntax-case lst (unquote ->)
-              [() (compile-end-element exp nextp fail-k pvar-lst cata-defs dotted-vars)]
-              [(unquote var)
-               (identifier? (syntax var))
-               (if (not ellipsis-allowed?)
-                   (sxml-match-syntax-error "improper list pattern not allowed in this context"
-                                            stx
-                                            (syntax dots))
-                   (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                                 (nextp (add-pat-var (syntax var) pvar-lst) cata-defs dotted-vars)])
-                     (values (with-syntax ([x exp]
-                                           [body next-tests])
-                               (syntax (let ([var x]) body)))
-                             new-pvar-lst
-                             new-cata-defs
-                             new-dotted-vars)))]
-              [(unquote [cata -> cvar ...])
-               (if (not ellipsis-allowed?)
-                   (sxml-match-syntax-error "improper list pattern not allowed in this context"
-                                            stx
-                                            (syntax dots))
-                   (let ([ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                     (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                                   (nextp (add-pat-var ctemp pvar-lst)
-                                          (add-cata-def depth
-                                                        (syntax [cvar ...])
-                                                        (syntax cata)
-                                                        ctemp
-                                                        cata-defs)
-                                          dotted-vars)])
-                       (values (with-syntax ([ct ctemp]
-                                             [x exp]
-                                             [body next-tests])
-                                 (syntax (let ([ct x]) body)))
-                               new-pvar-lst
-                               new-cata-defs
-                               new-dotted-vars))))]
-              [(unquote [cvar ...])
-               (let ([ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                 (if (not cata-fun)
-                     (sxml-match-syntax-error "sxml-match pattern: catamorphism not allowed in this context"
-                                              stx
-                                              (syntax [cvar ...])))
-                 (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (nextp (add-pat-var ctemp pvar-lst)
-                                      (add-cata-def depth
-                                                    (syntax [cvar ...])
-                                                    cata-fun
-                                                    ctemp
-                                                    cata-defs)
-                                      dotted-vars)])
-                   (values (with-syntax ([ct ctemp]
-                                         [x exp]
-                                         [body next-tests])
-                             (syntax (let ([ct x]) body)))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              [(item dots . rst)
-               (ellipsis? (syntax dots))
-               (if (not ellipsis-allowed?)
-                   (sxml-match-syntax-error "ellipses not allowed in this context"
-                                            stx
-                                            (syntax dots))
-                   (compile-dotted-pattern-list (syntax item)
-                                                (syntax rst)
-                                                exp
-                                                nextp
-                                                fail-k
-                                                pvar-lst
-                                                depth
-                                                cata-fun
-                                                cata-defs
-                                                dotted-vars))]
-              [(item . rst)
-               (compile-item (syntax item)
-                             exp
-                             (lambda (new-exp new-pvar-lst new-cata-defs new-dotted-vars)
-                               (compile-item-list (syntax rst)
-                                                  new-exp
-                                                  nextp
-                                                  fail-k
-                                                  ellipsis-allowed?
-                                                  new-pvar-lst
-                                                  depth
-                                                  cata-fun
-                                                  new-cata-defs
-                                                  new-dotted-vars))
-                             fail-k
-                             pvar-lst
-                             depth
-                             cata-fun
-                             cata-defs
-                             dotted-vars)]))]
-         [compile-dotted-pattern-list
-          (lambda (item
-                   tail
-                   exp
-                   nextp
-                   fail-k
-                   pvar-lst
-                   depth
-                   cata-fun
-                   cata-defs
-                   dotted-vars)
-            (let-values ([(tail-tests tail-pvar-lst tail-cata-defs tail-dotted-vars)
-                          (compile-item-list tail
-                                             (syntax lst)
-                                             (lambda (new-pvar-lst new-cata-defs new-dotted-vars)
-                                               (values (with-syntax ([(npv ...) new-pvar-lst])
-                                                         (syntax (values #t npv ...)))
-                                                       new-pvar-lst
-                                                       new-cata-defs
-                                                       new-dotted-vars))
-                                             (syntax fail)
-                                             #f
-                                             '()
-                                             depth
-                                             '()
-                                             '()
-                                             dotted-vars)]
-                         [(item-tests item-pvar-lst item-cata-defs item-dotted-vars)
-                          (compile-item item
-                                        (syntax lst)
-                                        (lambda (new-exp new-pvar-lst new-cata-defs new-dotted-vars)
-                                          (values (with-syntax ([(npv ...) new-pvar-lst])
-                                                    (syntax (values #t (cdr lst) npv ...)))
-                                                  new-pvar-lst
-                                                  new-cata-defs
-                                                  new-dotted-vars))
-                                        (syntax fail)
-                                        '()
-                                        (+ 1 depth)
-                                        cata-fun
-                                        '()
-                                        dotted-vars)])
-              ; more here: check for duplicate pat-vars, cata-defs
-              (let-values ([(final-tests final-pvar-lst final-cata-defs final-dotted-vars)
-                            (nextp (append tail-pvar-lst item-pvar-lst pvar-lst)
-                                   (append tail-cata-defs item-cata-defs cata-defs)
-                                   (append item-pvar-lst
-                                           (cata-defs->pvar-lst item-cata-defs)
-                                           tail-dotted-vars
-                                           dotted-vars))])
-                (let ([temp-item-pvar-lst (generate-temporaries item-pvar-lst)])
-                  (values
-                   (with-syntax
-                       ([x exp]
-                        [fail-to fail-k]
-                        [tail-body tail-tests]
-                        [item-body item-tests]
-                        [final-body final-tests]
-                        [(ipv ...) item-pvar-lst]
-                        [(gpv ...) temp-item-pvar-lst]
-                        [(tpv ...) tail-pvar-lst]
-                        [(item-void ...) (map (lambda (i) (syntax (void))) item-pvar-lst)]
-                        [(tail-void ...) (map (lambda (i) (syntax (void))) tail-pvar-lst)]
-                        [(item-null ...) (map (lambda (i) (syntax '())) item-pvar-lst)]
-                        [(item-cons ...) (map (lambda (a b)
-                                                (with-syntax ([xa a]
-                                                              [xb b])
-                                                  (syntax (cons xa xb))))
-                                              item-pvar-lst
-                                              temp-item-pvar-lst)])
-                     (syntax (letrec ([match-tail
-                                       (lambda (lst fail)
-                                         tail-body)]
-                                      [match-item
-                                       (lambda (lst)
-                                         (let ([fail (lambda ()
-                                                       (values #f
-                                                               lst
-                                                               item-void ...))])
-                                           item-body))]
-                                      [match-dotted
-                                       (lambda (x)
-                                         (let-values ([(tail-res tpv ...)
-                                                       (match-tail x
-                                                                   (lambda ()
-                                                                     (values #f
-                                                                             tail-void ...)))])
-                                           (if tail-res
-                                               (values item-null ...
-                                                       tpv ...)
-                                               (let-values ([(res new-x ipv ...) (match-item x)])
-                                                 (if res
-                                                     (let-values ([(gpv ... tpv ...)
-                                                                   (match-dotted new-x)])
-                                                       (values item-cons ... tpv ...))
-                                                     (let-values ([(last-tail-res tpv ...)
-                                                                   (match-tail x fail-to)])
-                                                       (values item-null ... tpv ...)))))))])
-                               (let-values ([(ipv ... tpv ...)
-                                             (match-dotted x)])
-                                 final-body))))
-                   final-pvar-lst
-                   final-cata-defs
-                   final-dotted-vars)))))]
-         [compile-item
-          (lambda (item exp nextp fail-k pvar-lst depth cata-fun cata-defs dotted-vars)
-            (syntax-case item (unquote ->)
-              ; normal pattern var
-              [(unquote var)
-               (identifier? (syntax var))
-               (let ([new-exp (car (generate-temporaries (list exp)))])
-                 (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (nextp new-exp (add-pat-var (syntax var) pvar-lst) cata-defs dotted-vars)])
-                   (values (with-syntax ([x exp]
-                                         [nx new-exp]
-                                         [body next-tests]
-                                         [fail-to fail-k])
-                             (syntax (if (pair? x)
-                                         (let ([nx (cdr x)]
-                                               [var (car x)])
-                                           body)
-                                         (fail-to))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              ; named catamorphism
-              [(unquote [cata -> cvar ...])
-               (let ([new-exp (car (generate-temporaries (list exp)))]
-                     [ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                 (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (nextp new-exp
-                                      (add-pat-var ctemp pvar-lst)
-                                      (add-cata-def depth
-                                                    (syntax [cvar ...])
-                                                    (syntax cata)
-                                                    ctemp
-                                                    cata-defs)
-                                      dotted-vars)])
-                   (values (with-syntax ([x exp]
-                                         [nx new-exp]
-                                         [ct ctemp]
-                                         [body next-tests]
-                                         [fail-to fail-k])
-                             (syntax (if (pair? x)
-                                         (let ([nx (cdr x)]
-                                               [ct (car x)])
-                                           body)
-                                         (fail-to))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              ; basic catamorphism
-              [(unquote [cvar ...])
-               (let ([new-exp (car (generate-temporaries (list exp)))]
-                     [ctemp (car (generate-temporaries (syntax ([cvar ...]))))])
-                 (if (not cata-fun)
-                     (sxml-match-syntax-error "sxml-match pattern: catamorphism not allowed in this context"
-                                              stx
-                                              (syntax [cvar ...])))
-                 (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (nextp new-exp
-                                      (add-pat-var ctemp pvar-lst)
-                                      (add-cata-def depth
-                                                    (syntax [cvar ...])
-                                                    cata-fun
-                                                    ctemp
-                                                    cata-defs)
-                                      dotted-vars)])
-                   (values (with-syntax ([x exp]
-                                         [nx new-exp]
-                                         [ct ctemp]
-                                         [body next-tests]
-                                         [fail-to fail-k])
-                             (syntax (if (pair? x)
-                                         (let ([nx (cdr x)]
-                                               [ct (car x)])
-                                           body)
-                                         (fail-to))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]
-              [(tag item ...)
-               (identifier? (syntax tag))
-               (let ([new-exp (car (generate-temporaries (list exp)))])
-                 (let-values ([(after-tests after-pvar-lst after-cata-defs after-dotted-vars)
-                               (compile-element-pat (syntax (tag item ...))
-                                                    (with-syntax ([x exp])
-                                                      (syntax (car x)))
-                                                    (lambda (more-pvar-lst more-cata-defs more-dotted-vars)
-                                                      (let-values ([(next-tests new-pvar-lst
-                                                                                new-cata-defs
-                                                                                new-dotted-vars)
-                                                                    (nextp new-exp
-                                                                           more-pvar-lst
-                                                                           more-cata-defs
-                                                                           more-dotted-vars)])
-                                                        (values (with-syntax ([x exp]
-                                                                              [nx new-exp]
-                                                                              [body next-tests])
-                                                                  (syntax (let ([nx (cdr x)])
-                                                                            body)))
-                                                                new-pvar-lst
-                                                                new-cata-defs
-                                                                new-dotted-vars)))
-                                                    fail-k
-                                                    pvar-lst
-                                                    depth
-                                                    cata-fun
-                                                    cata-defs
-                                                    dotted-vars)])
-                   ; test that we are not at the end of an item-list, BEFORE
-                   ; entering tests for the element pattern (against the 'car' of the item-list)
-                   (values (with-syntax ([x exp]
-                                         [body after-tests]
-                                         [fail-to fail-k])
-                             (syntax (if (pair? x)
-                                         body
-                                         (fail-to))))
-                           after-pvar-lst
-                           after-cata-defs
-                           after-dotted-vars)))]
-              [(i ...)
-               (sxml-match-syntax-error "bad pattern syntax (not an element pattern)"
-                                        stx
-                                        (syntax (i ...)))]
-              [i
-               (identifier? (syntax i))
-               (sxml-match-syntax-error "bad pattern syntax (symbol not allowed in this context)"
-                                        stx
-                                        (syntax i))]
-              [literal
-               (literal? (syntax literal))
-               (let ([new-exp (car (generate-temporaries (list exp)))])
-                 (let-values ([(next-tests new-pvar-lst new-cata-defs new-dotted-vars)
-                               (nextp new-exp pvar-lst cata-defs dotted-vars)])
-                   (values (with-syntax ([x exp]
-                                         [nx new-exp]
-                                         [body next-tests]
-                                         [fail-to fail-k])
-                             (syntax (if (and (pair? x) (equal? literal (car x)))
-                                         (let ([nx (cdr x)])
-                                           body)
-                                         (fail-to))))
-                           new-pvar-lst
-                           new-cata-defs
-                           new-dotted-vars)))]))])
-      (let ([fail-k (syntax failure)])
-        (syntax-case stx (unquote guard ->)
-          [(compile-clause ((unquote var) (guard gexp ...) action0 action ...)
-                           exp
-                           cata-fun
-                           fail-exp)
-           (identifier? (syntax var))
-           (syntax (let ([var exp])
-                     (if (and gexp ...)
-                         (begin action0 action ...)
-                         (fail-exp))))]
-          [(compile-clause ((unquote [cata -> cvar ...]) (guard gexp ...) action0 action ...)
-                           exp
-                           cata-fun
-                           fail-exp)
-           (syntax (if (and gexp ...)
-                       (let-values ([(cvar ...) (cata exp)])
-                         (begin action0 action ...))
-                       (fail-exp)))]
-          [(compile-clause ((unquote [cvar ...]) (guard gexp ...) action0 action ...)
-                           exp
-                           cata-fun
-                           fail-exp)
-           (if (not (extract-cata-fun (syntax cata-fun)))
-               (sxml-match-syntax-error "sxml-match pattern: catamorphism not allowed in this context"
-                                        stx
-                                        (syntax [cvar ...]))
-               (syntax (if (and gexp ...)
-                           (let-values ([(cvar ...) (cata-fun exp)])
-                             (begin action0 action ...))
-                           (fail-exp))))]
-          [(compile-clause ((unquote var) action0 action ...) exp cata-fun fail-exp)
-           (identifier? (syntax var))
-           (syntax (let ([var exp])
-                     action0 action ...))]
-          [(compile-clause ((unquote [cata -> cvar ...]) action0 action ...) exp cata-fun fail-exp)
-           (syntax (let-values ([(cvar ...) (cata exp)])
-                     action0 action ...))]
-          [(compile-clause ((unquote [cvar ...]) action0 action ...) exp cata-fun fail-exp)
-           (if (not (extract-cata-fun (syntax cata-fun)))
-               (sxml-match-syntax-error "sxml-match pattern: catamorphism not allowed in this context"
-                                        stx
-                                        (syntax [cvar ...]))
-               (syntax (let-values ([(cvar ...) (cata-fun exp)])
-                         action0 action ...)))]
-          [(compile-clause ((lst . rst) (guard gexp ...) action0 action ...) exp cata-fun fail-exp)
-           (and (identifier? (syntax lst)) (eq? 'list (syntax->datum (syntax lst))))
-           (let-values ([(result pvar-lst cata-defs dotted-vars)
-                         (compile-item-list (syntax rst)
-                                            (syntax exp)
-                                            (lambda (new-pvar-lst new-cata-defs new-dotted-vars)
-                                              (values
-                                               (with-syntax
-                                                   ([exp-body (process-cata-defs new-cata-defs
-                                                                                 (process-output-action
-                                                                                  (syntax (begin action0
-                                                                                                 action ...))
-                                                                                  new-dotted-vars))]
-                                                    [fail-to fail-k])
-                                                 (syntax (if (and gexp ...) exp-body (fail-to))))
-                                               new-pvar-lst
-                                               new-cata-defs
-                                               new-dotted-vars))
-                                            fail-k
-                                            #t
-                                            '()
-                                            0
-                                            (extract-cata-fun (syntax cata-fun))
-                                            '()
-                                            '())])
-             (with-syntax ([fail-to fail-k]
-                           [body result])
-               (syntax (let ([fail-to fail-exp])
-                         (if (nodeset? exp)
-                             body
-                             (fail-to))))))]
-          [(compile-clause ((lst . rst) action0 action ...) exp cata-fun fail-exp)
-           (and (identifier? (syntax lst)) (eq? 'list (syntax-object->datum (syntax lst))))
-           (let-values ([(result pvar-lst cata-defs dotted-vars)
-                         (compile-item-list (syntax rst)
-                                            (syntax exp)
-                                            (lambda (new-pvar-lst new-cata-defs new-dotted-vars)
-                                              (values (process-cata-defs new-cata-defs
-                                                                         (process-output-action
-                                                                          (syntax (begin action0
-                                                                                         action ...))
-                                                                          new-dotted-vars))
-                                                      new-pvar-lst
-                                                      new-cata-defs
-                                                      new-dotted-vars))
-                                            fail-k
-                                            #t
-                                            '()
-                                            0
-                                            (extract-cata-fun (syntax cata-fun))
-                                            '()
-                                            '())])
-             (with-syntax ([body result]
-                           [fail-to fail-k])
-               (syntax (let ([fail-to fail-exp])
-                         (if (nodeset? exp)
-                             body
-                             (fail-to))))))]
-          [(compile-clause ((fst . rst) (guard gexp ...) action0 action ...) exp cata-fun fail-exp)
-           (identifier? (syntax fst))
-           (let-values ([(result pvar-lst cata-defs dotted-vars)
-                         (compile-element-pat (syntax (fst . rst))
-                                              (syntax exp)
-                                              (lambda (new-pvar-lst new-cata-defs new-dotted-vars)
-                                                (values
-                                                 (with-syntax
-                                                     ([body (process-cata-defs new-cata-defs
-                                                                               (process-output-action
-                                                                                (syntax (begin action0
-                                                                                               action ...))
-                                                                                new-dotted-vars))]
-                                                      [fail-to fail-k])
-                                                   (syntax (if (and gexp ...) body (fail-to))))
-                                                 new-pvar-lst
-                                                 new-cata-defs
-                                                 new-dotted-vars))
-                                              fail-k
-                                              '()
-                                              0
-                                              (extract-cata-fun (syntax cata-fun))
-                                              '()
-                                              '())])
-             (with-syntax ([fail-to fail-k]
-                           [body result])
-               (syntax (let ([fail-to fail-exp])
-                         body))))]
-          [(compile-clause ((fst . rst) action0 action ...) exp cata-fun fail-exp)
-           (identifier? (syntax fst))
-           (let-values ([(result pvar-lst cata-defs dotted-vars)
-                         (compile-element-pat (syntax (fst . rst))
-                                              (syntax exp)
-                                              (lambda (new-pvar-lst new-cata-defs new-dotted-vars)
-                                                (values (process-cata-defs new-cata-defs
-                                                                           (process-output-action
-                                                                            (syntax (begin action0
-                                                                                           action ...))
-                                                                            new-dotted-vars))
-                                                        new-pvar-lst
-                                                        new-cata-defs
-                                                        new-dotted-vars))
-                                              fail-k
-                                              '()
-                                              0
-                                              (extract-cata-fun (syntax cata-fun))
-                                              '()
-                                              '())])
-             (with-syntax ([fail-to fail-k]
-                           [body result])
-               (syntax (let ([fail-to fail-exp])
-                         body))))]
-          [(compile-clause ((i ...) (guard gexp ...) action0 action ...) exp cata-fun fail-exp)
-           (sxml-match-syntax-error "bad pattern syntax (not an element pattern)"
-                                    stx
-                                    (syntax (i ...)))]
-          [(compile-clause ((i ...) action0 action ...) exp cata-fun fail-exp)
-           (sxml-match-syntax-error "bad pattern syntax (not an element pattern)"
-                                    stx
-                                    (syntax (i ...)))]
-          [(compile-clause (pat (guard gexp ...) action0 action ...) exp cata-fun fail-exp)
-           (identifier? (syntax pat))
-           (sxml-match-syntax-error "bad pattern syntax (symbol not allowed in this context)"
-                                    stx
-                                    (syntax pat))]
-          [(compile-clause (pat action0 action ...) exp cata-fun fail-exp)
-           (identifier? (syntax pat))
-           (sxml-match-syntax-error "bad pattern syntax (symbol not allowed in this context)"
-                                    stx
-                                    (syntax pat))]
-          [(compile-clause (literal (guard gexp ...) action0 action ...) exp cata-fun fail-exp)
-           (literal? (syntax literal))
-           (syntax (if (and (equal? literal exp) (and gexp ...))
-                       (begin action0 action ...)
-                       (fail-exp)))]
-          [(compile-clause (literal action0 action ...) exp cata-fun fail-exp)
-           (literal? (syntax literal))
-           (syntax (if (equal? literal exp)
-                       (begin action0 action ...)
-                       (fail-exp)))])))))
-
-(define-syntax sxml-match1
-  (syntax-rules ()
-    [(sxml-match1 exp cata-fun clause)
-     (compile-clause clause exp cata-fun
-                     (lambda () (error 'sxml-match "no matching clause found")))]
-    [(sxml-match1 exp cata-fun clause0 clause ...)
-     (let/ec escape
-       (compile-clause clause0 exp cata-fun
-                       (lambda () (call-with-values
-                                      (lambda () (sxml-match1 exp cata-fun
-                                                              clause ...))
-                                    escape))))]))
-
-(define-syntax sxml-match
-  (syntax-rules ()
-    ((sxml-match val clause0 clause ...)
-     (letrec ([cfun (lambda (exp)
-                      (sxml-match1 exp cfun clause0 clause ...))])
-       (cfun val)))))
-
-(define-syntax sxml-match-let1
-  (syntax-rules ()
-    [(sxml-match-let1 syntag synform () body0 body ...)
-     (let () body0 body ...)]
-    [(sxml-match-let1 syntag synform ([pat exp]) body0 body ...)
-     (compile-clause (pat (let () body0 body ...))
-                     exp
-                     #f
-                     (lambda () (error 'syntag "could not match pattern ~s" 'pat)))]
-    [(sxml-match-let1 syntag synform ([pat0 exp0] [pat exp] ...) body0 body ...)
-     (compile-clause (pat0 (sxml-match-let1 syntag synform ([pat exp] ...) body0 body ...))
-                     exp0
-                     #f
-                     (lambda () (error 'syntag "could not match pattern ~s" 'pat0)))]))
-
-(define-syntax sxml-match-let-help
-  (lambda (stx)
-    (syntax-case stx ()
-      [(sxml-match-let-help syntag synform ([pat exp] ...) body0 body ...)
-       (with-syntax ([(temp-name ...) (generate-temporaries (syntax (exp ...)))])
-         (syntax (let ([temp-name exp] ...)
-                   (sxml-match-let1 syntag synform ([pat temp-name] ...) body0 body ...))))])))
-
-(define-syntax sxml-match-let
-  (lambda (stx)
-    (syntax-case stx ()
-      [(sxml-match-let ([pat exp] ...) body0 body ...)
-       (with-syntax ([synform stx])
-         (syntax (sxml-match-let-help sxml-match-let synform ([pat exp] ...) body0 body ...)))])))
-
-(define-syntax sxml-match-let*
-  (lambda (stx)
-    (syntax-case stx ()
-      [(sxml-match-let* () body0 body ...)
-       (syntax (let () body0 body ...))]
-      [(sxml-match-let* ([pat0 exp0] [pat exp] ...) body0 body ...)
-       (with-syntax ([synform stx])
-         (syntax (sxml-match-let-help sxml-match-let* synform ([pat0 exp0])
-                                      (sxml-match-let* ([pat exp] ...)
-                                                       body0 body ...))))])))