diff --git a/graph/graph/graph2.lp2.rkt b/graph/graph/graph2.lp2.rkt index e24268f1..9439879f 100644 --- a/graph/graph/graph2.lp2.rkt +++ b/graph/graph/graph2.lp2.rkt @@ -22,10 +22,9 @@ name. For example, a graph representing a city and its inhabitants could use these variants: @chunk[ - [City #|[streets : (Listof Street)]|# [inhabitants : (Listof Person)]] - #|DEBUG|# - #|[Street [houses : (Listof House)]] - [House [owner : Person] [location : Street]]|# + [City [streets : (Listof Street)] [inhabitants : (Listof Person)]] + [Street [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 @@ -55,33 +54,32 @@ create other 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[street] and @tc[person] -mappings. +street names @tc[c], and calls for each element the @tc[m-street] mapping and +the @tc[Person] node constructor. @; Would be nicer with (map (∘ (curry street c) my-car) c)), but that doesn't @; typecheck (yet). @chunk[ - [(city [c : (Listof (Pairof String String))]) : City - (City #|DEBUG|##|(remove-duplicates (map (curry street c) (cars c)))|# - (remove-duplicates (map Person (cdrs c))))]] + [(m-city [c : (Listof (Pairof String String))]) : City + (City (remove-duplicates (map (curry m-street c) (cars c))) + (remove-duplicates (map Person (cdrs c))))]] @subsubsection{More mappings} -Next, we write the @tc[street] mapping, which takes a street name and the whole -city @tc[c] in list form, and creates a @tc[Street] node. +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[ - #|DEBUG|# - #|[(street [c : (Listof (Pairof String String))] [s : String]) : Street - (Street (map (curry (curry house s) c) - (cars (filter (λ ([x : (Pairof String String)]) - (equal? (cdr x) s)) - c))))]|#] + [(m-street [c : (Listof (Pairof String String))] [s : String]) : Street + (Street (map (curry (curry m-house s) c) + (cars (filter (λ ([x : (Pairof String String)]) + (equal? (cdr x) s)) + c))))]] -The @tc[house] mapping calls back the @tc[street] mapping, to store for each +The @tc[m-house] mapping 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 the @tc[street] function here returns a +aren't called directly, and instead the @tc[m-street] function here 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. @@ -91,19 +89,19 @@ 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. -Finally, we write the @tc[house] mapping. +Finally, we write the @tc[m-house] mapping. @chunk[ - #| - [(house [s : String] [c : (Listof (Pairof String String))] [p : String]) - : House - (House (Person p) (street c s))]|# - #|DEBUG|#] + [(m-house [s : String] + [c : (Listof (Pairof String String))] + [p : String]) + : House + (House (Person p) (m-street c s))]] Notice how we are calling directly the @tc[Person] constructor above. We also -called it directly in the @tc[city] mapping. Since @tc[Person] does not contain -references to @tc[House], @tc[Street] or @tc[City], we do not need to delay -creation of these nodes by calling yet another mapping. +called it directly in the @tc[m-city] mapping. Since @tc[Person] does not +contain references to @tc[House], @tc[Street] or @tc[City], we do not need to +delay creation of these nodes by calling yet another mapping. @; TODO: above: Should we merge two identical instances of Person? They won't @; necessarily be eq? if they contain cycles deeper in their structure, anyway. @@ -113,10 +111,12 @@ creation of these nodes by calling yet another mapping. @; database, though. The number and names of mappings do not necessarily reflect the graph's type. -Here, we have no mapping named @tc[person], because that node is always created -directly. Conversely, we could have two mappings, @tc[big-street] and -@tc[small-street], with different behaviours, instead of passing an extra -boolean argument to @tc[street]. +Here, we have no mapping named @tc[m-person], because that node is always +created directly. Conversely, we could have two mappings, @tc[m-big-street] and +@tc[m-small-street], with different behaviours, instead of passing an extra +boolean argument to @tc[m-street]. + +@; TODO: make the two street mappings @subsubsection{Making a constructor for the graph} @@ -135,18 +135,18 @@ boolean argument to @tc[street]. Let's take a second look at the root mapping: @chunk[ - [(city [c : (Listof (Pairof String String))]) - (City (remove-duplicates (map (∘ (curry street c) car) c)) - (remove-duplicates (map (∘ Person cdr) c)))]] + [(m-city [c : (Listof (Pairof String String))]) : City + (City (remove-duplicates (map (curry m-street c) (cars c))) + (remove-duplicates (map Person (cdrs c))))]] -The first case shows that we can use @tc[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[street] will contain all information passed to -it, here a street name and @tc[c]. Two placeholders for @tc[street] will -therefore be @tc[equal?] if and only if all the arguments passed to @tc[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 first case shows that 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 second case shows that we can also directly call the constructor for the @tc[Person] node type. If that type contains references to other nodes, the @@ -273,7 +273,9 @@ the latest @tc[Δ-queues] in order to have these elements added to the queue. @chunk[ (fold-queues - [(mapping [e : ] get-tag Δ-queues) + [(mapping/placeholder-tag [e : ] + Δ-queues + enqueue) : ] ...)] @@ -292,19 +294,19 @@ tagged with the @tc[mapping]'s name), and a constructor: @; TODO: just use (variant [mapping param-type ...] ...) @chunk[ - (define-type mapping/placeholder-type (List 'placeholder - 'mapping + (define-type mapping/placeholder-type (List 'mapping/placeholder-tag param-type ...)) (: mapping/make-placeholder (→ param-type ... mapping/placeholder-type)) (define (mapping/make-placeholder [param : param-type] ...) - (list 'placeholder 'mapping param ...))] + (list 'mapping/placeholder-tag param ...))] The code above needs some identifiers derived from @tc[mapping] names: @chunk[ (define-temp-ids "~a/make-placeholder" (mapping ...)) (define-temp-ids "~a/placeholder-type" (mapping ...)) + (define-temp-ids "~a/placeholder-tag" (mapping ...)) (define/with-syntax (root/make-placeholder . _) #'(mapping/make-placeholder ...))] @@ -359,11 +361,11 @@ which return type is the desired node type. … (define-type node/incomplete-type - (Pairof 'incomplete (Pairof 'node (List field/incomplete-type …)))) + (Pairof 'node/incomplete-tag (List field/incomplete-type …))) (: node/make-incomplete (→ field/incomplete-type … node/incomplete-type)) (define (node/make-incomplete field-name …) - (list 'incomplete 'node field-name …))] + (list 'node/incomplete-tag field-name …))] Since the incomplete type for fields will appear in two different places, above and in the incomplete-to-with-promises conversion routine below, we write it in @@ -383,7 +385,7 @@ We do that (for/list ([x (in-syntax #'(node ...))]) (multiassoc-syntax x - #'([result-type . (List 'placeholder 'mapping param-type ...)] + #'([result-type . mapping/placeholder-type];;;;;;;;;;;;;;;;;;;;;;;;;;;; . (List 'mapping/placeholder-tag param-type ...) …))))] The multiassoc-syntax function used above filters the associative syntax list @@ -413,6 +415,7 @@ The code above also needs some identifiers derived from @tc[node] and @chunk[ (define-temp-ids "~a/make-incomplete" (node …)) (define-temp-ids "~a/incomplete-type" (node …)) + (define-temp-ids "~a/incomplete-tag" (node …)) (define-temp-ids "~a/incomplete-fields" (node …)) (define/with-syntax ((field/incomplete-type …) …) (stx-map generate-temporaries #'((field-name …) …)))] @@ -422,20 +425,36 @@ The code above also needs some identifiers derived from @tc[node] and @chunk[ [node/incomplete-type node/with-promises-type - (λ (x) (and (pair? x) - (eq? (car x) 'incomplete) - (pair? (cdr x)) - (eq? (cadr x) 'node))) + (λ (x) (and (pair? x) (eq? (car x) 'node/incomplete-tag))) (λ ([x : node/incomplete-type] [acc : Void]) - (if (eq? (car x) 'incomplete) - - ))]] + )]] + +@chunk[ + [mapping/placeholder-type + (tmpl-replace-in-type result-type [node node/with-promises-type] …) + (λ (x) (and (pair? x) + (eq? (car x) 'mapping/placeholder-tag))) + (λ ([x : mapping/placeholder-type] [acc : Void]) + )]] + + +@; TODO: this would be much simpler if we forced having only one mapping per +@; node, and extended that with a macro. + +@chunk[ + (define/with-syntax ((node/compatible-mappings ...) ...) + (for/list ([x (in-syntax #'(node ...))]) + (multiassoc-syntax + x + #'([result-type . mapping] + …))))] @chunk[ (error (~a "Not implemented yet " x))] @chunk[ - (% tag new-Δ-queues = (get-tag (cadr x) x Δ-queues) + (% index new-Δ-queues = (enqueue 'mapping/placeholder-tag x Δ-queues) + (list 'mapping/placeholder-tag index) (error (~a "Not implemented yet " x)))] @@ -447,25 +466,18 @@ The code above also needs some identifiers derived from @tc[node] and @; Or maybe we can do this from the ouside, using a wrapper macro? @CHUNK[ - (let ([mapping-result (apply mapping/function (cddr e))]) - (tmpl-fold-instance (tmpl-cdr-assoc-syntax - result-type - [node . (List 'incomplete - 'node - …)] - …) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (let ([mapping-result (apply mapping/function (cdr e))]) + (tmpl-fold-instance Void - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - …)) + … + …)) 'todo!] +@chunk[ + (tmpl-cdr-assoc-syntax result-type + [node . (List …)] + …)] + @section{The mapping functions} We define the mapping functions as they are described by the user, with an @@ -475,7 +487,8 @@ to return an incomplete node type. @chunk[ (define-type mapping/incomplete-result-type (tmpl-replace-in-type result-type - [node node/incomplete-type] + [node (List 'node/incomplete-tag + …)] …)) (: mapping/function (→ param-type … mapping/incomplete-result-type)) @@ -547,35 +560,7 @@ to return an incomplete node type. g - - - - - - - - - - - - - - - - - - - - - - - - - - - - (require (submod ".." doc)))] @chunk[<*> diff --git a/graph/graph/rewrite-type.lp2.rkt b/graph/graph/rewrite-type.lp2.rkt index 610061ed..5ba7c83f 100644 --- a/graph/graph/rewrite-type.lp2.rkt +++ b/graph/graph/rewrite-type.lp2.rkt @@ -378,11 +378,11 @@ functions is undefined. @subsection{The code} @CHUNK[ - (define-for-syntax (fold-instance t stx-acc-type r) + (define-for-syntax (fold-instance whole-type stx-acc-type r) (define/with-syntax acc-type stx-acc-type) (define/with-syntax ([from to pred? fun] ...) r) - (recursive-replace t))] + (recursive-replace whole-type))] @CHUNK[ (define (new-type-for stx) (replace-in-type stx #'([from to] ...))) @@ -485,7 +485,14 @@ functions is undefined. (cond #,@(stx-map (λ (ta) ) #'(a ...)) - [(typecheck-fail #'#,type)]))] + [else + (begin + val + (typecheck-fail #,type + #,(~a "Unhandled union case in " + (syntax->datum #'(U a …)) + ", whole type was:" + (syntax->datum whole-type))))]))] [((~literal quote) a) #'(inst values 'a acc-type)] [x:id @@ -567,7 +574,7 @@ And one each for @tc[fold-instance] and @tc[replace-in-instance2]: [(_ type:expr acc-type:expr [from to pred? fun] …) #`(begin "fold-instance expanded code below. Initially called with:" - '(fold-instance type acc-type [from to pred? fun] …) + '(fold-instance type acc-type [from to pred? λ…] …) #,(fold-instance #'type #'acc-type #'([from to pred? fun] …)))])) @@ -586,6 +593,7 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and (require (for-syntax syntax/parse racket/syntax syntax/stx + racket/format syntax/parse/experimental/template "../lib/low-untyped.rkt") "structure.lp2.rkt"