Part 2 of inline-instance-top

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

@@ -112,6 +112,7 @@ plain list.
          (define-temp-ids "~a/first-step" name)
          (define-temp-ids "first-step-expander2" name)
          (define-temp-ids "top1-accumulator-type" name)
+         (define-temp-ids "~a/constructor-top2" (mapping …))
          (define-temp-ids "~a/accumulator" (node …))
          (define-temp-ids "~a/simple-mapping" (node …))
          (define-temp-ids "~a/node" (mapping …))
@@ -292,7 +293,8 @@ identifier, so that it can be matched against by
        <inline-type-top1>
        <inline-instance-top1-types>
        <inline-instance-top1>
-       <outer-inline>]
+       <outer-inline>
+       <inline-instance-top2>]
 
 We create the inlined-node by inlining the temporary nodes
 in all of its fields:
@@ -473,9 +475,23 @@ layer of actual nodes. We do this in three steps:
        …]
 
 @chunk[<inline-instance-top2>
+       (define (mapping/constructor-top2 [param cp param-type] …)
+         (% <constructor-top2-body>))
+       …
+       
+       (define #,(datum->syntax #'name 'DBG)
+         (list mapping/constructor-top2 …))]
+
+@chunk[<constructor-top2-body>
+       first-graph = (name/first-step #:root mapping/node param …)
+       alists = (list (!each mapping '()) …)
+       with-indices-top1 last-acc = ((inline-instance-top1* result-type ())
+                                     (get first-graph returned)
+                                     (cons 1 alists))
+       (_ . (node/accumulator …)) = last-acc
+       in
        ;; Call the second step graph constructor:
-       (name #:roots (ann (cdr LAST-ACCUMULATOR)
-                          (list (vectorof (name/first-step mapping/node)))))]
+       (name #:roots [node (lists (cdrs node/accumulator))] …)]
 
 @chunk[<inline-instance-top3>
        (replace-in-instance #'TYPE??

graph-lib/graph/graph.scrbl

@@ -0,0 +1,26 @@
+#lang scribble/manual
+
+@(require scribble-enhanced/manual-form)
+
+@(require (for-label typed/racket/base
+                     "graph.lp2.rkt"))
+
+@title{Low-level graph macro}
+
+
+@defform[(graph …)
+         #:result graph-id
+         #:contracts ([old-type (syntax-for type)]
+                      [from (and/c identifier? (syntax-for type))]
+                      [to (syntax-for type)])]{
+ …}
+
+@defform[(graph-id #:roots [node args] …)
+         #:result (List (Vectorof node/promise-type) …)
+         #:contracts ([args (Listof (List arg-type …))])]{
+ Create a graph instance, starting from the given root
+ arguments. Each element of the returned list contains a
+ vector with all the graph roots for that node type, in the
+ same order as their arguments were given. If there are some
+ duplicates in the lists of arguments, the same node will be
+ returned for both.}

graph-lib/lib/low.rkt

@@ -12,6 +12,7 @@
    "low/typed-rackunit.rkt"
    "low/typed-rackunit-extensions.rkt"
    "low/syntax-parse.rkt"
+   "low/tmpl.rkt"
    "low/threading.rkt"
    "low/aliases.rkt"
    "low/sequence.rkt"

graph-lib/lib/low/list.rkt

@@ -7,6 +7,11 @@
            AListof)
 
   (define-type (AListof K V) (Listof (Pairof K V)))
+  (define-match-expander alistof
+    (λ (stx)
+      (syntax-case stx ()
+        [(keys-pat vals-pat)
+         #'(list (cons keys-pat vals-pat) …)])))
   
   (: indexof (∀ (A B) (→ A (Listof B) (→ A B Any) (U #f Integer))))
   (define (indexof elt lst [compare equal?])

graph-lib/lib/low/template.scrbl

@@ -86,6 +86,13 @@ Keywords: grammar, parser, template.
                     
                     (~sort key template ooo)
                     (~loc stxloc . template)
+                    ;; Like (template . template), but discards the first and
+                    ;; keeps just the second. If the first contains pattern
+                    ;; variables which are repeated, this has the effect of
+                    ;; repeating the second as many times as the first. Example:
+                    ;; #'(vector (~each some-pattern-var '()))
+                    ;; => (vector '() '() '() '() '())
+                    (~each template template)
                     
                     ;; escaped
                     (ddd escaped)
@@ -233,6 +240,12 @@ This can also be used to rename the @racket[parse] and
 @racket[tmpl] could be renamed to @racket[quasisyntax], or
 something similar).
 
+Otherwise, @racket[grammar/custom] could just @racket[set!]
+some for-syntax variable which stores the options. A second
+boolean for-syntax variable could be used to check if 
+@racket[grammar/custom] was called twice, and throw an error
+in that case.
+
 Or maybe we should just use units? Can they be customized in
 a similar way?
 

graph-lib/lib/low/tmpl.rkt

@@ -0,0 +1,14 @@
+#lang typed/racket
+(require "typed-untyped.rkt")
+(define-typed/untyped-modules #:no-test
+  (provide !each)
+  
+  (module m-!each racket
+    (provide !each)
+    (require syntax/parse/experimental/template)
+    
+    (define-template-metafunction (!each stx)
+      (syntax-case stx ()
+        [(_ a b) #'b])))
+  
+  (require 'm-!each))

graph-lib/lib/low/type-inference-helpers.rkt

@@ -1,7 +1,7 @@
 #lang typed/racket
 (require "typed-untyped.rkt")
 (define-typed/untyped-modules #:no-test
-  (provide cars cdrs)
+  (provide cars cdrs lists)
   
   #|
   ;; This does not work, in the end.
@@ -22,4 +22,7 @@
   (define (cars l) ((inst map A (Pairof A Any)) car l))
   
   (: cdrs (∀ (B) (→ (Listof (Pairof Any B)) (Listof B))))
-  (define (cdrs l) ((inst map B (Pairof Any B)) cdr l)))
+  (define (cdrs l) ((inst map B (Pairof Any B)) cdr l))
+
+  (: lists (∀ (A) (→ (Listof A) (Listof (List A)))))
+  (define (lists l) ((inst map (List A) A) (λ (x) (list x)) l)))