From 06979954fa1358a41632e162975975abd3d3be0c Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 10 Feb 2012 04:10:51 -0700
Subject: [PATCH] syntax/parse: added experimental template form

Also added more atomic patterns to syntax-parse (previously overlooked).
---
 .../syntax/parse/experimental/template.rkt    | 359 ++++++++++++++++++
 collects/syntax/parse/private/rep.rkt         |   5 +-
 .../scribblings/parse/experimental.scrbl      |  92 +++++
 .../syntax/scribblings/parse/parse-common.rkt |   3 +
 collects/tests/stxparse/test-template.rkt     | 103 +++++
 5 files changed, 561 insertions(+), 1 deletion(-)
 create mode 100644 collects/syntax/parse/experimental/template.rkt
 create mode 100644 collects/tests/stxparse/test-template.rkt

diff --git a/collects/syntax/parse/experimental/template.rkt b/collects/syntax/parse/experimental/template.rkt
new file mode 100644
index 0000000000..02e2bd177a
--- /dev/null
+++ b/collects/syntax/parse/experimental/template.rkt
@@ -0,0 +1,359 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     racket/set
+                     racket/syntax
+                     racket/match
+                     racket/private/sc
+                     unstable/struct)
+         racket/match
+         racket/vector
+         syntax/stx
+         syntax/parse/private/residual
+         unstable/struct)
+(provide template
+         ??
+         ?@)
+
+#|
+To do:
+- improve error messages
+- support flexible depths, eg
+  (with-syntax ([(a ...) #'(1 2 3)]
+                [((b ...) ...) #'((1 2 3) (4 5 6) (7 8 9))])
+    #'(((a b) ...) ...))  ;; a has depth 1, used at depth 2
+|#
+
+#|
+A Template (T) is one of:
+  - pvar
+  - atom (including (), not pvar)
+  - (H . T)
+  - (H ... . T), (H ... ... . T), etc
+  - (?? T T)
+  - ... other standard compound forms
+
+A HeadTemplate (H) is one of:
+  - T
+  - (?? T)
+  - (?@ . T)
+|#
+
+(define-syntax (template stx)
+  (parameterize ((current-syntax-context stx))
+    (syntax-case stx ()
+      [(template t)
+       (let-values ([(guide pvars) (parse-template #'t)])
+         ;; (eprintf "guide = ~s\n" guide)
+         (with-syntax ([guide
+                        guide]
+                       [(var ...)
+                        (for/list ([pvar (in-vector pvars)])
+                          (let* ([valvar (syntax-mapping-valvar pvar)]
+                                 [attr (syntax-local-value valvar (lambda () #f))])
+                            (cond [(attribute-mapping? attr)
+                                   (attribute-mapping-var attr)]
+                                  [else valvar])))])
+           (syntax-arm #'(substitute (quote-syntax t) 'guide (vector var ...)))))])))
+
+(define-syntaxes (?? ?@)
+  (let ([tx (lambda (stx) (raise-syntax-error #f "not allowed as an expression" stx))])
+    (values tx tx)))
+
+;; ============================================================
+
+#|
+A Guide (G) is one of:
+  - _
+  - (G . G)
+  - positive-integer
+  - negative-integer
+  - #s(stxvector G)
+  - #s(stxstruct G)
+  - #&G
+  - #s(dots HG (vector-of integer) nat G)
+  - #s(app HG G)
+  - #s(escaped G)
+  - #s(orelse G (vector-of integer) G)
+
+A HeadGuide (HG) is one of:
+  - G
+  - #s(app-opt G (vector-of integer))
+  - #s(splice G)
+|#
+
+(define-syntax-rule (begin-both-phases form ...)
+  (begin (begin-for-syntax form ...)
+         (begin form ...)))
+
+(begin-both-phases
+ (struct stxvector (g) #:prefab)
+ (struct stxstruct (g) #:prefab)
+ (struct dots (head hdrivers nesting tail) #:prefab)
+ (struct app (head tail) #:prefab)
+ (struct escaped (body) #:prefab)
+ (struct orelse (g1 drivers1 g2) #:prefab)
+ (struct app-opt (g drivers) #:prefab)
+ (struct splice (g) #:prefab))
+
+;; ============================================================
+
+(begin-for-syntax
+
+ (define (parse-template t)
+   (let-values ([(_const? drivers pre-guide) (parse-t t 0 #f)])
+     ;; (eprintf "pre-guide = ~s\n" pre-guide)
+     (define (pvar-set->env drivers)
+       (for/hash ([pvar (in-set drivers)]
+                  [n (in-naturals 1)])
+         (values pvar n)))
+     (define main-env (pvar-set->env drivers))
+     (define (loop g loop-env)
+       (define (pvar->index pvar)
+         (let ([loop-index (hash-ref loop-env pvar #f)])
+           (if loop-index
+               (- loop-index)
+               (hash-ref main-env pvar))))
+       (match g
+         ['_ '_]
+         [(cons g1 g2) (cons (loop g1 loop-env) (loop g2 loop-env))]
+         [(? syntax-pattern-variable? pvar) (pvar->index pvar)]
+         [(dots head hdrivers nesting tail)
+          (let* ([sub-loop-env (pvar-set->env hdrivers)]
+                 [sub-loop-vector (index-hash->vector sub-loop-env pvar->index)])
+            (dots (loop head sub-loop-env)
+                  sub-loop-vector
+                  nesting
+                  (loop tail loop-env)))]
+         [(app head tail)
+          (app (loop head loop-env) (loop tail loop-env))]
+         [(escaped g1)
+          (escaped (loop g1 loop-env))]
+         [(orelse g1 drivers1 g2)
+          (orelse (loop g1 loop-env)
+                  (for/vector ([pvar (in-set drivers1)])
+                    (pvar->index pvar))
+                  (loop g2 loop-env))]
+         [(stxvector g1)
+          (stxvector (loop g1 loop-env))]
+         [(stxstruct g1)
+          (stxstruct (loop g1 loop-env))]
+         [(? box?)
+          (box (loop (unbox g) loop-env))]
+         [(app-opt g1 drivers1)
+          (app-opt (loop g1 loop-env)
+                   (for/vector ([pvar (in-set drivers1)])
+                     (pvar->index pvar)))]
+         [(splice g1)
+          (splice (loop g1 loop-env))]
+         [else (error 'parse:convert "bad pre-guide: ~e" g)]))
+     (define guide (loop pre-guide #hash()))
+     (values guide
+             (index-hash->vector main-env))))
+
+ ;; ----------------------------------------
+
+ (define (parse-t t depth esc?)
+   (syntax-case t (?? ?@)
+     [id
+      (identifier? #'id)
+      (cond [(and (not esc?)
+                  (or (free-identifier=? #'id (quote-syntax ...))
+                      (free-identifier=? #'id (quote-syntax ??))
+                      (free-identifier=? #'id (quote-syntax ?@))))
+             (wrong-syntax #'id "illegal use")]
+            [else
+             (let ([pvar (lookup-pvar #'id depth)])
+               (cond [pvar (values #f (set pvar) pvar)]
+                     [else (values #t (set) '_)]))])]
+     [atom
+      (atom? (syntax-e #'atom))
+      (values #t (set) '_)]
+     [(head DOTS . tail)
+      (and (not esc?)
+           (identifier? #'DOTS) (free-identifier=? #'DOTS (quote-syntax ...)))
+      (let-values ([(nesting tail)
+                    (let loop ([nesting 1] [tail #'tail])
+                      (syntax-case tail ()
+                        [(DOTS . tail)
+                         (and (identifier? #'DOTS) (free-identifier=? #'DOTS (quote-syntax ...)))
+                         (loop (add1 nesting) #'tail)]
+                        [else (values nesting tail)]))])
+        (let-values ([(hconst? hdrivers _hsplice? hguide) (parse-h #'head (+ depth nesting) esc?)]
+                     [(tconst? tdrivers tguide) (parse-t tail depth esc?)])
+          (values #f
+                  (set-union hdrivers tdrivers)
+                  (dots hguide hdrivers nesting tguide))))]
+     [(DOTS template)
+      (and (not esc?)
+           (identifier? #'DOTS) (free-identifier=? #'DOTS (quote-syntax ...)))
+      (let-values ([(const? drivers guide) (parse-t #'template depth #t)])
+        (values #f drivers (escaped guide)))]
+     [(?? t1 t2)
+      (not esc?)
+      (let-values ([(const1? drivers1 guide1) (parse-t #'t1 depth esc?)]
+                   [(const2? drivers2 guide2) (parse-t #'t2 depth esc?)])
+        (values #f
+                (set-union drivers1 drivers2)
+                (orelse guide1 drivers1 guide2)))]
+     [(?? . _)
+      (not esc?)
+      (wrong-syntax t "bad pattern")]
+     [(head . tail)
+      (let-values ([(hconst? hdrivers hsplice? hguide) (parse-h #'head depth esc?)]
+                   [(tconst? tdrivers tguide) (parse-t #'tail depth esc?)])
+        (let ([const? (and hconst? tconst?)])
+          (values const?
+                  (set-union hdrivers tdrivers)
+                  (cond [const? '_]
+                        [hsplice? (app hguide tguide)]
+                        [else (cons hguide tguide)]))))]
+     [vec
+      (vector? (syntax-e #'vec))
+      (let-values ([(const? drivers guide) (parse-t (vector->list (syntax-e #'vec)) depth esc?)])
+        (values const? drivers (if const? '_ (stxvector guide))))]
+     [pstruct
+      (prefab-struct-key (syntax-e #'pstruct))
+      (let-values ([(const? drivers guide) (parse-t (struct->list (syntax-e #'pstruct)) depth esc?)])
+        (values const? drivers (if const? '_ (stxstruct guide))))]
+     [#&template
+      (let-values ([(const? drivers guide) (parse-t #'template depth esc?)])
+        (values const? drivers (if const? '_ (box guide))))]
+     [_ (wrong-syntax t "bad pattern")]))
+
+ (define (parse-h h depth esc?)
+   (syntax-case h (?? ?@)
+     [(?? t)
+      (not esc?)
+      (let-values ([(const? drivers guide) (parse-t #'t depth esc?)])
+        (values #f drivers #t (app-opt guide drivers)))]
+     [(?@ . t)
+      (not esc?)
+      (let-values ([(const? drivers guide) (parse-t #'t depth esc?)])
+        (values #f drivers #t (splice guide)))]
+     [t
+      (let-values ([(const? drivers guide) (parse-t #'t depth esc?)])
+        (values const? drivers #f guide))]))
+
+ (define (atom? x)
+   (or (null? x)
+       (number? x)
+       (boolean? x)
+       (string? x)
+       (bytes? x)
+       (keyword? x)
+       (regexp? x)
+       (char? x)))
+
+ (define (lookup-pvar id depth)
+   (let ([v (syntax-local-value id (lambda () #f))])
+     (cond [(syntax-pattern-variable? v)
+            (unless (or (= (syntax-mapping-depth v) depth)
+                        (= (syntax-mapping-depth v) 0))
+              (wrong-syntax id
+                            "pattern variable used at wrong ellipsis depth (expected ~s, used at ~s)"
+                            (syntax-mapping-depth v)
+                            depth))
+            v]
+           [else #f])))
+
+ (define (index-hash->vector hash [f values])
+   (let ([vec (make-vector (hash-count hash))])
+     (for ([(value index) (in-hash hash)])
+       (vector-set! vec (sub1 index) (f value)))
+     vec))
+ )
+
+;; ============================================================
+
+(define (substitute stx g main-env)
+  ;; (eprintf "main-env = ~s\n" main-env)
+  (define (get index lenv)
+    (cond [(positive? index)
+           (vector-ref main-env (sub1 index))]
+          [else
+           (vector-ref lenv (- -1 index))]))
+  (define (loop stx g lenv)
+    (match g
+      ['_ stx]
+      [(cons g1 g2)
+       (restx stx (cons (loop (stx-car stx) g1 lenv) (loop (stx-cdr stx) g2 lenv)))]
+      [(? exact-integer? index)
+       (let ([v (get index lenv)])
+         (unless (syntax? v)
+           (error 'template "syntax pattern variable is not syntax-valued"))
+         v)]
+      [(dots ghead henv nesting gtail)
+       (define head-stx (stx-car stx))
+       (define (nestloop lenv* nesting)
+         (cond [(zero? nesting)
+                (loop-h head-stx ghead lenv*)]
+               [else
+                (for ([v (in-vector lenv*)])
+                  (unless v (error 'template "loop variable is not defined")))
+                (let ([len0 (length (vector-ref lenv* 0))])
+                  (for ([v (in-vector lenv*)])
+                    (unless (= len0 (length v))
+                      (error 'template "loop variable count mismatch")))
+                  (let dotsloop ([len0 len0] [lenv* lenv*])
+                    (if (zero? len0)
+                        null
+                        (let ([lenv** (vector-map car lenv*)])
+                          (cons (nestloop lenv** (sub1 nesting))
+                                (dotsloop (sub1 len0) (vector-map! cdr lenv*)))))))]))
+       (let ([head-results ;; (listof^nesting (listof stx)) -- extra listof for loop-h
+              (nestloop (vector-map (lambda (index) (get index lenv)) henv) nesting)]
+             [tail-result (loop (stx-drop nesting (stx-cdr stx)) gtail lenv)])
+         (restx stx (deep-append head-results nesting tail-result)))]
+      [(app ghead gtail)
+       (restx stx (append (loop-h (stx-car stx) ghead lenv)
+                          (loop (stx-cdr stx) gtail lenv)))]
+      [(escaped g1)
+       (loop (stx-cadr stx) g1 lenv)]
+      [(orelse g1 drivers1 g2)
+       (if (for/and ([index (in-vector drivers1)]) (get index lenv))
+           (loop (stx-cadr stx) g1 lenv)
+           (loop (stx-caddr stx) g2 lenv))]
+      [(stxvector g1)
+       (restx stx (list->vector (loop (vector->list (syntax-e stx)) g1 lenv)))]
+      [(stxstruct g1)
+       (let ([s (syntax-e stx)])
+         (restx stx (apply make-prefab-struct
+                           (prefab-struct-key s)
+                           (loop (struct->list s) g1 lenv))))]
+      [(box g1)
+       (restx stx (box (loop (unbox (syntax-e stx)) g1 lenv)))]))
+  (define (loop-h stx hg lenv)
+    (match hg
+      [(app-opt g1 drivers1)
+       (if (for/and ([index (in-vector drivers1)]) (get index lenv))
+           (list (loop (stx-cadr stx) g1 lenv))
+           null)]
+      [(splice g1)
+       (let* ([v (loop (stx-cdr stx) g1 lenv)]
+              [v* (stx->list v)])
+         (unless v*
+           (error 'template "not a syntax list: ~e" v))
+         v*)]
+      [else (list (loop stx hg lenv))]))
+  (loop stx g #f))
+
+(define (stx-cadr x) (stx-car (stx-cdr x)))
+(define (stx-cddr x) (stx-cdr (stx-cdr x)))
+(define (stx-caddr x) (stx-car (stx-cdr (stx-cdr x))))
+
+(define (stx-drop n x)
+  (cond [(zero? n) x]
+        [else (stx-drop (sub1 n) (stx-cdr x))]))
+
+(define (restx basis val)
+  (if (syntax? basis)
+      (datum->syntax basis val basis basis)
+      val))
+
+;; deep-append : (listof^(nesting+1) A) nat (listof A) -> (listof A)
+;; (Actually, in practice onto is stx, so this is an improper append.)
+(define (deep-append lst nesting onto)
+  (cond [(null? lst) onto]
+        [(zero? nesting) (append lst onto)]
+        [else (deep-append (car lst) (sub1 nesting)
+                           (deep-append (cdr lst) nesting onto))]))
diff --git a/collects/syntax/parse/private/rep.rkt b/collects/syntax/parse/private/rep.rkt
index 05d274dcb3..dcefc508fc 100644
--- a/collects/syntax/parse/private/rep.rkt
+++ b/collects/syntax/parse/private/rep.rkt
@@ -76,7 +76,10 @@
         (boolean? datum)
         (string? datum)
         (number? datum)
-        (keyword? datum))))
+        (keyword? datum)
+        (bytes? datum)
+        (char? datum)
+        (regexp? datum))))
 
 (define (id-predicate kw)
   (lambda (stx)
diff --git a/collects/syntax/scribblings/parse/experimental.scrbl b/collects/syntax/scribblings/parse/experimental.scrbl
index 37cc09d9ba..bc4f7276b0 100644
--- a/collects/syntax/scribblings/parse/experimental.scrbl
+++ b/collects/syntax/scribblings/parse/experimental.scrbl
@@ -264,3 +264,95 @@ patterns as @racket[target-stxclass-id] but with the given
 (syntax-parse #'(8 9) [(n:nat>10 ...) 'ok])
 ]
 }
+
+
+@section{Syntax Templates}
+
+@defmodule[syntax/parse/experimental/template]
+
+@(define literal-ellipsis (racket ...))
+
+@defform/subs[#:literals (?? ?@)
+              (template tmpl)
+              ([tmpl pattern-variable-id
+                     atomic-tmpl
+                     (head-tmpl . tmpl)
+                     (head-tmpl ellipsis ...+ . tmpl)
+                     (?? tmpl tmpl)
+                     #(@#,svar[tmpl] ...)
+                     #s(prefab-struct-key @#,svar[tmpl] ...)
+                     #&@#,svar[tmpl]]
+               [head-templ tmpl
+                           (?? tmpl)
+                           (?@ . tmpl)]
+               [ellipsis @#,literal-ellipsis])]{
+
+Constructs a syntax object from a syntax template, like
+@racket[syntax], but provides additional templating forms for dealing
+with optional terms and splicing sequences of terms.
+
+@specsubform[#:literals (??)
+             (?? tmpl alt-tmpl)]{
+
+Produces @racket[tmpl] unless any attribute used in @racket[tmpl] has
+an absent value; in that case, @racket[alt-tmpl] is used instead.
+
+@examples[#:eval the-eval
+(syntax-parse #'(m 1 2 3)
+  [(_ (~optional (~seq #:op op:expr)) arg:expr ...)
+   (template ((?? op +) arg ...))])
+(syntax-parse #'(m #:op max 1 2 3)
+  [(_ (~optional (~seq #:op op:expr)) arg:expr ...)
+   (template ((?? op +) arg ...))])
+]
+}
+
+@specsubform[#:literals (??)
+             (?? tmpl)]{
+
+Produces @racket[tmpl] unless any attribute used in @racket[tmpl] has
+an absent value; in that case, the term is omitted.  Can only occur in
+head position in a template.
+
+@examples[#:eval the-eval
+(syntax-parse #'(m 1)
+  [(_ x:expr (~optional y:expr))
+   (template (m2 x (?? y)))])
+(syntax-parse #'(m 1 2)
+  [(_ x:expr (~optional y:expr))
+   (template (m2 x (?? y)))])
+]
+}
+
+@specsubform[#:literals (?@)
+             (?@ . tmpl)]{
+
+Similar to @racket[unquote-splicing], splices the result of
+@racket[tmpl] (which must be a syntax list) into the surrounding
+template. Can only occur in head position in a template.
+
+@examples[#:eval the-eval
+(syntax-parse #'(m #:a 1 #:b 2 3 4 #:e 5)
+  [(_ (~or pos:expr (~seq kw:keyword kwarg:expr)) ...)
+   (template (m2 (?@ kw kwarg) ... pos ...))])
+]
+
+The @racket[tmpl] must produce proper syntax lists, but it does not
+itself need to be expressed as a proper list. For example, to unpack
+pattern variables that contain syntax lists, use a ``dotted''
+template:
+@examples[#:eval the-eval
+(with-syntax ([x #'(a b c)])
+  (template ((?@ . x) d)))
+(with-syntax ([(x ...) #'((1 2 3) (4 5))])
+  (template ((?@ . x) ...)))
+]
+}
+}
+
+@deftogether[[
+@defidform[??]
+@defidform[?@]
+]]{
+Auxiliary forms used by @racket[template].
+}
diff --git a/collects/syntax/scribblings/parse/parse-common.rkt b/collects/syntax/scribblings/parse/parse-common.rkt
index 31711791f7..7ffb29a523 100644
--- a/collects/syntax/scribblings/parse/parse-common.rkt
+++ b/collects/syntax/scribblings/parse/parse-common.rkt
@@ -37,6 +37,7 @@
                                                 syntax/parse/experimental/contract
                                                 syntax/parse/experimental/reflect
                                                 syntax/parse/experimental/specialize
+                                                syntax/parse/experimental/template
                                                 syntax/parse/experimental/eh)])
                                     `((for-syntax racket/base ,@mods)
                                       ,@mods)))))))
@@ -106,6 +107,7 @@
                     syntax/parse/experimental/reflect
                     syntax/parse/experimental/provide
                     syntax/parse/experimental/specialize
+                    syntax/parse/experimental/template
                     syntax/parse/experimental/eh
                     "parse-dummy-bindings.rkt"))
 (provide (for-label (all-from-out racket/base)
@@ -117,5 +119,6 @@
                     (all-from-out syntax/parse/experimental/reflect)
                     (all-from-out syntax/parse/experimental/provide)
                     (all-from-out syntax/parse/experimental/specialize)
+                    (all-from-out syntax/parse/experimental/template)
                     (all-from-out syntax/parse/experimental/eh)
                     (all-from-out "parse-dummy-bindings.rkt")))
diff --git a/collects/tests/stxparse/test-template.rkt b/collects/tests/stxparse/test-template.rkt
new file mode 100644
index 0000000000..44a9f33d01
--- /dev/null
+++ b/collects/tests/stxparse/test-template.rkt
@@ -0,0 +1,103 @@
+#lang racket/base
+(require (for-syntax racket/base)
+         rackunit
+         racket/syntax
+         syntax/parse
+         syntax/parse/experimental/template)
+
+;; FIXME: need to test errors, too
+
+(define-syntax (tc stx)
+  (syntax-case stx ()
+    [(tc expr expected)
+     #`(test-equal? (format "line ~s" #,(syntax-line stx))
+                    (syntax->datum expr)
+                    expected)]))
+
+;; ----------------------------------------
+
+;; Common pattern variable definitions
+;; (avoids having to have 'with-syntax' in every test case)
+
+(define/with-syntax uu #'ABC)
+(define/with-syntax (aa ...) #'(a b c))
+(define/with-syntax (xx ...) #'(x y z))
+(define/with-syntax (nn ...) #'(1 2 3))
+(define/with-syntax ((yy ...) ...) #'((1 2 3) (4 5 6) (7 8 9)))
+
+(define/syntax-parse (~or oo:nat _:id) #'x)
+(define/syntax-parse ((~describe "x" (~or pp:nat _:id)) ...) #'(a 1 b 2 3))
+
+;; ----------------------------------------
+
+(tc (template uu) 'ABC)
+
+;; FIXME: add other atoms when supported
+;; FIXME: add other compound stx when supported
+(tc (template abz) 'abz)
+(tc (template ()) '())
+(tc (template 5) '5)
+(tc (template (1 2 #f #t "hey")) '(1 2 #f #t "hey"))
+(tc (template (1 . b)) '(1 . b))
+(tc (template (1 . uu)) '(1 . ABC))
+
+(tc (template #(aa ... done))
+    '#(a b c done))
+(tc (template #s(blah xx ...))
+    '#s(blah x y z))
+
+(tc (template (aa ...))
+    '(a b c))
+(tc (template ((aa aa) ...))
+    '((a a) (b b) (c c)))
+(tc (template (start (aa ok) ... done))
+    '(start (a ok) (b ok) (c ok) done))
+(tc (template ((aa nn xx) ...))
+    '((a 1 x) (b 2 y) (c 3 z)))
+(tc (template (aa ... ((nn xx) ...)))
+    '(a b c ((1 x) (2 y) (3 z))))
+(tc (template (aa ... (nn xx) ...))
+    '(a b c (1 x) (2 y) (3 z)))
+
+(tc (template (aa ... ((yy ok) ...) ...))
+    '(a b c ((1 ok) (2 ok) (3 ok)) ((4 ok) (5 ok) (6 ok)) ((7 ok) (8 ok) (9 ok))))
+
+(tc (template ((?@ 1 2) 3))
+    '(1 2 3))
+(tc (with-syntax ([w '(1 2 3)])
+      (template ((?@ 0 . w) 4)))
+    '(0 1 2 3 4))
+(tc (template ((?@ aa ok) ...))
+    '(a ok b ok c ok))
+(tc (template ((?@ aa nn) ...))
+    '(a 1 b 2 c 3))
+(tc (template (aa ... (?@ nn xx) ...))
+    '(a b c 1 x 2 y 3 z))
+
+;; escape
+(tc (template (abc (xx (... (q ...))) ...))
+    '(abc (x (q ...)) (y (q ...)) (z (q ...))))
+(tc (template (abc (xx (... (q ... nn))) ...))
+    '(abc (x (q ... 1)) (y (q ... 2)) (z (q ... 3))))
+
+;; consecutive ellipses
+(tc (template (yy ... ...))
+    '(1 2 3 4 5 6 7 8 9))
+
+;; ??
+(tc (template (?? (ok oo go) nah))
+    'nah)
+(tc (template ((?? (ready oo)) done))
+    '(done))
+
+;; ----------------------------------------
+
+;; combined ?? ?@
+(tc (syntax-parse #'(a b c 1 2 3)
+      [(a:id ... (~optional s:str) n:nat ...)
+       (template (a ... n ... (?@ . (?? (string: s) ()))))])
+    '(a b c 1 2 3))
+(tc (syntax-parse #'(a b c "hello!" 1 2 3)
+      [(a:id ... (~optional s:str) n:nat ...)
+       (template (a ... n ... (?@ . (?? (string: s) ()))))])
+    '(a b c 1 2 3 string: "hello!"))