Fixed bug due to improper implementation of #:?, FB case #107.

graph-lib/graph/__.rkt.tmp

@@ -0,0 +1,31 @@
+#lang racket
+
+[<graph-example>
+       (define-graph g1
+         ;; Node types (same):
+         [(a [field₁ : (List Foo Bar n-mb/placeholder Baz Quux)]
+             [field₂ : (Pairof …c/placeholder …a/placeholder)])]
+         [(b [field₃] …)]
+         [(c [field₇] …)]
+
+         [(n-ma [val : a])]
+         ;[(n-ma1 [val : a])]
+         ;[(n-ma2 [val : a])]
+         [(n-mb [val : (Listof b)])]
+         [(n-mc [val : c])]
+         ;; Mappings: functions from external data to nodes
+         [m-n-ma1 (→ (Listof String) n-ma1)
+          (n-ma1/incomplete
+           (ma (… (m-n-mb some-data) …)
+               (cons (m-n-mc more-data)
+                     (m-n-ma2 other-data))))]
+         ;[m-n-ma2 (→ String Integer n-ma2) …]
+         [m-n-mb (→ Integer n-mb) …]
+         [m-n-mc (→ … n-mc) …]
+         [ma (→ arg1: (List Foo Bar n-mb/placeholder Baz Quux)
+                arg2: (Pairof n-mc/placeholder
+                              n-ma2/placeholder)
+                a)
+          (a/incomplete arg1 arg2)]
+         [mb (→ ? b) …]
+         [mc (→ ? c) …])]

graph-lib/graph/__DEBUG_graph6.rkt

@@ -86,3 +86,165 @@
 (dg grr)
 (dg grra)
 |#
+
+
+
+
+
+
+
+
+
+
+;; DEBUG:
+#;(require (for-syntax racket/format
+                       "rewrite-type.lp2.rkt"
+                       racket/syntax
+                       syntax/parse
+                       (submod "../lib/low.rkt" untyped))
+           (for-syntax syntax/parse
+                       syntax/parse/experimental/template
+                       racket/syntax
+                       (submod "../lib/low.rkt" untyped)
+                       "rewrite-type.lp2.rkt" #|debug|#
+                       syntax/id-set
+                       racket/format
+                       mischief/transform)
+           (rename-in "../lib/low.rkt" [~> threading:~>])
+           "graph.lp2.rkt"
+           "get.lp2.rkt"
+           "../type-expander/type-expander.lp2.rkt"
+           "../type-expander/multi-id.lp2.rkt"
+           "adt.lp2.rkt" ; debug
+           "fold-queues.lp2.rkt"; debug
+           "rewrite-type.lp2.rkt"; debug
+           "meta-struct.rkt"; debug
+           racket/stxparam
+           racket/splicing)
+#;(begin
+    (define-graph
+      grr31/first-step
+      #:definitions
+      ((define-type-expander
+         (~> stx)
+         (syntax-parse
+             stx
+           ((_ (~datum m-cities)) (template (U (grr31/first-step #:placeholder m-cities4/node) (Listof (grr31/first-step #:placeholder City)))))
+           ((_ (~datum m-streets)) (template (U (grr31/first-step #:placeholder m-streets5/node) (Listof (grr31/first-step #:placeholder Street)))))))
+       (define-type-expander (first-step-expander2 stx) (syntax-parse stx ((_ (~datum m-cities)) #'(U m-cities4/node (Listof City))) ((_ (~datum m-streets)) #'(U m-streets5/node (Listof Street))))))
+      (City (streets : (Let (~> first-step-expander2) (~> m-streets))) ((City2/simple-mapping (streets : (~> m-streets))) (City streets)))
+      (Street (sname : (Let (~> first-step-expander2) String)) ((Street3/simple-mapping (sname : String)) (Street sname)))
+      (m-cities4/node
+       (returned : (Listof City))
+       ((m-cities (cnames : (Listof (Listof bubble))))
+        (m-cities4/node (let ((City City2/simple-mapping) (Street Street3/simple-mapping)) (define (strings→city (s : (Listof blob))) (City (m-streets s))) (map strings→city cnames)))))
+      (m-streets5/node (returned : (Listof Street)) ((m-streets (snames : (Listof String))) (m-streets5/node (let ((City City2/simple-mapping) (Street Street3/simple-mapping)) (map Street snames))))))
+    
+    (define-graph
+      grr3
+      #:definitions
+      ((define-type-expander (~>-to-result-type stx) (syntax-parse stx ((_ (~datum m-cities)) #'(Listof City)) ((_ (~datum m-streets)) #'(Listof Street))))
+       (define-type m-cities10/node-marker (U (grr31/first-step m-cities4/node) (Listof (grr31/first-step City))))
+       (define-type m-streets11/node-marker (U (grr31/first-step m-streets5/node) (Listof (grr31/first-step Street))))
+       (define-type-expander (second-step-marker-expander stx) (syntax-parse stx ((_ (~datum m-cities)) #'m-cities10/node-marker) ((_ (~datum m-streets)) #'m-streets11/node-marker)))
+       (define-type second-step-m-cities16/node-of-first (grr31/first-step m-cities4/node))
+       (define-type second-step-m-streets17/node-of-first (grr31/first-step m-streets5/node))
+       (define-type-expander
+         (second-step-marker2-expander stx)
+         (syntax-parse
+             stx
+           ((_ (~datum m-cities)) #'(U second-step-m-cities16/node-of-first (Listof (grr31/first-step City))))
+           ((_ (~datum m-streets)) #'(U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street))))))
+       #;(define-type-expander
+           (inline-type stx)
+           (dbg
+            ("inline-type" stx)
+            (syntax-parse
+                stx
+              ((_ i-t (~and seen (:id …)))
+               (let ((seen-list (syntax->list #'seen)))
+                 (when (and (not (null? seen-list)) (member (car seen-list) (cdr seen-list) free-identifier=?))
+                   (raise-syntax-error
+                    'define-graph/rich-returns
+                    (~a "Cycles in types are not allowed." " The following types were already inlined: " (syntax->datum #'seen) ", but " #'t " appeared a second time.")
+                    #'t)))
+               (replace-in-type
+                #'(Let (~> second-step-marker-expander) i-t)
+                #'((m-cities10/node-marker (inline-type (Listof City) (m-cities4/node . seen)))
+                   (m-streets11/node-marker (inline-type (Listof Street) (m-streets5/node . seen)))
+                   (City (grr3 #:placeholder City))
+                   (Street (grr3 #:placeholder Street))))))))
+       (define-syntax (inline-instance stx)
+         (dbg
+          ("inline-instance" stx)
+          (syntax-parse
+              stx
+            ((_ i-t (~and seen (:id …)))
+             (define/with-syntax typp #'(Let (~> second-step-marker2-expander) i-t))
+             (define/with-syntax
+               repl
+               (replace-in-instance
+                #'typp
+                #'((second-step-m-cities16/node-of-first Symbol (grr31/first-step #:? m-cities4/node) (λ _ (error "NIY4")))
+                   (second-step-m-streets17/node-of-first Symbol (grr31/first-step #:? m-streets5/node) (λ _ (error "NIY4")))
+                   (City (grr3 #:placeholder City) (grr31/first-step #:? City) (λ _ (error "NIY3")))
+                   (Street (grr3 #:placeholder Street) (grr31/first-step #:? Street) (λ _ (error "NIY3"))))))
+             (displayln (list "i-t=" #'typp))
+             (let ((seen-list (syntax->list #'seen)))
+               (when (and (not (null? seen-list)) (member (car seen-list) (cdr seen-list) free-identifier=?))
+                 (raise-syntax-error
+                  'define-graph/rich-returns
+                  (~a "Cycles in types are not allowed." " The following types were already inlined: " (syntax->datum #'seen) ", but " #'t " appeared a second time.")
+                  #'t)))
+             #'(λ ((x : (Let (~> second-step-marker2-expander) i-t))) repl (error "NIY2")))))))
+      (City (streets : (Let (~> ~>-to-result-type) (~> m-streets)))
+            ((City6/extract/mapping (from : (grr31/first-step City)))
+             (City
+              
+              (;;(inline-instance (~> m-streets) ())
+               (λ ((x : (Let (~> second-step-marker2-expander) (~> m-streets))))
+                 (λ ((val : (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))))
+                   (first-value
+                    ((λ ((val : (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))) (acc : Void))
+                       :
+                       (values (U Symbol (Listof (grr31/first-step Street))) Void)
+                       ;(ann val (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street))))
+                       (ann val (U (grr31/first-step m-streets5/node) (Listof (grr31/first-step Street))))
+                       (cond
+                         (((grr31/first-step #:? m-streets5/node) val)
+                          #;(if (equal? (ann 0 Number) 0)
+                                (ann val Nothing);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;PROBLEM
+                                #f)
+                          ((ann (λ ((x : second-step-m-streets17/node-of-first) (acc : Void)) (values ((λ _ (error "NIY4")) x) acc)) (→ second-step-m-streets17/node-of-first Void (values Symbol Void))) val acc))
+                         (#t
+                          ((λ ((val : (Listof (grr31/first-step Street))) (acc : Void))
+                             :
+                             (values (Listof (grr31/first-step Street)) Void)
+                             (let ((f
+                                    ((inst foldl (grr31/first-step Street) (Pairof (Listof (grr31/first-step Street)) Void) Nothing Nothing)
+                                     (λ ((x : (grr31/first-step Street)) (acc1 : (Pairof (Listof (grr31/first-step Street)) Void)))
+                                       (let-values (((res res-acc) ((inst values (grr31/first-step Street) Void) x (cdr acc1)))) (cons (cons res (car acc1)) res-acc)))
+                                     (cons '() acc)
+                                     val)))
+                               (values (reverse (car f)) (cdr f))))
+                           val
+                           acc))
+                         (else
+                          (typecheck-fail
+                           (Let (~> second-step-marker2-expander) (~> m-streets))
+                           "Unhandled union case in (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street))), whole type was:(Let (~> second-step-marker2-expander) (~> m-streets))"
+                           ))))
+                     val
+                     (void))))
+                 (error "NIY2"))
+               (get from streets))
+              
+              
+              
+              
+              #;((inline-instance (~> m-streets) ())
+                 (get from streets)))))
+      (Street (sname : (Let (~> ~>-to-result-type) String))
+              ((Street7/extract/mapping (from : (grr31/first-step Street)))
+               (Street ((inline-instance String ())
+                        (get from sname)))))))

graph-lib/graph/__DEBUG_graph6_B.rkt

@@ -0,0 +1,150 @@
+#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"
+         "../type-expander/multi-id.lp2.rkt"
+         "adt.lp2.rkt" ; debug
+         "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 (~>))
+|#
+
+
+(require "../lib/debug-syntax.rkt")
+
+(define-type blob String)
+(define-type-expander (bubble stx) #'String)
+
+(require (for-syntax syntax/strip-context))
+
+(define-syntax (super-define-graph/rich-return stx)
+  (syntax-case stx ()
+    [(_ name . rest)
+     (with-syntax ([(b (d (dgi n) . r) (dgi2 n2))
+                    (replace-context
+                     stx
+                     #'(begin
+                         (define-syntax-rule (dg1 name)
+                           (define-graph/rich-return name ~> . rest))
+                         (dg1 name)))])
+       #'(b (d (dgX n) . r) (dgX n2)))]))
+
+(require (for-syntax racket/format
+                     "rewrite-type.lp2.rkt"
+                     racket/syntax
+                     syntax/parse
+                     (submod "../lib/low.rkt" untyped))
+         (for-syntax syntax/parse
+                     syntax/parse/experimental/template
+                     racket/syntax
+                     (submod "../lib/low.rkt" untyped)
+                     "rewrite-type.lp2.rkt" #|debug|#
+                     syntax/id-set
+                     racket/format
+                     mischief/transform)
+         (rename-in "../lib/low.rkt" [~> threading:~>])
+         "graph.lp2.rkt"
+         "get.lp2.rkt"
+         "../type-expander/type-expander.lp2.rkt"
+         "../type-expander/multi-id.lp2.rkt"
+         "adt.lp2.rkt" ; debug
+         "fold-queues.lp2.rkt"; debug
+         "rewrite-type.lp2.rkt"; debug
+         "meta-struct.rkt"; debug
+         racket/stxparam
+         racket/splicing)
+(begin
+  (define-graph
+    grr31/first-step
+    #:definitions
+    ((define-type-expander
+       (~> stx)
+       (syntax-parse
+           stx
+         ((_ (~datum m-cities)) (template (U (grr31/first-step #:placeholder m-cities4/node) (Listof (grr31/first-step #:placeholder City)))))
+         ((_ (~datum m-streets)) (template (U (grr31/first-step #:placeholder m-streets5/node) (Listof (grr31/first-step #:placeholder Street)))))))
+     (define-type-expander (first-step-expander2 stx) (syntax-parse stx ((_ (~datum m-cities)) #'(U m-cities4/node (Listof City))) ((_ (~datum m-streets)) #'(U m-streets5/node (Listof Street))))))
+    (City (streets : (Let (~> first-step-expander2) (~> m-streets))) ((City2/simple-mapping (streets : (~> m-streets))) (City streets)))
+    (Street (sname : (Let (~> first-step-expander2) String)) ((Street3/simple-mapping (sname : String)) (Street sname)))
+    (m-cities4/node
+     (returned : (Listof City))
+     ((m-cities (cnames : (Listof (Listof bubble))))
+      (m-cities4/node (let ((City City2/simple-mapping) (Street Street3/simple-mapping)) (define (strings→city (s : (Listof blob))) (City (m-streets s))) (map strings→city cnames)))))
+    (m-streets5/node (returned : (Listof Street)) ((m-streets (snames : (Listof String))) (m-streets5/node (let ((City City2/simple-mapping) (Street Street3/simple-mapping)) (map Street snames))))))
+  
+  (define-graph
+    grr3
+    #:definitions
+    ((define-type-expander (~>-to-result-type stx) (syntax-parse stx ((_ (~datum m-cities)) #'(Listof City)) ((_ (~datum m-streets)) #'(Listof Street))))
+     (define-type m-cities10/node-marker (U (grr31/first-step m-cities4/node) (Listof (grr31/first-step City))))
+     (define-type m-streets11/node-marker (U (grr31/first-step m-streets5/node) (Listof (grr31/first-step Street))))
+     (define-type-expander (second-step-marker-expander stx) (syntax-parse stx ((_ (~datum m-cities)) #'m-cities10/node-marker) ((_ (~datum m-streets)) #'m-streets11/node-marker)))
+     (define-type second-step-m-cities16/node-of-first (grr31/first-step m-cities4/node))
+     (define-type second-step-m-streets17/node-of-first (grr31/first-step m-streets5/node))
+     (define-type-expander
+       (second-step-marker2-expander stx)
+       (syntax-parse
+           stx
+         ((_ (~datum m-cities)) #'(U second-step-m-cities16/node-of-first (Listof (grr31/first-step City))))
+         ((_ (~datum m-streets)) #'(U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street))))))
+     #;(define-type-expander
+         (inline-type stx)
+         (dbg
+          ("inline-type" stx)
+          (syntax-parse
+              stx
+            ((_ i-t (~and seen (:id …)))
+             (let ((seen-list (syntax->list #'seen)))
+               (when (and (not (null? seen-list)) (member (car seen-list) (cdr seen-list) free-identifier=?))
+                 (raise-syntax-error
+                  'define-graph/rich-returns
+                  (~a "Cycles in types are not allowed." " The following types were already inlined: " (syntax->datum #'seen) ", but " #'t " appeared a second time.")
+                  #'t)))
+             (replace-in-type
+              #'(Let (~> second-step-marker-expander) i-t)
+              #'((m-cities10/node-marker (inline-type (Listof City) (m-cities4/node . seen)))
+                 (m-streets11/node-marker (inline-type (Listof Street) (m-streets5/node . seen)))
+                 (City (grr3 #:placeholder City))
+                 (Street (grr3 #:placeholder Street))))))))
+     (define-syntax (inline-instance stx)
+       (dbg
+        ("inline-instance" stx)
+        (syntax-parse
+            stx
+          ((_ i-t (~and seen (:id …)))
+           (define/with-syntax typp #'(Let (~> second-step-marker2-expander) i-t))
+           (define/with-syntax
+             repl
+             (replace-in-instance
+              #'typp
+              #'((second-step-m-cities16/node-of-first Symbol (grr31/first-step #:? m-cities4/node) (λ _ (error "NIY4")))
+                 (second-step-m-streets17/node-of-first Symbol (grr31/first-step #:? m-streets5/node) (λ _ (error "NIY4")))
+                 (City (grr3 #:placeholder City) (grr31/first-step #:? City) (λ _ (error "NIY3")))
+                 (Street (grr3 #:placeholder Street) (grr31/first-step #:? Street) (λ _ (error "NIY3"))))))
+           (displayln (list "i-t=" #'typp))
+           (let ((seen-list (syntax->list #'seen)))
+             (when (and (not (null? seen-list)) (member (car seen-list) (cdr seen-list) free-identifier=?))
+               (raise-syntax-error
+                'define-graph/rich-returns
+                (~a "Cycles in types are not allowed." " The following types were already inlined: " (syntax->datum #'seen) ", but " #'t " appeared a second time.")
+                #'t)))
+           #'(λ ((x : (Let (~> second-step-marker2-expander) i-t))) repl (error "NIY2")))))))
+    (City (streets : (Let (~> ~>-to-result-type) (~> m-streets)))
+          ((City6/extract/mapping (from : (grr31/first-step City)))
+           (City ((inline-instance (~> m-streets) ())
+                  (get from streets)))))
+    (Street (sname : (Let (~> ~>-to-result-type) String))
+            ((Street7/extract/mapping (from : (grr31/first-step Street)))
+             (Street ((inline-instance String ())
+                      (get from sname)))))))

graph-lib/graph/adt.lp2.rkt

@@ -113,6 +113,7 @@ whose single value is a promise for a structure)@note{This
                     constructor?
                     constructor-values
                     tagged
+                    tagged?
                     define-tagged
                     variant
                     define-variant

graph-lib/graph/constructor.lp2.rkt

@@ -129,6 +129,7 @@ otherwise):
                                        (datum->syntax #f constructor-name))
                                       constructor-name→stx-name/alist))])
                  . body)
+               ;; TODO: set srcloc of fallback to stx on the next line:
                (remember-all-errors2 fallback constructor-name)))]
 
 @section{@racket[constructor]}
@@ -191,7 +192,7 @@ instance:
          (syntax-parse stx
            [(_ constructor-name (~maybe #:with-struct with-struct) v)
             (quasisyntax/loc stx
-              (#,(syntax/loc stx
+              (#,(template/loc stx
                    (Constructor-predicate? constructor-name
                                            (?? (?@ #:with-struct with-struct))))
                v))]

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

@@ -118,12 +118,16 @@ plain list.
          (define-temp-ids "~a/node-marker" (mapping …))
          (define-temp-ids "~a/node-marker2" (mapping …))
          (define-temp-ids "~a/from-first-pass" (node …))
+         (define-temp-ids "second-step-~a/node-of-first" (mapping …))
          ;(define step2-introducer (make-syntax-introducer))
          ;(define/with-syntax id-~> (datum->syntax #'name '~>))
          ;(define/with-syntax introduced-~> (datum->syntax #'name '~>))
          (quasitemplate/debug debug
            (begin
-             (define-graph name/first-step
+             #,(dbg
+          ("first-pass" stx)
+          (quasitemplate
+           (define-graph name/first-step
                #:definitions [<first-pass-type-expander>]
                [node [field c (Let [id-~> first-step-expander2] field-type)] …
                 [(node/simple-mapping [field c field-type] …)
@@ -134,7 +138,7 @@ plain list.
                  (mapping/node
                   (let ([node node/simple-mapping] …)
                     . body))]]
-               …)
+               …)))
              ;; TODO: how to return something else than a node??
              ;; Possibility 1: add a #:main function to define-graph, which can
              ;; call (make-root).
@@ -163,42 +167,9 @@ result type of the user-provided mappings, for example @tc[(Listof Street)]:
            ;; TODO: should fall-back to outer definition of ~>, if any?
            ))]
 
-We define the mapping's body in the second pass as a separate macro, so that
-when it is expanded, the @tc[second-step-marker-expander] has already been
-introduced.
-
-@CHUNK[<pass-2-mapping-body>
-       (define-syntax/parse (pass-2-mapping-body name
-                                                 <pass-2-mapping-body-args>)
-         <inline-temp-nodes>
-         (template
-          (node (<replace-in-instance> (get from field))
-                …)))]
-
-We need to provide to that staged macro all the identifiers it needs:
-
-@chunk[<pass-2-mapping-body-args>
-       id-~>
-       second-step-marker-expander
-       first-pass
-       node
-       (node* …)
-       from
-       (field …)
-       (field-type …)
-       (result-type …)
-       (mapping/node-marker …)
-       (mapping/node …)
-       val]
-
 The goal of these mappings is to inline the temporary nodes, and return a value
 which does not refer to them anymore:
 
-@chunk[<replace-in-instance>
-       (!inline-temp-nodes/instance field-type)
-       #;(tmpl-replace-in-instance (Let (id-~> second-step-marker-expander)
-                                        field-type)
-                                   <second-pass-replace>)]
 
 Where @tc[second-step-marker-expander] (in the input type
 to @tc[replace-in-instance]) expands to the temporary marker
@@ -207,30 +178,46 @@ produced by the first step.
 @chunk[<second-step-marker-expander>
        ;; TODO: should use Let or replace-in-type, instead of defining the node
        ;; globally like this.
-       (define-type node (name/first-step node))
+       ;(define-type node (name/first-step node))
-       …
+       ;…
+       #|
        (define-type mapping/node-marker (U result-type
-                                           (name/first-step node)))
+       (name/first-step node)))
+       ;; TODO: shouldn't it be (name/first-step mapping/node) ?
        …
+       |#
+       (define-type mapping/node-marker
+         (U (name/first-step mapping/node)
+            (tmpl-replace-in-type result-type
+              [mapping/node (name/first-step mapping/node)]
+              [node (name/first-step node)])))
+       …
+       
        ;; TODO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO;^^;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        (define-type-expander (second-step-marker-expander stx)
          (syntax-parse stx
            ;; TODO: should be ~literal
            [(_ (~datum mapping)) #'mapping/node-marker] …
            ;; TODO: should fall-back to outer definition of ~>, if any?
+           ))
+       
+       (define-type second-step-mapping/node-of-first
+         (name/first-step mapping/node))
+       …
+       
+       (define-type-expander (second-step-marker2-expander stx)
+         (syntax-parse stx
+           ;; TODO: should be ~literal
+           [(_ (~datum mapping)) #'(U second-step-mapping/node-of-first
+                                      (tmpl-replace-in-type result-type
+                                        [mapping/node (name/first-step mapping/node)]
+                                        [node (name/first-step node)]))] …
+           ;; TODO: should fall-back to outer definition of ~>, if any?
            ))]
 
 Replacing a marker node is as simple as extracting the
 contents of its single field.
 
-@chunk[<second-pass-replace>
-       [mapping/node-marker
-        <fully-replaced-mapping/result-type>
-        (graph #:? mapping/node)
-        (λ ([m : (first-pass mapping/node)])
-          (get m val))]
-       …]
-
 @subsection{Fully-inlined type}
 
 The result of recursively inlining the temporary mapping nodes may be a
@@ -279,7 +266,8 @@ in all of its fields:
 
 @chunk[<inlined-node>
        ;; inline from the field-type of the old node.
-       (node ((inline-instance field-type ()) (get from field));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+       (node ((inline-instance field-type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+                               ()) (get from field))
              …)]
 
 @subsection{Inlining instances}
@@ -287,29 +275,46 @@ To inline the temporary nodes in the instance, we use
 @tc[replace-in-instance], and call the inline-instance
 recursively:
 
-@chunk[<inline-instance>
+;; HERE, we should expand a type of the shape:
+
+(foo bar (U m-street (Listof Street)) baz quux)
+
+@CHUNK[<inline-instance>
        (define-syntax (inline-instance stx)
          (dbg
           ("inline-instance" stx)
           (syntax-parse stx
             [(_ i-t (~and seen (:id (… …))))
+             (define/with-syntax typp #'(Let (id-~> second-step-marker2-expander) i-t))
+             (define/with-syntax repl (replace-in-instance #'typp
+                                                           #'(<inline-instance-replacement>
+                                                              <inline-instance-nodes>)))
+             (displayln (list "i-t=" #'typp))
              <inline-check-seen>
-             (replace-in-instance #'(Let (id-~> second-step-marker-expander) i-t)
+             #'(λ ([x : (Let (id-~> second-step-marker2-expander) i-t)])
-                                  #'(<inline-instance-replacement>
+                 ;(
-                                     <inline-instance-nodes>))])))]
+                  repl
+                  ;x)
+                 (error "NIY2"))
+             #;(replace-in-instance #'(Let (id-~> second-step-marker2-expander) i-t)
+                                    #'(<inline-instance-replacement>
+                                       <inline-instance-nodes>))])))]
 
 @chunk[<inline-instance-replacement>
-       [mapping/node-marker                                   ;; from
+       [second-step-mapping/node-of-first                     ;; from
-        (inline-type result-type (mapping/node . seen))       ;; to
+        ;(inline-type result-type (mapping/node . seen))       ;; to
-        (first-pass #:? mapping/node)                         ;; pred?
+        Symbol ;; DEBUG
-        (inline-instance result-type (mapping/node . seen))]  ;; fun
+        (name/first-step #:? mapping/node)                    ;; pred?
+        #;(inline-instance result-type (mapping/node . seen))
+        (λ _ (error "NIY4"))]  ;; fun
        …]
 
 @chunk[<inline-instance-nodes>
-       [node                     ;; generated by the first pass
+       [node                       ;; from   ;; generated by the first pass
-        (name #:placeholder node) ;; new type
+        (name #:placeholder node)  ;; to     ;; new type
-        (first-pass #:? node)
+        (name/first-step #:? node) ;; pred?
-        node/extract/mapping]    ;; call mapping
+        #;node/extract/mapping
+        (λ _ (error "NIY3"))]      ;; fun    ;; call mapping
        …]
 
 @subsection{Inlining types}
@@ -385,7 +390,8 @@ Which is equivalent to:
           (first-pass m-3)
           #:or some-abritrary-type-3)]
 
-The generated code would be:
+The generated code would roughly be (possibly without
+merging the node + return-type pairs):
 
 @chunk[|<example (V (~> 1) (~> 2) …) generated >|
        (λ ([v : (V (first-pass m-1)
@@ -518,20 +524,21 @@ encapsulating the result types of mappings.
                   "meta-struct.rkt"; debug
                   racket/stxparam
                   racket/splicing)
-         (provide define-graph/rich-return); ~>)
+         (provide define-graph/rich-return
+                  (for-syntax dbg) ;; DEBUG
+                  ); ~>)
          
          ;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>))
          
          (require (for-syntax racket/pretty))
          
-         ;<pass-2-mapping-body>
          (begin-for-syntax
            (define-syntax-rule (dbg log . body)
              (begin
                (display ">>> ")(displayln (list . log))
                (let ((res (let () . body)))
                  (display "<<< ")(displayln (list . log))
-                 (display "<<<= ")(displayln res)
+                 (display "<<<= ")(display (car (list . log)))(displayln res)
                  res))))
          <graph-rich-return>)]
 

graph-lib/graph/graph.lp2.rkt

@@ -313,7 +313,8 @@ The graph name will be used in several ways:
                     ;; so we should wrap the nodes in a tag, which contains a
                     ;; promise, instead of the opposite (tag inside promise).
                     [(_ #:? (~datum node))
-                     (syntax/loc stx node?)]
+                     ((λ (v) (display "graph node?")(displayln v) v)
+                      (syntax/loc stx node?))] ;;;;;;;;;;;;;;;TODO: implement node? properly here! FB case 107
                     …
                     [(_ . rest)
                      (syntax/loc stx (root/constructor . rest))]))
@@ -568,7 +569,9 @@ library. We replace all occurrences of a @tc[node] name with a @tc[Promise] for
 that node's @tc[with-promises] type.
 
 @CHUNK[<define-promise-type/first-step>
-       (define-constructor node/promise-type #:private
+       (define-constructor node/promise-type
+         #:private
+         #:? node?
          (Promise node/with-promises))]
 @CHUNK[<define-with-promises>
        (define-plain-structure node/with-promises
@@ -750,8 +753,8 @@ via @tc[(g Street)].
        (λ (stx)
          (syntax-parse stx
            [(_ (~datum node)) #'node/promise-type] …
-           [(_ (~datum node) (~datum field))
+           ;[(_ (~datum node) (~datum field))
-            (template <field/with-promises-type>)] … …
+           ; (template <field/with-promises-type>)] … …
            [(_ #:incomplete (~datum node)) #'node/incomplete-type] …
            [(_ #:make-incomplete (~datum node))
             #'(→ field/incomplete-type … node/incomplete-type)] …

graph-lib/graph/remember.rkt

@@ -168,3 +168,7 @@
 (constructor . structure)
 (constructor . wstructure)
 (constructor . wstructure)
+(constructor . m-streets5/node)
+(constructor . tabc)
+(constructor . t)
+(constructor . t)

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

@@ -84,7 +84,7 @@ set of known type constructors like @tc[List] or @tc[Pairof], and recursively
 calls itself on the components of the type.
 
 @CHUNK[<replace-in-type>
-       (define-for-syntax (replace-in-type t r)
+       (define (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"
@@ -143,7 +143,7 @@ with an internal definition for @tc[recursive-replace]. The case of unions is
 offloaded to a separate subroutine.
 
 @CHUNK[<replace-in-instance>
-       (define-for-syntax (replace-in-instance val t r)
+       (define (replace-in-instance val t r)
          (parameterize-push-stx ([current-replacement
                                   `(replace-in-instance ,val ,t ,r)])
                                 (define/with-syntax ([from to fun] ...) r)
@@ -401,7 +401,7 @@ functions is undefined.
 @subsection{The code}
 
 @CHUNK[<fold-instance>
-       (define-for-syntax (fold-instance whole-type stx-acc-type r)
+       (define (fold-instance whole-type stx-acc-type r)
          (parameterize-push-stx ([current-replacement
                                   `(fold-instance ,whole-type ,stx-acc-type ,r)])
                                 (define/with-syntax acc-type stx-acc-type)
@@ -559,12 +559,12 @@ functions is undefined.
           (show-backtrace)
           (displayln (current-replacement))
           (raise-syntax-error
-             'replace-in-type
+           'replace-in-type
-             (~a "Type-fold-replace on untagged Unions isn't supported yet: "
+           (~a "Type-fold-replace on untagged Unions isn't supported yet: "
-                 (syntax->datum ta)
+               (syntax->datum ta)
-                 " in "
+               " in "
-                 (syntax->datum #'whole))
+               (syntax->datum #'whole))
-             ta)])]
+           ta)])]
 
 For cases of the union which are a tagged list, we use a simple guard, and call
 @tc[recursive-replace] on the whole @tc[(List 'tag b ...)] type.
@@ -593,17 +593,17 @@ better consistency between the behaviour of @tc[replace-in-instance] and
 efficient than the separate implementation.
 
 @CHUNK[<replace-in-instance2>
-       (define-for-syntax (replace-in-instance2 t r)
+       (define replace-in-instance2 (lambda/debug (t r)
-         (define/with-syntax ([from to pred? fun] ...) r)
+                                                  (define/with-syntax ([from to pred? fun] ...) r)
-         #`(λ ([val : #,(expand-type t)])
+                                                  #`(λ ([val : #,(expand-type t)])
-             (first-value
+                                                      (first-value
-              (#,(fold-instance t
+                                                       (#,(fold-instance t
-                                #'Void
+                                                                         #'Void
-                                #'([from to pred? (λ ([x : from] [acc : Void])
+                                                                         #'([from to pred? (λ ([x : from] [acc : Void])
-                                                    (values (fun x) acc))]
+                                                                                             (values (fun x) acc))]
-                                   ...))
+                                                                            ...))
-               val
+                                                        val
-               (void)))))]
+                                                        (void))))))]
 
 @section{Conclusion}
 
@@ -654,50 +654,55 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and
 
 @CHUNK[<*>
        (begin
-         (module main typed/racket
+         (module main racket/base
            (require
-             (for-syntax syntax/parse
+             syntax/parse
-                         racket/syntax
+             racket/syntax
-                         racket/format
+             racket/format
-                         syntax/parse/experimental/template
+             syntax/parse/experimental/template
-                         racket/sequence
+             racket/sequence
-                         (submod "../lib/low.rkt" untyped)
+             (submod "../lib/low.rkt" untyped)
-                         (only-in "../type-expander/type-expander.lp2.rkt"
+             (only-in "../type-expander/type-expander.lp2.rkt"
-                                  expand-type)
+                      expand-type)
-                         "meta-struct.rkt"
+             "meta-struct.rkt"
-                         "../lib/low/backtrace.rkt")
+             "../lib/low/backtrace.rkt"
-             "../type-expander/multi-id.lp2.rkt"
+             debug
-             "../type-expander/type-expander.lp2.rkt"
+             racket/require
-             "../lib/low.rkt")
+             (for-template (subtract-in
-           (begin-for-syntax (provide replace-in-type
+                            typed/racket
-                                      ;replace-in-instance
+                            "../type-expander/type-expander.lp2.rkt")
-                                      fold-instance
+                           "../type-expander/multi-id.lp2.rkt"
-                                      (rename-out [replace-in-instance2
+                           "../type-expander/type-expander.lp2.rkt"
-                                                   replace-in-instance])
+                           "../lib/low.rkt"))
-                                      tmpl-replace-in-type
+           (provide replace-in-type
-                                      tmpl-fold-instance
+                    ;replace-in-instance
-                                      tmpl-replace-in-instance))
+                    fold-instance
+                    (rename-out [replace-in-instance2
+                                 replace-in-instance])
+                    tmpl-replace-in-type
+                    tmpl-fold-instance
+                    tmpl-replace-in-instance)
            
-           (begin-for-syntax
+           
-             (define current-replacement (make-parameter #'()))
+           (define current-replacement (make-parameter #'()))
-             ;; TODO: move to lib
+           ;; TODO: move to lib
-             (require (for-syntax racket/base))
+           (require (for-syntax racket/base))
-             (define-syntax-rule (parameterize-push ([p val] ...) . body)
+           (define-syntax-rule (parameterize-push ([p val] ...) . body)
-               (parameterize ([p (cons val (p))] ...) . body))
+             (parameterize ([p (cons val (p))] ...) . body))
-             (define-syntax-rule (parameterize-push-stx ([p val] ...) . body)
+           (define-syntax-rule (parameterize-push-stx ([p val] ...) . body)
-               (parameterize ([p #`(#,val . #,(p))] ...) . body)))
+             (parameterize ([p #`(#,val . #,(p))] ...) . body))
            
            <replace-in-type>
            <replace-in-instance>
            <replace-in-instance2>
            <fold-instance>
-           (begin-for-syntax <template-metafunctions>))
+           <template-metafunctions>)
          
          (require 'main)
          (provide (all-from-out 'main))
          
          (module* test typed/racket
-           (require (submod "..")
+           (require (for-syntax (submod ".."))
                     typed/rackunit
                     "../type-expander/multi-id.lp2.rkt"
                     "../type-expander/type-expander.lp2.rkt")

graph-lib/graph/rewrite-type.scrbl

@@ -38,7 +38,7 @@ new type.
  to the new type, using the provided replacement functions
  for each part.}
 
-@defform[#:kind "function"
+@defform[#:kind "procedure"
          (replace-in-type old-type #'([from to] …))
          #:contracts ([old-type type]
                       [from identifier?]
@@ -47,7 +47,7 @@ new type.
  @racket[old-type], with all occurrences of @racket[from]
  replaced with @racket[to] in the type.}
 
-@defform[#:kind "function"
+@defform[#:kind "procedure"
          (replace-in-instance old-type #'([from to pred? fun] …))
          #:contracts ([old-type type]
                       [from identifier?]

graph-lib/graph/structure.lp2.rkt

@@ -30,7 +30,7 @@ types, it wouldn't be clear what fields the remaining type parameters affect).
 
 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
+@tc[#:instance] and @tc[#:make-instance], 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.
 
@@ -38,8 +38,8 @@ handle the empty structure as a special case.
        (define-splicing-syntax-class structure-args-stx-class
          (pattern
           (~or (~seq #:instance (~parse (field … value …) #'()))
-               (~seq #:constructor (~parse (field …) #'()))
+               (~seq #:make-instance (~parse (field …) #'()))
-               (~seq (~maybe #:constructor ~!)
+               (~seq (~maybe #:make-instance ~!)
                      (~or (~seq (~or-bug [field:id] field:id) …+)
                           (~seq [field:id (~and C :colon) type:expr] …+)))
                (~seq (~maybe #:instance ~!)
@@ -51,8 +51,8 @@ handle the empty structure as a special case.
        (begin-for-syntax <structure-args-stx-class>)
        
        (define-multi-id structure
-         #:type-expander structure-type-expander
+         #:type-expander <type-expander>
-         #:match-expander structure-match-expander
+         #:match-expander <match-expander>
          #:call
          (λ (stx)
            (syntax-parse stx
@@ -68,11 +68,11 @@ handle the empty structure as a special case.
        (let ()
          (define-structure empty-st)
          (define-structure stA [a Number])
-         (check-equal?: (empty-st) ((structure #:constructor)))
+         (check-equal?: (empty-st) ((structure #:make-instance)))
          (check-not-equal?: (empty-st) (structure [a 1]))
-         (check-not-equal?: (structure #:constructor) (structure [a 1]))
+         (check-not-equal?: (structure #:make-instance) (structure [a 1]))
          (check-not-equal?: (empty-st) (stA 1))
-         (check-not-equal?: (structure #:constructor) (stA 1)))
+         (check-not-equal?: (structure #:make-instance) (stA 1)))
        #;(let ()
            (define-structure st [a Number] [b String])
            (define-structure stA [a Number])
@@ -453,16 +453,14 @@ The fields in @tc[fields→stx-name-alist] are already sorted.
            (pattern field:id #:with (pat ...) #'())))]
 
 @chunk[<match-expander>
-       (define-for-syntax (structure-match-expander stx)
+       (λ/syntax-parse (_ :match-field-or-field-pat ...)
-         (syntax-parse stx
+         (if (check-remember-fields #'(field ...))
-           [(_ :match-field-or-field-pat ...)
+             (let ()
-            (if (check-remember-fields #'(field ...))
+               (define/with-syntax name (fields→stx-name #'(field ...)))
-                (let ()
+               (define/with-syntax ([sorted-field sorted-pat ...] ...)
-                  (define/with-syntax name (fields→stx-name #'(field ...)))
+                 (sort-car-fields #'((field pat ...) ...)))
-                  (define/with-syntax ([sorted-field sorted-pat ...] ...)
+               #'(name (and sorted-field sorted-pat ...) ...))
-                    (sort-car-fields #'((field pat ...) ...)))
+             <match-expander-remember-error>))]
-                  #'(name (and sorted-field sorted-pat ...) ...))
-                <match-expander-remember-error>)]))]
 
 If we just return @racket[(remember-all-errors list stx #'(field ...))] when a
 recompilation is needed, then the identifier @tc[delayed-error-please-recompile]
@@ -506,7 +504,7 @@ instead of needing an extra recompilation.
 @subsection{Type-expander}
 
 @CHUNK[<type-expander>
-       (define-for-syntax (structure-type-expander stx)
+       (λ (stx)
          (syntax-parse stx
            [(_ (~or-bug [field:id] field:id) …)
             (if (check-remember-fields #'(field ...))
@@ -595,8 +593,6 @@ its arguments across compilations, and adds them to the file
            <syntax-class-for-match>
            <structure-supertype>
            <structure-supertype*>
-           <match-expander>
-           <type-expander>
            
            <structure?>
            

graph-lib/graph/tagged.lp2.rkt

@@ -108,10 +108,11 @@ for a structure.
 @CHUNK[<tagged?>
        (define-syntax/parse (tagged? tag (~maybe #:with-struct with-struct)
                                      field …)
-         #'(λ (v) (and (constructor? tag (?? (?@ #:with-struct with-struct)) v)
+         (template
-                       (promise? (constructor-values v))
+          (λ (v) (and (constructor? tag (?? (?@ #:with-struct with-struct)) v)
-                       ((structure? field …)
+                      (promise? (constructor-values v))
-                        (force (constructor-values v))))))]
+                      ((structure? field …)
+                       (force (constructor-values v)))))))]
 
 @section{Tests}
 

graph-lib/graph/test-map-get.rkt

@@ -4,8 +4,7 @@
   (require (submod "graph.lp2.rkt" test))
   (require "get.lp2.rkt")
   (require "map.rkt")
-  (require "structure.lp2.rkt")
+  (require "adt.lp2.rkt")
-  (require "variant.lp2.rkt")
   (require "../lib/low.rkt")
   (require "../type-expander/type-expander.lp2.rkt")
   

graph-lib/lib/low/syntax-parse.rkt

@@ -25,6 +25,8 @@
            ~or-bug
            define-simple-macro
            λstx
+           ;template/loc
+           ;quasitemplate/loc
            template/debug
            quasitemplate/debug
            meta-eval)
@@ -134,6 +136,16 @@
       (check-equal? (syntax->datum ((λstx (foo bar) #'(foo bar)) #'a #'b))
                     (syntax->datum #'(a b)))))
   
+  ;; template/loc
+  (begin
+    (define-syntax-rule (template/loc loc . tmpl)
+      (quasisyntax/loc loc #,(template . tmpl))))
+
+  ;; quasitemplate/loc
+  (begin
+    (define-syntax-rule (quasitemplate/loc loc . tmpl)
+      (quasisyntax/loc loc #,(quasitemplate . tmpl))))
+  
   ;; template/debug
   (begin
     (define-syntax (template/debug stx)

graph-lib/make/make.rkt

@@ -6,7 +6,7 @@
 
 ;(current-directory "..")
 
-(run! (list (find-executable-path-or-fail "sh")
+#;(run! (list (find-executable-path-or-fail "sh")
             "-c"
             @string-append{
  found_long_lines=0