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

graph3.lp2.rkt typechecks, but doesn't add new placeholders to the queue yet. Also, the queue module itself isn't finished.

Browse Source
This commit is contained in:
Georges Dupéron 2015-12-04 22:34:39 +01:00
parent 5169b73bf5
commit 353c2ff426
5 changed files with 689 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
graph/graph/fold-queues.lp2.rkt
View File

@ -23,7 +23,7 @@
...)))]
@chunk[<define-Δ-queues-type>
(define/with-syntax queues/type
(define/with-syntax Δ-queues/type
#'(List (Δ-Hash Element-Type Index) ...))]
@chunk[<fold-queue-multi-sets-immutable-tags>
@ -32,8 +32,8 @@
<define-Δ-queues-type>
#'(list (λ ([element : Element-Type]
[enqueue : enqueue/type]
[Δ-queues : queues/type])
: result-type
[Δ-queues : Δ-queues/type])
: (values result-type Δ-queues/type)
. body)
...)
#;#'(error "Not implemented yet"))]

84
graph/graph/graph2.lp2.rkt → graph/graph/graph2.lp2.rkt_
View File

@ -111,36 +111,40 @@ Finally, we write the @tc[m-house] mapping.
[(m-person [p : String]) : Person
(Person p)]]
Notice how we are calling directly the @tc[Person] constructor above. We also
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.
@; And we are already merging all equal? placeholders, so there shouldn't be
@; any blowup in the number of nodes.
@; It would probably be better for graph-map etc. to have all the nodes in the
@; database, though.
The number and names of mappings do not necessarily reflect the graph's type.
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
@identity{
Notice how we are calling directly the @tc[Person] constructor above. We also
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.
@; And we are already merging all equal? placeholders, so there shouldn't be
@; any blowup in the number of nodes.
@; It would probably be better for graph-map etc. to have all the nodes in the
@; database, though.
The number and names of mappings do not necessarily reflect the graph's type.
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}
@chunk[<make-constructor-example>
(make-graph-constructor (<example-variants>)
<example-root>)]
@subsubsection{Creating a graph instance}
@chunk[<use-example>
(define g <make-constructor-example>)]
@identity{
@chunk[<make-constructor-example>
(make-graph-constructor (<example-variants>)
<example-root>)]
@subsubsection{Creating a graph instance}
@chunk[<use-example>
(define g <make-constructor-example>)]
}
@subsection{More details on the semantics}
@ -160,17 +164,19 @@ 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
constructor here will actually accept either a placeholder, or an actual
instance, which itself may contain placeholders.
The node type allowing placeholders is derived from the ideal type given above.
Here, the type for @tc[Person] is @tc[[String]], so there are no substitutions
to make. On the contrary, the type for @tc[City], originally expressed as
@tc[[(Listof Street) (Listof Person)]], will be rewritten into
@tc[[(Listof (U Street Street-Placeholder))
(Listof (U Person Person-Placeholder))]].
@identity{
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
constructor here will actually accept either a placeholder, or an actual
instance, which itself may contain placeholders.
The node type allowing placeholders is derived from the ideal type given above.
Here, the type for @tc[Person] is @tc[[String]], so there are no substitutions
to make. On the contrary, the type for @tc[City], originally expressed as
@tc[[(Listof Street) (Listof Person)]], will be rewritten into
@tc[[(Listof (U Street Street-Placeholder))
(Listof (U Person Person-Placeholder))]].
}
The @tc[rewrite-type] module we use to derive types with placeholders from the
original ones only handles a handful of the types offered by @tc[typed/racket].
@ -415,6 +421,7 @@ a separate chunk:
node/compatible-placeholder-types …)]
…)]
@identity{
We must however compute for each node the set of compatible placeholder types.
We do that
@ -456,6 +463,7 @@ The code above also needs some identifiers derived from @tc[node] and
(define-temp-ids "~a/incomplete-fields" (node …))
(define/with-syntax ((field/incomplete-type …) …)
(stx-map-nested #'((field-name …) …)))]
}
@subsection{Converting incomplete nodes to with-promises ones}

576
graph/graph/graph3.lp2.rkt Normal file
View File

@ -0,0 +1,576 @@
#lang debug scribble/lp2
@(require "../lib/doc.rkt")
@doc-lib-setup
@(define (comment . _) "")
@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[<example-variants>
[City [streets : (Listof Street)] [people : (Listof Person)] <m-city>]
[Street [houses : (Listof House)] <m-street>]
[House [owner : Person] [location : Street] <m-house>]
[Person [name : String] <m-person>]]
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 . person-name)] pairs, and will convert it to a more convenient
graph representation. Our single root parameter will thus be the whole list:
@chunk[<example-root>
'(["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>
[(m-city [c : (Listof (Pairof String String))])
(City (remove-duplicates (map (curry m-street c) (cars c)))
(remove-duplicates (map m-person (cdrs 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>
[(m-street [c : (Listof (Pairof String String))] [s : String])
(Street (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[make-graph-constructor] 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>
[(m-house [s : String]
[c : (Listof (Pairof String String))]
[p : String])
(House (m-person p) (m-street c s))]]
@chunk[<m-person>
[(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[make-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[<use-example>
(define g
(make-graph (<example-variants>) <example-root>))]
@subsection{More details on the semantics}
Let's take a second look at the root mapping:
@chunk[<m-city-2>
[(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[make-graph] macro is implemented.
@subsection{The macro's syntax}
We use a simple syntax for @tc[make-graph], and make it more flexible through
wrapper macros.
@chunk[<signature>
(make-graph ([node <field-signature> … <mapping-declaration>]
…)
(root-expr:expr …))]
Where @tc[<field-signature>] is:
@chunk[<field-signature>
[field:id (~literal :) field-type:expr]]
And @tc[<mapping-declaration>] is:
@chunk[<mapping-declaration>
((mapping:id [param:id (~literal :) 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-ids>
(define-temp-ids "~a/make-placeholder" (node …) #:first-base root)
(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 …))
(define-temp-ids "~a/make-incomplete" (node …))
(define-temp-ids "~a/incomplete-tag" (node …))
(define-temp-ids "~a/incomplete-type" ((field …) …))
(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/with-indices-type" ((field …) …))
(define-temp-ids "~a/with-promises-type" (node …))
(define-temp-ids "~a/make-with-promises" (node …))
(define-temp-ids "~a/with-promises-tag" (node …))
(define-temp-ids "~a/with-promises-type" ((field …) …))
(define-temp-ids "~a/mapping-function" (node …))]
@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[<fold-queue-type-element>
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[<fold-queue-type-result>
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-queue>
(fold-queues <root-placeholder>
[(node/placeholder-queue [e : <fold-queue-type-element>]
Δ-queues
enqueue)
: <fold-queue-type-result>
<fold-queue-body>]
...)]
@subsection{Making placeholders for nodes}
We start creating the root placeholder which we provide to @tc[fold-queues].
@chunk[<root-placeholder>
(root/make-placeholder root-expr …)]
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[<define-placeholder-type>
(define-type node/placeholder-type
(List 'node/placeholder-tag
param-type …))]
@; TODO: just use (variant [mapping param-type ...] ...)
Then we define the @tc[node/make-placeholder] function:
@chunk[<define-make-placeholder>
(: node/make-placeholder (→ param-type … node/placeholder-type))
(define (node/make-placeholder param …)
(list 'node/placeholder-tag 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-with-indices>
(define-type field/with-indices-type
(tmpl-replace-in-type field-type
[node (List 'node/with-indices-tag2 Index)]
…))
…
(define-type node/with-indices-type
(List 'node/with-indices-tag field/with-indices-type …))
(: node/make-with-indices (→ field/with-indices-type …
node/with-indices-type))
(define (node/make-with-indices field …)
(list 'node/with-indices-tag field …))]
@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-with-promises>
(define-type field/with-promises-type
(tmpl-replace-in-type field-type
[node (Promise node/with-promises-type)] …))
…
(define-type node/with-promises-type
(List 'node/with-promises-tag
field/with-promises-type …))
(: node/make-with-promises (→ field/with-promises-type …
node/with-promises-type))
(define (node/make-with-promises field …)
(list 'node/with-promises-tag field …))]
@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-incomplete>
(define-type field/incomplete-type
(tmpl-replace-in-type field-type
[node node/placeholder-type] …))
…
(define-type node/incomplete-type
(List 'node/incomplete-tag field/incomplete-type …))
(: node/make-incomplete (→ field/incomplete-type … node/incomplete-type))
(define (node/make-incomplete field …)
(list 'node/incomplete-tag field …))]
@subsection{Converting incomplete nodes to with-indices ones}
@chunk[<placeholder→with-indices-function>
(λ ([p : node/placeholder-type] [acc : Void])
: (values (List 'node/with-indices-tag2 Index) Void)
(% index new-Δ-queues = (enqueue 'node/placeholder-queue p Δ-queues)
(values (list 'node/with-indices-tag2 index)
acc)))]
@chunk[<placeholder→with-indices-clause>
[node/placeholder-type
(List 'node/with-indices-tag2 Index)
(λ (x) (and (pair? x) (eq? (car x) 'node/placeholder-tag)))
<placeholder→with-indices-function>]]
@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?
@CHUNK[<fold-queue-body>
(let ([mapping-result (apply node/mapping-function (cdr e))])
(let ([f (tmpl-fold-instance (List <field-incomplete-type> …)
Void
<placeholder→with-indices-clause> …)])
(let-values ([(r new-acc) (f (cdr mapping-result) (void))])
(values (cons 'node/with-indices-tag r)
Δ-queues))))]
Where @tc[<field-incomplete-type>] is the field-type in which node types are
replaced by placeholder types.
@chunk[ <field-incomplete-type>
(tmpl-replace-in-type field-type
[node node/placeholder-type] …)]
@section{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[<define-mapping-function>
(: 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)))]
@;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@comment[#|
@subsection{Converting incomplete nodes to with-promises ones}
@chunk[<convert-incomplete-to-with-promises>
[node/incomplete-type
node/with-promises-type
(λ (x) (and (pair? x) (eq? (car x) 'node/incomplete-tag)))
(λ ([x : node/incomplete-type] [acc : Void])
<convert-incomplete-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>
(error (~a "Not implemented yet " x))]
@chunk[<convert-placeholder-successor>
(% index new-Δ-queues = (enqueue 'mapping/placeholder-tag x Δ-queues)
(list 'mapping/placeholder-tag index)
(error (~a "Not implemented yet " x)))]
|#]
@section{Putting it all together}
@chunk[<make-graph-constructor>
(define-syntax/parse <signature>
<define-ids>
((λ (x) (pretty-write (syntax->datum x)) x)
(template
(let ()
(begin <define-placeholder-type>) …
(begin <define-make-placeholder>) …
(begin <define-with-indices>) …
(begin <define-with-promises>) …
(begin <define-incomplete>) …
(begin <define-mapping-function>) …
<fold-queue>))))]
@section{Conclusion}
@chunk[<module-main>
(module main typed/racket
(require (for-syntax syntax/parse
racket/syntax
syntax/stx
syntax/parse/experimental/template
racket/sequence
racket/pretty; DEBUG
alexis/util/threading; DEBUG
"rewrite-type.lp2.rkt"
"../lib/low-untyped.rkt")
alexis/util/threading; DEBUG
"fold-queues.lp2.rkt"
"rewrite-type.lp2.rkt"
"../lib/low.rkt")
;(begin-for-syntax
;<multiassoc-syntax>)
(provide make-graph)
<make-graph-constructor>)]
@chunk[<module-test>
(module* test typed/racket
(require (submod "..")
"fold-queues.lp2.rkt"; DEBUG
"rewrite-type.lp2.rkt"; DEBUG
"../lib/low.rkt"; DEBUG
typed/rackunit)
<use-example>
g
(require (submod ".." doc)))]
@chunk[<*>
(begin
<module-main>
(require 'main)
(provide (all-from-out 'main))
<module-test>)]

28
graph/lib/__DEBUG__.rkt
View File

@ -1,10 +1,36 @@
#lang racket
(require "low-untyped.rkt")
(with-syntax ([((foo ...) ...) #'((aa bb cc) (x1 x2))])
(define-temp-ids "___~a.truc" ((foo ...) ...) #:first-base fst)
(displayln (syntax->datum #'((___foo.truc ...) ...)))
(displayln (syntax->datum #'(fst ___fst.truc))))
(newline)
(with-syntax ([(foo ...) #'(aa bb cc)])
(define-temp-ids "___~a.truc" (foo ...) #:first-base fst)
(displayln (syntax->datum #'(___foo.truc ...)))
(displayln (syntax->datum #'(fst ___fst.truc))))
(newline)
(with-syntax ([foo #'aa])
(define-temp-ids "___~a.truc" foo)
(displayln (syntax->datum #'___foo.truc))
(displayln (syntax->datum #'(fst ___fst.truc))))
(newline)
(with-syntax ([((foo ...) ...) #'((aa bb cc) (x1 x2))])
(define-temp-ids "___~a.truc" ((foo ...) ...) #:first-base fst)
(displayln (syntax->datum #'(___foo.truc ... ...)))
(displayln (syntax->datum #'(fst ___fst.truc))))
(newline)
(define a 1)
(+ a a)
(+ a a)
(module t typed/racket
(require "low.rkt"))

50
graph/lib/low.rkt
View File

@ -554,6 +554,19 @@
(syntax-e id)))))
(begin-for-syntax
(define-syntax-class dotted
(pattern id:id
#:attr make-dotted
(λ (x) x)
#:attr wrap
(λ (x f) (f x #t)))
(pattern (nested:dotted (~literal ...));(~and dots (~literal ...)) ...+)
#:with id #'nested.id
#:attr make-dotted
(λ (x) #`(#,((attribute nested.make-dotted) x) (... ...)));dots …
#:attr wrap
(λ (x f) (f ((attribute nested.wrap) x f) #f))))
(define-syntax-class simple-format
(pattern format
#:when (string? (syntax-e #'format))
@ -571,6 +584,7 @@
(define-syntax (define-temp-ids stx)
(syntax-parse stx
#|
;; TODO : factor this with the next case.
[(_ format ((base:id (~literal ...)) (~literal ...)))
#:when (string? (syntax-e #'format))
@ -578,14 +592,14 @@
#'(define/with-syntax ((pat (... ...)) (... ...))
(stx-map (curry format-temp-ids format)
#'((base (... ...)) (... ...)))))]
|#
;; New features (arrows and #:first) special-cased for now
;; todo: make these features more general.
[(_ format:simple-format (base:id (~literal ...)) #:first-base first-base)
[(_ format:simple-format base:dotted #:first-base first-base)
#:with first (format-id #'first-base (syntax-e #'format) #'first-base)
(let ([first-base-len (identifier-length #'first-base)])
(syntax-cons-property #'(define-temp-ids format (base (... ...))
#:first first)
(syntax-cons-property #'(define-temp-ids format base #:first first)
'sub-range-binders
(list
(if (> (attribute format.left-len) 0)
@ -615,18 +629,27 @@
(attribute format.right-len))
'()))))]
[(_ format:simple-format (base:id (~literal ...))
[(_ format:simple-format
base:dotted
(~optional (~seq #:first-base first-base))
(~optional (~seq #:first first)))
(let* ([base-len (string-length (symbol->string (syntax-e #'base)))])
(define/with-syntax pat (format-id #'base (syntax-e #'format) #'base))
(let* ([base-len (string-length (symbol->string (syntax-e #'base.id)))])
(define/with-syntax pat
(format-id #'base.id (syntax-e #'format) #'base.id))
(define/with-syntax pat-dotted ((attribute base.make-dotted) #'pat))
(define/with-syntax format-temp-ids*
((attribute base.wrap) #'(compose car (curry format-temp-ids format))
(λ (x deepest?)
(if deepest?
x
#`(curry stx-map #,x)))))
(syntax-cons-property
(template (begin (define/with-syntax (pat (... ...))
(format-temp-ids format #'(base (... ...))))
(template (begin (define/with-syntax pat-dotted
(format-temp-ids* #'base))
(?? (?@ (define/with-syntax (first . _)
#'(pat (... ...)))))
(?? (?@ (define/with-syntax (fst . _)
#'(pat (... ...)))))))
#'pat-dotted)))))
'sub-range-binders
(list (if (> (attribute format.left-len) 0)
(vector (syntax-local-introduce #'pat)
@ -641,7 +664,7 @@
(attribute format.left-len)
base-len
(syntax-local-get-shadower #'base)
(syntax-local-get-shadower #'base.id)
0
base-len)
(if (> (attribute format.right-len) 0)
@ -652,7 +675,8 @@
(syntax-local-introduce #'format)
(attribute format.right-start)
(attribute format.right-len))
'()))))]
'())))
)]
[(_ format (base:id (~literal ...)))
#:when (string? (syntax-e #'format))
(with-syntax ([pat (format-id #'base (syntax-e #'format) #'base)])