Cleaned up flexible structures implementation. The problem is that compiling the definitions is rather slow (~4 minutes for 10/128 fields), although those can be pre-compiled in advance, and using the functions is rather slow to typecheck (about 0.4s to use a 10/32 constructor), which is more of a problem.

binarytree.hl.rkt

@@ -0,0 +1,12 @@
+#lang type-expander
+
+(provide BinaryTree)
+
+(require (for-syntax syntax/parse
+                     phc-toolkit/aliases))
+
+(define-type-expander BinaryTree
+  (syntax-parser
+    [(_ leafⱼ …)
+     ;; TODO: implement BinaryTree.
+     #'(List leafⱼ …)]))

flexible-with-generalized-ctor-test.rkt

@@ -1,13 +1,28 @@
 #lang type-expander
-(require (lib "phc-graph/flexible-with-generalized-ctor.hl.rkt"))
+(require "flexible-with-generalized-ctor.hl.rkt"
-(provide f g)
+         "binarytree.hl.rkt")
+(provide f-4-2 f-8-3)
 
-(builder-f f 4 2)
+(builder-f f-4-2 4 2)
 
-#;((inst f propagate-τ '|1| Number '|3| String)
+(ann ((inst f-4-2 propagate-τ '|1| Number '|3| String)
-   oracle '|1| 100 '|3| "bee")
+      oracle '|1| 100 '|3| "bee")
+     (BinaryTree
+      (Promise (Pairof #f Any))
+      (Promise (Pairof '|1| Number))
+      (Promise (Pairof #f Any))
+      (Promise (Pairof '|3| String))))
 
-(builder-f g 8 3)
+(builder-f f-8-3 8 3)
 
-#;((inst g propagate-τ '|1| Number '|3| String '|7| Symbol)
+(ann ((inst f-8-3 propagate-τ '|1| Number '|3| String '|7| Symbol)
-   oracle '|1| 100 '|3| "bee" '|7| 'buzz)
+      oracle '|1| 100 '|3| "bee" '|7| 'buzz)
+     (BinaryTree
+      (Promise (Pairof #f Any))
+      (Promise (Pairof '|1| Number))
+      (Promise (Pairof #f Any))
+      (Promise (Pairof '|3| String))
+      (Promise (Pairof #f Any))
+      (Promise (Pairof #f Any))
+      (Promise (Pairof #f Any))
+      (Promise (Pairof '|7| Symbol))))

flexible-with-generalized-ctor.hl.rkt

@@ -9,7 +9,6 @@
 
 ꩜chunk[<*>
        (provide builder-τ
-                None
                 propagate-τ
                 oracle
                 builder-f)
@@ -20,15 +19,8 @@
                             racket/list
                             racket/function
                             subtemplate/override)
-                (for-meta 2 racket/base))
+                (for-meta 2 racket/base)
-
+                "binarytree.hl.rkt")
-       (struct (T) None ([f : (Promise T)]))
-
-       (define-type-expander BinaryTree
-         (syntax-parser
-           [(_ leafⱼ …)
-            ;; TODO: implement BinaryTree.
-            #'(List leafⱼ …)]))
 
        <propagate-τ>
        <oracle-τ>
@@ -70,7 +62,7 @@ form of) the builder function type as follows:
           (→ (code:comment "; Keys and values:")
              {?@ (∩ Kⱼ (U 'NSymⱼᵢ …)) Xⱼ} …
              ;; Result type:
-             (BinaryTree |<Some or None>| …)))]
+             (BinaryTree (Promise |<Some or None>|) …)))]
 
 We expect each key ꩜racket[Kⱼ] to be a symbol of the shape ꩜racket[|0|],
 ꩜racket[|1|], ꩜racket[|2|] and so on:
@@ -115,11 +107,12 @@ otherwise. The second element of the pair contains our expected
 ꩜racket[(Some Xⱼ)] type, but the whole pair is collapsed to ꩜racket[Nothing]
 when ꩜racket[Kⱼ] is not ꩜racket['NSymᵢ].
 
-We use a similar approach to conditionally produce the ꩜racket[None] element,
+We use a similar approach to conditionally produce the ꩜racket[None] element
-but instead of intersecting ꩜racket[Kⱼ] with ꩜racket['NSymᵢ], we intersect it
+(which we represent as ꩜racket[#f]), but instead of intersecting ꩜racket[Kⱼ]
-with the complement of ꩜racket['NSymᵢ]. Typed Racket lacks the possibility to
+with ꩜racket['NSymᵢ], we intersect it with the complement of ꩜racket['NSymᵢ].
-negate a type, so we manually compute the complement of ꩜racket['NSymᵢ] in the
+Typed Racket lacks the possibility to negate a type, so we manually compute
-set of possible keys (that is, ꩜racket['NSymᵢ …]).
+the complement of ꩜racket['NSymᵢ] in the set of possible keys (that is,
+꩜racket['NSymᵢ …]).
 
 ꩜chunk[<builder-τ-with-3>
        #:with NSyms (NSymᵢ …)
@@ -138,7 +131,7 @@ The resulting type should therefore be ꩜racket[Nothing] only if there is no
 ꩜racket[(List . exceptᵢ)] otherwise.
 
 ꩜chunk[|<None if ∀ k ∈ Kⱼ , k ≠ NSymᵢ>|
-       (None (List {∩ Kᵢⱼ {U 'exceptᵢⱼ …}} …))]
+       (Pairof #f (List {∩ Kᵢⱼ {U 'exceptᵢⱼ …}} …))]
 
 This approach relies on the fact that occurrences of ꩜racket[Nothing] within
 structs and pairs containing collapse the entire struct or pair type to
@@ -163,12 +156,12 @@ To force Typed Racket to propagate ꩜racket[Nothing] outwards as much as
 we need, we intersect the whole form with a polymorphic type ꩜racket[A]:
 
 ꩜hlite[|<builder-function-type'>|
-       {/(∀(+ _ / _ _)(→ _ _ ooo (bt + (∩ / _ + A) / _)))}
+       {/(∀(+ _ / _ _)(→ _ _ ooo (bt (p + (∩ / _ + A)) / ooo)))}
        (∀ (A {?@ Kⱼ Xⱼ} …)
           (→ (code:comment "; Keys and values:")
              {?@ (∩ Kⱼ (U 'NSymⱼᵢ …)) Xⱼ} …
              ;; Result type:
-             (BinaryTree (∩ |<Some or None>| A) …)))]
+             (BinaryTree (Promise (∩ |<Some or None>| A)) …)))]
 
 The type ꩜racket[propagate-τ] defined below is used to instantiate ꩜racket[A],
 and is carefully picked so that its intersection will in no way change the
@@ -180,8 +173,8 @@ instantiated.
 
 ꩜chunk[<propagate-τ>
        (define-type propagate-τ
-         (U (Pairof Any Any)
+         (U (Pairof Symbol Any)
-            (None (Listof Any))))]
+            (Pairof #f (Listof Symbol))))]
 
 ꩜;Use chunkref instead of ꩜racket[|<Some or None>|] ?
 
@@ -199,8 +192,8 @@ upgrade.
 ꩜chunk[<oracle-τ>
        (define-type (oracle-τ A)
          (∀ (B) (→ (∩ B
-                      (U (Pairof Any Any)
+                      (U (Pairof Symbol Any)
-                         (None (Listof Any))))
+                         (Pairof #f (Listof Symbol))))
                    (∩ A B))))]
 
 The oracle does nothing more than return its argument unchanged:
@@ -220,7 +213,7 @@ oracle:
              (code:comment "; Keys and values:")
              {?@ (∩ Kⱼ (U 'NSymⱼᵢ …)) Xⱼ} …
              ;; Result type:
-             (BinaryTree (∩ |<Some or None>| A) …)))]
+             (BinaryTree (Promise (∩ |<Some or None>| A)) …)))]
 
 
 
@@ -243,11 +236,12 @@ oracle:
 ꩜chunk[<builder-function-implementation>
        (: name |<builder-function-type''>| #;(builder-τ n m))
        (define (name oracle {?@ kⱼ xⱼ} …)
-         (list (cond
+         (list (delay
-                 [((make-predicate 'NSymᵢⱼ) kᵢⱼ)
+                 (cond
-                  ((inst oracle (Pairof (∩ Kᵢⱼ 'NSymᵢⱼ) Xᵢⱼ)) (cons kᵢⱼ xᵢⱼ))]
+                   [((make-predicate 'NSymᵢⱼ) kᵢⱼ)
-                 …
+                    ((inst oracle (Pairof (∩ Kᵢⱼ 'NSymᵢⱼ) Xᵢⱼ)) (cons kᵢⱼ xᵢⱼ))]
-                 [else
+                   …
-                  ((inst oracle (None (List (∩ Kᵢⱼ (U 'exceptᵢⱼ …)) …)))
+                   [else
-                   (None (delay (list kᵢⱼ …))))])
+                    ((inst oracle (Pairof #f (List (∩ Kᵢⱼ (U 'exceptᵢⱼ …)) …)))
+                     (cons #f (list kᵢⱼ …)))]))
                …))]