diff --git a/graph-lib/graph/graph-6-rich-returns.lp2.rkt b/graph-lib/graph/graph-6-rich-returns.lp2.rkt index e7bc65f..14b35a1 100644 --- a/graph-lib/graph/graph-6-rich-returns.lp2.rkt +++ b/graph-lib/graph/graph-6-rich-returns.lp2.rkt @@ -112,6 +112,7 @@ plain list. (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/constructor-top2" (mapping …)) (define-temp-ids "~a/accumulator" (node …)) (define-temp-ids "~a/simple-mapping" (node …)) (define-temp-ids "~a/node" (mapping …)) @@ -292,7 +293,8 @@ identifier, so that it can be matched against by - ] + + ] We create the inlined-node by inlining the temporary nodes in all of its fields: @@ -473,9 +475,23 @@ layer of actual nodes. We do this in three steps: …] @chunk[ + (define (mapping/constructor-top2 [param cp param-type] …) + (% )) + … + + (define #,(datum->syntax #'name 'DBG) + (list mapping/constructor-top2 …))] + +@chunk[ + first-graph = (name/first-step #:root mapping/node param …) + alists = (list (!each mapping '()) …) + with-indices-top1 last-acc = ((inline-instance-top1* result-type ()) + (get first-graph returned) + (cons 1 alists)) + (_ . (node/accumulator …)) = last-acc + in ;; Call the second step graph constructor: - (name #:roots (ann (cdr LAST-ACCUMULATOR) - (list (vectorof (name/first-step mapping/node)))))] + (name #:roots [node (lists (cdrs node/accumulator))] …)] @chunk[ (replace-in-instance #'TYPE?? diff --git a/graph-lib/graph/graph.scrbl b/graph-lib/graph/graph.scrbl new file mode 100644 index 0000000..b342bfe --- /dev/null +++ b/graph-lib/graph/graph.scrbl @@ -0,0 +1,26 @@ +#lang scribble/manual + +@(require scribble-enhanced/manual-form) + +@(require (for-label typed/racket/base + "graph.lp2.rkt")) + +@title{Low-level graph macro} + + +@defform[(graph …) + #:result graph-id + #:contracts ([old-type (syntax-for type)] + [from (and/c identifier? (syntax-for type))] + [to (syntax-for type)])]{ + …} + +@defform[(graph-id #:roots [node args] …) + #:result (List (Vectorof node/promise-type) …) + #:contracts ([args (Listof (List arg-type …))])]{ + Create a graph instance, starting from the given root + arguments. Each element of the returned list contains a + vector with all the graph roots for that node type, in the + same order as their arguments were given. If there are some + duplicates in the lists of arguments, the same node will be + returned for both.} \ No newline at end of file diff --git a/graph-lib/lib/low.rkt b/graph-lib/lib/low.rkt index 18831c6..5996b48 100644 --- a/graph-lib/lib/low.rkt +++ b/graph-lib/lib/low.rkt @@ -12,6 +12,7 @@ "low/typed-rackunit.rkt" "low/typed-rackunit-extensions.rkt" "low/syntax-parse.rkt" + "low/tmpl.rkt" "low/threading.rkt" "low/aliases.rkt" "low/sequence.rkt" diff --git a/graph-lib/lib/low/list.rkt b/graph-lib/lib/low/list.rkt index fa2b7ed..1b74312 100644 --- a/graph-lib/lib/low/list.rkt +++ b/graph-lib/lib/low/list.rkt @@ -7,6 +7,11 @@ AListof) (define-type (AListof K V) (Listof (Pairof K V))) + (define-match-expander alistof + (λ (stx) + (syntax-case stx () + [(keys-pat vals-pat) + #'(list (cons keys-pat vals-pat) …)]))) (: indexof (∀ (A B) (→ A (Listof B) (→ A B Any) (U #f Integer)))) (define (indexof elt lst [compare equal?]) diff --git a/graph-lib/lib/low/template.scrbl b/graph-lib/lib/low/template.scrbl index c33c8f3..e8f0f55 100644 --- a/graph-lib/lib/low/template.scrbl +++ b/graph-lib/lib/low/template.scrbl @@ -86,6 +86,13 @@ Keywords: grammar, parser, template. (~sort key template ooo) (~loc stxloc . template) + ;; Like (template . template), but discards the first and + ;; keeps just the second. If the first contains pattern + ;; variables which are repeated, this has the effect of + ;; repeating the second as many times as the first. Example: + ;; #'(vector (~each some-pattern-var '())) + ;; => (vector '() '() '() '() '()) + (~each template template) ;; escaped (ddd escaped) @@ -233,6 +240,12 @@ This can also be used to rename the @racket[parse] and @racket[tmpl] could be renamed to @racket[quasisyntax], or something similar). +Otherwise, @racket[grammar/custom] could just @racket[set!] +some for-syntax variable which stores the options. A second +boolean for-syntax variable could be used to check if +@racket[grammar/custom] was called twice, and throw an error +in that case. + Or maybe we should just use units? Can they be customized in a similar way? diff --git a/graph-lib/lib/low/tmpl.rkt b/graph-lib/lib/low/tmpl.rkt new file mode 100644 index 0000000..ade54aa --- /dev/null +++ b/graph-lib/lib/low/tmpl.rkt @@ -0,0 +1,14 @@ +#lang typed/racket +(require "typed-untyped.rkt") +(define-typed/untyped-modules #:no-test + (provide !each) + + (module m-!each racket + (provide !each) + (require syntax/parse/experimental/template) + + (define-template-metafunction (!each stx) + (syntax-case stx () + [(_ a b) #'b]))) + + (require 'm-!each)) \ No newline at end of file diff --git a/graph-lib/lib/low/type-inference-helpers.rkt b/graph-lib/lib/low/type-inference-helpers.rkt index 9db433d..afe221c 100644 --- a/graph-lib/lib/low/type-inference-helpers.rkt +++ b/graph-lib/lib/low/type-inference-helpers.rkt @@ -1,7 +1,7 @@ #lang typed/racket (require "typed-untyped.rkt") (define-typed/untyped-modules #:no-test - (provide cars cdrs) + (provide cars cdrs lists) #| ;; This does not work, in the end. @@ -22,4 +22,7 @@ (define (cars l) ((inst map A (Pairof A Any)) car l)) (: cdrs (∀ (B) (→ (Listof (Pairof Any B)) (Listof B)))) - (define (cdrs l) ((inst map B (Pairof Any B)) cdr l))) \ No newline at end of file + (define (cdrs l) ((inst map B (Pairof Any B)) cdr l)) + + (: lists (∀ (A) (→ (Listof A) (Listof (List A))))) + (define (lists l) ((inst map (List A) A) (λ (x) (list x)) l))) \ No newline at end of file