Propper handling of omitted elements

copy-attribute.rkt

@@ -53,9 +53,13 @@
   #:with nested (nest-map (λ (pat) #`{~or #f ({~and #,pat} (... ...))})
                           (if (syntax-e #'syntax?)
                               #'{~or #f name}
-                              ;; variable with empty name, so that the attribute
+                              ;; Variable with empty name, so that the attribute
                               ;; gets exported without a prefix.
-                              #`{~or #f {~var #,(datum->syntax #'name '||)
+                              ;; Take care to keep the original srcloc,
+                              ;; otherwise error messages lack the proper srcloc
+                              #`{~or #f {~var #,(datum->syntax #'name
+                                                               '||
+                                                               #'name)
                                               extract-non-syntax}})
                           (syntax-e #'ellipsis-depth))
   (if (syntax-e #'syntax?)

ddd.rkt

@@ -81,15 +81,22 @@
       (quote-syntax #,(x-pvar-present-marker #'present-variables))
       body))
 
-(define (map#f* f l*)
+(define (=* . vs)
-  (cond [(andmap (λ (l) (eq? l #f)) l*)
+  (if (< (length vs) 2)
-         '(#f)]
+      #t
-        [(andmap (or/c null? #f) l*)
+      (apply = vs)))
-         '()]
+
-        [else (let ([cars (map (λ (l) (if l (car l) #f)) l*)]
+(define (map#f* f attr-ids l*)
-                    [cdrs (map (λ (l) (if l (cdr l) #f)) l*)])
+  (for ([l (in-list l*)]
-                (cons (apply f cars)
+        [attr-id (in-list attr-ids)])
-                      (map#f* f cdrs)))]))
+  (when (eq? l #f)
+    (raise-syntax-error (syntax-e attr-id)
+                        "attribute contains an omitted element"
+                        attr-id)))
+  (unless (apply =* (map length l*))
+    (raise-syntax-error 'ddd
+                        "incompatible ellipis counts for template"))
+  (apply map f l*))
 
 (define-syntax/case (ddd body) ()
   (define/with-syntax (pvar …)
@@ -162,6 +169,8 @@
 
   #'(map#f* (λ (iterated-pvarᵢ …)
               (expanded-f filling-pvar …))
+            (list (quote-syntax iterated-pvar)
+                  …)
             (list (attribute* iterated-pvar)
                   …)))
 

test/test-ddd-forms.rkt

@@ -230,16 +230,16 @@
      y … …])
 
 
-
+;; omitted element in the tree = not ok under ellipses
-#lang racket
+(check-exn
-
+ #rx"attribute contains an omitted element"
-(require subtemplate/ddd-forms
+ (λ ()
-         stxparse-info/case
-         stxparse-info/parse
-         rackunit
-         syntax/macro-testing
-         phc-toolkit/untyped)
-
    (syntax-parse #'([1 2 3] #:kw [4 5 6])
      [({~and {~or [x …] #:kw}} …)
-     ((x …) …)])
+      ((x …) …)])))
+
+;; omitted element in the tree = ok as auto-syntax-e
+(check-equal? (syntax-parse #'([1 2 3] #:kw [4 5 6])
+                [({~and {~or [x …] #:kw}} …)
+                 (x …)])
+              '((1 2 3) #f (4 5 6)))

test/test-ddd.rkt

@@ -72,3 +72,18 @@
                             (ddd (+ (syntax-e #'x) 3))))])
               '([3 (4 5 6)]
                 [2 (7 8)]))
+
+
+;; omitted element at the leaves = ok (should it be ok?)
+(check-equal? (syntax-parse #'(1 #f 3)
+                [({~and {~or x:nat #f}} …)
+                 (ddd x)])
+              '(1 #f 3))
+
+;; omitted element in the tree = not ok
+(check-exn
+ #rx"attribute contains an omitted element"
+ (λ ()
+   (syntax-parse #'((1 1) #f (1 2 1 1))
+     [({~and {~or (x:nat …) #f}} …)
+      (ddd (ddd x))])))