Part 1 of inline-instance-top (unfinished, the return type is Any).

graph-lib/Makefile

@@ -13,4 +13,4 @@ clean:
 .PHONY: build-dep
 build-dep:
 	# datatype is only used as an example in the docs.
-	raco pkg install --deps search-auto --update-deps --skip-installed alexis-util cover cover-coveralls debug datatype mischief
+	raco pkg install --deps search-auto --update-deps --skip-installed alexis-util cover cover-coveralls debug datatype mischief https://github.com/jsmaniac/scribble-enhanced.git#823fdda5a65552ce4fe8d6f8fbe07391ccca73bd

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

@@ -109,6 +109,7 @@ plain list.
 @CHUNK[<graph-rich-return>
        (define-syntax/parse <signature>
          (define/with-syntax (node* …) #'(node …))
+         (define/with-syntax ([root/field-type …] . _) #'([field-type …] …))
          (define-temp-ids "~a/first-step" name)
          (define-temp-ids "first-step-expander2" name)
          (define-temp-ids "top1-accumulator-type" name)
@@ -196,7 +197,7 @@ produced by the first step.
        (define-type mapping/node-marker
          (tmpl-replace-in-type result-type
            [mapping/node mapping/node-marker] ;;;;;;;TODO: test: I'm unsure here
-           [node (name #:placeholder City)])
+           [node (name #:placeholder node)])
          #;(U (name/first-step mapping/node)
               (tmpl-replace-in-type result-type
                 [mapping/node (name/first-step mapping/node)]
@@ -219,14 +220,26 @@ produced by the first step.
          (name/first-step node))
        …
 
+       ;; TODO: we should take care here: inside result-type, node names get
+       ;; bound to the identifier from the second graph, whereas semantically
+       ;; they denote nodes from the first graph. Since they get rewritten as
+       ;; second-step-node-of-first almost immediately it doesn't cause any
+       ;; problem, but it's a nasty gotcha. Hoisintg this out of the
+       ;; second graph definition should be enough. This probably happens in
+       ;; another couple of places too.
        (define-type-expander (second-step-marker2-expander stx)
          (syntax-parse stx
            ;; TODO: should be ~literal
            [(_ (~datum mapping))
-            #'(U second-step-mapping/node-of-first
+            (syntax-local-introduce
-                 result-type #;(tmpl-replace-in-type result-type
+             #'(U second-step-mapping/node-of-first
-                                 [mapping/node (name/first-step mapping/node)]
+                  result-type
-                                 [node (name/first-step node)]))]
+                  
+                  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<THIS WORKED
+                  
+                  #;(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?
            ))]
@@ -275,14 +288,17 @@ identifier, so that it can be matched against by
              [node [field c (Let [id-~> ~>-to-result-type] field-type)] …
               [(node/extract/mapping [from : (name/first-step node)])
                <inlined-node>]]
-             …))]
+             …))
+       
+       <inline-instance-top1-types>
+       <inline-instance-top1>
+       <outer-inline>]
 
 We create the inlined-node by inlining the temporary nodes
 in all of its fields:
 
 @chunk[<inlined-node>
-       ;; inline from the field-type of the old node.
+       (node ((inline-instance* field-type
-       (node ((inline-instance* field-type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                 ()) (get from field))
              …)]
 
@@ -297,6 +313,20 @@ recursively:
           ("inline-instance*" stx)
           (syntax-parse stx
             [(_ i-ty seen)
+             #;(syntax-case (expand-type #'(Let
+                                            (~>
+                                             second-step-marker2-expander)
+                                            (~> m-streets))) ()
+                 [(a_U
+                   a_second-step-m-streets19/node-of-first
+                   (a_Listof a_Street))
+                  (syntax-case #'([node second-step-node-of-first] …) ()
+                    [((_ _)
+                      (b_Street b_second-step-Street21-of-first))
+                     (begin
+                       (displayln #'a_Street)
+                       (displayln #'b_Street)
+                       (displayln (free-identifier=? #'a_Street #'b_Street)))])])
              (define/with-syntax replt
                (replace-in-type #'(Let (id-~> second-step-marker2-expander)
                                        i-ty)
@@ -317,7 +347,7 @@ recursively:
 
 @chunk[<inline-instance-replacement>
        [second-step-mapping/node-of-first                       ;; from
-        (inline-type result-type (mapping/node . seen))        ;; to
+        (inline-type result-type (mapping/node . seen))         ;; to
         (name/first-step #:? mapping/node)                      ;; pred?
         (λ ([x : second-step-mapping/node-of-first])            ;; fun
           ((inline-instance* result-type (mapping/node . seen))
@@ -347,6 +377,11 @@ layer of actual nodes. We do this in three steps:
  @item{Finally, we replace the placeholders with the
   second-pass nodes returned by the graph.}]
 
+@CHUNK[<outer-inline>
+       (inline-instance-top1* root/field-type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+                              ())
+       …]
+
 @CHUNK[<inline-instance-top1-types>
        (define-constructor mapping/node-index
          #:private
@@ -357,9 +392,19 @@ layer of actual nodes. We do this in three steps:
        …
        
        (define-type top1-accumulator-type
-         (pairof Index ;; max
+         (Pairof Index ;; max
-                 (list (listof (name/first-step node))
+                 (List (Listof (Pairof mapping/node-index (name/first-step node))) ;; AListof
-                       …)))]
+                       …)))
+
+       (define-type-expander (second-step-marker2-top-expander stx)
+         (syntax-parse stx
+           [(_ (~datum mapping))
+            (syntax-local-introduce
+             #'(U second-step-mapping/node-of-first
+                  result-type))]
+           …
+           ;; TODO: should fall-back to outer definition of ~>, if any?
+           ))]
 
 @CHUNK[<inline-instance-top1>
        (define-syntax (inline-instance-top1* stx)
@@ -367,12 +412,28 @@ layer of actual nodes. We do this in three steps:
           ("inline-instance-top1*" stx)
           (syntax-parse stx
             [(_ i-ty seen)
+             #;(syntax-case (expand-type #'(Let
+                                            (~>
+                                             second-step-marker2-top-expander)
+                                            (~> m-streets))) ()
+                 [(a_U
+                   a_second-step-m-streets19/node-of-first
+                   (a_Listof a_Street))
+                  (syntax-case #'([node second-step-node-of-first] …) ()
+                    [((_ _)
+                      (b_Street b_second-step-Street21-of-first))
+                     (begin
+                       (displayln #'a_Street)
+                       (displayln #'b_Street)
+                       (displayln (free-identifier=? #'a_Street #'b_Street)))])])
+             (displayln (list "~~~norepl=" #'(Let (id-~> second-step-marker2-top-expander)
+                                                  i-ty)))
              (define/with-syntax replt
-               (replace-in-type #'(Let (id-~> second-step-marker2-expander)
+               (replace-in-type #'(Let (id-~> second-step-marker2-top-expander)
                                        i-ty)
                                 #'([node second-step-node-of-first]
                                    …)))
-             (displayln (list "replt=" #'replt))
+             (displayln (list "replt-top=" #'replt))
              #'(inline-instance-top1 replt seen)])))
        
        (define-syntax (inline-instance-top1 stx)
@@ -389,13 +450,16 @@ layer of actual nodes. We do this in three steps:
 
 @chunk[<inline-instance-top1-replacement>
        [second-step-mapping/node-of-first                             ;; from
-        (inline-type result-type (mapping/node . seen))               ;; to
+        Any;(inline-type result-type (mapping/node . seen))               ;; to
         (name/first-step #:? mapping/node)                            ;; pred?
         (λ ([x : second-step-mapping/node-of-first]                   ;; fun
             [acc : top1-accumulator-type])
-          (values ((inline-instance-top1* result-type (mapping/node . seen))
+          (% inlined new-acc
-                   (get x returned))
+             = ((inline-instance-top1* result-type (mapping/node . seen))
-                  ACC))]
+                (get x returned)
+                acc)
+             in
+             (values inlined new-acc)))]
        …]
 
 @chunk[<inline-instance-top1-nodes>
@@ -408,11 +472,13 @@ layer of actual nodes. We do this in three steps:
           : (values mapping/node-index-marker
                     top1-accumulator-type)
           (% (idx . (node/accumulator …)) = acc
-             
+             new-index = (mapping/node-index idx)
              in
-             (values PLACEHOLDER
+             (values new-index
-                     (cons (add1 idx)
+                     (let ([node/accumulator (cons (cons new-index x)
-                           (NEW-NDS …)))))]
+                                                   node/accumulator)])
+                       (cons (assert (add1 idx) index?)
+                             (list node/accumulator …))))))]
        …]
 
 @chunk[<inline-instance-top2>
@@ -666,7 +732,8 @@ encapsulating the result types of mappings.
                               "rewrite-type.lp2.rkt" #|debug|#
                               syntax/id-set
                               racket/format
-                              mischief/transform)
+                              mischief/transform
+                              (submod "../type-expander/type-expander.lp2.rkt" expander))
                   (rename-in "../lib/low.rkt" [~> threading:~>])
                   "graph.lp2.rkt"
                   "get.lp2.rkt"
@@ -689,11 +756,11 @@ encapsulating the result types of mappings.
          (begin-for-syntax
            (define-syntax-rule (dbg log . body)
              (begin
-               ;(display ">>> ")(displayln (list . log))
+               (display ">>> ")(displayln (list . log))
                (let ((res (let () . body)))
-                 ;(display "<<< ")(displayln (list . log))
+                 (display "<<< ")(displayln (list . log))
-                 ;(display "<<<= ")(display (car (list . log)))
+                 (display "<<<= ")(display (car (list . log)))
-                 ;(display res)(displayln ".")
+                 (display res)(displayln ".")
                  res))))
          <graph-rich-return>)]
 

graph-lib/graph/rewrite-type.scrbl

@@ -1,5 +1,7 @@
 #lang scribble/manual
 
+@(require scribble-enhanced/manual-form)
+
 @(require (for-label typed/racket/base
                      "rewrite-type.lp2.rkt"))
 
@@ -10,80 +12,84 @@ type with other types, and generating conversion functions
 transforming instances of the old type into instances of the
 new type.
 
-@defform[#:kind "template metafunction"
-         (tmpl-fold-instance old-type
-           accumulator-type
-           [from to pred? fun] …)
-         #:contracts ([old-type type]
-                      [accumulator-type type]
-                      [from identifier?]
-                      [to type]
-                      [pred? predicate?]
-                      [fun (→ from acc (values to acc))])]{
- Produces the syntax for a function from @racket[old-type]
- to the new type, using the provided replacement functions
- for each part.}
-
-
-@defform[#:kind "template metafunction"
-         (tmpl-replace-in-instance old-type
-                                   [from to pred? fun] …)
-         #:contracts ([old-type type]
-                      [accumulator-type type]
-                      [from identifier?]
-                      [to type]
-                      [pred? predicate?]
-                      [fun (→ from to)])]{
- Produces the syntax for a function from @racket[old-type]
- to the new type, using the provided replacement functions
- for each part.}
-
 @defform[#:kind "procedure"
-         (replace-in-type old-type #'([from to] …))
+         (replace-in-type old-type
-         #:contracts ([old-type type]
+                          #'([from to] …))
-                      [from identifier?]
+         #:result (syntax-for type)
-                      [to type])]{
+         #:contracts ([old-type (syntax-for type)]
- This type-level function produces the syntax for the type 
+                      [from (and/c identifier? (syntax-for type))]
- @racket[old-type], with all occurrences of @racket[from]
+                      [to (syntax-for type)])]{
- replaced with @racket[to] in the type.}
+ This type-level function produces the syntax for the 
+ @racket[new-type]. The @racket[new-type] has the same shape
+ as the @racket[old-type], except all occurrences of the 
+ @racket[from] type (which must be just a single identifier)
+ replaced with the @racket[to] type in the type.
  
-@defform[#:kind "procedure"
+ The @racket[replace-in-type] type-level function first
-         (replace-in-instance old-type #'([from to pred? fun] …))
+ expands any @racketmodname[type-expander]s, and performs
-         #:contracts ([old-type type]
+ the replacements on the expanded type.}
-                      [from identifier?]
+
-                      [to type]
+@deftogether[
-                      [pred? predicate?]
+ (@defform[#:kind "procedure"
-                      [fun (→ from to)])]{
+           (replace-in-instance old-type
- Produces the syntax for the syntax for a function from 
+                                #'([from to pred? fun] …))
- @racket[old-type] to the new type, transforming all parts
+           #:result (syntax-for (→ old-type new-type))]
- of the data structure which satisfy @racket[pred?] using 
+   @defform[#:kind "template metafunction"
- @racket[fun]. @racket[pred?] should return true if and only
+            (tmpl-replace-in-instance old-type
- if the data pased as an argument is an instance of the 
+              [from to pred? fun] …)
- @racket[from] type. @racket[fun] should accept instances of
+            #:result (syntax-for (→ old-type new-type))
- the @racket[from] type, and return instances of the 
+            #:contracts ([old-type (syntax-for type)]
- @racket[to] type.}
+                         [from (and/c identifier? (syntax-for type))]
-
+                         [to (syntax-for type)]
-@defform[#:kind "procedure"
+                         [pred? (syntax-for predicate?)]
-         (fold-instance old-type
+                         [fun (syntax-for (→ from to))])])]{
-                        accumulator-type
+ Produces the syntax for the syntax for a function from the
-                        #'([from to pred? fun] …))
+ @racket[old-type] to the @racket[new-type], transforming
-         #:contracts ([old-type type]
+ all parts of the data structure which satisfy 
-                      [accumulator-type type]
+ @racket[pred?] using @racket[fun]. The @racket[new-type]
-                      [from identifier?]
+ will be the same as the one that would be returned by 
-                      [to type]
+ @racket[(replace-in-type old-type #'([from to] …))]
-                      [pred? predicate?]
+ 
-                      [fun (→ from acc (values to acc))])]{
+ @racket[pred?] should return true if and only if the data
- Produces the syntax for the syntax for a function from 
+ passed as an argument is an instance of the @racket[from]
- @racket[old-type] to the new type, transforming all parts
+ type. @racket[fun] should accept instances of the 
- of the data structure which satisfy @racket[pred?] using 
+ @racket[from] type, and return instances of the 
- @racket[fun]. The generated function takes as a second
+ @racket[to] type.
- argument an initial value for the accumulator. The
+}
- accumulator is passed to @racket[fun] and the one returned
+
- is used as the accumulator for the next call. No guarantee
+@deftogether[
- is made on the order of traversal.
+ (@defform[#:kind "procedure"
-
+           (fold-instance old-type
- @racket[pred?] should return true if and only
+                          accumulator-type
- if the data pased as an argument is an instance of the 
+                          ([from to pred? fun] …))
- @racket[from] type. @racket[fun] should accept instances of
+           #:result (syntax-for
- the @racket[from] type, and return instances of the 
+                     (→ old-type (Values new-type accumulator-type)))]
+   @defform[#:kind "template metafunction"
+            (tmpl-fold-instance old-type accumulator-type
+              [from to pred? fun] …)
+            #:result (syntax-for
+                      (→ old-type (Values new-type accumulator-type)))
+            #:contracts ([old-type (syntax-for type)]
+                         [accumulator-type (syntax-for type)]
+                         [from (and/c identifier? (syntax-for type))]
+                         [to (syntax-for type)]
+                         [pred? (syntax-for predicate?)]
+                         [fun (syntax-for (→ from acc (Values to acc)))])])]{
+ Produces the syntax for the syntax for a function from the
+ @racket[old-type] to the @racket[new-type], transforming
+ all parts of the data structure which satisfy 
+ @racket[pred?] using @racket[fun]. The @racket[new-type]
+ will be the same as the one that would be returned by 
+ @racket[(replace-in-type old-type #'([from to] …))]
+ 
+ The generated function takes as a second argument an
+ initial value for the accumulator. The accumulator is
+ passed to @racket[fun] and the one returned is used as the
+ accumulator for the next call. No guarantee is made on the
+ order of traversal.
+ 
+ @racket[pred?] should return true if and only if the data
+ passed as an argument is an instance of the @racket[from]
+ type. @racket[fun] should accept instances of the 
+ @racket[from] type, and return instances of the 
  @racket[to] type.}