diff --git a/graph-lib/graph/__DEBUG_graph5.rkt b/graph-lib/graph/__DEBUG_graph5.rkt index 7d412d70..974d8af7 100644 --- a/graph-lib/graph/__DEBUG_graph5.rkt +++ b/graph-lib/graph/__DEBUG_graph5.rkt @@ -49,7 +49,7 @@ (for-syntax syntax/parse)) (define-graph/multi-ctor gm ([a [b1 : b] [b2 : b] [s : String] [v : Number]] - [b [a : a] [s : String] [v : Number]]) + [b [a1 : a] [s : String] [v : Number]]) [(r [v : Integer] [w : String]) : a (printf "r ~a ~a\n" v w) @@ -70,6 +70,6 @@ (check-equal?: (get gmi v) 3) (check-equal?: (get gmi b1 v) 2) (check-equal?: (get gmi b1 s) "x") -(check-equal?: (get gmi b1 a v) 2) -;(check-equal?: (get gmi b1 a b1 a v) 1) -;(check-equal?: (get gmi b1 a b1 a b1 v) 1) +(check-equal?: (get gmi b1 a1 v) 2) +;(check-equal?: (get gmi b1 a1 b1 a1 v) 1) +;(check-equal?: (get gmi b1 a1 b1 a1 b1 v) 1) diff --git a/graph-lib/graph/graph-6-rich-returns.lp2.rkt b/graph-lib/graph/graph-6-rich-returns.lp2.rkt new file mode 100644 index 00000000..3896276f --- /dev/null +++ b/graph-lib/graph/graph-6-rich-returns.lp2.rkt @@ -0,0 +1,2987 @@ +#lang scribble/lp2 +@(require "../lib/doc.rkt") +@doc-lib-setup + +@title[#:style manual-doc-style]{Syntactic sugar for + @racket[graph]: rich return types} + +@(table-of-contents) + +@section{Introduction} + +We define a wrapper around the @tc[graph] macro, which +allows defining mappings with rich return types, instead of +being forced to return a single node. For example, a mapping +can return a list of nodes. + +During the graph construction, however, the user cannot +access the contents of these rich values. If this was +allowed, constructing a node might cause infinite recursion, +which is precisely one of the pitfalls our library strives +to avoid. For example, the following two constructors each +depend on parts of the other's output. + +@chunk[ + (define-graph (g [a [len : Integer] [bs : (Listof b)]] + [b [len : Integer] [as : (Listof a)]]) + [(ma) : (Listof a) + (let ([bs (mb)]) + (list (a (length bs) bs) + (a 42 bs)))] + [(mb) : (Listof b) + (let ([as (ma)]) + (list (b (length bs) as) + (b 123 as)))])] + +In the above example, running @tc[(ma)] will require +running @tc[(mb)] too, to compute the length of the list +returned by @tc[(mb)], and vice-versa. It is clear this code +will run into an infinite loop in an eager language like +@tc[typed/racket]. + +To avoid this kind of issue, we will make the mapping +functions return opaque values whose contents cannot be +inspected during the creation of the graph. This also makes +the implementation easier, as we will generate the graph in +two phases: first, we will associate a single-field node +with each mapping, and use it as their return type. Then, a +second pass will break these nodes, and extract their +constituents until an actual user-specified node is +reached. + +Since this implementation also allows serveral mappings to +return the same node, the new signature separates the +mapping declarations from the node definitions: + +@chunk[ + (define-graph/rich-return name:id + ((~commit [node:id …]) + …) + (~commit ) + …)] + +Where @tc[] hasn't changed: + +@chunk[ + (~describe "[field : type]" + [field:id c:colon field-type:expr])] + +We now allow more complex return types in a @tc[]: + +@chunk[ + (~describe "[(mapping [param : type] …) : result . body]" + [(mapping:id [param:id cp:colon param-type:expr] …) + cm:colon result-type:expr + . body])] + +Here is an example usage of this syntax: + +@chunk[ + (define-graph/rich-return grr + ([City [streets : (~> m-streets)]] + [Street [sname : String]]) + [(m-cities [cnames : (Listof (Listof String))]) : (Listof City) + (define (strings→city [s : (Listof String)]) : City + (City (m-streets s))) + (map strings→city cnames)] + [(m-streets [snames : (Listof String)]) : (Listof Street) + (map Street snames)])] + +The @tc[(~> m-streets)] type is a special marker which will +be expanded to the return type of @tc[m-streets] (namely +@tc[(Listof Street)]) in the final graph type. For the first +step, however, it will be expanded to +@tc[(U (grr #:placeholder m-streets/node) (Listof Street))]. +Without this, passing the result of @tc[(m-streets s)] to +@tc[City] would be impossible: the former is a placeholder +for the temporary node type which encapsulates the result +of @tc[m-streets], while the latter would normally expect a +plain list. + +@chunk[ + (define-syntax/parse + (define-temp-ids "first-step" name) + (define-temp-ids "~a/simple-mapping" (node …)) + (define-temp-ids "~a/node" (mapping …)) + (template + (debug + (begin + + (define-graph first-step + [node [field c field-type] … + [(node/simple-mapping [field c field-type] …);] …) + (node field …)]] … + [mapping/node [returned cm result-type] + [(mapping [param cp param-type] …) + (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[ + (define-type-expander (~> stx) + (syntax-case stx () + [(_ mapping) #'(U mapping/node result-type)] …))] + +@; TODO: replace-in-type doesn't work well here, we need to define a +@; type-expander. +@chunk[ + (tmpl-replace-in-type field-type + [(~> mapping) (U mapping/node result-type)] …)] + +@section{Conclusion} + +@chunk[ + (module main typed/racket + (require (for-syntax syntax/parse + syntax/parse/experimental/template + racket/syntax + syntax/stx + "../lib/low-untyped.rkt" + "../lib/low/multiassoc-syntax.rkt") + "../lib/low.rkt" + "graph.lp2.rkt" + "get.lp2.rkt" + "../type-expander/type-expander.lp2.rkt" + "../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 + ) + (provide define-graph/rich-return) + + (require (for-syntax racket/pretty)) + (define-syntax (debug stx) + (syntax-case stx () + [(_ body) + ;; syntax->string + (pretty-print (syntax->datum #'body)) + #'body])) + + + + + + #;(begin + (define-type-expander + (~> stx) + (syntax-case stx () + ((_ m-cities) #'(U m-cities3/node (Listof City))) + ((_ m-streets) #'(U m-streets4/node (Listof Street))))) + (define-graph + first-step #:debug + (City + (streets : (U m-streets4/node (Listof Street))) + ((City1/simple-mapping (streets : (U (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))))) + (City streets))) + (Street + (sname : 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))) + : + (first-step #:placeholder City) + (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))))))) + + + + + + + + + + + + + + + + + + + + + + + +(begin + (define-multi-id + first-step + #:type-expander + (λ (stx) + (syntax-parse + stx + ((_ (~datum City)) #'City58/with-promises-type) + ((_ (~datum Street)) #'Street59/with-promises-type) + ((_ (~datum m-cities3/node)) #'m-cities3/node60/with-promises-type) + ((_ (~datum m-streets4/node)) #'m-streets4/node61/with-promises-type) + ((_ #:incomplete (~datum City)) #'City22/incomplete-type) + ((_ #:incomplete (~datum Street)) #'Street23/incomplete-type) + ((_ #:incomplete (~datum m-cities3/node)) + #'m-cities3/node24/incomplete-type) + ((_ #:incomplete (~datum m-streets4/node)) + #'m-streets4/node25/incomplete-type) + ((_ #:make-incomplete (~datum City)) + #'(→ + (U + m-streets4/node17/placeholder-type + (Listof Street15/placeholder-type)) + City22/incomplete-type)) + ((_ #:make-incomplete (~datum Street)) + #'(→ String Street23/incomplete-type)) + ((_ #:make-incomplete (~datum m-cities3/node)) + #'(→ (Listof City14/placeholder-type) m-cities3/node24/incomplete-type)) + ((_ #:make-incomplete (~datum m-streets4/node)) + #'(→ + (Listof Street15/placeholder-type) + m-streets4/node25/incomplete-type)) + ((_ #:incomplete (~datum City) fld) + (syntax-parse + #'fld + ((~datum streets) + #'(U + m-streets4/node17/placeholder-type + (Listof Street15/placeholder-type))))) + ((_ #:incomplete (~datum Street) fld) + (syntax-parse #'fld ((~datum sname) #'String))) + ((_ #:incomplete (~datum m-cities3/node) fld) + (syntax-parse + #'fld + ((~datum returned) #'(Listof City14/placeholder-type)))) + ((_ #:incomplete (~datum m-streets4/node) fld) + (syntax-parse + #'fld + ((~datum returned) #'(Listof Street15/placeholder-type)))) + ((_ #:make-placeholder (~datum City)) + #'(→ + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))) + City14/placeholder-type)) + ((_ #:make-placeholder (~datum Street)) + #'(→ String Street15/placeholder-type)) + ((_ #:make-placeholder (~datum m-cities3/node)) + #'(→ (Listof (Listof String)) m-cities3/node16/placeholder-type)) + ((_ #:make-placeholder (~datum m-streets4/node)) + #'(→ (Listof String) m-streets4/node17/placeholder-type)) + ((_ #:placeholder (~datum City)) #'City14/placeholder-type) + ((_ #:placeholder (~datum Street)) #'Street15/placeholder-type) + ((_ #:placeholder (~datum m-cities3/node)) + #'m-cities3/node16/placeholder-type) + ((_ #:placeholder (~datum m-streets4/node)) + #'m-streets4/node17/placeholder-type))) + #:call + (λ (stx) + (syntax-parse + stx + ((_ #:λroot (~datum City)) #'City2/constructor) + ((_ #:λroot (~datum Street)) #'Street3/constructor) + ((_ #:λroot (~datum m-cities3/node)) #'m-cities3/node4/constructor) + ((_ #:λroot (~datum m-streets4/node)) #'m-streets4/node5/constructor) + ((_ #:root (~datum City) . rest) + (syntax/loc stx (City2/constructor . rest))) + ((_ #:root (~datum Street) . rest) + (syntax/loc stx (Street3/constructor . rest))) + ((_ #:root (~datum m-cities3/node) . rest) + (syntax/loc stx (m-cities3/node4/constructor . rest))) + ((_ #:root (~datum m-streets4/node) . rest) + (syntax/loc stx (m-streets4/node5/constructor . rest))) + ((_ . rest) (syntax/loc stx (City2/constructor . rest))))) + #:id + (λ (stx) #'City2/constructor)) + (begin + (struct (A) City10/placeholder-struct ((f : A))) + (define-type + City14/placeholder-type + (City10/placeholder-struct + (List + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))))))) + (begin + (struct (A) Street11/placeholder-struct ((f : A))) + (define-type + Street15/placeholder-type + (Street11/placeholder-struct (List String)))) + (begin + (struct (A) m-cities3/node12/placeholder-struct ((f : A))) + (define-type + m-cities3/node16/placeholder-type + (m-cities3/node12/placeholder-struct (List (Listof (Listof String)))))) + (begin + (struct (A) m-streets4/node13/placeholder-struct ((f : A))) + (define-type + m-streets4/node17/placeholder-type + (m-streets4/node13/placeholder-struct (List (Listof String))))) + (begin + (: + City6/make-placeholder + (→ + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))) + City14/placeholder-type)) + (define (City6/make-placeholder streets) + ((inst + City10/placeholder-struct + (List + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))))) + (list streets)))) + (begin + (: Street7/make-placeholder (→ String Street15/placeholder-type)) + (define (Street7/make-placeholder sname) + ((inst Street11/placeholder-struct (List String)) (list sname)))) + (begin + (: + m-cities3/node8/make-placeholder + (→ (Listof (Listof String)) m-cities3/node16/placeholder-type)) + (define (m-cities3/node8/make-placeholder cnames) + ((inst + m-cities3/node12/placeholder-struct + (List (Listof (Listof String)))) + (list cnames)))) + (begin + (: + m-streets4/node9/make-placeholder + (→ (Listof String) m-streets4/node17/placeholder-type)) + (define (m-streets4/node9/make-placeholder snames) + ((inst m-streets4/node13/placeholder-struct (List (Listof String))) + (list snames)))) + (begin + (define-type City50/index-type (List 'City46/with-indices-tag2 Index)) + (define-type + City34/with-indices-type + (List + 'City42/with-indices-tag + (U m-streets4/node53/index-type (Listof Street51/index-type)))) + (: + City38/make-with-indices + (→ + (U m-streets4/node53/index-type (Listof Street51/index-type)) + City34/with-indices-type)) + (define (City38/make-with-indices streets) + (list 'City42/with-indices-tag streets))) + (begin + (define-type Street51/index-type (List 'Street47/with-indices-tag2 Index)) + (define-type + Street35/with-indices-type + (List 'Street43/with-indices-tag String)) + (: Street39/make-with-indices (→ String Street35/with-indices-type)) + (define (Street39/make-with-indices sname) + (list 'Street43/with-indices-tag sname))) + (begin + (define-type + m-cities3/node52/index-type + (List 'm-cities3/node48/with-indices-tag2 Index)) + (define-type + m-cities3/node36/with-indices-type + (List 'm-cities3/node44/with-indices-tag (Listof City50/index-type))) + (: + m-cities3/node40/make-with-indices + (→ (Listof City50/index-type) m-cities3/node36/with-indices-type)) + (define (m-cities3/node40/make-with-indices returned) + (list 'm-cities3/node44/with-indices-tag returned))) + (begin + (define-type + m-streets4/node53/index-type + (List 'm-streets4/node49/with-indices-tag2 Index)) + (define-type + m-streets4/node37/with-indices-type + (List 'm-streets4/node45/with-indices-tag (Listof Street51/index-type))) + (: + m-streets4/node41/make-with-indices + (→ (Listof Street51/index-type) m-streets4/node37/with-indices-type)) + (define (m-streets4/node41/make-with-indices returned) + (list 'm-streets4/node45/with-indices-tag returned))) + (begin + (define-type + City58/with-promises-type + (tagged + City66/with-promises-tag + (streets + : + (U + (Promise m-streets4/node61/with-promises-type) + (Listof (Promise Street59/with-promises-type)))))) + (: + City62/make-with-promises + (→ + (U + (Promise m-streets4/node61/with-promises-type) + (Listof (Promise Street59/with-promises-type))) + City58/with-promises-type)) + (define (City62/make-with-promises streets78/value) + (tagged + City66/with-promises-tag + (streets + : + (U + (Promise m-streets4/node61/with-promises-type) + (Listof (Promise Street59/with-promises-type))) + streets78/value)))) + (begin + (define-type + Street59/with-promises-type + (tagged Street67/with-promises-tag (sname : String))) + (: Street63/make-with-promises (→ String Street59/with-promises-type)) + (define (Street63/make-with-promises sname79/value) + (tagged Street67/with-promises-tag (sname : String sname79/value)))) + (begin + (define-type + m-cities3/node60/with-promises-type + (tagged + m-cities3/node68/with-promises-tag + (returned : (Listof (Promise City58/with-promises-type))))) + (: + m-cities3/node64/make-with-promises + (→ + (Listof (Promise City58/with-promises-type)) + m-cities3/node60/with-promises-type)) + (define (m-cities3/node64/make-with-promises returned80/value) + (tagged + m-cities3/node68/with-promises-tag + (returned + : + (Listof (Promise City58/with-promises-type)) + returned80/value)))) + (begin + (define-type + m-streets4/node61/with-promises-type + (tagged + m-streets4/node69/with-promises-tag + (returned : (Listof (Promise Street59/with-promises-type))))) + (: + m-streets4/node65/make-with-promises + (→ + (Listof (Promise Street59/with-promises-type)) + m-streets4/node61/with-promises-type)) + (define (m-streets4/node65/make-with-promises returned81/value) + (tagged + m-streets4/node69/with-promises-tag + (returned + : + (Listof (Promise Street59/with-promises-type)) + returned81/value)))) + (begin + (define-type + City22/incomplete-type + (List + 'City30/incomplete-tag + (U + m-streets4/node17/placeholder-type + (Listof Street15/placeholder-type)))) + (: + City26/make-incomplete + (→ + (U m-streets4/node17/placeholder-type (Listof Street15/placeholder-type)) + City22/incomplete-type)) + (define (City26/make-incomplete streets) + (list 'City30/incomplete-tag streets))) + (begin + (define-type + Street23/incomplete-type + (List 'Street31/incomplete-tag String)) + (: Street27/make-incomplete (→ String Street23/incomplete-type)) + (define (Street27/make-incomplete sname) + (list 'Street31/incomplete-tag sname))) + (begin + (define-type + m-cities3/node24/incomplete-type + (List 'm-cities3/node32/incomplete-tag (Listof City14/placeholder-type))) + (: + m-cities3/node28/make-incomplete + (→ (Listof City14/placeholder-type) m-cities3/node24/incomplete-type)) + (define (m-cities3/node28/make-incomplete returned) + (list 'm-cities3/node32/incomplete-tag returned))) + (begin + (define-type + m-streets4/node25/incomplete-type + (List + 'm-streets4/node33/incomplete-tag + (Listof Street15/placeholder-type))) + (: + m-streets4/node29/make-incomplete + (→ (Listof Street15/placeholder-type) m-streets4/node25/incomplete-type)) + (define (m-streets4/node29/make-incomplete returned) + (list 'm-streets4/node33/incomplete-tag returned))) + (begin + (: + City70/mapping-function + (→ + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))) + City22/incomplete-type)) + (define City70/mapping-function + (let ((City1/simple-mapping City6/make-placeholder) + (Street2/simple-mapping Street7/make-placeholder) + (m-cities m-cities3/node8/make-placeholder) + (m-streets m-streets4/node9/make-placeholder) + (City City26/make-incomplete) + (Street Street27/make-incomplete) + (m-cities3/node m-cities3/node28/make-incomplete) + (m-streets4/node m-streets4/node29/make-incomplete)) + (λ ((streets + : + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))))) + : + City22/incomplete-type + (City streets))))) + (begin + (: Street71/mapping-function (→ String Street23/incomplete-type)) + (define Street71/mapping-function + (let ((City1/simple-mapping City6/make-placeholder) + (Street2/simple-mapping Street7/make-placeholder) + (m-cities m-cities3/node8/make-placeholder) + (m-streets m-streets4/node9/make-placeholder) + (City City26/make-incomplete) + (Street Street27/make-incomplete) + (m-cities3/node m-cities3/node28/make-incomplete) + (m-streets4/node m-streets4/node29/make-incomplete)) + (λ ((sname : String)) : Street23/incomplete-type (Street sname))))) + (begin + (: + m-cities3/node72/mapping-function + (→ (Listof (Listof String)) m-cities3/node24/incomplete-type)) + (define m-cities3/node72/mapping-function + (let ((City1/simple-mapping City6/make-placeholder) + (Street2/simple-mapping Street7/make-placeholder) + (m-cities m-cities3/node8/make-placeholder) + (m-streets m-streets4/node9/make-placeholder) + (City City26/make-incomplete) + (Street Street27/make-incomplete) + (m-cities3/node m-cities3/node28/make-incomplete) + (m-streets4/node m-streets4/node29/make-incomplete)) + (λ ((cnames : (Listof (Listof String)))) + : + m-cities3/node24/incomplete-type + (m-cities3/node + (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) + (define (strings→city (s : (Listof String))) + : + (first-step #:placeholder City) + (City (m-streets s))) + (map strings→city cnames))))))) + (begin + (: + m-streets4/node73/mapping-function + (→ (Listof String) m-streets4/node25/incomplete-type)) + (define m-streets4/node73/mapping-function + (let ((City1/simple-mapping City6/make-placeholder) + (Street2/simple-mapping Street7/make-placeholder) + (m-cities m-cities3/node8/make-placeholder) + (m-streets m-streets4/node9/make-placeholder) + (City City26/make-incomplete) + (Street Street27/make-incomplete) + (m-cities3/node m-cities3/node28/make-incomplete) + (m-streets4/node m-streets4/node29/make-incomplete)) + (λ ((snames : (Listof String))) + : + m-streets4/node25/incomplete-type + (m-streets4/node + (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) + (map Street snames))))))) + (: + fq + (case→ + (→ + 'City18/placeholder-queue + City14/placeholder-type + (List + (Vectorof City34/with-indices-type) + (Vectorof Street35/with-indices-type) + (Vectorof m-cities3/node36/with-indices-type) + (Vectorof m-streets4/node37/with-indices-type))) + (→ + 'Street19/placeholder-queue + Street15/placeholder-type + (List + (Vectorof City34/with-indices-type) + (Vectorof Street35/with-indices-type) + (Vectorof m-cities3/node36/with-indices-type) + (Vectorof m-streets4/node37/with-indices-type))) + (→ + 'm-cities3/node20/placeholder-queue + m-cities3/node16/placeholder-type + (List + (Vectorof City34/with-indices-type) + (Vectorof Street35/with-indices-type) + (Vectorof m-cities3/node36/with-indices-type) + (Vectorof m-streets4/node37/with-indices-type))) + (→ + 'm-streets4/node21/placeholder-queue + m-streets4/node17/placeholder-type + (List + (Vectorof City34/with-indices-type) + (Vectorof Street35/with-indices-type) + (Vectorof m-cities3/node36/with-indices-type) + (Vectorof m-streets4/node37/with-indices-type))))) + (define (fq queue-name placeholder) + (fold-queues + #:root + queue-name + placeholder + ((City18/placeholder-queue + (e : City14/placeholder-type) + (Δ-queues : Δ-Queues) + enqueue) + : + City34/with-indices-type + (let ((mapping-result + (apply + City70/mapping-function + ((struct-accessor City10/placeholder-struct 0) e))) + (f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List + (U + m-streets4/node17/placeholder-type + (Listof Street15/placeholder-type))) + Δ-Queues + (City14/placeholder-type + (List 'City46/with-indices-tag2 Index) + (struct-predicate City10/placeholder-struct) + λ…) + (Street15/placeholder-type + (List 'Street47/with-indices-tag2 Index) + (struct-predicate Street11/placeholder-struct) + λ…) + (m-cities3/node16/placeholder-type + (List 'm-cities3/node48/with-indices-tag2 Index) + (struct-predicate m-cities3/node12/placeholder-struct) + λ…) + (m-streets4/node17/placeholder-type + (List 'm-streets4/node49/with-indices-tag2 Index) + (struct-predicate m-streets4/node13/placeholder-struct) + λ…)) + (λ ((val + : + (List + (U + m-streets4/node17/placeholder-type + (Listof Street15/placeholder-type)))) + (acc : Δ-Queues)) + : + (values + (List + (U + (List 'm-streets4/node49/with-indices-tag2 Index) + (Listof (List 'Street47/with-indices-tag2 Index)))) + Δ-Queues) + (let*-values (((temp83) (apply values val)) + ((temp84 temp85) + ((λ ((val + : + (U + m-streets4/node17/placeholder-type + (Listof Street15/placeholder-type))) + (acc : Δ-Queues)) + : + (values + (U + (List + 'm-streets4/node49/with-indices-tag2 + Index) + (Listof + (List + 'Street47/with-indices-tag2 + Index))) + Δ-Queues) + (cond + (((struct-predicate + m-streets4/node13/placeholder-struct) + val) + ((ann + (λ ((p + : + m-streets4/node17/placeholder-type) + (Δ-acc : Δ-Queues)) + : + (values + (List + 'm-streets4/node49/with-indices-tag2 + Index) + Δ-Queues) + (% + index + new-Δ-acc + = + (enqueue + 'm-streets4/node21/placeholder-queue + p + Δ-acc) + (values + (list + 'm-streets4/node49/with-indices-tag2 + index) + new-Δ-acc))) + (→ + m-streets4/node17/placeholder-type + Δ-Queues + (values + (List + 'm-streets4/node49/with-indices-tag2 + Index) + Δ-Queues))) + val + acc)) + (#t + ((λ ((val + : + (Listof Street15/placeholder-type)) + (acc : Δ-Queues)) + : + (values + (Listof + (List + 'Street47/with-indices-tag2 + Index)) + Δ-Queues) + (let ((f + ((inst + foldl + Street15/placeholder-type + (Pairof + (Listof + (List + 'Street47/with-indices-tag2 + Index)) + Δ-Queues) + Nothing + Nothing) + (λ ((x + : + Street15/placeholder-type) + (acc1 + : + (Pairof + (Listof + (List + 'Street47/with-indices-tag2 + Index)) + Δ-Queues))) + (let-values (((res res-acc) + ((ann + (λ ((p + : + Street15/placeholder-type) + (Δ-acc + : + Δ-Queues)) + : + (values + (List + 'Street47/with-indices-tag2 + Index) + Δ-Queues) + (% + index + new-Δ-acc + = + (enqueue + 'Street19/placeholder-queue + p + Δ-acc) + (values + (list + 'Street47/with-indices-tag2 + index) + new-Δ-acc))) + (→ + Street15/placeholder-type + Δ-Queues + (values + (List + 'Street47/with-indices-tag2 + Index) + Δ-Queues))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + val + acc)) + (else + (typecheck-fail + (U + m-streets4/node17/placeholder-type + (Listof Street15/placeholder-type)) + "Unhandled union case in (U m-streets4/node17/placeholder-type (Listof Street15/placeholder-type)), whole type was:(List (U m-streets4/node17/placeholder-type (Listof Street15/placeholder-type)))")))) + temp83 + acc))) + (values (list temp84) temp85)))))) + (let-values (((r new-Δ-queues) (f (cdr mapping-result) Δ-queues))) + (values (apply City38/make-with-indices r) new-Δ-queues)))) + ((Street19/placeholder-queue + (e : Street15/placeholder-type) + (Δ-queues : Δ-Queues) + enqueue) + : + Street35/with-indices-type + (let ((mapping-result + (apply + Street71/mapping-function + ((struct-accessor Street11/placeholder-struct 0) e))) + (f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List String) + Δ-Queues + (City14/placeholder-type + (List 'City46/with-indices-tag2 Index) + (struct-predicate City10/placeholder-struct) + λ…) + (Street15/placeholder-type + (List 'Street47/with-indices-tag2 Index) + (struct-predicate Street11/placeholder-struct) + λ…) + (m-cities3/node16/placeholder-type + (List 'm-cities3/node48/with-indices-tag2 Index) + (struct-predicate m-cities3/node12/placeholder-struct) + λ…) + (m-streets4/node17/placeholder-type + (List 'm-streets4/node49/with-indices-tag2 Index) + (struct-predicate m-streets4/node13/placeholder-struct) + λ…)) + (λ ((val : (List String)) (acc : Δ-Queues)) + : + (values (List String) Δ-Queues) + (let*-values (((String93) (apply values val)) + ((String94 String95) + ((inst values String Δ-Queues) String93 acc))) + (values (list String94) String95)))))) + (let-values (((r new-Δ-queues) (f (cdr mapping-result) Δ-queues))) + (values (apply Street39/make-with-indices r) new-Δ-queues)))) + ((m-cities3/node20/placeholder-queue + (e : m-cities3/node16/placeholder-type) + (Δ-queues : Δ-Queues) + enqueue) + : + m-cities3/node36/with-indices-type + (let ((mapping-result + (apply + m-cities3/node72/mapping-function + ((struct-accessor m-cities3/node12/placeholder-struct 0) e))) + (f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof City14/placeholder-type)) + Δ-Queues + (City14/placeholder-type + (List 'City46/with-indices-tag2 Index) + (struct-predicate City10/placeholder-struct) + λ…) + (Street15/placeholder-type + (List 'Street47/with-indices-tag2 Index) + (struct-predicate Street11/placeholder-struct) + λ…) + (m-cities3/node16/placeholder-type + (List 'm-cities3/node48/with-indices-tag2 Index) + (struct-predicate m-cities3/node12/placeholder-struct) + λ…) + (m-streets4/node17/placeholder-type + (List 'm-streets4/node49/with-indices-tag2 Index) + (struct-predicate m-streets4/node13/placeholder-struct) + λ…)) + (λ ((val : (List (Listof City14/placeholder-type))) + (acc : Δ-Queues)) + : + (values + (List (Listof (List 'City46/with-indices-tag2 Index))) + Δ-Queues) + (let*-values (((temp98) (apply values val)) + ((temp99 temp100) + ((λ ((val : (Listof City14/placeholder-type)) + (acc : Δ-Queues)) + : + (values + (Listof + (List 'City46/with-indices-tag2 Index)) + Δ-Queues) + (let ((f + ((inst + foldl + City14/placeholder-type + (Pairof + (Listof + (List + 'City46/with-indices-tag2 + Index)) + Δ-Queues) + Nothing + Nothing) + (λ ((x : City14/placeholder-type) + (acc1 + : + (Pairof + (Listof + (List + 'City46/with-indices-tag2 + Index)) + Δ-Queues))) + (let-values (((res res-acc) + ((ann + (λ ((p + : + City14/placeholder-type) + (Δ-acc + : + Δ-Queues)) + : + (values + (List + 'City46/with-indices-tag2 + Index) + Δ-Queues) + (% + index + new-Δ-acc + = + (enqueue + 'City18/placeholder-queue + p + Δ-acc) + (values + (list + 'City46/with-indices-tag2 + index) + new-Δ-acc))) + (→ + City14/placeholder-type + Δ-Queues + (values + (List + 'City46/with-indices-tag2 + Index) + Δ-Queues))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp98 + acc))) + (values (list temp99) temp100)))))) + (let-values (((r new-Δ-queues) (f (cdr mapping-result) Δ-queues))) + (values (apply m-cities3/node40/make-with-indices r) new-Δ-queues)))) + ((m-streets4/node21/placeholder-queue + (e : m-streets4/node17/placeholder-type) + (Δ-queues : Δ-Queues) + enqueue) + : + m-streets4/node37/with-indices-type + (let ((mapping-result + (apply + m-streets4/node73/mapping-function + ((struct-accessor m-streets4/node13/placeholder-struct 0) e))) + (f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof Street15/placeholder-type)) + Δ-Queues + (City14/placeholder-type + (List 'City46/with-indices-tag2 Index) + (struct-predicate City10/placeholder-struct) + λ…) + (Street15/placeholder-type + (List 'Street47/with-indices-tag2 Index) + (struct-predicate Street11/placeholder-struct) + λ…) + (m-cities3/node16/placeholder-type + (List 'm-cities3/node48/with-indices-tag2 Index) + (struct-predicate m-cities3/node12/placeholder-struct) + λ…) + (m-streets4/node17/placeholder-type + (List 'm-streets4/node49/with-indices-tag2 Index) + (struct-predicate m-streets4/node13/placeholder-struct) + λ…)) + (λ ((val : (List (Listof Street15/placeholder-type))) + (acc : Δ-Queues)) + : + (values + (List (Listof (List 'Street47/with-indices-tag2 Index))) + Δ-Queues) + (let*-values (((temp105) (apply values val)) + ((temp106 temp107) + ((λ ((val : (Listof Street15/placeholder-type)) + (acc : Δ-Queues)) + : + (values + (Listof + (List 'Street47/with-indices-tag2 Index)) + Δ-Queues) + (let ((f + ((inst + foldl + Street15/placeholder-type + (Pairof + (Listof + (List + 'Street47/with-indices-tag2 + Index)) + Δ-Queues) + Nothing + Nothing) + (λ ((x : Street15/placeholder-type) + (acc1 + : + (Pairof + (Listof + (List + 'Street47/with-indices-tag2 + Index)) + Δ-Queues))) + (let-values (((res res-acc) + ((ann + (λ ((p + : + Street15/placeholder-type) + (Δ-acc + : + Δ-Queues)) + : + (values + (List + 'Street47/with-indices-tag2 + Index) + Δ-Queues) + (% + index + new-Δ-acc + = + (enqueue + 'Street19/placeholder-queue + p + Δ-acc) + (values + (list + 'Street47/with-indices-tag2 + index) + new-Δ-acc))) + (→ + Street15/placeholder-type + Δ-Queues + (values + (List + 'Street47/with-indices-tag2 + Index) + Δ-Queues))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp105 + acc))) + (values (list temp106) temp107)))))) + (let-values (((r new-Δ-queues) (f (cdr mapping-result) Δ-queues))) + (values + (apply m-streets4/node41/make-with-indices r) + new-Δ-queues)))))) + (begin + (: + City2/constructor + (→ + (U + (first-step #:placeholder m-streets4/node) + (Listof (first-step #:placeholder Street))) + (Promise City58/with-promises-type))) + (define (City2/constructor streets) + (match-let + (((list + City74/database + Street75/database + m-cities3/node76/database + m-streets4/node77/database) + (fq 'City18/placeholder-queue (City6/make-placeholder streets)))) + (begin + (: + City54/with-indices→with-promises + (→ City34/with-indices-type City58/with-promises-type)) + (define (City54/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val + : + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type)))) + (acc : Void)) + : + (values + (List + (U + (Promise m-streets4/node61/with-promises-type) + (Listof (Promise Street59/with-promises-type)))) + Void) + (let*-values (((temp112) (apply values val)) + ((temp113 temp114) + ((λ ((val + : + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + (acc : Void)) + : + (values + (U + (Promise + m-streets4/node61/with-promises-type) + (Listof + (Promise Street59/with-promises-type))) + Void) + (cond + (((λ (x) + (and (pair? x) + (eq? + (car x) + 'm-streets4/node49/with-indices-tag2))) + val) + ((ann + (λ ((tagged-index + : + m-streets4/node53/index-type) + (acc : Void)) + : + (values + (Promise + m-streets4/node61/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + m-streets4/node77/database + (cadr tagged-index)))) + (delay + (m-streets4/node57/with-indices→with-promises + successor-with-index))) + acc)) + (→ + m-streets4/node53/index-type + Void + (values + (Promise + m-streets4/node61/with-promises-type) + Void))) + val + acc)) + (#t + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise + Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc + : + Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + 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 + (U + m-streets4/node53/index-type + (Listof Street51/index-type)) + "Unhandled union case in (U m-streets4/node53/index-type (Listof Street51/index-type)), whole type was:(List (U m-streets4/node53/index-type (Listof Street51/index-type)))")))) + temp112 + acc))) + (values (list temp113) temp114))))) + (apply City62/make-with-promises (first-value (f (cdr n) (void)))))) + (begin + (: + Street55/with-indices→with-promises + (→ Street35/with-indices-type Street59/with-promises-type)) + (define (Street55/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List String) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List String)) (acc : Void)) + : + (values (List String) Void) + (let*-values (((String122) (apply values val)) + ((String123 String124) + ((inst values String Void) String122 acc))) + (values (list String123) String124))))) + (apply + Street63/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-cities3/node56/with-indices→with-promises + (→ + m-cities3/node36/with-indices-type + m-cities3/node60/with-promises-type)) + (define (m-cities3/node56/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof City50/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof City50/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise City58/with-promises-type))) + Void) + (let*-values (((temp127) (apply values val)) + ((temp128 temp129) + ((λ ((val : (Listof City50/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise City58/with-promises-type)) + Void) + (let ((f + ((inst + foldl + City50/index-type + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : City50/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + City50/index-type) + (acc : Void)) + : + (values + (Promise + City58/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + City74/database + (cadr + tagged-index)))) + (delay + (City54/with-indices→with-promises + successor-with-index))) + acc)) + (→ + City50/index-type + Void + (values + (Promise + City58/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp127 + acc))) + (values (list temp128) temp129))))) + (apply + m-cities3/node64/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-streets4/node57/with-indices→with-promises + (→ + m-streets4/node37/with-indices-type + m-streets4/node61/with-promises-type)) + (define (m-streets4/node57/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof Street51/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof Street51/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise Street59/with-promises-type))) + Void) + (let*-values (((temp134) (apply values val)) + ((temp135 temp136) + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc : Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp134 + acc))) + (values (list temp135) temp136))))) + (apply + m-streets4/node65/make-with-promises + (first-value (f (cdr n) (void)))))) + (delay + (City54/with-indices→with-promises (vector-ref City74/database 0)))))) + (begin + (: Street3/constructor (→ String (Promise Street59/with-promises-type))) + (define (Street3/constructor sname) + (match-let + (((list + City74/database + Street75/database + m-cities3/node76/database + m-streets4/node77/database) + (fq 'Street19/placeholder-queue (Street7/make-placeholder sname)))) + (begin + (: + City54/with-indices→with-promises + (→ City34/with-indices-type City58/with-promises-type)) + (define (City54/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val + : + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type)))) + (acc : Void)) + : + (values + (List + (U + (Promise m-streets4/node61/with-promises-type) + (Listof (Promise Street59/with-promises-type)))) + Void) + (let*-values (((temp141) (apply values val)) + ((temp142 temp143) + ((λ ((val + : + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + (acc : Void)) + : + (values + (U + (Promise + m-streets4/node61/with-promises-type) + (Listof + (Promise Street59/with-promises-type))) + Void) + (cond + (((λ (x) + (and (pair? x) + (eq? + (car x) + 'm-streets4/node49/with-indices-tag2))) + val) + ((ann + (λ ((tagged-index + : + m-streets4/node53/index-type) + (acc : Void)) + : + (values + (Promise + m-streets4/node61/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + m-streets4/node77/database + (cadr tagged-index)))) + (delay + (m-streets4/node57/with-indices→with-promises + successor-with-index))) + acc)) + (→ + m-streets4/node53/index-type + Void + (values + (Promise + m-streets4/node61/with-promises-type) + Void))) + val + acc)) + (#t + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise + Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc + : + Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + 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 + (U + m-streets4/node53/index-type + (Listof Street51/index-type)) + "Unhandled union case in (U m-streets4/node53/index-type (Listof Street51/index-type)), whole type was:(List (U m-streets4/node53/index-type (Listof Street51/index-type)))")))) + temp141 + acc))) + (values (list temp142) temp143))))) + (apply City62/make-with-promises (first-value (f (cdr n) (void)))))) + (begin + (: + Street55/with-indices→with-promises + (→ Street35/with-indices-type Street59/with-promises-type)) + (define (Street55/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List String) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List String)) (acc : Void)) + : + (values (List String) Void) + (let*-values (((String151) (apply values val)) + ((String152 String153) + ((inst values String Void) String151 acc))) + (values (list String152) String153))))) + (apply + Street63/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-cities3/node56/with-indices→with-promises + (→ + m-cities3/node36/with-indices-type + m-cities3/node60/with-promises-type)) + (define (m-cities3/node56/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof City50/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof City50/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise City58/with-promises-type))) + Void) + (let*-values (((temp156) (apply values val)) + ((temp157 temp158) + ((λ ((val : (Listof City50/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise City58/with-promises-type)) + Void) + (let ((f + ((inst + foldl + City50/index-type + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : City50/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + City50/index-type) + (acc : Void)) + : + (values + (Promise + City58/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + City74/database + (cadr + tagged-index)))) + (delay + (City54/with-indices→with-promises + successor-with-index))) + acc)) + (→ + City50/index-type + Void + (values + (Promise + City58/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp156 + acc))) + (values (list temp157) temp158))))) + (apply + m-cities3/node64/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-streets4/node57/with-indices→with-promises + (→ + m-streets4/node37/with-indices-type + m-streets4/node61/with-promises-type)) + (define (m-streets4/node57/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof Street51/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof Street51/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise Street59/with-promises-type))) + Void) + (let*-values (((temp163) (apply values val)) + ((temp164 temp165) + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc : Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp163 + acc))) + (values (list temp164) temp165))))) + (apply + m-streets4/node65/make-with-promises + (first-value (f (cdr n) (void)))))) + (delay + (Street55/with-indices→with-promises + (vector-ref Street75/database 0)))))) + (begin + (: + m-cities3/node4/constructor + (→ + (Listof (Listof String)) + (Promise m-cities3/node60/with-promises-type))) + (define (m-cities3/node4/constructor cnames) + (match-let + (((list + City74/database + Street75/database + m-cities3/node76/database + m-streets4/node77/database) + (fq + 'm-cities3/node20/placeholder-queue + (m-cities3/node8/make-placeholder cnames)))) + (begin + (: + City54/with-indices→with-promises + (→ City34/with-indices-type City58/with-promises-type)) + (define (City54/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val + : + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type)))) + (acc : Void)) + : + (values + (List + (U + (Promise m-streets4/node61/with-promises-type) + (Listof (Promise Street59/with-promises-type)))) + Void) + (let*-values (((temp170) (apply values val)) + ((temp171 temp172) + ((λ ((val + : + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + (acc : Void)) + : + (values + (U + (Promise + m-streets4/node61/with-promises-type) + (Listof + (Promise Street59/with-promises-type))) + Void) + (cond + (((λ (x) + (and (pair? x) + (eq? + (car x) + 'm-streets4/node49/with-indices-tag2))) + val) + ((ann + (λ ((tagged-index + : + m-streets4/node53/index-type) + (acc : Void)) + : + (values + (Promise + m-streets4/node61/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + m-streets4/node77/database + (cadr tagged-index)))) + (delay + (m-streets4/node57/with-indices→with-promises + successor-with-index))) + acc)) + (→ + m-streets4/node53/index-type + Void + (values + (Promise + m-streets4/node61/with-promises-type) + Void))) + val + acc)) + (#t + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise + Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc + : + Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + 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 + (U + m-streets4/node53/index-type + (Listof Street51/index-type)) + "Unhandled union case in (U m-streets4/node53/index-type (Listof Street51/index-type)), whole type was:(List (U m-streets4/node53/index-type (Listof Street51/index-type)))")))) + temp170 + acc))) + (values (list temp171) temp172))))) + (apply City62/make-with-promises (first-value (f (cdr n) (void)))))) + (begin + (: + Street55/with-indices→with-promises + (→ Street35/with-indices-type Street59/with-promises-type)) + (define (Street55/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List String) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List String)) (acc : Void)) + : + (values (List String) Void) + (let*-values (((String180) (apply values val)) + ((String181 String182) + ((inst values String Void) String180 acc))) + (values (list String181) String182))))) + (apply + Street63/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-cities3/node56/with-indices→with-promises + (→ + m-cities3/node36/with-indices-type + m-cities3/node60/with-promises-type)) + (define (m-cities3/node56/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof City50/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof City50/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise City58/with-promises-type))) + Void) + (let*-values (((temp185) (apply values val)) + ((temp186 temp187) + ((λ ((val : (Listof City50/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise City58/with-promises-type)) + Void) + (let ((f + ((inst + foldl + City50/index-type + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : City50/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + City50/index-type) + (acc : Void)) + : + (values + (Promise + City58/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + City74/database + (cadr + tagged-index)))) + (delay + (City54/with-indices→with-promises + successor-with-index))) + acc)) + (→ + City50/index-type + Void + (values + (Promise + City58/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp185 + acc))) + (values (list temp186) temp187))))) + (apply + m-cities3/node64/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-streets4/node57/with-indices→with-promises + (→ + m-streets4/node37/with-indices-type + m-streets4/node61/with-promises-type)) + (define (m-streets4/node57/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof Street51/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof Street51/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise Street59/with-promises-type))) + Void) + (let*-values (((temp192) (apply values val)) + ((temp193 temp194) + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc : Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp192 + acc))) + (values (list temp193) temp194))))) + (apply + m-streets4/node65/make-with-promises + (first-value (f (cdr n) (void)))))) + (delay + (m-cities3/node56/with-indices→with-promises + (vector-ref m-cities3/node76/database 0)))))) + (begin + (: + m-streets4/node5/constructor + (→ (Listof String) (Promise m-streets4/node61/with-promises-type))) + (define (m-streets4/node5/constructor snames) + (match-let + (((list + City74/database + Street75/database + m-cities3/node76/database + m-streets4/node77/database) + (fq + 'm-streets4/node21/placeholder-queue + (m-streets4/node9/make-placeholder snames)))) + (begin + (: + City54/with-indices→with-promises + (→ City34/with-indices-type City58/with-promises-type)) + (define (City54/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val + : + (List + (U + m-streets4/node53/index-type + (Listof Street51/index-type)))) + (acc : Void)) + : + (values + (List + (U + (Promise m-streets4/node61/with-promises-type) + (Listof (Promise Street59/with-promises-type)))) + Void) + (let*-values (((temp199) (apply values val)) + ((temp200 temp201) + ((λ ((val + : + (U + m-streets4/node53/index-type + (Listof Street51/index-type))) + (acc : Void)) + : + (values + (U + (Promise + m-streets4/node61/with-promises-type) + (Listof + (Promise Street59/with-promises-type))) + Void) + (cond + (((λ (x) + (and (pair? x) + (eq? + (car x) + 'm-streets4/node49/with-indices-tag2))) + val) + ((ann + (λ ((tagged-index + : + m-streets4/node53/index-type) + (acc : Void)) + : + (values + (Promise + m-streets4/node61/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + m-streets4/node77/database + (cadr tagged-index)))) + (delay + (m-streets4/node57/with-indices→with-promises + successor-with-index))) + acc)) + (→ + m-streets4/node53/index-type + Void + (values + (Promise + m-streets4/node61/with-promises-type) + Void))) + val + acc)) + (#t + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise + Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc + : + Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + 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 + (U + m-streets4/node53/index-type + (Listof Street51/index-type)) + "Unhandled union case in (U m-streets4/node53/index-type (Listof Street51/index-type)), whole type was:(List (U m-streets4/node53/index-type (Listof Street51/index-type)))")))) + temp199 + acc))) + (values (list temp200) temp201))))) + (apply City62/make-with-promises (first-value (f (cdr n) (void)))))) + (begin + (: + Street55/with-indices→with-promises + (→ Street35/with-indices-type Street59/with-promises-type)) + (define (Street55/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List String) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List String)) (acc : Void)) + : + (values (List String) Void) + (let*-values (((String209) (apply values val)) + ((String210 String211) + ((inst values String Void) String209 acc))) + (values (list String210) String211))))) + (apply + Street63/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-cities3/node56/with-indices→with-promises + (→ + m-cities3/node36/with-indices-type + m-cities3/node60/with-promises-type)) + (define (m-cities3/node56/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof City50/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof City50/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise City58/with-promises-type))) + Void) + (let*-values (((temp214) (apply values val)) + ((temp215 temp216) + ((λ ((val : (Listof City50/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise City58/with-promises-type)) + Void) + (let ((f + ((inst + foldl + City50/index-type + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : City50/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + City58/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + City50/index-type) + (acc : Void)) + : + (values + (Promise + City58/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + City74/database + (cadr + tagged-index)))) + (delay + (City54/with-indices→with-promises + successor-with-index))) + acc)) + (→ + City50/index-type + Void + (values + (Promise + City58/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp214 + acc))) + (values (list temp215) temp216))))) + (apply + m-cities3/node64/make-with-promises + (first-value (f (cdr n) (void)))))) + (begin + (: + m-streets4/node57/with-indices→with-promises + (→ + m-streets4/node37/with-indices-type + m-streets4/node61/with-promises-type)) + (define (m-streets4/node57/with-indices→with-promises n) + (define f + (begin + "fold-instance expanded code below. Initially called with:" + '(fold-instance + (List (Listof Street51/index-type)) + Void + (City50/index-type + (Promise City58/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'City46/with-indices-tag2))) + λ…) + (Street51/index-type + (Promise Street59/with-promises-type) + (λ (x) + (and (pair? x) (eq? (car x) 'Street47/with-indices-tag2))) + λ…) + (m-cities3/node52/index-type + (Promise m-cities3/node60/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-cities3/node48/with-indices-tag2))) + λ…) + (m-streets4/node53/index-type + (Promise m-streets4/node61/with-promises-type) + (λ (x) + (and (pair? x) + (eq? (car x) 'm-streets4/node49/with-indices-tag2))) + λ…)) + (λ ((val : (List (Listof Street51/index-type))) (acc : Void)) + : + (values + (List (Listof (Promise Street59/with-promises-type))) + Void) + (let*-values (((temp221) (apply values val)) + ((temp222 temp223) + ((λ ((val : (Listof Street51/index-type)) + (acc : Void)) + : + (values + (Listof + (Promise Street59/with-promises-type)) + Void) + (let ((f + ((inst + foldl + Street51/index-type + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void) + Nothing + Nothing) + (λ ((x : Street51/index-type) + (acc1 + : + (Pairof + (Listof + (Promise + Street59/with-promises-type)) + Void))) + (let-values (((res res-acc) + ((ann + (λ ((tagged-index + : + Street51/index-type) + (acc : Void)) + : + (values + (Promise + Street59/with-promises-type) + Void) + (values + (let ((successor-with-index + (vector-ref + Street75/database + (cadr + tagged-index)))) + (delay + (Street55/with-indices→with-promises + successor-with-index))) + acc)) + (→ + Street51/index-type + Void + (values + (Promise + Street59/with-promises-type) + Void))) + x + (cdr acc1)))) + (cons + (cons res (car acc1)) + res-acc))) + (cons '() acc) + val))) + (values (reverse (car f)) (cdr f)))) + temp221 + acc))) + (values (list temp222) temp223))))) + (apply + m-streets4/node65/make-with-promises + (first-value (f (cdr n) (void)))))) + (delay + (m-streets4/node57/with-indices→with-promises + (vector-ref m-streets4/node77/database 0))))))) + + + + + + + + + + + + + + + + + + )] + +@chunk[ + (module* test typed/racket + (require (submod "..") + typed/rackunit) + + #;)] + +@chunk[<*> + (begin + + + (require 'main) + (provide (all-from-out 'main)) + + )] \ No newline at end of file diff --git a/graph-lib/graph/graph-modify.lp2.rkt b/graph-lib/graph/graph-modify.lp2.rkt new file mode 100644 index 00000000..57e1f6b5 --- /dev/null +++ b/graph-lib/graph/graph-modify.lp2.rkt @@ -0,0 +1,699 @@ +#lang scribble/lp2 +@(require "../lib/doc.rkt") +@doc-lib-setup + +@title[#:style manual-doc-style]{Graph library} + +@(table-of-contents) + +@; TODO: allow a mapping to return a new placeholder, in order to act as a +@; redirect. All references to the old placeholder will act as if they were to +@; the new placeholder. + +@section{Introduction} + +This module provides a @tc[graph] macro which helps constructing immutable +graphs (using lambdas to defer potentially cyclic references). + +@subsection{Example usage} + +We will start with a running example, which will help us both show the macro's +syntax, and see some of the key advantages offered by this graph library. + +@subsection{The graph's type} + +Each node type in the graph is a variant's constructor, tagged with the node +name. For example, a graph representing a city and its inhabitants could use +these constructors: + +@chunk[ + [City [streets : (Listof Street)] [people : (Listof Person)] ] + [Street [sname : String] [houses : (Listof House)] ] + [House [owner : Person] [location : Street] ] + [Person [name : String] ]] + +Notice the cycle in the type: a street contains houses, which are located on the +same street. + +@subsubsection{A seed from which to unravel the graph: the root parameters} + +In order to build a graph with that type, we start from the root parameters. +Here, we will take a representation of the city as a list of +@tc[(street-name . person-name)] pairs, and will convert it to a more convenient +graph representation. Our single root parameter will thus be the whole list: + +@chunk[ + '(["Amy" . "Ada Street"] + ["Jack" . "J Street"] + ["Anabella" . "Ada Street"])] + +We will then provide a mapping from the root parameter to the root node, in our +case @tc[City]. When processing the root parameter, one can call other mappings +that will create their corresponding nodes. + +@subsubsection{Mapping the root parameters to the root node} + +Here is the root mapping for our example. It maps over the list of names and +street names @tc[c], and calls for each element the @tc[m-street] and +@tc[m-person] mappings. + +@; Would be nicer with (map (∘ (curry street c) car) c)), but that doesn't +@; typecheck (yet). +@chunk[ + [(m-city [c : (Listof (Pairof String String))]) + (City (remove-duplicates (map (curry m-street c) (cdrs c))) + (remove-duplicates (map m-person (cars c))))]] + +@subsubsection{More mappings} + +Next, we write the @tc[m-street] mapping, which takes a street name and the +whole city @tc[c] in list form, and creates a @tc[Street] node. + +@chunk[ + [(m-street [c : (Listof (Pairof String String))] [s : String]) + (Street s (map (curry (curry m-house s) c) + (cars (filter (λ ([x : (Pairof String String)]) + (equal? (cdr x) s)) + c))))]] + +The @tc[m-house] mapping defined below calls back the @tc[m-street] mapping, to +store for each house a reference to the containing street. Normally, this would +cause infinite recursion in an eager language, like @tc[typed/racket]. However, +the mappings aren't called directly, and instead, in the body of @tc[m-house], +@tc[m-street] is shadowed by a function which returns a placeholder. This allows +us to not worry about mutually recursive mappings: a mapping can be called any +number of times with the same data, it will actually only be run once. + +The @tc[define-graph] macro will post-process the result of each mapping, and +replace the placeholders with promises for the the result of the mapping. The +promises are not available during graph construction, so there is no risk of +forcing one before it is available. + +We can now write the @tc[m-house] and @tc[m-person] mappings. + +@chunk[ + [(m-house [s : String] + [c : (Listof (Pairof String String))] + [p : String]) + (House (m-person p) (m-street c s))]] + +@chunk[ + [(m-person [p : String]) + (Person p)]] + +@subsubsection{Creating an instance of the graph} + +For now, we will supply directly the root arguments to the @tc[define-graph] +macro, as well as the node types and mappings. We can later curry the macro, so +that it first takes the node types and mappings, and produces a lambda taking +the root arguments as parameters. + +@chunk[ + (define-graph gr ) + #;(define g (gr )) + (define g1 (gr )) + (define g g1)] + +@subsection{More details on the semantics} + +Let's take a second look at the root mapping: + +@chunk[ + [(m-city [c : (Listof (Pairof String String))]) + (City (remove-duplicates (map (curry m-street c) (cars c))) + (remove-duplicates (map m-person (cdrs c))))]] + +As this example shows, we can use @tc[m-street] as any other function, passing +it to @tc[curry], and calling @tc[remove-duplicates] on the results. Note that +each placeholder returned by @tc[m-street] will contain all information passed +to it, here a street name and @tc[c]. Two placeholders for @tc[m-street] will +therefore be @tc[equal?] if and only if all the arguments passed to +@tc[m-street] are @tc[equal?]. The placeholders also include a symbol specifying +which mapping was called, so two placeholders for two different mappings will +not be @tc[equal?], even if identical parameters were supplied. + +The node type allowing placeholders is derived from the ideal type given above. +Here, the type for @tc[Person] is @tc[[Person [name : String]]], so there are no +substitutions to make. Conversely, the type for @tc[City], originally expressed +as @tc[[(Listof Street) (Listof Person)]], will be rewritten as +@tc[[(Listof Street/placeholder-type) (Listof Person/placeholder-type)]]. + +The @tc[rewrite-type] module, which we use to derive types with placeholders +from the ideal ones, only handles a handful of the types offered by +@tc[typed/racket]. In particular, it does not handle recursive types described +with @tc[Rec] yet. + +@section{Implementation} + +In this section, we will describe how the @tc[define-graph] macro is +implemented. + +@subsection{The macro's syntax} + +We use a simple syntax for @tc[define-graph], and make it more flexible through +wrapper macros. + +@chunk[ + (define-graph name + (~optional (~and debug #:debug)) + (~maybe #:definitions (extra-definition:expr …)) + [node … ] + …)] + +Where @tc[] is: + +@chunk[ + [field:id :colon field-type:expr]] + +And @tc[] is: + +@chunk[ + ((mapping:id [param:id :colon param-type:expr] …) + . mapping-body)] + +@subsection{The different types of a node} + +A single node name can refer to several types: + +@itemlist[ + @item{The @emph{ideal} type, expressed by the user, for example + @racket[[City (Listof Street) (Listof Person)]], it is never used as-is in + practice} + @item{The @emph{placeholder} type, type and constructor, which just store the + arguments for the mapping along with a tag indicating the node name} + @item{The @emph{incomplete} type, in which references to other node types are + allowed to be either actual (@racket[incomplete]) instances, or placeholders. + For example, @racket[[City (Listof (U Street Street/placeholder-type)) + (Listof (U Person Person/placeholder-type))]].} + @item{The @emph{with-indices} type, in which references to other node types + must be replaced by an index into the results list for the target node's + @racket[with-promises] type. For example, + @racket[[City (Listof (List 'Street/with-indices-tag2 Index)) + (Listof (List 'Person/with-indices-tag2 Index))]].} + @item{The @emph{with-promises} type, in which references to other node types + must be replaced by a @racket[Promise] for the target node's + @racket[with-promises] type. For example, + @racket[[City (Listof (Promise Street/with-promises-type)) + (Listof (Promise Person/with-promises-type))]].} + @item{The @emph{mapping function}, which takes some parameters and + returns a node (using the code provided by the user)}] + +We derive identifiers for these based on the @tc[node] name: + +@;;;; +@chunk[ + (define/with-syntax ((root-param …) . _) #'((param …) …)) + (define/with-syntax ((root-param-type …) . _) #'((param-type …) …)) + + (define-temp-ids "~a/main-constructor" name) + (define-temp-ids "~a/constructor" (node …) #:first-base root) + (define-temp-ids "~a/make-placeholder" (node …) #:first-base root) + (define-temp-ids "~a/placeholder-struct" (node …)) + (define-temp-ids "~a/placeholder-type" (node …)) + (define-temp-ids "~a/placeholder-queue" (node …)) + + (define-temp-ids "~a/incomplete-type" (node …)) + (define-temp-ids "~a/make-incomplete" (node …)) + (define-temp-ids "~a/incomplete-tag" (node …)) + + (define-temp-ids "~a/with-indices-type" (node …)) + (define-temp-ids "~a/make-with-indices" (node …)) + (define-temp-ids "~a/with-indices-tag" (node …)) + (define-temp-ids "~a/with-indices-tag2" (node …)) + (define-temp-ids "~a/index-type" (node …)) + (define-temp-ids "~a/with-indices→with-promises" (node …) + #:first-base root) + + (define-temp-ids "~a/with-promises-type" (node …) #:first-base root) + (define-temp-ids "~a/make-with-promises" (node …)) + (define-temp-ids "~a/with-promises-tag" (node …)) + + (define-temp-ids "~a/mapping-function" (node …)) + + (define-temp-ids "~a/database" (node …) #:first-base root) + + (define-temp-ids "~a/value" ((field …) …))] + +@subsection{Overview} + +The macro relies heavily on two sidekick modules: @tc[rewrite-type], and +@tc[fold-queue]. The former will allow us to derive from the ideal type of a +node the incomplete type and the with-promises type. It will also allow us to +search inside instances of incomplete nodes, in order to extract the +placehoders, and replace these parts with promises. The latter, @tc[fold-queue], +will be used to process all the pending placeholders, with the possibility to +enqueue more as new placeholders are discovered inside incomplete nodes. + +When the graph constructor is called with the arguments for the root parameters, +it is equivalent to make and then resolve an initial placeholder. We will use a +function from the @tc[fold-queue] library to process the queues of pending +placeholders, starting with a queue containing only that root placeholder. +We will have one queue for each placeholder type.@note{It we had only one queue, + we would have only one collection of results, and would need a @racket[cast] + when extracting nodes from the collection of results.} The element types of the +queues will therefore be these placeholder types. + +@chunk[ + node/placeholder-type] + +The return type for each queue will be the corresponding with-indices type. The +fold-queues function will therefore return a vector of with-indices nodes for +each node type. + +@chunk[ + node/with-indices-type] + + +@; Problem: how do we ensure we return the right type for the root? +@; How do we avoid casts when doing look-ups? +@; We need several queues, handled in parallel, with distinct element types. +@; * Several result aggregators, one for each type, so we don't have to cast +@; * Several queues, so that we can make sure the root node is of the expected +@; type. + +@; TODO: clarity. +@; The @tc[fold-queues] function allows us to associate each element with a tag, +@; so that, inside the processing function and outside, we can refer to an +@; element using this tag, which can be more lightweight than keeping a copy of +@; the element. +@; +@; We will tag our elements with an @tc[Index], which prevents memory leakage: +@; if we kept references to the original data added to the queue, a graph's +@; representation would hold references to its input, which is not the case when +@; using simple integers to refer to other nodes, instead of using the input for +@; these nodes. Also, it makes lookups in the database much faster, as we will +@; be able to use an array instead of a hash table. + +@subsection{The queues of placeholders} + +The fold-queues macro takes a root element, in our case the root placeholder, +which it will insert into the first queue. The next clauses are the queue +handlers, which look like function definitions of the form +@tc[(queue-name [element : element-type] Δ-queues enqueue) : result-type]. The +@tc[enqueue] argument is a function used to enqueue elements and get a tag in +return, which can later be used to retrieve the processed element. + +Since the @tc[enqueue] function is pure, it takes a parameter of the same type +as @tc[Δ-queues] representing the already-enqueued elements, and returns a +modified copy, in addition to the tag. The queue's processing body should return +two values: the result of processing the element, and the latest version of +@tc[Δ-queues], which stores the new elements to be added to the queue. + +@chunk[ + (fold-queues #:root queue-name + placeholder + [(node/placeholder-queue [e : ] + [Δ-queues : Δ-Queues] + enqueue) + : + ] + ...)] + +@subsection{Making placeholders for nodes} + +We start creating the root placeholder which we provide to @tc[fold-queues]. + +@chunk[ + (root/make-placeholder root-param …)] + +To make the placeholder, we will need a @tc[node/make-placeholder] function for +each @tc[node]. We first define the type of each placeholder (a list of +arguments, tagged with the @tc[node]'s name): + +@; TODO: maybe replace node types with placeholder types + +@chunk[ + (struct (A) node/placeholder-struct ([f : A])) + (define-type node/placeholder-type + (node/placeholder-struct (List param-type …)))] + +@; TODO: just use (variant [mapping param-type ...] ...) + +Then we define the @tc[node/make-placeholder] function: + +@chunk[ + (: node/make-placeholder (→ param-type … node/placeholder-type)) + (define (node/make-placeholder param …) + ((inst node/placeholder-struct (List param-type …)) (list param …)))] + +@subsection{Making with-indices nodes} + +We derive the @tc[with-indices] type from each @emph{ideal} node type using the +@tc[tmpl-replace-in-type] template metafunction from the rewrite-type library. +We replace all occurrences of a @tc[node] name with an @tc[Index], which +indicates at which index in the queue's results the successor can be found. + +@; TODO: use a type-expander here, instead of a template metafunction. + +@CHUNK[ + (define-type node/index-type (List 'node/with-indices-tag2 Index)) + + (define-type node/with-indices-type + (List 'node/with-indices-tag …)) + + (: node/make-with-indices (→ … + node/with-indices-type)) + (define (node/make-with-indices field …) + (list 'node/with-indices-tag field …))] + +@CHUNK[ + (tmpl-replace-in-type field-type [node node/index-type] …)] + +@subsection{Making with-promises nodes} + +We derive the @tc[with-promises] type from each @emph{ideal} node type using +the @tc[tmpl-replace-in-type] template metafunction from the rewrite-type +library. We replace all occurrences of a @tc[node] name with a @tc[Promise] for +that node's @tc[with-promises] type. + +@; TODO: use a type-expander here, instead of a template metafunction. + +@CHUNK[ + (define-type node/with-promises-type + (tagged node/with-promises-tag + [field : ] …)) + + (: node/make-with-promises (→ … + node/with-promises-type)) + (define (node/make-with-promises field/value …) + (tagged node/with-promises-tag + [field : field/value] + …))] + +@CHUNK[ + (tmpl-replace-in-type field-type + [node (Promise node/with-promises-type)] …)] + +@subsection{Making incomplete nodes} + +We derive the @tc[incomplete] type from each @emph{ideal} node type using +the @tc[tmpl-replace-in-type] template metafunction from the rewrite-type +library. We replace all occurrences of a @tc[node] name with its +@tc[placeholder] type. + +@; TODO: use a type-expander here, instead of a template metafunction. + +@CHUNK[ + (define-type node/incomplete-type + (List 'node/incomplete-tag …)) + + (: node/make-incomplete (→ … + node/incomplete-type)) + (define (node/make-incomplete field …) + (list 'node/incomplete-tag field …))] + +@CHUNK[ + (tmpl-replace-in-type field-type + [node node/placeholder-type] …)] + +@subsection{Converting incomplete nodes to with-indices ones} + +@; TODO: we don't need that many annotations +@chunk[ + (λ ([p : node/placeholder-type] [Δ-acc : Δ-Queues]) + : (values (List 'node/with-indices-tag2 Index) Δ-Queues) + (% index new-Δ-acc = (enqueue 'node/placeholder-queue p Δ-acc) + (values (list 'node/with-indices-tag2 index) + new-Δ-acc)))] + +@chunk[ + [node/placeholder-type + (List 'node/with-indices-tag2 Index) + (struct-predicate node/placeholder-struct) + ]] + +@subsubsection{Processing the placeholders} + +@; TODO: also allow returning a placeholder (which means we should then +@; process that placeholder in turn). The placeholder should return the +@; same node type, but can use a different mapping? +@; Or maybe we can do this from the ouside, using a wrapper macro? + +@; TODO: we don't need that many let etc., use % instead once everything works. +@CHUNK[ + (let ([mapping-result + (apply node/mapping-function + ((struct-accessor node/placeholder-struct 0) e))] + [f (tmpl-fold-instance (List …) + Δ-Queues + …)]) + (let-values ([(r new-Δ-queues) (f (cdr mapping-result) Δ-queues)]) + (values (apply node/make-with-indices r) + new-Δ-queues)))] + +Where @tc[] is the @tc[field-type] in which node types +are replaced by placeholder types: + +@chunk[ + (tmpl-replace-in-type field-type + [node node/placeholder-type] …)] + +@subsection{The mapping functions} + +We define the mapping functions as they are described by the user, with an +important change: Instead of returning an @emph{ideal} node type, we expect them +to return an @emph{incomplete} node type. + +@chunk[ + (: node/mapping-function (→ param-type … node/incomplete-type)) + (define node/mapping-function + (let ([mapping node/make-placeholder] + … + [node node/make-incomplete] + …) + (λ ([param : param-type] …) : node/incomplete-type + . mapping-body)))] + +@subsection{Returning a with-promises nodes} + +We will return a with-promises version of the root node, which contains promises +for its successors. The user can then force one of these to obtain the +with-promises version of the desired successor. + +@; TODO: put a diagram here, or an example at least + +This use of promises is safe, since their resolution depends only on the vectors +returned by fold-queues, which are already fully computed when we create the +root with-promises node. We therefore have no risk of forcing a promise that +can't be resolved, or that would depend on itself, causing an infinite loop. + +@subsubsection{Why use promises?} + +We use promises because we would like to only use immutable data structures. +Resolving the links in the graph would require mutating the nodes, so instead, +when extracting the @emph{placeholders} from an @emph{incomplete} node, we +produce a @emph{with-indices} node, which, instead of direct references to the +successors, just stores a tag and index. Later, the successors are processed, +and stored at the corresponding index in the queue for that tag. + +We then wrap each tagged index with a lambda, which also holds a reference to +the vectors returned by fold-queue, which containin all the with-indices nodes. +When calling the lambda, it extracts the with-indices node for that tag and +index, further replaces the tagged indices within, and returns a brand new +with-promises node. + +We could leave it as that, having the with-promises nodes contain lambdas +instead of actual references to their successors. However, when an immutable +function (like one of these lambdas) is called twice with the same arguments (in +this case none), @tc[typed/racket]'s occurrence typing currently does not infer +that the result will always be the same. This means that pattern-matching using +the @tc[match] macro won't work properly, for example. We therefore wrap these +functions into promises. The occcurrence typing mechanism in @tc[typed/racket] +knows that a promise will always return the same value when forced multiple +times. By default, promises use mutable data structures under the hood, to cache +their result, but we do not rely on that. We could use @tc[delay/name], which +doesn't cache the return value, but it was removed from @tc[typed/racket] +because @hyperlink["https://github.com/racket/typed-racket/issues/159"]{it + caused type safety problems}. + +@subsubsection{Creating with-promises nodes from with-indices ones} + +@chunk[ + [node/index-type + (Promise node/with-promises-type) + (λ (x) (and (pair? x) + (eq? (car x) 'node/with-indices-tag2))) + (λ ([tagged-index : node/index-type] [acc : Void]) + : (values (Promise node/with-promises-type) Void) + (values acc))]] + +TODO: check what we are closing over in that promise. +I think we are closing over the successor-with-index (but not its whole +database), as well as everything that the with-indices→with-promises function +closes over. + +@chunk[ + (let ([successor-with-index (vector-ref node/database + (cadr tagged-index))]) + (delay (node/with-indices→with-promises successor-with-index)))] + +@chunk[ + (: node/with-indices→with-promises (→ node/with-indices-type + node/with-promises-type)) + (define (node/with-indices→with-promises n) + (define f (tmpl-fold-instance (List …) + Void + …)) + (apply node/make-with-promises (first-value (f (cdr n) (void)))))] + +Where @tc[] is the @tc[field-type] in which node types +are replaced by tagged indices: + +@chunk[ + (tmpl-replace-in-type field-type [node node/index-type] …)] + +@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +@section{Referencing the type of nodes} + +The identifier defined by @tc[define-graph] will both act as a constuctor for +graph instances, and as a type-expander, that we will use to reference the node +types. We will thus be able to refer to the type of Street nodes in our example +via @tc[(g Street)]. + +@chunk[ + (λ (stx) + (syntax-parse stx + [(_ (~datum node)) #'node/with-promises-type] … + [(_ #:incomplete (~datum node)) #'node/incomplete-type] … + [(_ #:make-incomplete (~datum node)) + #'(→ … node/incomplete-type)] … + [(_ #:incomplete (~datum node) fld) + (syntax-parse #'fld + [(~datum field) #'] …)] … + [(_ #:make-placeholder (~datum node)) + #'(→ param-type … node/placeholder-type)] … + [(_ #:placeholder (~datum node)) #'node/placeholder-type] …))] + +We will be able to use this type expander in function types, for example: + +@chunk[ + (define (type-example [x : (gr Street)]) + : (gr Street) + x) + (check-equal?: (let* ([v1 (car (structure-get (cadr (force g)) streets))] + [v2 (ann (type-example (force v1)) (gr Street))] + [v3 (structure-get (cadr v2) sname)]) + v3) + : String + "Ada Street")] + +@section{Putting it all together} + +@chunk[ + (define-syntax/parse + + ((λ (x) + (when (attribute debug) + (pretty-write (syntax->datum x))) + x) + (template + ;(let () + (begin + (define-multi-id name + #:type-expander + #:call (λ (stx) + (syntax-parse stx + ;; TODO: move this to a dot expander, so that writing + ;; g.a gives a constructor for the a node of g, and + ;; (g.a foo bar) or (let ((c .g.a)) (c foo bar)) both + ;; call it + [(_ #:λroot (~datum node)) + #'node/constructor] + … + [(_ #:root (~datum node) . rest) + (syntax/loc stx (node/constructor . rest))] + … + [(_ . rest) + (syntax/loc stx (root/constructor . rest))])) + #:id (λ (stx) #'root/constructor)) + + (?? (splicing-let ([mapping node/make-placeholder] + … + [node node/make-incomplete] + …) + extra-definition + …)) + + (begin ) … + (begin ) … + (begin ) … + (begin ) … + (begin ) … + + (begin ) … + + (: fq (case→ (→ 'node/placeholder-queue node/placeholder-type + (List (Vectorof node/with-indices-type) …)) + …)) + (define (fq queue-name placeholder) + ) + + ))))] + +@chunk[ + (begin + (: node/constructor (→ param-type … (Promise node/with-promises-type))) + (define (node/constructor param …) + (match-let ([(list node/database …) + (fq 'node/placeholder-queue + (node/make-placeholder param …))]) + (begin ) … + (delay (node/with-indices→with-promises + (vector-ref node/database 0)))))) + …] + +@chunk[ + (module main typed/racket + (require (for-syntax syntax/parse + racket/syntax + syntax/stx + syntax/parse/experimental/template + racket/sequence + racket/pretty + "rewrite-type.lp2.rkt" + "../lib/low-untyped.rkt" + "meta-struct.rkt") + racket/splicing + "fold-queues.lp2.rkt" + "rewrite-type.lp2.rkt" + "../lib/low.rkt" + "structure.lp2.rkt" + "variant.lp2.rkt" + "../type-expander/type-expander.lp2.rkt" + "../type-expander/multi-id.lp2.rkt" + "meta-struct.rkt") + + ;(begin-for-syntax + ;) + + (provide define-graph) + )] + +In @tc[module-test], we have to require @tc[type-expander] because it provides a +@tc[:] macro which is a different identifier than the one from typed/racket, +therefore the @tc[:] bound in the @tc[graph] macro with @tc[:colon] would +not match the one from @tc[typed/racket] + +@chunk[ + (module* test typed/racket + (require (submod "..") + (only-in "../lib/low.rkt" cars cdrs check-equal?:) + (only-in "structure.lp2.rkt" structure-get) + "../type-expander/type-expander.lp2.rkt" + typed/rackunit) + + (provide g) + + )] + +The whole file, finally: + +@chunk[<*> + (begin + + + (require 'main) + (provide (all-from-out 'main)) + + )] diff --git a/graph-lib/graph/graph.lp2.rkt b/graph-lib/graph/graph.lp2.rkt index ac679c3e..10612fd7 100644 --- a/graph-lib/graph/graph.lp2.rkt +++ b/graph-lib/graph/graph.lp2.rkt @@ -208,8 +208,8 @@ We derive identifiers for these based on the @tc[node] name: (define-temp-ids "~a/main-constructor" name) (define-temp-ids "~a/constructor" (node …) #:first-base root) (define-temp-ids "~a/make-placeholder" (node …) #:first-base root) + (define-temp-ids "~a/placeholder-struct" (node …)) (define-temp-ids "~a/placeholder-type" (node …)) - (define-temp-ids "~a/placeholder-tag" (node …)) (define-temp-ids "~a/placeholder-queue" (node …)) (define-temp-ids "~a/incomplete-type" (node …)) @@ -226,7 +226,7 @@ We derive identifiers for these based on the @tc[node] name: (define-temp-ids "~a/with-promises-type" (node …) #:first-base root) (define-temp-ids "~a/make-with-promises" (node …)) - (define-temp-ids "~a/with-promises-tag" (node …)) + (define-temp-ids "~a/with-promises-struct" (node …)) (define-temp-ids "~a/mapping-function" (node …)) @@ -323,9 +323,9 @@ arguments, tagged with the @tc[node]'s name): @; TODO: maybe replace node types with placeholder types @chunk[ + (struct (A) node/placeholder-struct ([f : A])) (define-type node/placeholder-type - (List 'node/placeholder-tag - param-type …))] + (node/placeholder-struct (List param-type …)))] @; TODO: just use (variant [mapping param-type ...] ...) @@ -334,7 +334,7 @@ Then we define the @tc[node/make-placeholder] function: @chunk[ (: node/make-placeholder (→ param-type … node/placeholder-type)) (define (node/make-placeholder param …) - (list 'node/placeholder-tag param …))] + ((inst node/placeholder-struct (List param-type …)) (list param …)))] @subsection{Making with-indices nodes} @@ -369,9 +369,11 @@ that node's @tc[with-promises] type. @; TODO: use a type-expander here, instead of a template metafunction. @CHUNK[ + (struct (A) node/with-promises-struct ([f : A])) (define-type node/with-promises-type - (tagged node/with-promises-tag - [field : ] …)) + (node/with-promises-struct (List [field : ] …)) + #;(tagged node/with-promises-tag + )) (: node/make-with-promises (→ … node/with-promises-type)) @@ -419,8 +421,7 @@ library. We replace all occurrences of a @tc[node] name with its @chunk[ [node/placeholder-type (List 'node/with-indices-tag2 Index) - (λ (x) (and (pair? x) - (eq? (car x) 'node/placeholder-tag))) + (struct-predicate node/placeholder-struct) ]] @subsubsection{Processing the placeholders} @@ -432,13 +433,15 @@ library. We replace all occurrences of a @tc[node] name with its @; TODO: we don't need that many let etc., use % instead once everything works. @CHUNK[ - (let ([mapping-result (apply node/mapping-function (cdr e))]) - (let ([f (tmpl-fold-instance (List …) - Δ-Queues - …)]) - (let-values ([(r new-Δ-queues) (f (cdr mapping-result) Δ-queues)]) - (values (apply node/make-with-indices r) - new-Δ-queues))))] + (let ([mapping-result + (apply node/mapping-function + ((struct-accessor node/placeholder-struct 0) e))] + [f (tmpl-fold-instance (List …) + Δ-Queues + …)]) + (let-values ([(r new-Δ-queues) (f (cdr mapping-result) Δ-queues)]) + (values (apply node/make-with-indices r) + new-Δ-queues)))] Where @tc[] is the @tc[field-type] in which node types are replaced by placeholder types: @@ -589,14 +592,6 @@ We will be able to use this type expander in function types, for example: (template ;(let () (begin - (begin ) … - (begin ) … - (begin ) … - (begin ) … - (begin ) … - - (begin ) … - (define-multi-id name #:type-expander #:call (λ (stx) @@ -622,6 +617,14 @@ We will be able to use this type expander in function types, for example: extra-definition …)) + (begin ) … + (begin ) … + (begin ) … + (begin ) … + (begin ) … + + (begin ) … + (: fq (case→ (→ 'node/placeholder-queue node/placeholder-type (List (Vectorof node/with-indices-type) …)) …)) @@ -651,7 +654,8 @@ We will be able to use this type expander in function types, for example: racket/sequence racket/pretty "rewrite-type.lp2.rkt" - "../lib/low-untyped.rkt") + "../lib/low-untyped.rkt" + "meta-struct.rkt") racket/splicing "fold-queues.lp2.rkt" "rewrite-type.lp2.rkt" @@ -659,7 +663,8 @@ We will be able to use this type expander in function types, for example: "structure.lp2.rkt" "variant.lp2.rkt" "../type-expander/type-expander.lp2.rkt" - "../type-expander/multi-id.lp2.rkt") + "../type-expander/multi-id.lp2.rkt" + "meta-struct.rkt") ;(begin-for-syntax ;) diff --git a/graph-lib/graph/meta-struct.rkt b/graph-lib/graph/meta-struct.rkt new file mode 100644 index 00000000..d281191d --- /dev/null +++ b/graph-lib/graph/meta-struct.rkt @@ -0,0 +1,131 @@ +#lang racket + +(require syntax/parse/experimental/template + syntax/parse + (for-syntax racket/syntax)) + +(provide meta-struct? + (struct-out meta-struct-info) + get-meta-struct-info + ;; More provided by `shorthand` in the code below + meta-struct-subtype? + struct-predicate + struct-constructor + struct-accessor) + +(module info racket + (require racket/struct-info) + + (provide meta-struct? + (struct-out meta-struct-info) + get-meta-struct-info) + + (define (meta-struct? s) + (and (identifier? s) + (let ([v (syntax-local-value s (λ _ #f))]) + (and v (struct-info? v))))) + + (struct meta-struct-info + (type-descriptor + constructor + predicate + accessors + mutators + super-type) + #:transparent) + + (define (get-meta-struct-info s #:srcloc [srcloc #f]) + (if (meta-struct? s) + (apply meta-struct-info (extract-struct-info (syntax-local-value s))) + (raise-syntax-error 'get-struct-info + "not a structure definition" + (or srcloc s) + s)))) + +(require 'info + (for-syntax 'info)) + +(define-syntax (shorthand stx) + (syntax-case stx () + [(_ base) + (with-syntax ([name (format-id #'base "meta-struct-~a" #'base)] + [accessor (format-id #'base "meta-struct-info-~a" #'base)] + [tmpl (format-id #'base "tmpl-struct-~a" #'base)]) + #'(begin + (provide name tmpl) + (define-template-metafunction (tmpl stx) + (syntax-parse stx + [(_ s (~optional (~seq #:srcloc srcloc))) + (accessor + (get-meta-struct-info #'s #:srcloc (attribute srcloc)))])) + (define (name s #:srcloc [srcloc #f]) + (accessor + (get-meta-struct-info s #:srcloc srcloc)))))])) + +(shorthand type-descriptor) +(shorthand constructor) +(shorthand predicate) +(shorthand accessors) +(shorthand mutators) +(shorthand super-type) + +(define-syntax (struct-predicate stx) + (syntax-case stx () + [(_ s) (meta-struct-info-predicate (get-meta-struct-info #'s))])) +(define-syntax (struct-constructor stx) + (syntax-case stx () + [(_ s) (meta-struct-info-constructor (get-meta-struct-info #'s))])) +(define-syntax (struct-accessor stx) + (syntax-case stx () + [(_ s i) (list-ref (meta-struct-info-accessors (get-meta-struct-info #'s)) + (syntax-e #'i))])) + +(define (meta-struct-subtype? sub super) + (or (equal? (meta-struct-type-descriptor sub) + (meta-struct-type-descriptor super)) + (let ((up (meta-struct-super-type sub))) + (and (meta-struct? up) + (meta-struct-subtype? up super))))) + +(module* test racket + (require (for-syntax (submod "..")) + rackunit) + + (define-syntax (test-subtype? stx) + (syntax-case stx () + [(_ sub super) + #`#,(if (meta-struct-subtype? #'sub #'super) + #t + #f)])) + + (module m1 racket + (struct sa ()) + (provide (struct-out sa))) + (module m2 racket + (require (submod ".." m1)) + (struct sb sa ()) + (provide (rename-out [sa sa2])) + (provide (struct-out sb))) + (require 'm1) + (require 'm2) + (struct sc sb ()) + + (check-true (test-subtype? sa sa)) + (check-true (test-subtype? sa2 sa)) + (check-true (test-subtype? sb sa)) + (check-true (test-subtype? sc sa)) + + (check-true (test-subtype? sa sa2)) + (check-true (test-subtype? sa2 sa2)) + (check-true (test-subtype? sb sa2)) + (check-true (test-subtype? sc sa2)) + + (check-false (test-subtype? sa sb)) + (check-false (test-subtype? sa2 sb)) + (check-true (test-subtype? sb sb)) + (check-true (test-subtype? sc sb)) + + (check-false (test-subtype? sa sc)) + (check-false (test-subtype? sa2 sc)) + (check-false (test-subtype? sb sc)) + (check-true (test-subtype? sc sc))) \ No newline at end of file diff --git a/graph-lib/graph/remember.rkt b/graph-lib/graph/remember.rkt index a44c3761..e10ef011 100644 --- a/graph-lib/graph/remember.rkt +++ b/graph-lib/graph/remember.rkt @@ -87,3 +87,10 @@ (structure ab v) (structure a c) (structure a c) +(structure a1 s v) +(structure a1 s v) +(structure a1 s v) +(structure returned) +(structure returned) +(structure returned) +(structure returned) diff --git a/graph-lib/graph/rewrite-type.lp2.rkt b/graph-lib/graph/rewrite-type.lp2.rkt index ca2ca551..2d303450 100644 --- a/graph-lib/graph/rewrite-type.lp2.rkt +++ b/graph-lib/graph/rewrite-type.lp2.rkt @@ -87,7 +87,7 @@ 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) - (syntax-parse t + (syntax-parse (expand-type t) ))] @@ -206,7 +206,8 @@ The other cases are similarly defined: [((~literal U) a ...) #`(let ([v-cache val]) (cond - #,@(stx-map (λ (ta) (replace-in-union #'v-cache ta r)) + #,@(stx-map (λ (ta) + (replace-in-union #'v-cache ta r)) #'(a ...))))] [((~literal quote) a) #'val] @@ -221,9 +222,17 @@ 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 - [(List ((~literal quote) tag:id) b ...) + [((~literal List) ((~literal quote) tag:id) b ...) ] - [_ (error "Type-replace on untagged Unions isn't supported yet!")]))] + [_ (raise-syntax-error + 'replace-in-type + (format "Type-replace on untagged Unions isn't supported yet: ~a" + t) + t)] + [s:id + #:when (begin (printf "~a ~a\n" (meta-struct? #'s) #'s) + (meta-struct? #'s)) + (error "Type-replace on struct unions: WIP.")]))] 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. @@ -481,11 +490,13 @@ functions is undefined. (cdr f))))] [((~literal U) a ...) (define/with-syntax (new-a-type …) (stx-map new-type-for #'(a …))) + (printf ": ~a\n" type) #`(λ ([val : (U a ...)] [acc : acc-type]) : (values (U new-a-type …) acc-type) (cond - #,@(stx-map (λ (ta) ) - #'(a ...)) + #,@(for/list ([ta (in-syntax #'(a ...))] + [last? (in-last? (in-syntax #'(a ...)))]) + ) [else (typecheck-fail #,type #,(~a "Unhandled union case in " @@ -501,16 +512,28 @@ functions is undefined. @CHUNK[ (syntax-parse ta - [(List ((~literal quote) tag:id) b ...) + [((~literal List) ((~literal quote) tag:id) b ...) ] - [(Pairof ((~literal quote) tag:id) b) + [((~literal Pairof) ((~literal quote) tag:id) b) ] [x:id #:attr assoc-result (stx-assoc #'x #'((from to pred? fun) ...)) #:when (attribute assoc-result) #:with (x-from x-to x-pred? x-fun) #'assoc-result ] - [_ (error "Type-replace on untagged Unions isn't supported yet!")])] + [_ + #:when last? + #`[#t ;; Hope type occurrence will manage here. + (#,(recursive-replace ta) val acc)]] + [s:id + #:when (begin (printf "~a ~a\n" (meta-struct? #'s) #'s) + (meta-struct? #'s)) + (error "Type-replace on struct unions: WIP.")] + [_ (raise-syntax-error + 'replace-in-type + (format "Type-replace on untagged Unions isn't supported yet: ~a" + 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. @@ -589,17 +612,22 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and @chunk[<*> (begin (module main typed/racket - (require (for-syntax syntax/parse - racket/syntax - syntax/stx - racket/format - syntax/parse/experimental/template - "../lib/low-untyped.rkt") - "structure.lp2.rkt" - "variant.lp2.rkt" - "../type-expander/multi-id.lp2.rkt" - "../type-expander/type-expander.lp2.rkt" - "../lib/low.rkt") + (require + (for-syntax syntax/parse + racket/syntax + syntax/stx + racket/format + syntax/parse/experimental/template + racket/sequence + "../lib/low-untyped.rkt" + (only-in "../type-expander/type-expander.lp2.rkt" + expand-type) + "meta-struct.rkt") + "structure.lp2.rkt" + "variant.lp2.rkt" + "../type-expander/multi-id.lp2.rkt" + "../type-expander/type-expander.lp2.rkt" + "../lib/low.rkt") (begin-for-syntax (provide replace-in-type ;replace-in-instance fold-instance diff --git a/graph-lib/graph/structure.lp2.rkt b/graph-lib/graph/structure.lp2.rkt index 56269ace..2c8bec77 100644 --- a/graph-lib/graph/structure.lp2.rkt +++ b/graph-lib/graph/structure.lp2.rkt @@ -414,10 +414,10 @@ The fields in @tc[fields→stx-name-alist] are already sorted. (structure-get v field)))] @chunk[ - (my-st-type-info-predicate (get-struct-info stx (cdr s)))] + (meta-struct-predicate (cdr s) #:srcloc stx)] @CHUNK[ - (list-ref (my-st-type-info-accessors (get-struct-info stx (cdr s))) + (list-ref (meta-struct-accessors (cdr s) #:srcloc stx) (indexof (syntax->datum #'field) (reverse (car s))))] @chunk[ @@ -485,30 +485,6 @@ instead of needing an extra recompilation. @subsection{Anonymous type} -@subsection{Accessing information about racket's structs at compile-time} -@chunk[ - (begin-for-syntax - (struct my-st-type-info - (type-descriptor - constructor - predicate - accessors - mutators - super-type) - #:transparent))] - -@CHUNK[ - (define-for-syntax (get-struct-info stx s) - (let* ([fail (λ () (raise-syntax-error 'get-struct-info - "not a structure definition" - stx - s))] - [v (if (identifier? s) - (syntax-local-value s fail) - (fail))] - [i (if (not (struct-info? v)) (fail) (extract-struct-info v))]) - (apply my-st-type-info i)))] - @subsection{Type-expander} @CHUNK[ @@ -620,7 +596,8 @@ chances that we could write a definition for that identifier. ;; in-syntax on older versions: ;;;unstable/sequence "../lib/low-untyped.rkt" - "../lib/low/multiassoc-syntax.rkt") + "../lib/low/multiassoc-syntax.rkt" + "meta-struct.rkt") "../lib/low.rkt" "../type-expander/type-expander.lp2.rkt" "../type-expander/multi-id.lp2.rkt") @@ -647,8 +624,6 @@ chances that we could write a definition for that identifier. - - diff --git a/graph-lib/lib/low.rkt b/graph-lib/lib/low.rkt index ed5cf997..af77aff4 100644 --- a/graph-lib/lib/low.rkt +++ b/graph-lib/lib/low.rkt @@ -324,7 +324,9 @@ replace-first Syntax-Listof check-duplicate-identifiers - generate-temporary) + generate-temporary + sequence-length>= + in-last?) (require (only-in racket [compose ∘] @@ -601,6 +603,24 @@ ; (ann '() (Listof (Syntaxof Nothing))) (my-in-syntax #'())) +(: sequence-length>= (→ (Sequenceof Any) Index Boolean)) +(define (sequence-length>= s l) + (let-values ([(more? next) (sequence-generate s)]) + (define (rec [remaining : Index]) : Boolean + (if (= remaining 0) + #t + (and (more?) + (begin (next) + (rec (sub1 remaining)))))) + (rec l))) + +(: in-last? (→ (Sequenceof Any) (Sequenceof (U #f 'last)))) +(define (in-last? s) + (if (sequence-length>= s 1) + (sequence-append (sequence-map (λ _ #f) (sequence-tail s 1)) + (in-value 'last)) + empty-sequence)) + (: check-duplicate-identifiers (→ (Syntaxof (Listof (Syntaxof Symbol))) Boolean))