Fixed most bugs related to ~> type expander

graph-lib/graph/__DEBUG_graph6.rkt

@@ -11,68 +11,331 @@
          "fold-queues.lp2.rkt"; debug
          "rewrite-type.lp2.rkt"; debug
          "meta-struct.rkt"; debug
+         racket/splicing; debug
          (for-syntax syntax/parse)
          (for-syntax syntax/parse/experimental/template))
 
+#|
 (require "__DEBUG_graph6B.rkt")
 
 (frozen (~>))
+|#
+
+
 
 (define-graph/rich-return grr
-    ([City [streets : (~> m-streets)]]
+  ([City [streets : (~> m-streets)]]
-     [Street [sname : String]])
+   [Street [sname : String]])
-    [(m-cities [cnames : (Listof (Listof String))])
+  [(m-cities [cnames : (Listof (Listof String))])
-     : (Listof City)
+   : (Listof City)
-     (define (strings→city [s : (Listof String)])
+   (define (strings→city [s : (Listof String)])
-       (City (m-streets s)))
+     (City (m-streets s)))
-     (map strings→city cnames)]
+   (map strings→city cnames)]
-    [(m-streets [snames : (Listof String)])
+  [(m-streets [snames : (Listof String)])
-     : (Listof Street)
+   : (Listof Street)
-     (map Street snames)])
+   (map Street snames)])
+
+
+;(first-step '(("a" "b") ("c" "d")))
+
+
+
+
+
+
+
+#;(begin
+  (define-multi-id
+   first-step
+   #:type-expander
+   (λ (stx)
+     (syntax-parse
+      stx
+      ((_ (~datum City)) #'City45/with-promises-type)
+      ((_ (~datum Street)) #'Street46/with-promises-type)
+      ((_ (~datum m-cities3/node)) #'m-cities3/node47/with-promises-type)
+      ((_ (~datum m-streets4/node)) #'m-streets4/node48/with-promises-type)
+      ((_ #:incomplete (~datum City)) #'City25/incomplete-type)
+      ((_ #:incomplete (~datum Street)) #'Street26/incomplete-type)
+      ((_ #:incomplete (~datum m-cities3/node))
+       #'m-cities3/node27/incomplete-type)
+      ((_ #:incomplete (~datum m-streets4/node))
+       #'m-streets4/node28/incomplete-type)
+      ((_ #:make-incomplete (~datum City))
+       #'(→ streets41/incomplete-type City25/incomplete-type))
+      ((_ #:make-incomplete (~datum Street))
+       #'(→ sname42/incomplete-type Street26/incomplete-type))
+      ((_ #:make-incomplete (~datum m-cities3/node))
+       #'(→ returned43/incomplete-type m-cities3/node27/incomplete-type))
+      ((_ #:make-incomplete (~datum m-streets4/node))
+       #'(→ returned44/incomplete-type m-streets4/node28/incomplete-type))
+      ((_ #:incomplete (~datum City) fld)
+       (syntax-parse #'fld ((~datum streets) #'streets41/incomplete-type)))
+      ((_ #:incomplete (~datum Street) fld)
+       (syntax-parse #'fld ((~datum sname) #'sname42/incomplete-type)))
+      ((_ #:incomplete (~datum m-cities3/node) fld)
+       (syntax-parse #'fld ((~datum returned) #'returned43/incomplete-type)))
+      ((_ #:incomplete (~datum m-streets4/node) fld)
+       (syntax-parse #'fld ((~datum returned) #'returned44/incomplete-type)))
+      ((_ #:make-placeholder (~datum City))
+       #'(→ (~> m-streets) City21/placeholder-type))
+      ((_ #:make-placeholder (~datum Street))
+       #'(→ String Street22/placeholder-type))
+      ((_ #:make-placeholder (~datum m-cities3/node))
+       #'(→ (Listof (Listof String)) m-cities3/node23/placeholder-type))
+      ((_ #:make-placeholder (~datum m-streets4/node))
+       #'(→ (Listof String) m-streets4/node24/placeholder-type))
+      ((_ #:placeholder (~datum City)) #'City21/placeholder-type)
+      ((_ #:placeholder (~datum Street)) #'Street22/placeholder-type)
+      ((_ #:placeholder (~datum m-cities3/node))
+       #'m-cities3/node23/placeholder-type)
+      ((_ #:placeholder (~datum m-streets4/node))
+       #'m-streets4/node24/placeholder-type)))
+   #:call
+   (λ (stx)
+     (syntax-parse
+      stx
+      ((_ #:λroot (~datum City)) #'City5/constructor)
+      ((_ #:λroot (~datum Street)) #'Street6/constructor)
+      ((_ #:λroot (~datum m-cities3/node)) #'m-cities3/node7/constructor)
+      ((_ #:λroot (~datum m-streets4/node)) #'m-streets4/node8/constructor)
+      ((_ #:root (~datum City) . rest)
+       (syntax/loc stx (City5/constructor . rest)))
+      ((_ #:root (~datum Street) . rest)
+       (syntax/loc stx (Street6/constructor . rest)))
+      ((_ #:root (~datum m-cities3/node) . rest)
+       (syntax/loc stx (m-cities3/node7/constructor . rest)))
+      ((_ #:root (~datum m-streets4/node) . rest)
+       (syntax/loc stx (m-streets4/node8/constructor . rest)))
+      ((_ . rest) (syntax/loc stx (City5/constructor . rest)))))
+   #:id
+   (λ (stx) #'City5/constructor))
+  (begin
+    (: City9/make-placeholder City13/make-placeholder-type)
+    (define (City9/make-placeholder streets)
+      (City17/placeholder-struct (list streets))))
+  (begin
+    (: Street10/make-placeholder Street14/make-placeholder-type)
+    (define (Street10/make-placeholder sname)
+      (Street18/placeholder-struct (list sname))))
+  (begin
+    (:
+     m-cities3/node11/make-placeholder
+     m-cities3/node15/make-placeholder-type)
+    (define (m-cities3/node11/make-placeholder cnames)
+      (m-cities3/node19/placeholder-struct (list cnames))))
+  (begin
+    (:
+     m-streets4/node12/make-placeholder
+     m-streets4/node16/make-placeholder-type)
+    (define (m-streets4/node12/make-placeholder snames)
+      (m-streets4/node20/placeholder-struct (list snames))))
+  (begin
+    (: City29/make-incomplete City33/make-incomplete-type)
+    (define (City29/make-incomplete streets)
+      (list 'City37/incomplete-tag streets)))
+  (begin
+    (: Street30/make-incomplete Street34/make-incomplete-type)
+    (define (Street30/make-incomplete sname)
+      (list 'Street38/incomplete-tag sname)))
+  (begin
+    (: m-cities3/node31/make-incomplete m-cities3/node35/make-incomplete-type)
+    (define (m-cities3/node31/make-incomplete returned)
+      (list 'm-cities3/node39/incomplete-tag returned)))
+  (begin
+    (:
+     m-streets4/node32/make-incomplete
+     m-streets4/node36/make-incomplete-type)
+    (define (m-streets4/node32/make-incomplete returned)
+      (list 'm-streets4/node40/incomplete-tag returned)))
+  (begin (struct (A) City17/placeholder-struct ((f : A)) #:transparent))
+  (begin (struct (A) Street18/placeholder-struct ((f : A)) #:transparent))
+  (begin
+    (struct (A) m-cities3/node19/placeholder-struct ((f : A)) #:transparent))
+  (begin
+    (struct (A) m-streets4/node20/placeholder-struct ((f : A)) #:transparent))
+  (begin (struct City49/index-type ((i : Index)) #:transparent))
+  (begin (struct Street50/index-type ((i : Index)) #:transparent))
+  (begin (struct m-cities3/node51/index-type ((i : Index)) #:transparent))
+  (begin (struct m-streets4/node52/index-type ((i : Index)) #:transparent))
+  (splicing-let
+   ((City1/simple-mapping City9/make-placeholder)
+    (Street2/simple-mapping Street10/make-placeholder)
+    (m-cities m-cities3/node11/make-placeholder)
+    (m-streets m-streets4/node12/make-placeholder)
+    (City City29/make-incomplete)
+    (Street Street30/make-incomplete)
+    (m-cities3/node m-cities3/node31/make-incomplete)
+    (m-streets4/node m-streets4/node32/make-incomplete))
+   (begin
+     (define-type-expander
+      (~> stx)
+      (syntax-parse
+       stx
+       ((_ (~datum m-cities))
+        (template
+         (U
+          (first-step #:placeholder m-cities3/node)
+          (Listof (first-step #:placeholder City)))))
+       ((_ (~datum m-streets))
+        (template
+         (U
+          (first-step #:placeholder m-streets4/node)
+          (Listof (first-step #:placeholder Street)))))))
+     (define-type-expander
+      (first-step-expander2 stx)
+      (displayln (format "first-step-expander2: ~a" stx))
+      (syntax-parse
+       stx
+       ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City)))
+       ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street))))))
+   (define-graph-second-step
+    ((City5/constructor
+      Street6/constructor
+      m-cities3/node7/constructor
+      m-streets4/node8/constructor)
+     City5/constructor
+     (City9/make-placeholder
+      Street10/make-placeholder
+      m-cities3/node11/make-placeholder
+      m-streets4/node12/make-placeholder)
+     (City13/make-placeholder-type
+      Street14/make-placeholder-type
+      m-cities3/node15/make-placeholder-type
+      m-streets4/node16/make-placeholder-type)
+     (City17/placeholder-struct
+      Street18/placeholder-struct
+      m-cities3/node19/placeholder-struct
+      m-streets4/node20/placeholder-struct)
+     (City21/placeholder-type
+      Street22/placeholder-type
+      m-cities3/node23/placeholder-type
+      m-streets4/node24/placeholder-type)
+     (City25/incomplete-type
+      Street26/incomplete-type
+      m-cities3/node27/incomplete-type
+      m-streets4/node28/incomplete-type)
+     (City29/make-incomplete
+      Street30/make-incomplete
+      m-cities3/node31/make-incomplete
+      m-streets4/node32/make-incomplete)
+     (City33/make-incomplete-type
+      Street34/make-incomplete-type
+      m-cities3/node35/make-incomplete-type
+      m-streets4/node36/make-incomplete-type)
+     (City37/incomplete-tag
+      Street38/incomplete-tag
+      m-cities3/node39/incomplete-tag
+      m-streets4/node40/incomplete-tag)
+     ((streets41/incomplete-type)
+      (sname42/incomplete-type)
+      (returned43/incomplete-type)
+      (returned44/incomplete-type))
+     (City45/with-promises-type
+      Street46/with-promises-type
+      m-cities3/node47/with-promises-type
+      m-streets4/node48/with-promises-type)
+     City45/with-promises-type
+     (City49/index-type
+      Street50/index-type
+      m-cities3/node51/index-type
+      m-streets4/node52/index-type))
+    (first-step
+     #:debug
+     #:definitions
+     ((define-type-expander
+       (~> stx)
+       (syntax-parse
+        stx
+        ((_ (~datum m-cities))
+         (template
+          (U
+           (first-step #:placeholder m-cities3/node)
+           (Listof (first-step #:placeholder City)))))
+        ((_ (~datum m-streets))
+         (template
+          (U
+           (first-step #:placeholder m-streets4/node)
+           (Listof (first-step #:placeholder Street)))))))
+      (define-type-expander
+       (first-step-expander2 stx)
+       (displayln (format "first-step-expander2: ~a" stx))
+       (syntax-parse
+        stx
+        ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City)))
+        ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street))))))
+     (City
+      (streets
+       :
+       (Let (~> first-step-expander2) (U (Pairof '~> (U)) (~> m-streets))))
+      ((City1/simple-mapping (streets : (~> m-streets))) (City streets)))
+     (Street
+      (sname : (Let (~> first-step-expander2) (U (Pairof '~> (U)) String)))
+      ((Street2/simple-mapping (sname : String)) (Street sname)))
+     (m-cities3/node
+      (returned : (Listof City))
+      ((m-cities (cnames : (Listof (Listof String))))
+       (m-cities3/node
+        (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
+          (define (strings→city (s : (Listof String))) (City (m-streets s)))
+          (map strings→city cnames)))))
+     (m-streets4/node
+      (returned : (Listof Street))
+      ((m-streets (snames : (Listof String)))
+       (m-streets4/node
+        (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
+          (map Street snames)))))))))
+
+
+
+
+
+
+
 
 #;(define-syntax (blah stx)
-  #'(begin
+    #'(begin
-      (define-graph
+        (define-graph
-        first-step
+          first-step
-        #:definitions
+          #:definitions
-        ((define-type-expander
+          ((define-type-expander
-           (~> stx)
+             (~> stx)
-           (syntax-parse
+             (syntax-parse
-               stx
+                 stx
-             ((_ (~datum m-cities))
+               ((_ (~datum m-cities))
-              (template
+                (template
-               (U
+                 (U
-                (first-step #:placeholder m-cities3/node)
+                  (first-step #:placeholder m-cities3/node)
-                (Listof (first-step #:placeholder City)))))
+                  (Listof (first-step #:placeholder City)))))
-             ((_ (~datum m-streets))
+               ((_ (~datum m-streets))
-              (template
+                (template
-               (U
+                 (U
-                (first-step #:placeholder m-streets4/node)
+                  (first-step #:placeholder m-streets4/node)
-                (Listof (first-step #:placeholder Street)))))))
+                  (Listof (first-step #:placeholder Street)))))))
-         (define-type-expander
+           (define-type-expander
-           (first-step-expander2 stx)
+             (first-step-expander2 stx)
-           (syntax-parse
+             (syntax-parse
-               stx
+                 stx
-             ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City)))
+               ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City)))
-             ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street))))))
+               ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street))))))
-        (City
+          (City
-         (streets : (Let (~> first-step-expander2) (~> m-streets)))
+           (streets : (Let (~> first-step-expander2) (~> m-streets)))
-         ((City1/simple-mapping (streets : (~> m-streets))) (City streets)))
+           ((City1/simple-mapping (streets : (~> m-streets))) (City streets)))
-        (Street
+          (Street
-         (sname : (Let (~> first-step-expander2) String))
+           (sname : (Let (~> first-step-expander2) String))
-         ((Street2/simple-mapping (sname : String)) (Street sname)))
+           ((Street2/simple-mapping (sname : String)) (Street sname)))
-        (m-cities3/node
-         (returned : (Listof City))
-         ((m-cities (cnames : (Listof (Listof String))))
           (m-cities3/node
-           (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
+           (returned : (Listof City))
-             (define (strings→city (s : (Listof String))) (City (m-streets s)))
+           ((m-cities (cnames : (Listof (Listof String))))
-             (map strings→city cnames)))))
+            (m-cities3/node
-        (m-streets4/node
+             (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
-         (returned : (Listof Street))
+               (define (strings→city (s : (Listof String))) (City (m-streets s)))
-         ((m-streets (snames : (Listof String)))
+               (map strings→city cnames)))))
           (m-streets4/node
-           (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
+           (returned : (Listof Street))
-             (map Street snames))))))))
+           ((m-streets (snames : (Listof String)))
+            (m-streets4/node
+             (let ((City City1/simple-mapping) (Street Street2/simple-mapping))
+               (map Street snames))))))))
 
-;(blah)
+;(blah)

graph-lib/graph/__DEBUG_graph6B.rkt

@@ -5,21 +5,36 @@
          "graph.lp2.rkt"
          "get.lp2.rkt"
          "../type-expander/type-expander.lp2.rkt"
+         (for-syntax (submod "../type-expander/type-expander.lp2.rkt" expander))
          "../type-expander/multi-id.lp2.rkt"
          "structure.lp2.rkt" ; debug
          "variant.lp2.rkt" ; debug
          "fold-queues.lp2.rkt"; debug
          "rewrite-type.lp2.rkt"; debug
          "meta-struct.rkt"; debug
+         racket/splicing
          (for-syntax syntax/parse)
          (for-syntax syntax/parse/experimental/template))
 
+(define-syntax (d-exp stx)
+  (syntax-case stx ()
+    [(_ T)
+     (displayln (expand-type #'T))
+     #'(begin (: x T)
+              (define x 1))]))
+
 (define-syntax (frozen stx)
   (syntax-parse stx
-    [(_ a)
+    [(_ def a)
      #'(begin
-         (define-type-expander (te stx) #'Number)
+         (splicing-let ()
-         (: x (Let [~> te] a))
+           def
-         (define x 1))]))
+           (d-exp a)))]))
 
-(provide frozen)
+(define-syntax (goo stx)
+  (syntax-case stx ()
+    [(_ T)
+     #`(frozen (define-type-expander (#,(datum->syntax #'T #'te) stx) #'Number)
+               T)]))
+
+(goo te)

graph-lib/graph/__DEBUG_graph6C.rkt

@@ -0,0 +1,42 @@
+#lang typed/racket
+
+(require "graph-6-rich-returns.lp2.rkt"
+         "../lib/low.rkt"
+         "graph.lp2.rkt"
+         "get.lp2.rkt"
+         "../type-expander/type-expander.lp2.rkt"
+         (for-syntax (submod "../type-expander/type-expander.lp2.rkt" expander))
+         "../type-expander/multi-id.lp2.rkt"
+         "structure.lp2.rkt" ; debug
+         "variant.lp2.rkt" ; debug
+         "fold-queues.lp2.rkt"; debug
+         "rewrite-type.lp2.rkt"; debug
+         "meta-struct.rkt"; debug
+         racket/splicing
+         (for-syntax syntax/parse)
+         (for-syntax syntax/parse/experimental/template))
+
+(define-syntax (d-exp stx)
+  (syntax-case stx ()
+    [(_ a) #'(begin (define x a) x)]))
+
+(define-syntax (frozen stx)
+  (syntax-parse stx
+    [(_ def val a)
+     #`(begin (let ((#,(datum->syntax #'a (syntax->datum #'def)) val))
+                (d-exp a)))]))
+
+(define-syntax (goo stx)
+  (syntax-case stx ()
+    [(_ a)
+     #`(frozen #,(datum->syntax #'a #'te) 9
+               a)]))
+
+(goo te)
+
+(define-syntax (lake stx)
+  (syntax-parse stx
+    [(_ val a)
+     #`(let ((#,(datum->syntax stx 'te) val)) a)]))
+
+(lake 3 te)

graph-lib/graph/__DEBUG_graph6D.rkt

@@ -0,0 +1,42 @@
+#lang typed/racket
+
+(require "graph-6-rich-returns.lp2.rkt"
+         "../lib/low.rkt"
+         "graph.lp2.rkt"
+         "get.lp2.rkt"
+         "../type-expander/type-expander.lp2.rkt"
+         (for-syntax (submod "../type-expander/type-expander.lp2.rkt" expander))
+         "../type-expander/multi-id.lp2.rkt"
+         "structure.lp2.rkt" ; debug
+         "variant.lp2.rkt" ; debug
+         "fold-queues.lp2.rkt"; debug
+         "rewrite-type.lp2.rkt"; debug
+         "meta-struct.rkt"; debug
+         racket/splicing
+         (for-syntax syntax/parse)
+         (for-syntax syntax/parse/experimental/template))
+
+(define-syntax (d-exp stx)
+  (syntax-case stx ()
+    [(_ a) #'(begin (define x a) x)]))
+
+(define-syntax (frozen stx)
+  (syntax-parse stx
+    [(_ def val a)
+     #`(begin (define def val) ;#,(datum->syntax #'a (syntax->datum #'(define def val)))
+              (d-exp a))]))
+
+(define-syntax (goo stx)
+  (syntax-case stx ()
+    [(_ a)
+     #`(frozen #,(datum->syntax #'a 'te) 9
+               a)]))
+
+(goo te)
+
+(define-syntax (lake stx)
+  (syntax-parse stx
+    [(_ val a)
+     #`(let ((#,(datum->syntax stx 'tea) val)) a)]))
+
+(lake 3 tea)

graph-lib/graph/graph-6-rich-returns.lp2.rkt

@@ -104,13 +104,13 @@ plain list.
          (define-temp-ids "first-step-expander2" name)
          (define-temp-ids "~a/simple-mapping" (node …))
          (define-temp-ids "~a/node" (mapping …))
-         (define/with-syntax ~>-id (datum->syntax stx #'~> stx))
+         (define/with-syntax ~>-id (datum->syntax #'name '~>))
          (template
-          (debug
+          ;(debug
            (begin
              (define-graph first-step
                #:definitions [<first-pass-type-expander>]
-               [node [field c (Let [~> first-step-expander2] (U (Pairof '~>-id (U)) field-type))] …
+               [node [field c (Let [~>-id first-step-expander2] field-type)] …
                 [(node/simple-mapping [field c field-type] …)
                  ;<first-pass-field-type>] …)
                  (node field …)]] …
@@ -119,14 +119,16 @@ plain list.
                  (mapping/node
                   (let ([node node/simple-mapping] …)
                     . body))]]
-               …)))))]
+               …))))]
 
 As explained above, during the first pass, the field types
 of nodes will allow placeholders for the temporary nodes
 encapsulating the result types of mappings.
 
 @chunk[<first-pass-type-expander>
-       (define-type-expander (~> stx)
+       ;; TODO: to avoid conflicting definitions of ~>, we should either use
+       ;; syntax-parameterize, or make a #:local-definitions
+       (define-type-expander (~>-id stx)
          (syntax-parse stx
            [(_ (~datum mapping)) ;; TODO: should be ~literal
             (template
@@ -165,7 +167,7 @@ encapsulating the result types of mappings.
                               "../lib/low/multiassoc-syntax.rkt"
                               "rewrite-type.lp2.rkt"; debug
                               )
-                  "../lib/low.rkt"
+                  (rename-in "../lib/low.rkt" [~> threading:~>])
                   "graph.lp2.rkt"
                   "get.lp2.rkt"
                   "../type-expander/type-expander.lp2.rkt"
@@ -175,8 +177,11 @@ encapsulating the result types of mappings.
                   "fold-queues.lp2.rkt"; debug
                   "rewrite-type.lp2.rkt"; debug
                   "meta-struct.rkt"; debug
-                  )
+                  racket/stxparam
-         (provide define-graph/rich-return)
+                  racket/splicing)
+         (provide define-graph/rich-return); ~>)
+
+         ;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>))
          
          (require (for-syntax racket/pretty))
          (define-syntax (debug stx)
@@ -246,7 +251,7 @@ encapsulating the result types of mappings.
 
 
 
-(begin
+#;(begin
    (define-graph
     first-step
     #:definitions

graph-lib/graph/graph.lp2.rkt

@@ -213,9 +213,9 @@ We derive identifiers for these based on the @tc[node] name:
        (define-temp-ids "~a/make-incomplete-type" (node …))
        (define-temp-ids "~a/incomplete-tag" (node …))
        (define-temp-ids "~a/incomplete-type" ((field …) …))
-
+       
        (define-temp-ids "~a/with-promises-type" (node …) #:first-base root)
-
+       
        (define-temp-ids "~a/index-type" (node …))]
 
 @chunk[<pass-to-second-step>
@@ -226,7 +226,7 @@ We derive identifiers for these based on the @tc[node] name:
        (node/make-placeholder-type …)
        (node/placeholder-struct …)
        (node/placeholder-type …)
-
+       
        (node/incomplete-type …)
        (node/make-incomplete …)
        (node/make-incomplete-type …)
@@ -354,9 +354,11 @@ The first step macro is defined as follows:
        (define-syntax/parse <signature>
          <define-ids/first-step>
          (debug-template debug
-          (begin ; Can't use (let () …) because of TR bug #192
+           ;; Can't use (let () …) because of TR bug #262
-            <first-step-definitions>
+           ;; https://github.com/racket/typed-racket/issues/262
-            <first-step-bindings>)))]
+           (begin
+             <first-step-definitions>
+             <first-step-bindings>)))]
 
 @subsubsection{Second step}
 
@@ -376,7 +378,7 @@ It will be called from the first step with the following syntax:
 @chunk[<second-step>
        (define-syntax/parse <signature-second-step>
          <define-ids/second-step>
-         (template ;debug-template debug
+         (debug-template debug
           (begin
             (begin <define-mapping-function>) …
             
@@ -737,7 +739,7 @@ via @tc[(g Street)].
             (syntax-parse #'fld
               [(~datum field) #'field/incomplete-type] …)] …
            [(_ #:make-placeholder (~datum node))
-            #'(→ param-type … node/placeholder-type)] …
+            #'node/make-placeholder-type] …
            [(_ #:placeholder (~datum node)) #'node/placeholder-type] …))]
 
 We will be able to use this type expander in function types, for example:

graph-lib/graph/rewrite-type.lp2.rkt

@@ -87,7 +87,11 @@ calls itself on the components of the type.
        (define-for-syntax (replace-in-type t r)
          (define (recursive-replace new-t) (replace-in-type new-t r))
          (define/with-syntax ([from to] ...) r)
+         #;(displayln (format "~a\n=> ~a"
+                            (syntax->datum t)
+                            (syntax->datum (expand-type t))))
          (syntax-parse (expand-type t)
+           #:context #'(replace-in-type t r)
            <replace-in-type-substitute>
            <replace-in-type-other-cases>))]
 
@@ -169,6 +173,7 @@ The other cases are similarly defined:
          (define/with-syntax val stx-val)
          (define/with-syntax (v-cache) (generate-temporaries #'(val-cache)))
          (syntax-parse type
+           #:context 'recursive-replace-2
            [x:id
             #:attr assoc-from-to (cdr-stx-assoc #'x #'((from . (to . fun)) ...))
             #:when (attribute assoc-from-to)
@@ -222,6 +227,7 @@ TODO: we currently don't check that each @tc[tag] is distinct.
        (define (replace-in-union stx-v-cache t r)
          (define/with-syntax v-cache stx-v-cache)
          (syntax-parse t
+           #:context 'replace-in-union-3
            [((~literal List) ((~literal quote) tag:id) b ...)
             <replace-in-tagged-union-instance>]
            [_ (raise-syntax-error
@@ -399,6 +405,7 @@ functions is undefined.
        (define (recursive-replace type)
          (define/with-syntax (v-cache) (generate-temporaries #'(val-cache)))
          (syntax-parse type
+           #:context 'recursive-replace-4
            [x:id
             #:attr assoc-from-to-fun (stx-assoc #'x #'((from to fun) ...))
             #:when (attribute assoc-from-to-fun)
@@ -511,6 +518,7 @@ functions is undefined.
 
 @CHUNK[<replace-fold-union>
        (syntax-parse ta
+         #:context 'replace-fold-union-5
          [((~literal List) ((~literal quote) tag:id) b ...)
           <replace-fold-union-tagged-list>]
          [((~literal Pairof) ((~literal quote) tag:id) b)
@@ -583,6 +591,7 @@ one for @tc[replace-in-type]:
 @CHUNK[<template-metafunctions>
        (define-template-metafunction (tmpl-replace-in-type stx)
          (syntax-parse stx
+           #:context 'tmple-replace-in-type-6
            [(_ (~optional (~and debug? #:debug)) type:expr [from to] …)
             (when (attribute debug?)
               (displayln (format "~a" stx)))
@@ -597,6 +606,7 @@ And one each for @tc[fold-instance] and @tc[replace-in-instance2]:
 @CHUNK[<template-metafunctions>
        (define-template-metafunction (tmpl-fold-instance stx)
          (syntax-parse stx
+           #:context 'tmpl-fold-instance-7
            [(_ type:expr acc-type:expr [from to pred? fun] …)
             #`(begin
                 "fold-instance expanded code below. Initially called with:"
@@ -607,6 +617,7 @@ And one each for @tc[fold-instance] and @tc[replace-in-instance2]:
        
        (define-template-metafunction (tmpl-replace-in-instance stx)
          (syntax-parse stx
+           #:context 'tmpl-replace-in-instance-8
            [(_ type:expr [from to fun] …)
             #`#,(replace-in-instance2 #'type #'([from to fun] …))]))]
 

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

@@ -132,7 +132,11 @@ else.
                            (type-expander-nested-application env))
                      . args) ;; TODO: test
                     #:with expanded-once
-                    #'(nested-application.expanded-once . args)))
+                    #'(nested-application.expanded-once . args))
+           (pattern (~datum ~>)
+                    #:with expanded-once #'()
+                    #:when (displayln (format "dict = ~a" (dict->list env)))
+                    #:when #f))
          
          (define-syntax-class fa (pattern (~or (~literal ∀) (~literal All))))
          (syntax-parse stx