Work in progress for implementing (structure) so that it is both a hybrid function and empty struct, but actually it can't be passed to polymorphic functions (like map, …), so it's probably better to just add an optional #:instance or #:constructor argument to clarify.

graph/graph/__DEBUG_graph__.rkt

@@ -1,5 +1,19 @@
 #lang debug typed/racket
 
+(require "structure.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"]))
+(check-equal:? (st 1 "b") ((structure [a : Number] [b : String]) 1 "b"))
+(check-equal:? (st 1 "b") ((structure [a] [b]) 1 "b"))
+(check-equal:? (st 1 "b") ((structure a b) 1 "b"))
+(check-equal:? (st 1 "b") ((structure [a] b) 1 "b"))
+
+
+#|
 (require (submod "graph3.lp2.rkt" test))
 (require "../lib/low.rkt")
 (require racket/list)
@@ -34,3 +48,5 @@
       x))
 
 (forceall 5 g)
+
+|#

graph/graph/remember.rkt

@@ -38,3 +38,5 @@
 (structure faa fab fav)
 (structure fba fbv)
 (structure fav)
+(structure a)
+(structure a)

graph/graph/structure.lp2.rkt

@@ -12,12 +12,116 @@ Structures are represented using regular racket @tc[struct]s, see
 @seclink["type-system|structures"]{the overview document}.
 @;secref["structures" #:doc "type-system.scrbl"].
 
+When called, @tc[structure] accepts several syntaxes:
+@tc[(structure [field] …)], which returns a constructor with @tc[∀] types for,
+@tc[(structure [field value] …)], which returns an instance, inferring the type
+of the fields, @tc[(structure [field : type] …)], which returns a constructor
+with the given types, or @tc[(structure [field : type value] …)], which returns
+an instance using the given types. the types have to be all provided, or not
+given at all, but a mix of typed and @tc[∀] is not allowed for now (rationale:
+since typed/racket currently doesn't support named instantiation of polymorphic
+types, it wouldn't be clear what fields the remaining type parameters affect).
+
+@;{(begin-for-syntax
+ (define-syntax-class field-descriptor
+ (pattern
+ (~or field:id
+ [field:id (~maybe (~lit :) type:expr) (~maybe value:expr)]))))}
+
 @chunk[<structure>
        (define-multi-id structure
          #:type-expander structure-type-expander
          #:match-expander structure-match-expander
-         #:call (λ/syntax-parse (_ [field value] ...)
+         #:call (λ (stx)
-                  #'((make-structure-constructor field ...) value ...)))]
+                  (syntax-parse stx
+                    [(_) <hybrid-empty>]
+                    [(_ (~or (~seq (~or-bug [field:id] field:id) …)
+                             (~seq [field:id (~lit :) type:expr] …)
+                             (~seq [field:id value:expr] …)
+                             (~seq [field:id (~lit :) type:expr value:expr] …)))
+                     (define/with-syntax c
+                       #'(make-structure-constructor field …))
+                     (define/with-syntax ct
+                       (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-not-equal:? (empty-st) (structure [a 1]))
+         (check-not-equal:? (structure) (structure [a 1]))
+         (check-not-equal:? (empty-st) (stA 1))
+         (check-not-equal:? (structure) (stA 1)))
+       #;(let ()
+           (define-structure st [a Number] [b String])
+           (define-structure stA [a Number])
+           (define-structure stABC [a Number] [b String] [c Number])
+           (define st1 (st 1 "b"))
+           (check-equal:? st1 (structure [a 1] [b "b"]))
+           (check-equal:? st1 (structure [a : Number 1] [b : String "b"]))
+           (check-equal:? st1 ((structure [a : Number] [b : String]) 1 "b"))
+           (check-equal:? st1 ((structure [a] [b]) 1 "b"))
+           (check-equal:? st1 ((structure a b) 1 "b"))
+           (check-equal:? st1 ((structure [a] b) 1 "b"))
+           
+           (define st2 (st 2 "b"))
+           (check-not-equal:? st2 st1)
+           (check-not-equal:? st2 (structure [a 1] [b "b"]))
+           (check-not-equal:? st2 (structure [a : Number 1] [b : String "b"]))
+           (check-not-equal:? st2 ((structure [a : Number] [b : String]) 1 "b"))
+           (check-not-equal:? st2 ((structure [a] [b]) 1 "b"))
+           (check-not-equal:? st2 ((structure a b) 1 "b"))
+           (check-not-equal:? st2 ((structure [a] b) 1 "b"))
+           
+           (define sta (stA 1))
+           (check-not-equal:? sta st1)
+           (check-not-equal:? sta (structure [a 1] [b "b"]))
+           (check-not-equal:? sta (structure [a : Number 1] [b : String "b"]))
+           (check-not-equal:? sta ((structure [a : Number] [b : String]) 1 "b"))
+           (check-not-equal:? sta ((structure [a] [b]) 1 "b"))
+           (check-not-equal:? sta ((structure a b) 1 "b"))
+           (check-not-equal:? sta ((structure [a] b) 1 "b"))
+           
+           (define st3 (stABC 1 "b" 3))
+           (check-not-equal:? st3 st1)
+           (check-not-equal:? st3 (structure [a 1] [b "b"]))
+           (check-not-equal:? st3 (structure [a : Number 1] [b : String "b"]))
+           (check-not-equal:? st3 ((structure [a : Number] [b : String]) 1 "b"))
+           (check-not-equal:? st3 ((structure [a] [b]) 1 "b"))
+           (check-not-equal:? st3 ((structure a b) 1 "b"))
+           (check-not-equal:? st3 ((structure [a] b) 1 "b")))]
 
 @chunk[<define-structure>
        (define-syntax (define-structure stx)
@@ -34,16 +138,20 @@ Structures are represented using regular racket @tc[struct]s, see
                   (syntax-case stx2 ()
                     [(_ pat ...) #'(structure [field pat] ...)]))
                 #:else
-                (inst (make-structure-constructor field ...) type ...))]))]
+                (if (not (stx-null? #'(type …)))
+                    #'(inst (make-structure-constructor field ...) type ...)
+                    #'(make-structure-constructor field ...)))]))]
 
 
 @chunk[<test-define-structure>
+       (define-structure empty-st)
        (define-structure st [a Number] [b String])
        (define-structure st2 [b String] [a Number])]
 
 Test constructor:
 
 @chunk[<test-define-structure>
+       (check-equal:? (empty-st) : empty-st (empty-st))
        (check-equal:? (get (st 1 "b") b) : String "b")
        (check-equal:? (get (st2 "a" 2) b) : String "a")]
 
@@ -139,10 +247,18 @@ 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<?))
-                                               (get-remembered 'structure)))]
+                                               <all-remembered-structs+empty>))]
                     [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.
 
@@ -175,8 +291,8 @@ be used to make @tc[structure] instances like this:
 
 @chunk[<test-make-structure-constructor>
        (check-equal? (begin ((make-structure-constructor a b c) 1 "b" #t)
-                            #t)
+                            'it-works)
-                     #t)]
+                     'it-works)]
 
 To create such an instance, we use the underlying @tc[struct]'s constructor.
 First, we need to check if the list of fields was already remembered, in which
@@ -332,8 +448,8 @@ instead of needing an extra recompilation.
                 (let ()
                   (define/with-syntax ([sorted-field sorted-type] ...)
                     (sort-car-fields #'((field type) ...)))
-                  (if (null? (syntax->list #'(sorted-type ...)))
+                  (if (stx-null? #'(sorted-type ...))
-                      (fields→stx-name #'(field ...))
+                      (fields→stx-name #'(field …)) ; #'(field …) is empty here.
                       #`(#,(fields→stx-name #'(field ...)) sorted-type ...)))
                 (remember-all-errors #'U stx #'(field ...)))]))]
 
@@ -417,6 +533,7 @@ chances that we could write a definition for that identifier.
            (require (for-syntax racket
                                 racket/syntax
                                 syntax/parse
+                                syntax/parse/experimental/template
                                 mzlib/etc
                                 racket/struct-info
                                 syntax/stx
@@ -441,6 +558,9 @@ 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>
            
@@ -468,7 +588,9 @@ chances that we could write a definition for that identifier.
            <test-get-field>
            <test-match-expander>
            <test-type-expander>
+           <test-structure>
            <test-define-structure>
+           <test-hybrid-empty-2>
            
            (require (submod ".." doc))))]
 

graph/lib/low.rkt

@@ -91,12 +91,51 @@
   (require 'mb)
   (check-equal? require-provide-foo 7))
 
-;; ==== low/define-syntax-parse.rkt ====
+;; ==== low/syntax-parse.rkt ====
 (require syntax/parse
-         syntax/parse/define)
+         syntax/parse/define
+         (for-syntax racket/syntax))
 
 (provide define-syntax/parse
-         λ/syntax-parse)
+         λ/syntax-parse
+         ~maybe
+         ~lit
+         ~or-bug)
+
+(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
@@ -132,7 +171,8 @@
               syntax/parse/experimental/template)
   typed/rackunit)
 
-(provide check-equal:?)
+(provide check-equal:?
+         check-not-equal:?)
 
 ;; TODO: this won't expand types in the ann.
 
@@ -140,7 +180,15 @@
   (check-equal:? actual
                  (~optional (~seq (~datum :) type))
                  expected)
-  (template (check-equal? (?? (ann actual type) actual) expected)))
+  (template (check-equal? (?? (ann actual type) actual)
+                          (?? (ann expected type) expected))))
+
+(define-syntax/parse
+  (check-not-equal:? actual
+                     (~optional (~seq (~datum :) type))
+                     expected)
+  (template (check-not-equal? (?? (ann actual type) actual)
+                              (?? (ann expected type) expected))))
 
 ;; ==== low/typed-fixnum.rkt ===
 

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

@@ -14,16 +14,21 @@ TODO: maybe we should cache @tc[p-else] and @tc[p-get].
           'self
           (format "can't set ~a" (syntax->datum #'self)))]
 
-@chunk[<stx-class-kw-else>
+@CHUNK[<stx-class-kw-else>
        (define-splicing-syntax-class kw-else
+         #:attributes (p-just-set! p-just-call p-just-id)
          (pattern (~seq #:mutable-else p-else)
                   #:with p-just-set! #'#'(set! p-else . rest)
                   #:with p-just-call #'#'(p-else . rest)
                   #:with p-just-id #'#'p-else)
          (pattern (~seq #:else p-else)
                   #:with p-just-set! <fail-set!>
-                  #:with p-just-call #'#'(p-else . rest)
+                  #:with p-just-call #'#`(#,p-else . rest)
-                  #:with p-just-id #'#'p-else))]
+                  #:with p-just-id #'p-else)
+         (pattern (~seq #:mutable-else-id p-else-id)
+                  #:with (:kw-else) #'(#:mutable-else #'p-else-id))
+         (pattern (~seq #:else-id p-else-id)
+                  #:with (:kw-else) #'(#:else #'p-else-id)))]
 
 @chunk[<stx-class-kw-set!+call+id>
        (define-splicing-syntax-class kw-set!+call+id
@@ -31,6 +36,10 @@ TODO: maybe we should cache @tc[p-else] and @tc[p-get].
                         (~optional (~or (~seq #:call p-user-call:expr)
                                         (~seq #:call-id p-user-call-id:id)))
                         (~optional (~seq #:id p-user-id:expr)))
+                  ; TODO: add #:macro with prop:procedure, see
+                  ; file:///usr/local/racket-6.3.0.4/doc/syntax/stxparse-patter
+                  ; ns.html?q=~optional#%28def._%28%28lib._syntax%2Fparse..rkt%
+                  ; 29._prop~3apattern-expander%29%29
                   #:attr p-just-set!
                   (and (attribute p-user-set!) #'(p-user-set! stx))
                   #:attr p-just-call
@@ -129,6 +138,31 @@ to configure).
 
 Test with @tc[#:else]:
 
+@chunk[<test-multi-id>
+       (define-multi-id bar-id
+         #:type-expander
+         (λ (stx) #'(List `,(Repeat 'x 2) Number))
+         #:match-expander
+         (λ (stx) #'(cons _ _))
+         #:custom-write
+         (λ (self port mode) (display "custom-write for foo" port))
+         #:else-id p1)
+       
+       (check-equal? (ann (ann '((x x) 79) bar)
+                          (List (List 'x 'x) Number))
+                     '((x x) 79))
+       
+       ;(set! bar 'bad)
+       
+       (let ([test-match (λ (val) (match val [(bar-id) #t] [_ #f]))])
+         (check-equal? (test-match '(a . b)) #t)
+         (check-equal? (test-match #(1 2 3)) #f))
+
+       (let ([f-bar-id bar-id])
+         (check-equal? (f-bar-id 6) 7))
+       (check-equal? (bar-id 6) 7)
+       (check-equal? (map bar-id '(1 5 3 4 2)) '(2 6 4 5 3))]
+
 @chunk[<test-multi-id>
        (define-multi-id bar
          #:type-expander
@@ -137,7 +171,7 @@ Test with @tc[#:else]:
          (λ (stx) #'(cons _ _))
          #:custom-write
          (λ (self port mode) (display "custom-write for foo" port))
-         #:else p1)
+         #:else #'p1)
        
        (check-equal? (ann (ann '((x x) 79) bar)
                           (List (List 'x 'x) Number))

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

@@ -40,9 +40,9 @@ contain the expander procedure, or directly an expander procedure.
                [else
                 (raise-argument-error
                  'prop:type-expander-guard
-                 (~a "an exact non-negative integer designating a field index "
+                 (~a "a procedure of arity 1, or an exact non-negative integer "
-                     "within the structure that should contain a procedure of "
+                     "designating a field index within the structure that "
-                     "arity 1, or a procedure of arity 1.")
+                     "should contain a procedure of arity 1.")
                  val)]))]
 
 If the value is a field index, it should be within bounds. The
@@ -269,7 +269,7 @@ ususal @code{#'()} and @code{#`()}. In order to expand types and bind type
 variables in the result, we define two template metafunctions:
 
 @chunk[<template-metafunctions>
-       (define-template-metafunction (template-expand-type stx)
+       (define-template-metafunction (tmpl-expand-type stx)
          (syntax-parse stx
            [(_ () t) (expand-type #'t)]
            [(_ tvars t) (expand-type (bind-type-vars #'tvars #'t))]))]
@@ -329,7 +329,7 @@ them.
                                     (~optional default:expr)])
                   #:with tvars tvars
                   #:with (expanded ...)
-                  (template (kw [id (?@ : (template-expand-type tvars type))
+                  (template (kw [id (?@ : (tmpl-expand-type tvars type))
                                  (?? default)]))))
        
        (define-splicing-syntax-class (new-mand-formal tvars)
@@ -339,7 +339,7 @@ them.
          (pattern [id:id :colon type:expr]
                   #:with tvars tvars
                   #:with (expanded ...)
-                  (template ([id : (template-expand-type tvars type)])))
+                  (template ([id : (tmpl-expand-type tvars type)])))
          (pattern (~var kw (new-kw-formal tvars))
                   #:with (expanded ...) #'(kw.expanded ...)))
        
@@ -348,7 +348,7 @@ them.
          (pattern [id:id (~optional (~seq :colon type:expr)) default:expr]
                   #:with tvars tvars
                   #:with (expanded ...)
-                  (template ([id (?@ : (template-expand-type tvars type))
+                  (template ([id (?@ : (tmpl-expand-type tvars type))
                               default])))
          (pattern (~var kw (new-kw-formal tvars))
                   #:with (expanded ...) #'(kw.expanded ...)))
@@ -363,8 +363,8 @@ them.
                         (~seq (~datum ...) bound:expr)))
                   #:with tvars tvars
                   #:with expanded
-                  (template (rest : (template-expand-type tvars type)
+                  (template (rest : (tmpl-expand-type tvars type)
-                                  (?? x* (?@ (... ...) (template-expand-type
+                                  (?? x* (?@ (... ...) (tmpl-expand-type
                                                         tvars bound)))))))
        
        (define-syntax-class (new-lambda-formals tvars)
@@ -394,7 +394,7 @@ them.
                   #:with tvars tvars
                   #:with expanded
                   (template (name
-                             (?? (?@ : (template-expand-type tvars type)))))))
+                             (?? (?@ : (tmpl-expand-type tvars type)))))))
        
        (define-syntax-class (new-name-or-parenthesised-annotated-name tvars)
          (pattern name:id
@@ -402,7 +402,7 @@ them.
          (pattern [id:id :colon type:expr]
                   #:with tvars tvars
                   #:with expanded
-                  (template [id : (template-expand-type tvars type)])))]
+                  (template [id : (tmpl-expand-type tvars type)])))]
 
 @subsection{@racket[define-type]}
 
@@ -412,7 +412,7 @@ them.
            [(_ (~or name:id (name:id TVar ...)) type . rest)
             (template
              (define-type (?? (name TVar ...) name)
-               (template-expand-type (?? (TVar ...) ()) type)
+               (tmpl-expand-type (?? (TVar ...) ()) type)
                . rest))]))]
 
 @chunk[<test-define-type>
@@ -437,7 +437,7 @@ them.
                e ...)
             (template
              (define (?@ . tvars) (?? v formals.expanded)
-               (?? (?@ : (template-expand-type tvars.vars type)))
+               (?? (?@ : (tmpl-expand-type tvars.vars type)))
                e ...))]))]
 
 @CHUNK[<test-define>
@@ -471,7 +471,7 @@ them.
                (~optional (~seq :colon ret-type))
                e ...)
             (template (lambda (?@ . tvars) args.expanded
-                        (?? (?@ : (template-expand-type tvars.vars ret-type)))
+                        (?? (?@ : (tmpl-expand-type tvars.vars ret-type)))
                         e ...))]))]
 
 @CHUNK[<test-lambda>
@@ -495,8 +495,12 @@ them.
                (~and name+parent (~or name:id [name:id parent:id]))
                ([field:id :colon type:expr] ...)
                . rest)
-            (template (struct (?? tvars.maybe) name+parent
+            (displayln #'(tvars= tvars
-                        ([field : (template-expand-type tvars.vars type)] ...)
+                                 name+parent= name+parent
+                                 field...= field ...
+                                 rest= rest))
+            (template (struct (?? tvars.maybe) name (?? parent)
+                        ([field : (tmpl-expand-type tvars.vars type)] ...)
                         . rest))]))]
 
 @chunk[<test-struct>
@@ -507,6 +511,11 @@ them.
        (struct s4 () #:transparent)
        (struct (A B) s5 ([x : A] [y : B]) #:transparent)
        (struct (A B) s6 () #:transparent)
+       (struct (s7 s2) ([z : String]) #:transparent)
+       (struct (A) (s8 s3) ([z : A]) #:transparent)
+       (struct (A B C) (s9 s5) ([z : C]) #:transparent)
+       (struct (A B C) (s10 s2) ([z : C]) #:transparent)
+       (struct (A B C) (s11 s5) ([z : C]))
        
        (check (λ (a b) (not (equal? a b))) (s0) (s0))
        (check-equal? (s1-x (s1 123)) 123)
@@ -518,13 +527,119 @@ them.
        (check-equal? (s5-x (s5 6 7)) 6)
        (check-equal? (s5-y (s5 6 7)) 7)
        (check-equal? (s5 6 7) (s5 6 7))
-       (check-equal? (s6) (s6))]
+       (check-equal? ((inst s5 Number String) 6 "g") (s5 6 "g"))
+       (check-equal? (s6) (s6))
+       (check-equal? ((inst s6 Number String)) (s6))
+       
+       ;(check-equal? (s7-x (s7 -1 -2 "c") -1))
+       ;(check-equal? (s7-y (s7 -1 -2 "c") -2))
+       (check-equal? (s7-z (s7 -1 -2 "c")) "c")
+       (check-equal? (s2-x (s7 -1 -2 "c")) -1)
+       (check-equal? (s2-y (s7 -1 -2 "c")) -2)
+       (check-not-equal? (s7 -1 -2 "c") (s7 -1 -2 "c"))
+       (check-not-exn (λ () (ann (s7 -1 -2 "c") s2)))
+       (check-true (s2? (s7 -1 -2 "c")))
+       
+       ;(check-equal? (s8-x (s8 -1 -2 "c") -1))
+       ;(check-equal? (s8-y (s8 -1 -2 "c") -2))
+       (check-equal? (s8-z (s8 -1 -2 "c")) "c")
+       (check-equal? (s3-x (s8 -1 -2 "c")) -1)
+       (check-equal? (s3-y (s8 -1 -2 "c")) -2)
+       (check-equal? (s8 -1 -2 "c") (s8 -1 -2 "c"))
+       (check-equal? ((inst s8 String) -1 -2 "c") (s8 -1 -2 "c"))
+       (check-not-exn (λ () (ann ((inst s8 String) -1 -2 "c") s3)))
+       (check-true (s3? ((inst s8 String) -1 -2 "c")))
+       
+       ;(check-equal? (s9-x (s9 8 9 10)) 8)
+       ;(check-equal? (s9-y (s9 8 9 10)) 9)
+       (check-equal? (s9-z (s9 8 9 10)) 10)
+       (check-equal? (s5-x (s9 8 9 10)) 8)
+       (check-equal? (s5-y (s9 8 9 10)) 9)
+       (check-equal? (s9 8 9 10) (s9 8 9 10))
+       ;(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j");;;;;;;;;;;;;;
+       ;                          (Struct s5))));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+       (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
+                                 (s5 Number Symbol))))
+       (check-true (s5? ((inst s9 Number Symbol String) -1 'i "j")))
+       (check-not-equal? (s10 11 12 13) (s10 11 12 13))
+       (check-not-equal? (s11 14 15 16) (s11 14 15 16))]
+
+@subsection{@racket[define-struct/exec]}
+
+@chunk[<define-struct/exec>
+       (define-syntax (new-define-struct/exec stx)
+         (syntax-parse stx
+           [(_ (~and name+parent (~or name:id [name:id parent:id]))
+               ([field:id (~maybe :colon type:expr)] ...)
+               [proc :colon proc-type])
+            (template (define-struct/exec name+parent
+                        ([field (?? (?@ : (tmpl-expand-type () type)))] ...)
+                        [proc : (tmpl-expand-type () proc-type)]))]))]
+
+@chunk[<test-define-struct/exec>
+       (define-struct/exec se0 ()
+         ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
+         [(λ (self v) (cons self v)) : (→ se0 Any (Pairof se0 Any))])
+       (define-struct/exec se1 ([x : Number])
+         ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
+         [(λ (self v) (cons self v)) : (→ se1 Any (Pairof se1 Any))])
+       (define-struct/exec se2 ([x : Number] [y : Number])
+         [(λ (self v) (cons self v)) : (→ se2 Any (Pairof se2 Any))])
+       (define-struct/exec (se3 se2) ([z : String])
+         [(λ (self v w) (list self v w))
+          ;: (∀ (A B) (→ se3 A B (List se2 A B)))])
+          : (→ se3 Any Any (List se2 Any Any))])
+       (define-struct/exec (se4 se2) ([z : String])
+         [(λ (self v w) (list self v w))
+          ;: (∀ (A B) (→ se4 A B (List se2 A B)))])
+          : (→ se4 Any (→ Number Number) (List se2 Any (→ Number Number)))])
+       
+       (check (λ (a b) (not (equal? a b))) (se0) (se0))
+       (check-equal? (cdr ((se0) 'a)) 'a)
+       (check-not-exn (λ () (ann (car ((se0) 'a)) se0)))
+       (check-true (se0? (car ((se0) 'a))))
+       
+       (check (λ (a b) (not (equal? a b))) (se1 123) (se1 123))
+       (check-equal? (se1-x (se1 123)) 123)
+       (check-equal? (se1-x (car ((se1 123) 'b))) 123)
+       (check-equal? (cdr ((se1 123) 'b)) 'b)
+       (check-not-exn (λ () (ann (car ((se1 123) 'b)) se1)))
+       (check-true (se1? (car ((se1 123) 'b))))
+       
+       (check (λ (a b) (not (equal? a b))) (se2 2 3) (se2 2 3))
+       (check-equal? (se2-x (se2 2 3)) 2)
+       (check-equal? (se2-y (se2 2 3)) 3)
+       (check-equal? (se2-x (car ((se2 2 3) 'c))) 2)
+       (check-equal? (se2-y (car ((se2 2 3) 'c))) 3)
+       (check-equal? (cdr ((se2 2 3) 'c)) 'c)
+       (check-not-exn (λ () (ann (car ((se2 2 3) 'c)) se2)))
+       (check-true (se2? (car ((se2 2 3) 'c))))
+
+       (check (λ (a b) (not (equal? a b))) (se3 4 5 "f") (se3 4 5 "f"))
+       (check-equal? (se2-x (se3 4 5 "f")) 4)
+       (check-equal? (se2-y (se3 4 5 "f")) 5)
+       (check-equal? (se3-z (se3 4 5 "f")) "f")
+       (check-equal? (se2-x (car ((se3 4 5 "f") 'd 'e))) 2)
+       (check-equal? (se2-y (car ((se3 4 5 "f") 'd 'e))) 3)
+       (check-equal? (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))])
+                       (if (se3? ret)
+                           (se3-z ret)
+                           "wrong type!"))
+                     "f")
+       (check-equal? (cadr ((se3 4 5 "f") 'd 'e)) 'd)
+       (check-equal? (caddr ((se3 4 5 "f") 'd 'e)) 'e)
+       (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))))]
 
 @subsection{@racket[ann]}
 
 @chunk[<ann>
        (define-syntax/parse (new-ann value:expr (~optional :colon) type:expr)
-         (template (ann value (template-expand-type () type))))]
+         (template (ann value (tmpl-expand-type () type))))]
 
 @chunk[<test-ann>
        (let ()
@@ -543,8 +658,8 @@ them.
        (define-syntax/parse (new-inst v
                                       (~optional :colon) t ...
                                       (~optional (~seq last (~datum ...) b:id)))
-         (template (inst v (template-expand-type () t) ...
+         (template (inst v (tmpl-expand-type () t) ...
-                         (?? (?@ (template-expand-type () last)
+                         (?? (?@ (tmpl-expand-type () last)
                                  (... ...) b)))))]
 
 @chunk[<test-inst>
@@ -577,7 +692,7 @@ them.
             e:expr] ...)
           . rest)
          (template
-          (let (?? (?@ loop (?? (?@ : (template-expand-type tvars.vars
+          (let (?? (?@ loop (?? (?@ : (tmpl-expand-type tvars.vars
                                                         return-type)))))
             (?@ . tvars)
             ([(?@ . name.expanded) e] ...)
@@ -664,7 +779,7 @@ them.
 
 @chunk[<make-predicate>
        (define-syntax/parse (new-make-predicate type:expr)
-         (template (make-predicate (template-expand-type () type))))]
+         (template (make-predicate (tmpl-expand-type () type))))]
 
 @chunk[<test-make-predicate>
        (let ()
@@ -781,7 +896,7 @@ yet.
         do:
         with-handlers
         define-struct/exec:
-        define-struct/exec)]
+        #|define-struct/exec|#)]
 
 @section{Future work}
 
@@ -863,7 +978,8 @@ We can finally define the overloaded forms, as well as the extra
          (require (for-syntax racket
                               racket/syntax
                               syntax/parse
-                              syntax/parse/experimental/template)
+                              syntax/parse/experimental/template
+                              "../lib/low-untyped.rkt")
                   "../lib/low.rkt")
          
          (require (submod ".." expander))
@@ -880,6 +996,7 @@ We can finally define the overloaded forms, as well as the extra
                               [new-lambda lambda]
                               [new-lambda λ]
                               [new-struct struct]
+                              [new-define-struct/exec define-struct/exec]
                               [new-ann ann]
                               [new-inst inst]
                               [new-let let]
@@ -897,6 +1014,7 @@ We can finally define the overloaded forms, as well as the extra
          <define>
          <lambda>
          <struct>
+         <define-struct/exec>
          <ann>
          <inst>
          <let>
@@ -921,6 +1039,7 @@ And, last but not least, we will add a @tc[test] module.
          <test-define>
          <test-lambda>
          <test-struct>
+         <test-define-struct/exec>
          <test-ann>
          <test-inst>
          <test-let>