Implemented in library: check-equal?-classes:, which tests that elements in the same class are equal?, and elements in distinct classes are not equal?, as well as repeat-stx, which solves the (syntax-parse #'((1 2 3) (x y)) [([a b …] …) #'([(a b) …] …)) problem.

graph/graph/__DEBUG_graph__.rkt

@@ -1,9 +1,12 @@
 #lang debug typed/racket
 
-(require "structure.lp2.rkt")
+;(require "structure.lp2.rkt")
-(require "../type-expander/type-expander.lp2.rkt")
+;(require "variant.lp2.rkt")
+;(require "../type-expander/type-expander.lp2.rkt")
 (require "../lib/low.rkt")
 
+#|
+
 (define-structure st [a Number] [b String])
 (check-equal:? (st 1 "b") (structure [a 1] [b "b"]))
 (check-equal:? (st 1 "b") (structure [a : Number 1] [b : String "b"]))
@@ -12,6 +15,12 @@
 (check-equal:? (st 1 "b") ((structure a b) 1 "b"))
 (check-equal:? (st 1 "b") ((structure [a] b) 1 "b"))
 
+((tagged t a b c) 1 'b "c")
+((tagged t a [b] c) 1 'b "c")
+((tagged t [a] [b] [c]) 1 'b "c")
+((tagged t [a : Number] [b : Symbol] [c : String]) 1 'b "c")
+(tagged t [a : Number 1] [b : Symbol 'b] [c : String "c"])
+(tagged t [a 1] [b 'b] [c "c"])
 
 #|
 (require (submod "graph3.lp2.rkt" test))
@@ -49,4 +58,5 @@
 
 (forceall 5 g)
 
+|#
 |#

graph/graph/remember.rkt

@@ -39,4 +39,4 @@
 (structure fba fbv)
 (structure fav)
 (structure a)
-(structure a)
+(structure a)

graph/graph/structure.lp2.rkt

@@ -28,62 +28,51 @@ types, it wouldn't be clear what fields the remaining type parameters affect).
  (~or field:id
  [field:id (~maybe (~lit :) type:expr) (~maybe value:expr)]))))}
 
+A call to @tc[(structure)] with no field, is ambiguous: it could return a
+constructor function, or an instance. We added two optional keywords,
+@tc[#:instance] and @tc[#:constructor], to disambiguate. They can also be used
+when fields with or without values are provided, so that macros don't need to
+handle the empty structure as a special case.
+
+@chunk[<structure-args-stx-class>
+       (define-splicing-syntax-class structure-args-stx-class
+         (pattern
+          (~or (~seq #:instance (~parse (field … value …) #'()))
+               (~seq #:constructor (~parse (field …) #'()))
+               (~seq (~maybe #:constructor ~!)
+                     (~or (~seq (~or-bug [field:id] field:id) …+)
+                          (~seq [field:id (~and C (~lit :)) type:expr] …+)))
+               (~seq (~maybe #:instance ~!)
+                     (~or (~seq [field:id value:expr] …+)
+                          (~seq [field:id (~and C (~lit :)) type:expr
+                                 value:expr] …+))))))]
+
 @chunk[<structure>
+       (begin-for-syntax <structure-args-stx-class>)
+       
        (define-multi-id structure
          #:type-expander structure-type-expander
          #:match-expander structure-match-expander
-         #:call (λ (stx)
+         #:call
-                  (syntax-parse stx
+         (λ (stx)
-                    [(_) <hybrid-empty>]
+           (syntax-parse stx
-                    [(_ (~or (~seq (~or-bug [field:id] field:id) …)
+             [(_ :structure-args-stx-class)
-                             (~seq [field:id (~lit :) type:expr] …)
+              (define/with-syntax c #'(make-structure-constructor field …))
-                             (~seq [field:id value:expr] …)
+              (define/with-syntax ct (template (?? (inst c type …) c)))
-                             (~seq [field:id (~lit :) type:expr value:expr] …)))
+              (syntax-property
-                     (define/with-syntax c
+               (template (?? (ct value …) ct))
-                       #'(make-structure-constructor field …))
+               'disappeared-use (stx-map syntax-local-introduce
-                     (define/with-syntax ct
+                                         (template ((?? (?@ (C …)))))))])))]
-                       (if (and (attribute type) (not (stx-null? #'(type …))))
-                           #'(inst c type …)
-                           #'c))
-                     (template (?? (ct value …) ct))])))]
-
-@subsection[#:tag "structure|hybrid-empty"]{Hybrid constructor / instance for
- the empty structure}
-
-A call to @tc[(structure)] with no field, is ambiguous: it could return a
-constructor function, or an instance. We use @tc[define-struct/exec] to make it
-behave like both.
-
-@CHUNK[<declare-hybrid-empty>
-       (struct empty/noexec-type ())
-       
-       (define-struct/exec (empty/exec-type empty)
-         ()
-         [(λ _ empty-instance) : (→ Any empty)])
-       
-       (define empty-instance (empty/exec-type))]
-
-@CHUNK[<test-hybrid-empty>
-       (check-equal:? empty-instance : empty empty-instance)
-       (check-equal:? empty-instance : empty (empty-instance))
-       (check-equal:? (empty-instance) : empty empty-instance)
-       (check-equal:? (empty-instance) : empty (empty-instance))]
-
-@CHUNK[<test-hybrid-empty-2>
-       (check-equal:? (structure) (structure))
-       (check-equal:? (structure) ((structure)))
-       (check-equal:? ((structure)) (structure))
-       (check-equal:? ((structure)) ((structure)))]
 
 @chunk[<test-structure>
        (let ()
          (define-structure empty-st)
          (define-structure stA [a Number])
-         (check-equal:? (empty-st) ((structure)))
+         (check-equal:? (empty-st) ((structure #:constructor)))
          (check-not-equal:? (empty-st) (structure [a 1]))
-         (check-not-equal:? (structure) (structure [a 1]))
+         (check-not-equal:? (structure #:constructor) (structure [a 1]))
          (check-not-equal:? (empty-st) (stA 1))
-         (check-not-equal:? (structure) (stA 1)))
+         (check-not-equal:? (structure #:constructor) (stA 1)))
        #;(let ()
            (define-structure st [a Number] [b String])
            (define-structure stA [a Number])
@@ -247,18 +236,10 @@ one low-level @tc[struct] is generated for them.
 @CHUNK[<named-sorted-structures>
        (define-for-syntax named-sorted-structures
          (for/list ([s (remove-duplicates (map (λ (s) (sort s symbol<?))
-                                               <all-remembered-structs+empty>))]
+                                               (get-remembered 'structure)))]
                     [i (in-naturals)])
            `(,(string->symbol (format "struct-~a" i)) . ,s)))]
 
-We add the empty struct (with no fields) to the list of remembered structs as a
-special case, because we need it to define the hybrid instance/constructor in
-section @secref{structure|hybrid-empty}.
-
-@chunk[<all-remembered-structs+empty>
-       (cons '()
-             (get-remembered 'structure))]
-
 We will also need utility functions to sort the fields when querying this
 associative list.
 
@@ -306,9 +287,8 @@ should succeed.
              (let ()
                (define/with-syntax (sorted-field ...)
                  (sort-fields #'(field ...)))
-               (define/with-syntax (TTemp ...)
+               (define-temp-ids "~a/TTemp" (field …))
-                 (generate-temporaries #'(field ...)))
+               #`(λ #:∀ (field/TTemp …) ([field : field/TTemp] …)
-               #`(λ #:∀ (TTemp ...) ([field : TTemp] ...)
                    (#,(fields→stx-name #'(field ...)) sorted-field ...)))
              (remember-all-errors #'list stx #'(field ...))))]
 
@@ -443,13 +423,20 @@ instead of needing an extra recompilation.
 @CHUNK[<type-expander>
        (define-for-syntax (structure-type-expander stx)
          (syntax-parse stx
-           [(_ [field type] ...)
+           [(_ (~or-bug [field:id] field:id) …)
+            (if (check-remember-fields #'(field ...))
+                (let ()
+                  (define/with-syntax (sorted-field …)
+                    (sort-fields #'(field …)))
+                  (fields→stx-name #'(field …)))
+                (remember-all-errors #'U stx #'(field ...)))]
+           [(_ (~seq [field:id type:expr] …))
             (if (check-remember-fields #'(field ...))
                 (let ()
                   (define/with-syntax ([sorted-field sorted-type] ...)
                     (sort-car-fields #'((field type) ...)))
                   (if (stx-null? #'(sorted-type ...))
-                      (fields→stx-name #'(field …)) ; #'(field …) is empty here.
+                      (fields→stx-name #'()) ; #'(field …) is empty here.
                       #`(#,(fields→stx-name #'(field ...)) sorted-type ...)))
                 (remember-all-errors #'U stx #'(field ...)))]))]
 
@@ -549,6 +536,9 @@ chances that we could write a definition for that identifier.
                     get
                     structure)
            
+           (begin-for-syntax
+             (provide structure-args-stx-class))
+           
            <remember-all>
            <get-remembered>
            <check-remember-fields>
@@ -558,9 +548,6 @@ chances that we could write a definition for that identifier.
            <sort-fields>
            <declare-all-structs>
            <fields→stx-name>
-           <declare-hybrid-empty>
-           (require typed/rackunit)
-           <test-hybrid-empty>
            <make-structure-constructor>
            <delayed-error-please-recompile>
            
@@ -590,7 +577,6 @@ chances that we could write a definition for that identifier.
            <test-type-expander>
            <test-structure>
            <test-define-structure>
-           <test-hybrid-empty-2>
            
            (require (submod ".." doc))))]
 

graph/graph/variant.lp2.rkt

@@ -117,10 +117,34 @@ number of name collisions.
          (λ/syntax-parse (_ tag:id . structure-pat)
            #`(constructor tag #,(syntax/loc #'structure-pat
                                   (structure . structure-pat))))
-         #:call
+         #:call ;; TODO: clean this up a bit, and explain it.
-         (λ/syntax-parse (_ tag:id . structure-field-value)
+         (λ/syntax-parse
-           #`(constructor tag #,(syntax/loc #'structure-field-value
+           (~and (_ (~and (~seq disambiguate …) (~or (~seq #:instance)
-                                  (structure . structure-field-value)))))]
+                                                     (~seq #:constructor)
+                                                     (~seq)))
+                    tag:id . fields)
+                 (~parse (sa:structure-args-stx-class)
+                           #'(disambiguate … . fields)))
+           (define-temp-ids "~a/TTemp" (sa.field …))
+           (define/with-syntax c
+             (if (attribute sa.type)
+                 #`(λ ([sa.field : sa.type] …)
+                     : (constructor tag #,(syntax/loc #'fields
+                                            (structure [sa.field sa.type] …)))
+                     (constructor tag
+                                  #,(syntax/loc #'fields
+                                      (structure #:instance
+                                                 [sa.field : sa.type sa.field] …))))
+                 #`(λ #:∀ (sa.field/TTemp …) ([sa.field : sa.field/TTemp] …)
+                     : (constructor tag #,(syntax/loc #'fields
+                                            (structure [sa.field sa.field/TTemp] …)))
+                     (constructor tag
+                                  #,(syntax/loc #'fields
+                                      (structure #:instance
+                                                 [sa.field sa.field] …))))))
+           (if (attribute sa.value)
+               #'(c sa.value …)
+               #'c)))]
 
 @chunk[<test-tagged>
        (check-equal? (match (ann (tagged foo [x "o"] [y 3] [z 'z])
@@ -146,7 +170,7 @@ number of name collisions.
                #'(tagged tag [field pat] ...))
              #:call
              (λ/syntax-parse (_ value ...)
-               #'(tagged tag [field value] ...))))]
+               #'(tagged tag #:instance [field value] ...))))]
 
 @chunk[<test-define-tagged>
        (define-tagged tagged-s1)

graph/lib/low.rkt

@@ -10,11 +10,19 @@
 (provide half-typed-module typed/untyped-prefix define-modules)
 
 ;; half-typed-module
-(define-syntax-rule (typed-module m typed-language untyped-language . body)
+(define-syntax-rule (typed-module m t u typed-language untyped-language . body)
-  (module m typed-language . body))
+  (begin
+    (module m typed-language
+      (module t typed-language . body)
+      (module u untyped-language . body)
+      . body)))
 
-(define-syntax-rule (untyped-module m typed-language untyped-language . body)
+(define-syntax-rule (untyped-module m u typed-language untyped-language . body)
-  (module m untyped-language . body))
+  (begin
+    (module m untyped-language
+      (module t typed-language . body)
+      (module u untyped-language . body)
+      . body)))
 
 (define-typed/untyped-identifier half-typed-module typed-module untyped-module)
 
@@ -92,74 +100,76 @@
   (check-equal? require-provide-foo 7))
 
 ;; ==== low/syntax-parse.rkt ====
-(require syntax/parse
-         syntax/parse/define
-         (for-syntax racket/syntax))
 
-(provide define-syntax/parse
+(define-modules ([no-submodule]
-         λ/syntax-parse
+                 [syntax-parse-extensions-untyped typed/racket/no-check])
-         ~maybe
+  (require syntax/parse
-         ~lit
+           syntax/parse/define
-         ~or-bug)
+           (for-syntax racket/base
-
+                       racket/syntax))
-(define-syntax ~maybe
-  (pattern-expander
-   (λ (stx)
-     (syntax-case stx ()
-       [(~maybe pat ...)
-        (datum->syntax #'~maybe
-                       #'(~optional (~seq pat ...)))]))))
-
-;; Circumvent the bug that causes "syntax-parse: duplicate attribute in: a" in:
-;; (syntax-parse #'(x y z) [((~or a (a b c)) ...) #'(a ...)])
-(define-syntax ~or-bug
-  (pattern-expander
-   (λ (stx)
-     (syntax-case stx ()
-       [(~or-bug pat ...)
-        (let ()
-          (define (s stx) (datum->syntax #'~or-bug stx))
-          ;(define/with-syntax ~~and (datum->syntax #'~or-bug #'~and))
-          ;(define/with-syntax ~~parse (datum->syntax #'~or-bug #'~parse))
-          ;(define/with-syntax ~~or (datum->syntax #'~or-bug #'~parse))
-          #;#'(~~and x (~~parse (~~or pat ...) #'x))
-          #`(#,(s #'~and) x (#,(s #'~parse) #,(s #'(~or pat ...)) #'x))
-          )]))))
-
-(define-syntax ~lit
-  (pattern-expander
-   (λ (stx)
-     (syntax-case stx ()
-       [(~lit lit)
-        (datum->syntax #'~lit
-                       #'(~literal lit))]
-       [(~lit lit …)
-        (datum->syntax #'lit
-                       #'(~seq (~literal lit)))]))))
-
-(begin-for-syntax
-  (require (for-syntax racket/base
-                       racket/stxparam)
-           racket/stxparam)
   
-  (provide stx)
+  (provide define-syntax/parse
+           λ/syntax-parse
+           ~maybe
+           ~lit
+           ~or-bug)
   
-  (define-syntax-parameter stx
+  (define-syntax ~maybe
-    (lambda (stx)
+    (pattern-expander
-      (raise-syntax-error (syntax-e stx)
+     (λ (stx)
-                          "Can only be used in define-syntax/parse"))))
+       (syntax-parse stx
-
+         [(self pat ...)
-(define-simple-macro (define-syntax/parse (name . args) . body)
+          (define (s stx) (datum->syntax #'self stx stx stx))
-  (define-syntax (name stx2)
+          #`(#,(s #'~optional) (#,(s #'~seq) pat ...))]))))
-    (syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+  
-                         (syntax-parse stx2
+  ;; Circumvent the bug that causes "syntax-parse: duplicate attribute in: a" in
-                           [(_ . args) . body]))))
+  ;; (syntax-parse #'(x y z) [((~or a (a b c)) ...) #'(a ...)])
-
+  (define-syntax ~or-bug
-(define-simple-macro (λ/syntax-parse args . body)
+    (pattern-expander
-  (λ (stx2)
+     (λ (stx)
-    ;(syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+       (syntax-parse stx
-    (syntax-parse stx2
+         [(self pat ...)
-      [args . body])));)
+          (define (s stx) (datum->syntax #'self stx stx stx))
+          #`(#,(s #'~and) x (#,(s #'~parse) (#,(s #'~or) pat ...) #'x))]))))
+  
+  (define-syntax ~lit
+    (pattern-expander
+     (λ (stx)
+       (syntax-parse stx
+         [(self (~optional (~seq name:id (~literal ~))) lit)
+          (define (s stx) (datum->syntax #'self stx stx stx))
+          (if (attribute name)
+              #`(#,(s #'~and) name (#,(s #'~literal) lit))
+              #`(#,(s #'~literal) lit))]
+         [(self (~optional (~seq name:id (~literal ~))) lit …)
+          (define (s stx) (datum->syntax #'self stx stx stx))
+          (if (attribute name)
+              #`(#,(s #'~and) name (#,(s #'~seq) (#,(s #'~literal) lit)))
+              #`(#,(s #'~seq) (#,(s #'~literal) lit)))]))))
+  
+  (begin-for-syntax
+    (require (for-syntax racket/base
+                         racket/stxparam)
+             racket/stxparam)
+    
+    (provide stx)
+    
+    (define-syntax-parameter stx
+      (lambda (stx)
+        (raise-syntax-error (syntax-e stx)
+                            "Can only be used in define-syntax/parse"))))
+  
+  (define-simple-macro (define-syntax/parse (name . args) body0 . body)
+    (define-syntax (name stx2)
+      (syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+                           (syntax-parse stx2
+                             [(_ . args) body0 . body]))))
+  
+  (define-simple-macro (λ/syntax-parse args . body)
+    (λ (stx2)
+      ;(syntax-parameterize ([stx (make-rename-transformer #'stx2)])
+      (syntax-parse stx2
+        [args . body]))))
 
 ;; If you include this as a file, you need to do:
 ;(begin-for-syntax (provide stx))
@@ -220,6 +230,7 @@
          sixth-value seventh-value eighth-value ninth-value tenth-value
          ∘
          …
+         …+
          stx-list
          stx-e
          stx-pair
@@ -240,7 +251,9 @@
 
 (require (only-in racket
                   [compose ∘]
-                  [... …]))
+                  [... …])
+         (only-in syntax/parse
+                  [...+ …+]))
 
 (require (for-syntax syntax/parse syntax/parse/experimental/template))
 
@@ -437,7 +450,7 @@
                   ([x : (Listof Number) (in-heads '(1 2 3 4 5))]) x)
                 '((1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5))))
 
-;; Can't write the type of on-split, because typed/racket doesn't allow writing
+;; Can't write the type of in-split, because typed/racket doesn't allow writing
 ;; (Sequenceof A B), just (Sequenceof A).
 ;; in-parallel's type has access to the multi-valued version of Sequenceof,
 ;; though, so we let typed/racket propagate the inferred type.
@@ -998,4 +1011,186 @@
     [(_ expr )]))
 |#
 
+;; ==== low/repeat-stx.rkt ===
+
+(define-modules ([no-submodule] [repeat-stx-untyped typed/racket/no-check])
+  (require syntax/stx
+           (for-syntax racket/base
+                       racket/syntax
+                       syntax/parse))
+  
+  (provide repeat-stx)
+  
+  (define-for-syntax (repeat-stx-2 stx)
+    (syntax-parse stx
+      [(a:id b:id)
+       #'(λ _ a)]
+      [(a:id (b:expr (~literal ...)))
+       #`(λ (bs) (stx-map #,(repeat-stx-2 #'(a b)) bs))]))
+  
+  (define-for-syntax (repeat-stx-1 stx)
+    (syntax-parse stx
+      [(a:id b:expr)
+       #`(λ (a bs) (#,(repeat-stx-2 #'(a b)) bs))]
+      [((a:expr (~literal ...)) (b:expr (~literal ...)))
+       #`(λ (s1 s2) (stx-map #,(repeat-stx-1 #'(a b)) s1 s2))]))
+  
+  (define-syntax (repeat-stx stx)
+    (syntax-parse stx
+      [(_ a:expr b:expr)
+       #`(#,(repeat-stx-1 #'(a b)) #'a #'b)])))
+
+(module repeat-stx-test racket
+  (require (submod ".." repeat-stx-untyped))
+  (require syntax/parse
+           rackunit)
+  
+  (check-equal?
+   (syntax-parse #'(1 2)
+     [(a b)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a b)))])
+   1)
+  
+  (check-equal?
+   (syntax-parse #'(1 2 3)
+     [(a b ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a (b ...))))])
+   '(1 1))
+  
+  (check-equal?
+   (syntax-parse #'(1 (2 3) (uu vv ww) (xx yy))
+     [(a (b ...) ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a ((b ...) ...))))])
+   '((1 1) (1 1 1) (1 1)))
+  
+  (check-equal?
+   (syntax-parse #'(1 ((2) (3 3)) ((uu) (vv vv) (ww ww ww)) ((xx) (yy)))
+     [(a ((b ...) ...) ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx a (((b ...) ...) ...))))])
+   '(((1) (1 1)) ((1) (1 1) (1 1 1)) ((1) (1))))
+  
+  (check-equal?
+   (syntax-parse #'([1 x] [2 y] [3 z])
+     [([a b] ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) (b ...))))])
+   '(1 2 3))
+  
+  (check-equal?
+   (syntax-parse #'((1 2 3) (a b))
+     [([a b ...] ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) ((b ...) ...))))])
+   '((1 1) (a)))
+  
+  (check-equal?
+   (syntax-parse #'(((1 2 3) (a b)) ((x y z t) (-1 -2)))
+     [[[[a b ...] ...] ...]
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx ((a ...) ...) (((b ...) ...) ...))))])
+   '(((1 1) (a)) ((x x x) (-1))))
+  
+  (check-equal?
+   (syntax-parse #'((f (1 2 3) (a b)) (g (x y z t) (-1 -2)))
+     [[[a (b ...) ...] ...]
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) (((b ...) ...) ...))))])
+   '(((f f f) (f f)) ((g g g g) (g g))))
+  
+  (check-equal?
+   (syntax-parse #'((h () ()) (i () (x y z) ()))
+     [([a (b ...) ...] ...)
+      (syntax->datum
+       (datum->syntax
+        #'dummy
+        (repeat-stx (a ...) (((b ...) ...) ...))))])
+   '((() ()) (() (i i i) ()))))
+
+(module+ test
+  (require (submod ".." repeat-stx-test)))
+
+;; ==== low/test-framework.rkt ====
+(require (for-syntax syntax/parse)
+         (for-syntax (submod "." syntax-parse-extensions-untyped))
+         (for-syntax (submod "." repeat-stx-untyped))
+         typed/rackunit)
+
+(provide check-equal?-classes
+         check-equal?-classes:)
+
+(: check-equal?-classes (∀ (A ...) (→ (Pairof String (Listof A)) ... Void)))
+(define (check-equal?-classes . classes)
+  (for* ([(head tail) (in-split* classes)])
+    (let ([this-class (sequence-ref tail 0)]
+          [different-classes (in-sequences head (sequence-tail tail 1))])
+      (for ([val (cdr this-class)])
+        (for ([other-val (cdr this-class)])
+          #;(displayln (format "Test ~a ∈ ~a = ~a ∈ ~a …"
+                               val
+                               this-class
+                               other-val
+                               this-class))
+          (check-equal? val other-val
+                        (format "Test ~a ∈ ~a = ~a ∈ ~a failed."
+                                val
+                                this-class
+                                other-val
+                                this-class)))
+        (for ([different-class different-classes])
+          (for ([different-val (cdr different-class)])
+            #;(displayln (format "Test ~a ∈ ~a != ~a ∈ ~a ∈ ~a …"
+                                 val
+                                 this-class
+                                 different-val
+                                 different-class
+                                 (sequence->list different-classes)))
+            (check-not-equal? val different-val
+                              (format "Test ~a ∈ ~a != ~a ∈ ~a ∈ ~a failed."
+                                      val
+                                      this-class
+                                      different-val
+                                      different-class
+                                      (sequence->list different-classes)))))))))
+
+(define-syntax/parse (check-equal?-classes:
+                      (~seq [(~maybe #:name name:expr)
+                             (~maybe (~lit :) c-type)
+                             (~seq val (~maybe (~lit :) v-type)) …])
+                      …)
+  (define/with-syntax ([a-val …] …)
+    (template ([(?? (ann val v-type) val) …] …)))
+  (define/with-syntax ([aa-val …] …)
+    (let ()
+      ;; TODO: this is ugly, repeat-stx should handle missing stuff instead.
+      (define/with-syntax (xx-c-type …) (template ((?? (c-type) ()) …)))
+      (syntax-parse (repeat-stx (xx-c-type …) ([val …] …))
+        [([((~optional c-type-rep)) …] …)
+         (template ([(?? name "") (?? (ann a-val c-type-rep) a-val) …] …))])))
+  (template
+   (check-equal?-classes (list aa-val …) …)))
+
+;; ==== low/typed-not-implemented-yet.rkt ====
+
+(define-syntax-rule (? t) ((λ () : t (error "Not implemented yet"))))
+
 ;; ==== end ====

graph/type-expander/type-expander.lp2.rkt

@@ -495,10 +495,6 @@ them.
                (~and name+parent (~or name:id [name:id parent:id]))
                ([field:id :colon type:expr] ...)
                . rest)
-            (displayln #'(tvars= tvars
-                                 name+parent= name+parent
-                                 field...= field ...
-                                 rest= rest))
             (template (struct (?? tvars.maybe) name (?? parent)
                         ([field : (tmpl-expand-type tvars.vars type)] ...)
                         . rest))]))]
@@ -631,7 +627,6 @@ them.
        (check-equal? ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 123)
                      246)
        (check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2)))
-       (check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se3)))
        (check-true (se2? (car ((se2 2 3) 'd))))
        (check-true (se3? (car ((se2 2 3) 'e))))]