diff --git a/graph/graph/fold-queues.lp2.rkt b/graph/graph/fold-queues.lp2.rkt index 40126c3d..b5a0f45d 100644 --- a/graph/graph/fold-queues.lp2.rkt +++ b/graph/graph/fold-queues.lp2.rkt @@ -23,7 +23,7 @@ ...)))] @chunk[ - (define/with-syntax queues/type + (define/with-syntax Δ-queues/type #'(List (Δ-Hash Element-Type Index) ...))] @chunk[ @@ -32,8 +32,8 @@ #'(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"))] diff --git a/graph/graph/graph2.lp2.rkt b/graph/graph/graph2.lp2.rkt_ similarity index 91% rename from graph/graph/graph2.lp2.rkt rename to graph/graph/graph2.lp2.rkt_ index 05c3a312..d6c70577 100644 --- a/graph/graph/graph2.lp2.rkt +++ b/graph/graph/graph2.lp2.rkt_ @@ -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-graph-constructor () - )] - -@subsubsection{Creating a graph instance} - -@chunk[ - (define g )] +@identity{ + @chunk[ + (make-graph-constructor () + )] + + @subsubsection{Creating a graph instance} + + @chunk[ + (define g )] +} @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} diff --git a/graph/graph/graph3.lp2.rkt b/graph/graph/graph3.lp2.rkt new file mode 100644 index 00000000..ab9d0167 --- /dev/null +++ b/graph/graph/graph3.lp2.rkt @@ -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[ + [City [streets : (Listof Street)] [people : (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 +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[ + '(["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) (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 [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 [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[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[ + (define g + (make-graph () ))] + +@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[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[ + (make-graph ([node … ] + …) + (root-expr:expr …))] + +Where @tc[] is: + +@chunk[ + [field:id (~literal :) field-type:expr]] + +And @tc[] is: + +@chunk[ + ((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-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[ + 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 + [(node/placeholder-queue [e : ] + Δ-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-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-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[ + (: 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-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-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-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[ + (λ ([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[ + [node/placeholder-type + (List 'node/with-indices-tag2 Index) + (λ (x) (and (pair? x) (eq? (car x) 'node/placeholder-tag))) + ]] + +@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[ + (let ([mapping-result (apply node/mapping-function (cdr e))]) + (let ([f (tmpl-fold-instance (List …) + Void + …)]) + (let-values ([(r new-acc) (f (cdr mapping-result) (void))]) + (values (cons 'node/with-indices-tag r) + Δ-queues))))] + +Where @tc[] is the field-type in which node types are +replaced by placeholder types. + +@chunk[ + (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[ + (: 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[ + [node/incomplete-type + node/with-promises-type + (λ (x) (and (pair? x) (eq? (car x) 'node/incomplete-tag))) + (λ ([x : node/incomplete-type] [acc : Void]) + )]] + + @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[ + (% 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[ + (define-syntax/parse + + ((λ (x) (pretty-write (syntax->datum x)) x) + (template + (let () + (begin ) … + (begin ) … + (begin ) … + (begin ) … + (begin ) … + (begin ) … + ))))] + +@section{Conclusion} + +@chunk[ + (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 + ;) + + (provide make-graph) + )] + +@chunk[ + (module* test typed/racket + (require (submod "..") + "fold-queues.lp2.rkt"; DEBUG + "rewrite-type.lp2.rkt"; DEBUG + "../lib/low.rkt"; DEBUG + typed/rackunit) + + + + g + + + + + + + + + + + + + + + + + + + + + + + + + + + (require (submod ".." doc)))] + +@chunk[<*> + (begin + + + (require 'main) + (provide (all-from-out 'main)) + + )] \ No newline at end of file diff --git a/graph/lib/__DEBUG__.rkt b/graph/lib/__DEBUG__.rkt index 0d4c3f42..bc67903c 100644 --- a/graph/lib/__DEBUG__.rkt +++ b/graph/lib/__DEBUG__.rkt @@ -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) \ No newline at end of file +(+ a a) + +(module t typed/racket + (require "low.rkt")) \ No newline at end of file diff --git a/graph/lib/low.rkt b/graph/lib/low.rkt index 80584164..dde57a13 100644 --- a/graph/lib/low.rkt +++ b/graph/lib/low.rkt @@ -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)])