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

Uncommited changes.

Browse Source
This commit is contained in:
Georges Dupéron 2016-03-31 18:36:01 +02:00
parent e9c3fbf8e5
commit 20802f257f
9 changed files with 505 additions and 23 deletions

7
graph-lib/graph/adt.scrbl
View File

@ -6,6 +6,7 @@
@doc-lib-setup
@defform[#:kind "type expander"
#:literals (:)
(tagged tag field-desc)
#:grammar
[(tag Identifier)
@ -32,7 +33,8 @@
(tagged)]{
}
@defform*[((tagged maybe-instance tag just-field …)
@defform*[#:literals (:)
((tagged maybe-instance tag just-field …)
(tagged maybe-make-instance tag field+value …))
#:grammar
[(maybe-instance (code:line)
@ -72,7 +74,8 @@
@defform[(tagged? tag
#:with-struct with-struct
field)]{
field)
#:contracts ([with-struct struct-type?])]{
The @racket[#:with-struct] option is reserved for internal
use. It is used by @racket[#:private] and
@racket[#:uninterned] in @racket[define-contructor] and

155
graph-lib/graph/graph-6-rich-returns.lp2.rkt
View File

@ -111,6 +111,8 @@ plain list.
(define/with-syntax (node* …) #'(node …))
(define-temp-ids "~a/first-step" name)
(define-temp-ids "first-step-expander2" name)
(define-temp-ids "top1-accumulator-type" name)
(define-temp-ids "~a/accumulator" (node …))
(define-temp-ids "~a/simple-mapping" (node …))
(define-temp-ids "~a/node" (mapping …))
(define-temp-ids "~a/extract/mapping" (node …))
@ -120,6 +122,9 @@ plain list.
(define-temp-ids "~a/from-first-pass" (node …))
(define-temp-ids "second-step-~a/node-of-first" (mapping …))
(define-temp-ids "second-step-~a-of-first" (node …))
(define-temp-ids "~a/node-index" (mapping …))
(define-temp-ids "~a/node-index-marker" (mapping …))
(define-temp-ids "~a/node-index?" (mapping …))
;(define step2-introducer (make-syntax-introducer))
;(define/with-syntax id-~> (datum->syntax #'name '~>))
;(define/with-syntax introduced-~> (datum->syntax #'name '~>))
@ -130,7 +135,8 @@ plain list.
(quasitemplate
(define-graph name/first-step
#:definitions [<first-pass-type-expander>]
[node [field c (Let [id-~> first-step-expander2] field-type)] …
[node [field c (Let [id-~> first-step-expander2] field-type)]
#| |#…
[(node/simple-mapping [field c field-type] …)
;<first-pass-field-type>] …)
(node field …)]] …
@ -189,7 +195,7 @@ produced by the first step.
|#
(define-type mapping/node-marker
(tmpl-replace-in-type result-type
[mapping/node mapping/node-marker] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO: test: I'm unsure here
[mapping/node mapping/node-marker] ;;;;;;;TODO: test: I'm unsure here
[node (name #:placeholder City)])
#;(U (name/first-step mapping/node)
(tmpl-replace-in-type result-type
@ -197,7 +203,7 @@ produced by the first step.
[node (name/first-step node)])))
…
;; TODO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO;^^;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TODO;^^;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-type-expander (second-step-marker-expander stx)
(syntax-parse stx
;; TODO: should be ~literal
@ -216,10 +222,11 @@ produced by the first step.
(define-type-expander (second-step-marker2-expander stx)
(syntax-parse stx
;; TODO: should be ~literal
[(_ (~datum mapping)) #'(U second-step-mapping/node-of-first
result-type #;(tmpl-replace-in-type result-type
[mapping/node (name/first-step mapping/node)]
[node (name/first-step node)]))]
[(_ (~datum mapping))
#'(U second-step-mapping/node-of-first
result-type #;(tmpl-replace-in-type result-type
[mapping/node (name/first-step mapping/node)]
[node (name/first-step node)]))]
…
;; TODO: should fall-back to outer definition of ~>, if any?
))]
@ -275,7 +282,7 @@ in all of its fields:
@chunk[<inlined-node>
;; inline from the field-type of the old node.
(node ((inline-instance* field-type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(node ((inline-instance* field-type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
()) (get from field))
…)]
@ -291,7 +298,8 @@ recursively:
(syntax-parse stx
[(_ i-ty seen)
(define/with-syntax replt
(replace-in-type #'(Let (id-~> second-step-marker2-expander) i-ty)
(replace-in-type #'(Let (id-~> second-step-marker2-expander)
i-ty)
#'([node second-step-node-of-first]
…)))
(displayln (list "replt=" #'replt))
@ -328,6 +336,8 @@ recursively:
We need to inline the mapping nodes between the root mapping node and the first
layer of actual nodes. We do this in three steps:
@; TODO: example + test
@itemlist[
@item{First, we replace the actual nodes with
placeholders, which contain just an index, and aggregate
@ -337,6 +347,130 @@ layer of actual nodes. We do this in three steps:
@item{Finally, we replace the placeholders with the
second-pass nodes returned by the graph.}]
@CHUNK[<inline-instance-top1-types>
(define-constructor mapping/node-index
#:private
#:? mapping/node-index?
Index)
…
(define-type mapping/node-index-marker mapping/node-index)
…
(define-type top1-accumulator-type
(pairof Index ;; max
(list (listof (name/first-step node))
…)))]
@CHUNK[<inline-instance-top1>
(define-syntax (inline-instance-top1* stx)
(dbg
("inline-instance-top1*" stx)
(syntax-parse stx
[(_ i-ty seen)
(define/with-syntax replt
(replace-in-type #'(Let (id-~> second-step-marker2-expander)
i-ty)
#'([node second-step-node-of-first]
…)))
(displayln (list "replt=" #'replt))
#'(inline-instance-top1 replt seen)])))
(define-syntax (inline-instance-top1 stx)
(dbg
("inline-instance-top1" stx)
(syntax-parse stx
[(_ i-t (~and seen (:id (… …))))
<inline-check-seen>
;(replace-in-instance #'i-t
(fold-instance #'i-t
#'top1-accumulator-type
#'(<inline-instance-top1-replacement>
<inline-instance-top1-nodes>))])))]
@chunk[<inline-instance-top1-replacement>
[second-step-mapping/node-of-first ;; from
(inline-type result-type (mapping/node . seen)) ;; to
(name/first-step #:? mapping/node) ;; pred?
(λ ([x : second-step-mapping/node-of-first] ;; fun
[acc : top1-accumulator-type])
(values ((inline-instance-top1* result-type (mapping/node . seen))
(get x returned))
ACC))]
…]
@chunk[<inline-instance-top1-nodes>
[second-step-node-of-first ;; node of first step ;; from
mapping/node-index-marker ;; new type ;; to
(name/first-step #:? node) ;; pred?
;node/extract/mapping] ;; call mapping ;; fun
(λ ([x : second-step-node-of-first]
[acc : top1-accumulator-type])
: (values mapping/node-index-marker
top1-accumulator-type)
(% (idx . (node/accumulator …)) = acc
in
(values PLACEHOLDER
(cons (add1 idx)
(NEW-NDS …)))))]
…]
@chunk[<inline-instance-top2>
;; Call the second step graph constructor:
(name #:roots (ann (cdr LAST-ACCUMULATOR)
(list (vectorof (name/first-step mapping/node)))))]
@chunk[<inline-instance-top3>
(replace-in-instance #'TYPE??
#'([mapping/node-index ;; from
(name node) ;; to
mapping/node-index? ;; pred?
(λ ([idx : mapping/node-index]) ;; fun
(VECTOR-REF ??? (constructor-values idx)))
]))]
@(begin #|
@CHUNK[<inline-instance-top3>
(define-syntax (inline-instance-top3* stx)
(dbg
("inline-instance-top3*" stx)
(syntax-parse stx
[(_ i-ty seen)
(define/with-syntax replt
(replace-in-type #'(Let (id-~> second-step-marker2-expander)
i-ty)
#'([node second-step-node-of-first]
…)))
(displayln (list "replt=" #'replt))
#'(inline-instance-top3 replt seen)])))
(define-syntax (inline-instance-top3 stx)
(dbg
("inline-instance-top3" stx)
(syntax-parse stx
[(_ i-t (~and seen (:id (… …))))
<inline-check-seen>
(replace-in-instance #'i-t
#'(<inline-instance-top3-replacement>
<inline-instance-top3-nodes>))])))]
@chunk[<inline-instance-top3-replacement>
[second-step-mapping/node-of-first ;; from
(inline-type result-type (mapping/node . seen)) ;; to
(name/first-step #:? mapping/node) ;; pred?
(λ ([x : second-step-mapping/node-of-first]) ;; fun
((inline-instance-top3* result-type (mapping/node . seen))
(get x returned)))]
…]
@chunk[<inline-instance-top3-nodes>
[second-step-node-of-first ;; node of first step ;; from
(name #:placeholder node) ;; new type ;; to
(name/first-step #:? node) ;; pred?
node/extract/mapping] ;; call mapping ;; fun
…]
|#)
@subsection{Inlining types}
The input type for the inlining of field @tc[streets] of the node @tc[City] is:
@ -558,7 +692,8 @@ encapsulating the result types of mappings.
;(display ">>> ")(displayln (list . log))
(let ((res (let () . body)))
;(display "<<< ")(displayln (list . log))
;(display "<<<= ")(display (car (list . log)))(display res)(displayln ".")
;(display "<<<= ")(display (car (list . log)))
;(display res)(displayln ".")
res))))
<graph-rich-return>)]

2
graph-lib/graph/graph-test.rkt
View File

@ -32,7 +32,7 @@
;; Check that the two requests for (splash) give the same node:
;; Also, (n2) is disconnected from the rest of the graph.
(check-true:
(% ((a b c d) (e) ())
(% (#(a b c d) #(e) #())
= (gr-simple #:roots
[Fountain '((splash) (splish) (splash) (soak))]
[Node2 '((n2))]

13
graph-lib/graph/graph.lp2.rkt
View File

@ -453,16 +453,17 @@ node.
@chunk[<multi-constructor>
(: name/multi-constructor (→ (Listof (List param-type …))
…
(List (Listof node/promise-type) …)))
…
(List (Vectorof node/promise-type) …)))
(define (name/multi-constructor node/multi-rest …)
(% (node/multi-indices …) (node/database …) = <fold-queues2>
in
(begin <define-with-indices→with-promises>) …
(list (map (λ ([idx : Index])
(node/with-indices→with-promises
(vector-ref node/database idx)))
node/multi-indices)
(list (list->vector
(map (λ ([idx : Index])
(node/with-indices→with-promises
(vector-ref node/database idx)))
node/multi-indices))
…)))]
@chunk[<fold-queues2>

25
graph-lib/graph/rewrite-type.scrbl
View File

@ -61,4 +61,29 @@ new type.
if the data pased as an argument is an instance of the
@racket[from] type. @racket[fun] should accept instances of
the @racket[from] type, and return instances of the
@racket[to] type.}
@defform[#:kind "procedure"
(fold-instance old-type
accumulator-type
#'([from to pred? fun] …))
#:contracts ([old-type type]
[accumulator-type type]
[from identifier?]
[to type]
[pred? predicate?]
[fun (→ from acc (values to acc))])]{
Produces the syntax for the syntax for a function from
@racket[old-type] to the new type, transforming all parts
of the data structure which satisfy @racket[pred?] using
@racket[fun]. The generated function takes as a second
argument an initial value for the accumulator. The
accumulator is passed to @racket[fun] and the one returned
is used as the accumulator for the next call. No guarantee
is made on the order of traversal.
@racket[pred?] should return true if and only
if the data pased as an argument is an instance of the
@racket[from] type. @racket[fun] should accept instances of
the @racket[from] type, and return instances of the
@racket[to] type.}

6
graph-lib/lib/low/in.rkt
View File

@ -5,4 +5,8 @@
(require racket/stxparam)
(define-syntax-parameter in
(λ _ "`in' used out of context. It can only be used in some forms."))
(λ (stx)
(raise-syntax-error
'in
"used out of context. It can only be used in some forms."
stx)))

10
graph-lib/lib/low/percent.rkt
View File

@ -3,8 +3,10 @@
(define-typed/untyped-modules #:no-test
(provide % define% in)
(require (for-syntax syntax/parse))
(require "in.rkt")
(require (for-syntax syntax/parse
"typed-untyped.rkt")
"in.rkt")
(begin-for-syntax (require-typed/untyped "aliases.rkt"))
#|(define-syntax (% stx)
(syntax-parse stx #:literals (= → :)
@ -21,7 +23,9 @@
(pattern ()
#:with expanded #'(list))
(pattern (x:%pat . rest:%pat)
#:with expanded #'(cons x.expanded rest.expanded)))
#:with expanded #'(cons x.expanded rest.expanded))
(pattern #(x:%pat …)
#:with expanded #'(vector x.expanded …)))
(define-splicing-syntax-class %assignment
#:attributes ([pat.expanded 1] [expr 0])
#:literals (= in)

58
graph-lib/lib/low/percent.scrbl Normal file
View File

@ -0,0 +1,58 @@
#lang scribble/manual
@(require (for-label typed/racket/base
"percent.rkt"))
@title{@racket[let-in] binding and destructuring form}
@defform[#:literals (in = and)
(% parallel-binding …
maybe-in
body …)
#:grammar
[(parallel-binding (code:line binding and parallel-binding)
binding)
(binding (code:line pattern … = expr))
(maybe-in (code:line)
in)
(expr expression)]]{
Locally binds the variables in the @racket[pattern]s to the
@racket[expr]. Each binding clause should contain as many
@racket[pattern]s as @racket[expr] produces values. The
@racket[body …] forms are evaluated with the given
variables bound.
The bindings are executed in sequence, as if bound with
@racket[let*], unless grouped using @racket[and], in which
case they are executed in parallel, as if bound with
@racket[let].
NOTE: TODO: for now bindings are run in sequence, and
parallel bindings have not been implemented yet.}
@defform[#:literals (: :: …)
(define% (name pattern …)
body …)
#:grammar
[(pattern variable
[variable : type]
cons-pattern
list-pattern
vector-pattern)
(cons-pattern (pattern . pattern)
(pattern :: pattern))
(list-pattern (pattern …)
(pattern … :: tail-pattern))
(tail-pattern pattern)
(vector-pattern #(pattern …))
(variable identifier)]]{
Locally binds the variables in the @racket[pattern]s to the
@racket[expr]. Each binding clause should contain as many
@racket[pattern]s as @racket[expr] produces values. The
@racket[body …] forms are evaluated with the given
variables bound.
The bindings are executed in parallel, as if bound with
@racket[let].}

252
graph-lib/lib/low/template.scrbl Normal file
View File

@ -0,0 +1,252 @@
#lang scribble/manual
@(require (for-label typed/racket/base
syntax/parse
;"template.rkt"
))
@(define ellipses (racket ...))
@title{Versatile parser and template library}
Keywords: grammar, parser, template.
@defform[(parse expr [pattern body …] …)]{
Analogous to @racket[syntax-parse], except it isn't
specialized for syntax, but rather works for arbitrary
s-expressions, including syntax ones (denoted by
@racket[#'(…)] in the pattern).}
@defform[#:literals (: :: ... else struct)
(tmpl template)
#:grammar
[(template variable
[variable : type] ;; (ann variable type)
;; cons-template
(template . template)
(template :: template)
;; list
(template**)
;; list*
template**-dotted
;; vector
#(template**)
(vector . template**-dotted)
;; hash-template: template** must expand to a list of pairs.
(hash . template**-dotted) ;; TODO: how to distinguish
(hasheq . template**-dotted) ;; mutable and immutable?
(hasheqv . template**-dotted)
#hash([template . template])
#hasheq([template . template])
#hasheqv([template . template])
;; struct-template
(struct-id template …)
(struct struct-id template …)
#s(prefab-id template …)
#s(template template …) ;; Only allowed in untyped racket
;; box
#&template
;; call-template
(~identifier args …) ;; calls (identifier args …)
(~ expr args …) ;; calls (expr args …)
;; unquote-template
,expr
,@(list expr)
,@(list* expr) ;; must appear in last position.
;; template-expander
template-expander-id
(template-expander-id args …)
;; maybe-template (should all be template expanders
;; which means the system is extensible enough to express
;; these special cases).
(?? alt-template …)
(?@ . template**-dotted)
(??@ . template**-dotted)
(?if condition template template)
(|@if| condition template template)
(if@ condition template template)
(|@cond| [condition template] …)
(|@cond| [condition template] … [else template])
(cond@ condition template template)
;; like #,@(with-syntax ([meta-var #'template])
;; #'(template**))
(~let ([meta-var+args template])
. template**-dotted)
(~sort key template ooo)
(~loc stxloc . template)
;; escaped
(ddd escaped)
;;
;; literal
#t
#f
string
bytes
number
char
keyword
regexp
pregexp)
(meta-var+args meta-var
(meta-var meta-arg …))
(tail-template template)
;; specialize mid-sequence in repetition (diagonal-matrix-style)
(variable identifier)
(template**-dotted (template* … . template)
template**)
(template** (code:line template* …)
(code:line template* … :: template)
(code:line template* … (~rest . template)))
(template* template
(code:line template ooo)
special-cased-template)
(special-cased-template (code:line template vardd)
(code:line template ddvar))
;; Where var is an iterated variable.
(vardd var.. ;; exclude the current iteration
var...) ;; include the current iteration
(ddvar ..var ;; exclude the current iteration
...var) ;; include the current iteration
(ooo #,ellipses ;; TODO: make it a hyperlink
___
..k ;; k positive integer
__k ;; k positive integer
(code:line .. expr) ;; expr must return a positive integer
(code:line __ expr)) ;; expr must return a positive integer
(ddd #,ellipses)
]]{
TODO: implement the versatile template library.
@racket[...]
TODO: support for typed/racket.
The patterns for @racket[parse] should all have a way to
create a symmetric counterpart for @racket[tmpl], which
produces the original value. This symmetry is important
because allows lens-like macros, which operate on only part
of the data structure, leaving everything else intact.
@racket[??] works like @racket[??] from
@racket[syntax/parse/experimental/template], except it
allows any number of alternatives (including 0, to avoid
special-casing in macros). It is more or less equivalent to
@racket[(?? a (?? b (?? c …)))], following syntax/parse's
semantics.
@racket[?@] has the same meaning as in syntax/parse.
@racket[(??@ t* …)] is a shortcut for
@racket[(?? (?@ t* …))]
For better compatibility with at-exp, @racket[|@if|] can be
written @racket[if@], and the same goes for
@racket[|@cond|] etc.
TODO: what's the difference between @racket[~],
@racket[template-expander] and @racket[unquote]?
@racket[template-expander] runs at compile-time and should
treat its arguments as syntax.
Concerning unquoting, unlike @racket[racket]'s default
behaviour in @RACKET[#'([x #,(y …)] …)], unquoting should
not break the nesting of ellipses. How should we express
voluntary variation of the level of nesting? @racket[~let]
already allows expanding part of the template at some level
and inserting it verbatim somewhere below, but it's not a
silver bullet. One case which comes to mind is when some of
the nested data should be mixed with less-nested data, for
example going from
@racket[([10 1 2 3] [100 4 5] [1000 6])] to
@racket[([10 20 30] [400 500] [6000])] should be relatively
easy to express. Maybe @racket[~let] with parameters can be
a suitable generalized solution:
@RACKET[({~let ([(addx v) #,(+ x v)]) [(addx y) …]} …)]
The special-cased template syntax should allow special
treatment of the @racket[i]-th iteration in a doubly-nested
loop: matching @racket[x] on @racket[(1 2 3 4 5)], and
using the template @racket[(0 x.. ,(* x x) ..x 1) …] will
produce @racket[(1 1 1 1 1)
(0 4 1 1 1)
(0 0 9 1 1)
(0 0 0 16 1)
(0 0 0 0 24)]. The pattern before
@racket[x..] and the pattern after @racket[..x] can expand
to multiple items which will be spliced in by wrapping it
with @racket[?@].}
@section{Ideas for implementation}
@subsection{Extensibility (expanders)}
Allow normal, inline-prefix, inline-postfix and inline-infix
expanders, which can bind using regular expressions. This
allows implementing exotic syntax like @racket[var..]
(postfix, operates on the pattern preceeding it),
@racket[..var] (postfix, operates on the pattern after it),
@racket[(… escaped-pattern)] (normal, operates on the
containing s-exp)
@subsection{Customization}
For things that are likely to be customized by the user in
the whole file scope, define a grammar/custom module, used
as follows:
@racketblock[(require grammar/custom)
(grammar/custom option …)]
The @racket[grammar/custom] macro expands to
@racket[(require grammar/core)] followed by a bunch of
@racket[define-syntax] which wrap the core macros, providing
them the custom options:
@racketblock[(require grammar/core)
(define-syntax-rule (parse . rest)
(parse/core #:global-options (option …) . rest))
(define-syntax-rule (tmpl . rest)
(parse/core #:global-options (option …) . rest))]
This can also be used to rename the @racket[parse] and
@racket[tmpl] macros, if desired (for example,
@racket[tmpl] could be renamed to @racket[quasisyntax], or
something similar).
Or maybe we should just use units? Can they be customized in
a similar way?
The idea is to avoid having to wrap the whole file in a
@racket[(parameterize …)], and be able to easily
@racket[provide] a customized variation of this library:
@racketblock[(provide (customized-out grammar/custom))]
@subsection{Things to look at}
@itemlist[
@item{@racket[math/arry], for @racket[::] and array
broadcasting.}
@item{Quasipatterns in @racket[match].}
@item{The @racket[lens] library}]