suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Just before switching to one-mapping-per-node version.

Browse Source
This commit is contained in:
Georges Dupéron 2015-11-20 21:03:05 +01:00
parent 7acbb2acc8
commit f96beb16f7
2 changed files with 100 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

183
graph/graph/graph2.lp2.rkt
View File

@ -22,10 +22,9 @@ name. For example, a graph representing a city and its inhabitants could use
these variants: these variants:
@chunk[<example-variants> @chunk[<example-variants>
[City #|[streets : (Listof Street)]|# [inhabitants : (Listof Person)]] [City [streets : (Listof Street)] [inhabitants : (Listof Person)]]
#|DEBUG|# [Street [houses : (Listof House)]]
#|[Street [houses : (Listof House)]] [House [owner : Person] [location : Street]]
[House [owner : Person] [location : Street]]|#
[Person [name : String]]] [Person [name : String]]]
Notice the cycle in the type: a street contains houses, which are located on the 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} @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 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] street names @tc[c], and calls for each element the @tc[m-street] mapping and
mappings. the @tc[Person] node constructor.
@; Would be nicer with (map (∘ (curry street c) my-car) c)), but that doesn't @; Would be nicer with (map (∘ (curry street c) my-car) c)), but that doesn't
@; typecheck (yet). @; typecheck (yet).
@chunk[<example-mappings> @chunk[<example-mappings>
[(city [c : (Listof (Pairof String String))]) : City [(m-city [c : (Listof (Pairof String String))]) : City
(City #|DEBUG|##|(remove-duplicates (map (curry street c) (cars c)))|# (City (remove-duplicates (map (curry m-street c) (cars c)))
(remove-duplicates (map Person (cdrs c))))]] (remove-duplicates (map Person (cdrs c))))]]
@subsubsection{More mappings} @subsubsection{More mappings}
Next, we write the @tc[street] mapping, which takes a street name and the whole Next, we write the @tc[m-street] mapping, which takes a street name and the
city @tc[c] in list form, and creates a @tc[Street] node. whole city @tc[c] in list form, and creates a @tc[Street] node.
@chunk[<example-mappings> @chunk[<example-mappings>
#|DEBUG|# [(m-street [c : (Listof (Pairof String String))] [s : String]) : Street
#|[(street [c : (Listof (Pairof String String))] [s : String]) : Street (Street (map (curry (curry m-house s) c)
(Street (map (curry (curry house s) c)
(cars (filter (λ ([x : (Pairof String String)]) (cars (filter (λ ([x : (Pairof String String)])
(equal? (cdr x) s)) (equal? (cdr x) s))
c))))]|#] 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 house a reference to the containing street. Normally, this would cause infinite
recursion in an eager language, like @tc[typed/racket]. However, the mappings 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 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 mapping can be called any number of times with the same data, it will actually
only be run once. 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 mapping. The promises are not available during graph construction, so there is
no risk of forcing one before it is available. 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[<example-mappings> @chunk[<example-mappings>
#| [(m-house [s : String]
[(house [s : String] [c : (Listof (Pairof String String))] [p : String]) [c : (Listof (Pairof String String))]
[p : String])
: House : House
(House (Person p) (street c s))]|# (House (Person p) (m-street c s))]]
#|DEBUG|#]
Notice how we are calling directly the @tc[Person] constructor above. We also 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 called it directly in the @tc[m-city] mapping. Since @tc[Person] does not
references to @tc[House], @tc[Street] or @tc[City], we do not need to delay contain references to @tc[House], @tc[Street] or @tc[City], we do not need to
creation of these nodes by calling yet another mapping. delay creation of these nodes by calling yet another mapping.
@; TODO: above: Should we merge two identical instances of Person? They won't @; 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. @; 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. @; database, though.
The number and names of mappings do not necessarily reflect the graph's type. 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 Here, we have no mapping named @tc[m-person], because that node is always
directly. Conversely, we could have two mappings, @tc[big-street] and created directly. Conversely, we could have two mappings, @tc[m-big-street] and
@tc[small-street], with different behaviours, instead of passing an extra @tc[m-small-street], with different behaviours, instead of passing an extra
boolean argument to @tc[street]. boolean argument to @tc[m-street].
@; TODO: make the two street mappings
@subsubsection{Making a constructor for the graph} @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: Let's take a second look at the root mapping:
@chunk[<example-mappings-2> @chunk[<example-mappings-2>
[(city [c : (Listof (Pairof String String))]) [(m-city [c : (Listof (Pairof String String))]) : City
(City (remove-duplicates (map (∘ (curry street c) car) c)) (City (remove-duplicates (map (curry m-street c) (cars c)))
(remove-duplicates (map (∘ Person cdr) c)))]] (remove-duplicates (map Person (cdrs c))))]]
The first case shows that we can use @tc[street] as any other function, passing The first case shows that we can use @tc[m-street] as any other function,
it to @tc[curry], and calling @tc[remove-duplicates] on the results. Note that passing it to @tc[curry], and calling @tc[remove-duplicates] on the results.
each placeholder returned by @tc[street] will contain all information passed to Note that each placeholder returned by @tc[m-street] will contain all
it, here a street name and @tc[c]. Two placeholders for @tc[street] will information passed to it, here a street name and @tc[c]. Two placeholders for
therefore be @tc[equal?] if and only if all the arguments passed to @tc[street] @tc[m-street] will therefore be @tc[equal?] if and only if all the arguments
are @tc[equal?]. The placeholders also include a symbol specifying which mapping passed to @tc[m-street] are @tc[equal?]. The placeholders also include a symbol
was called, so two placeholders for two different mappings will not be specifying which mapping was called, so two placeholders for two different
@tc[equal?], even if identical parameters were supplied. 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 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 @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-queue> @chunk[<fold-queue>
(fold-queues <root-placeholder> (fold-queues <root-placeholder>
[(mapping [e : <fold-queue-type-element>] get-tag Δ-queues) [(mapping/placeholder-tag [e : <fold-queue-type-element>]
Δ-queues
enqueue)
: <fold-queue-type-result> : <fold-queue-type-result>
<fold-queue-body>] <fold-queue-body>]
...)] ...)]
@ -292,19 +294,19 @@ tagged with the @tc[mapping]'s name), and a constructor:
@; TODO: just use (variant [mapping param-type ...] ...) @; TODO: just use (variant [mapping param-type ...] ...)
@chunk[<define-mapping-placeholder> @chunk[<define-mapping-placeholder>
(define-type mapping/placeholder-type (List 'placeholder (define-type mapping/placeholder-type (List 'mapping/placeholder-tag
'mapping
param-type ...)) param-type ...))
(: mapping/make-placeholder (→ param-type ... mapping/placeholder-type)) (: mapping/make-placeholder (→ param-type ... mapping/placeholder-type))
(define (mapping/make-placeholder [param : param-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: The code above needs some identifiers derived from @tc[mapping] names:
@chunk[<define-ids> @chunk[<define-ids>
(define-temp-ids "~a/make-placeholder" (mapping ...)) (define-temp-ids "~a/make-placeholder" (mapping ...))
(define-temp-ids "~a/placeholder-type" (mapping ...)) (define-temp-ids "~a/placeholder-type" (mapping ...))
(define-temp-ids "~a/placeholder-tag" (mapping ...))
(define/with-syntax (root/make-placeholder . _) (define/with-syntax (root/make-placeholder . _)
#'(mapping/make-placeholder ...))] #'(mapping/make-placeholder ...))]
@ -359,11 +361,11 @@ which return type is the desired node type.
… …
(define-type node/incomplete-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)) (: node/make-incomplete (→ field/incomplete-type … node/incomplete-type))
(define (node/make-incomplete field-name …) (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 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 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 ...))]) (for/list ([x (in-syntax #'(node ...))])
(multiassoc-syntax (multiassoc-syntax
x 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 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-ids> @chunk[<define-ids>
(define-temp-ids "~a/make-incomplete" (node …)) (define-temp-ids "~a/make-incomplete" (node …))
(define-temp-ids "~a/incomplete-type" (node …)) (define-temp-ids "~a/incomplete-type" (node …))
(define-temp-ids "~a/incomplete-tag" (node …))
(define-temp-ids "~a/incomplete-fields" (node …)) (define-temp-ids "~a/incomplete-fields" (node …))
(define/with-syntax ((field/incomplete-type …) …) (define/with-syntax ((field/incomplete-type …) …)
(stx-map generate-temporaries #'((field-name …) …)))] (stx-map generate-temporaries #'((field-name …) …)))]
@ -422,20 +425,36 @@ The code above also needs some identifiers derived from @tc[node] and
@chunk[<convert-incomplete-to-with-promises> @chunk[<convert-incomplete-to-with-promises>
[node/incomplete-type [node/incomplete-type
node/with-promises-type node/with-promises-type
(λ (x) (and (pair? x) (λ (x) (and (pair? x) (eq? (car x) 'node/incomplete-tag)))
(eq? (car x) 'incomplete)
(pair? (cdr x))
(eq? (cadr x) 'node)))
(λ ([x : node/incomplete-type] [acc : Void]) (λ ([x : node/incomplete-type] [acc : Void])
(if (eq? (car x) 'incomplete) <convert-incomplete-successor>)]]
<convert-incomplete-successor>
<convert-placeholder-successor>))]] @chunk[<convert-placeholder-to-with-promises>
[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])
<convert-placeholder-successor>)]]
@; TODO: this would be much simpler if we forced having only one mapping per
@; node, and extended that with a macro.
@chunk[<define-compatible-mappings>
(define/with-syntax ((node/compatible-mappings ...) ...)
(for/list ([x (in-syntax #'(node ...))])
(multiassoc-syntax
x
#'([result-type . mapping]
…))))]
@chunk[<convert-incomplete-successor> @chunk[<convert-incomplete-successor>
(error (~a "Not implemented yet " x))] (error (~a "Not implemented yet " x))]
@chunk[<convert-placeholder-successor> @chunk[<convert-placeholder-successor>
(% 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)))] (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? @; Or maybe we can do this from the ouside, using a wrapper macro?
@CHUNK[<fold-queue-body> @CHUNK[<fold-queue-body>
(let ([mapping-result (apply mapping/function (cddr e))]) (let ([mapping-result (apply mapping/function (cdr e))])
(tmpl-fold-instance (tmpl-cdr-assoc-syntax (tmpl-fold-instance <the-incomplete-type>
result-type
[node . (List 'incomplete
'node
<field/incomplete-type> …)]
…)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Void Void
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; <convert-incomplete-to-with-promises> …
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; <convert-placeholder-to-with-promises> …))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
<convert-incomplete-to-with-promises> …))
'todo!] 'todo!]
@chunk[<the-incomplete-type>
(tmpl-cdr-assoc-syntax result-type
[node . (List <field/incomplete-type> …)]
…)]
@section{The mapping functions} @section{The mapping functions}
We define the mapping functions as they are described by the user, with an 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-mapping-function> @chunk[<define-mapping-function>
(define-type mapping/incomplete-result-type (define-type mapping/incomplete-result-type
(tmpl-replace-in-type result-type (tmpl-replace-in-type result-type
[node node/incomplete-type] [node (List 'node/incomplete-tag
<field/incomplete-type> …)]
…)) …))
(: mapping/function (→ param-type … mapping/incomplete-result-type)) (: mapping/function (→ param-type … mapping/incomplete-result-type))
@ -548,34 +561,6 @@ to return an incomplete node type.
g g
(require (submod ".." doc)))] (require (submod ".." doc)))]
@chunk[<*> @chunk[<*>

16
graph/graph/rewrite-type.lp2.rkt
View File

@ -378,11 +378,11 @@ functions is undefined.
@subsection{The code} @subsection{The code}
@CHUNK[<fold-instance> @CHUNK[<fold-instance>
(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 acc-type stx-acc-type)
(define/with-syntax ([from to pred? fun] ...) r) (define/with-syntax ([from to pred? fun] ...) r)
<recursive-replace-fold-instance> <recursive-replace-fold-instance>
(recursive-replace t))] (recursive-replace whole-type))]
@CHUNK[<recursive-replace-fold-instance> @CHUNK[<recursive-replace-fold-instance>
(define (new-type-for stx) (replace-in-type stx #'([from to] ...))) (define (new-type-for stx) (replace-in-type stx #'([from to] ...)))
@ -485,7 +485,14 @@ functions is undefined.
(cond (cond
#,@(stx-map (λ (ta) <replace-fold-union>) #,@(stx-map (λ (ta) <replace-fold-union>)
#'(a ...)) #'(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) [((~literal quote) a)
#'(inst values 'a acc-type)] #'(inst values 'a acc-type)]
[x:id [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] …) [(_ type:expr acc-type:expr [from to pred? fun] …)
#`(begin #`(begin
"fold-instance expanded code below. Initially called with:" "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 #,(fold-instance #'type
#'acc-type #'acc-type
#'([from to pred? fun] …)))])) #'([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 (require (for-syntax syntax/parse
racket/syntax racket/syntax
syntax/stx syntax/stx
racket/format
syntax/parse/experimental/template syntax/parse/experimental/template
"../lib/low-untyped.rkt") "../lib/low-untyped.rkt")
"structure.lp2.rkt" "structure.lp2.rkt"