321 lines
11 KiB
Racket
321 lines
11 KiB
Racket
#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[<example-infinite-loop>
|
|
(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[<signature>
|
|
(define-graph/rich-return name:id
|
|
((~commit [node:id <field-signature> …])
|
|
…)
|
|
(~commit <mapping-declaration>)
|
|
…)]
|
|
|
|
Where @tc[<field-signature>] hasn't changed:
|
|
|
|
@chunk[<field-signature>
|
|
(~describe "[field : type]"
|
|
[field:id c:colon field-type:expr])]
|
|
|
|
We now allow more complex return types in a @tc[<mapping-declaration>]:
|
|
|
|
@chunk[<mapping-declaration>
|
|
(~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[<test-graph-rich-return>
|
|
(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 (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[<graph-rich-return>
|
|
(define-syntax/parse <signature>
|
|
(define-temp-ids "first-step" name)
|
|
(define-temp-ids "first-step-expander2" name)
|
|
(define-temp-ids "~a/simple-mapping" (node …))
|
|
(define-temp-ids "~a/node" (mapping …))
|
|
(define/with-syntax ~>-id (datum->syntax #'name '~>))
|
|
(template
|
|
;(debug
|
|
(begin
|
|
(define-graph first-step
|
|
#:definitions [<first-pass-type-expander>]
|
|
[node [field c (Let [~>-id first-step-expander2] field-type)] …
|
|
[(node/simple-mapping [field c field-type] …)
|
|
;<first-pass-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[<first-pass-type-expander>
|
|
;; TODO: to avoid conflicting definitions of ~>, we should either use
|
|
;; syntax-parameterize, or make a #:local-definitions
|
|
(define-type-expander (~>-id stx)
|
|
(syntax-parse stx
|
|
[(_ (~datum mapping)) ;; TODO: should be ~literal
|
|
(template
|
|
(U (first-step #:placeholder mapping/node)
|
|
(tmpl-replace-in-type result-type
|
|
[node (first-step #:placeholder node)]
|
|
…)))]
|
|
…
|
|
;; TODO: should fall-back to outer definition of ~>, if any.
|
|
))
|
|
(define-type-expander (first-step-expander2 stx)
|
|
(syntax-parse stx
|
|
[(_ (~datum mapping)) ;; TODO: should be ~literal
|
|
#'(U mapping/node result-type)]
|
|
…
|
|
;; TODO: should fall-back to outer definition of ~>, if any.
|
|
)
|
|
#;(U (first-step #:placeholder m-streets4/node)
|
|
(Listof (first-step #:placeholder Street))))]
|
|
|
|
@; TODO: replace-in-type doesn't work wfell here, we need to define a
|
|
@; type-expander.
|
|
@chunk[<first-pass-field-type>
|
|
(tmpl-replace-in-type field-type
|
|
[(~> mapping) (U mapping/node result-type)] …)]
|
|
|
|
@section{Conclusion}
|
|
|
|
@chunk[<module-main>
|
|
(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"
|
|
"rewrite-type.lp2.rkt"; debug
|
|
)
|
|
(rename-in "../lib/low.rkt" [~> threading:~>])
|
|
"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
|
|
racket/stxparam
|
|
racket/splicing)
|
|
(provide define-graph/rich-return); ~>)
|
|
|
|
;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>))
|
|
|
|
(require (for-syntax racket/pretty))
|
|
(define-syntax (debug stx)
|
|
(syntax-case stx ()
|
|
[(_ body)
|
|
;; syntax->string
|
|
(pretty-print (syntax->datum #'body))
|
|
#'body]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#;(begin
|
|
(define-graph
|
|
first-step
|
|
#:definitions
|
|
((define-type-expander
|
|
(~> stx)
|
|
(syntax-parse
|
|
stx
|
|
((_ (~datum m-cities))
|
|
(template
|
|
(U
|
|
(first-step #:placeholder m-cities3/node)
|
|
(Listof (first-step #:placeholder City)))))
|
|
((_ (~datum m-streets))
|
|
(template
|
|
(U
|
|
(first-step #:placeholder m-streets4/node)
|
|
(Listof (first-step #:placeholder Street)))))))
|
|
(define-type-expander
|
|
(first-step-expander2 stx)
|
|
(syntax-parse
|
|
stx
|
|
((_ (~literal m-cities))
|
|
(template
|
|
(U m-streets4/node (Listof Street))))
|
|
((_ (~literal m-streets))
|
|
(template
|
|
(U m-streets4/node (Listof Street)))))))
|
|
(City
|
|
(streets : (Let [~> first-step-expander2] (~> m-streets))#;(~> m-streets))
|
|
((City1/simple-mapping (streets : (~> m-streets))) (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))) (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-graph
|
|
first-step
|
|
#:definitions
|
|
((define-type-expander
|
|
(~> stx)
|
|
(syntax-parse
|
|
stx
|
|
((_ (~datum m-cities))
|
|
(template
|
|
(U
|
|
(first-step #:placeholder m-cities3/node)
|
|
(Listof (first-step #:placeholder City)))))
|
|
((_ (~datum m-streets))
|
|
(template
|
|
(U
|
|
(first-step #:placeholder m-streets4/node)
|
|
(Listof (first-step #:placeholder Street)))))))
|
|
(define-type-expander
|
|
(first-step-expander2 stx)
|
|
(syntax-parse
|
|
stx
|
|
((_ (~datum m-cities)) #'(U m-cities3/node (Listof City)))
|
|
((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street))))))
|
|
(City
|
|
(streets : (Let (~> first-step-expander2) (~> m-streets)))
|
|
((City1/simple-mapping (streets : (~> m-streets))) (City streets)))
|
|
(Street
|
|
(sname : (Let (~> first-step-expander2) 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))) (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)))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<graph-rich-return>)]
|
|
|
|
@chunk[<module-test>
|
|
(module* test typed/racket
|
|
(require (submod "..")
|
|
typed/rackunit)
|
|
|
|
;;<test-graph-rich-return>
|
|
)]
|
|
|
|
@chunk[<*>
|
|
(begin
|
|
<module-main>
|
|
|
|
(require 'main)
|
|
(provide (all-from-out 'main))
|
|
|
|
<module-test>)] |