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

Part 1 of inline-instance-top (with correct return type)

Browse Source
This commit is contained in:
Georges Dupéron 2016-04-03 17:13:13 +02:00
parent 9124c39c0d
commit f2a43904b5
2 changed files with 50 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -109,7 +109,6 @@ plain list.
@CHUNK[<graph-rich-return> @CHUNK[<graph-rich-return>
(define-syntax/parse <signature> (define-syntax/parse <signature>
(define/with-syntax (node* …) #'(node …)) (define/with-syntax (node* …) #'(node …))
(define/with-syntax ([root/field-type …] . _) #'([field-type …] …))
(define-temp-ids "~a/first-step" name) (define-temp-ids "~a/first-step" name)
(define-temp-ids "first-step-expander2" name) (define-temp-ids "first-step-expander2" name)
(define-temp-ids "top1-accumulator-type" name) (define-temp-ids "top1-accumulator-type" name)
@ -290,6 +289,7 @@ identifier, so that it can be matched against by
<inlined-node>]] <inlined-node>]]
…)) …))
<inline-type-top1>
<inline-instance-top1-types> <inline-instance-top1-types>
<inline-instance-top1> <inline-instance-top1>
<outer-inline>] <outer-inline>]
@ -313,20 +313,6 @@ recursively:
("inline-instance*" stx) ("inline-instance*" stx)
(syntax-parse stx (syntax-parse stx
[(_ i-ty seen) [(_ i-ty seen)
#;(syntax-case (expand-type #'(Let
(~>
second-step-marker2-expander)
(~> m-streets))) ()
[(a_U
a_second-step-m-streets19/node-of-first
(a_Listof a_Street))
(syntax-case #'([node second-step-node-of-first] …) ()
[((_ _)
(b_Street b_second-step-Street21-of-first))
(begin
(displayln #'a_Street)
(displayln #'b_Street)
(displayln (free-identifier=? #'a_Street #'b_Street)))])])
(define/with-syntax replt (define/with-syntax replt
(replace-in-type #'(Let (id-~> second-step-marker2-expander) (replace-in-type #'(Let (id-~> second-step-marker2-expander)
i-ty) i-ty)
@ -346,19 +332,19 @@ recursively:
<inline-instance-nodes>))])))] <inline-instance-nodes>))])))]
@chunk[<inline-instance-replacement> @chunk[<inline-instance-replacement>
[second-step-mapping/node-of-first ;; from [second-step-mapping/node-of-first ;; from
(inline-type result-type (mapping/node . seen)) ;; to (inline-type result-type (mapping/node . seen)) ;; to
(name/first-step #:? mapping/node) ;; pred? (name/first-step #:? mapping/node) ;; pred?
(λ ([x : second-step-mapping/node-of-first]) ;; fun (λ ([x : second-step-mapping/node-of-first]) ;; fun
((inline-instance* result-type (mapping/node . seen)) ((inline-instance* result-type (mapping/node . seen))
(get x returned)))] (get x returned)))]
…] …]
@chunk[<inline-instance-nodes> @chunk[<inline-instance-nodes>
[second-step-node-of-first ;; node of first step ;; from [second-step-node-of-first ;; node of first step ;; from
(name #:placeholder node) ;; new type ;; to (name #:placeholder node) ;; new type ;; to
(name/first-step #:? node) ;; pred? (name/first-step #:? node) ;; pred?
node/extract/mapping] ;; call mapping ;; fun node/extract/mapping] ;; call mapping ;; fun
…] …]
@subsection{Inlining instances, at the top} @subsection{Inlining instances, at the top}
@ -378,7 +364,7 @@ layer of actual nodes. We do this in three steps:
second-pass nodes returned by the graph.}] second-pass nodes returned by the graph.}]
@CHUNK[<outer-inline> @CHUNK[<outer-inline>
(inline-instance-top1* root/field-type;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (inline-instance-top1* result-type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
()) ())
…] …]
@ -393,7 +379,7 @@ layer of actual nodes. We do this in three steps:
(define-type top1-accumulator-type (define-type top1-accumulator-type
(Pairof Index ;; max (Pairof Index ;; max
(List (Listof (Pairof mapping/node-index (name/first-step node))) ;; AListof (List (AListof mapping/node-index (name/first-step node))
…))) …)))
(define-type-expander (second-step-marker2-top-expander stx) (define-type-expander (second-step-marker2-top-expander stx)
@ -412,22 +398,6 @@ layer of actual nodes. We do this in three steps:
("inline-instance-top1*" stx) ("inline-instance-top1*" stx)
(syntax-parse stx (syntax-parse stx
[(_ i-ty seen) [(_ i-ty seen)
#;(syntax-case (expand-type #'(Let
(~>
second-step-marker2-top-expander)
(~> m-streets))) ()
[(a_U
a_second-step-m-streets19/node-of-first
(a_Listof a_Street))
(syntax-case #'([node second-step-node-of-first] …) ()
[((_ _)
(b_Street b_second-step-Street21-of-first))
(begin
(displayln #'a_Street)
(displayln #'b_Street)
(displayln (free-identifier=? #'a_Street #'b_Street)))])])
(displayln (list "~~~norepl=" #'(Let (id-~> second-step-marker2-top-expander)
i-ty)))
(define/with-syntax replt (define/with-syntax replt
(replace-in-type #'(Let (id-~> second-step-marker2-top-expander) (replace-in-type #'(Let (id-~> second-step-marker2-top-expander)
i-ty) i-ty)
@ -450,7 +420,7 @@ layer of actual nodes. We do this in three steps:
@chunk[<inline-instance-top1-replacement> @chunk[<inline-instance-top1-replacement>
[second-step-mapping/node-of-first ;; from [second-step-mapping/node-of-first ;; from
Any;(inline-type result-type (mapping/node . seen)) ;; to (inline-type-top1 result-type (mapping/node . seen)) ;; to
(name/first-step #:? mapping/node) ;; pred? (name/first-step #:? mapping/node) ;; pred?
(λ ([x : second-step-mapping/node-of-first] ;; fun (λ ([x : second-step-mapping/node-of-first] ;; fun
[acc : top1-accumulator-type]) [acc : top1-accumulator-type])
@ -463,11 +433,10 @@ layer of actual nodes. We do this in three steps:
…] …]
@chunk[<inline-instance-top1-nodes> @chunk[<inline-instance-top1-nodes>
[second-step-node-of-first ;; node of first step ;; from [second-step-node-of-first ;; node of first step ;; from
mapping/node-index-marker ;; new type ;; to mapping/node-index-marker ;; new type ;; to
(name/first-step #:? node) ;; pred? (name/first-step #:? node) ;; pred?
;node/extract/mapping] ;; call mapping ;; fun (λ ([x : second-step-node-of-first] ;; record the old node ;; fun
(λ ([x : second-step-node-of-first]
[acc : top1-accumulator-type]) [acc : top1-accumulator-type])
: (values mapping/node-index-marker : (values mapping/node-index-marker
top1-accumulator-type) top1-accumulator-type)
@ -481,6 +450,28 @@ layer of actual nodes. We do this in three steps:
(list node/accumulator …))))))] (list node/accumulator …))))))]
…] …]
@chunk[<inline-type-top1>
(define-type-expander (inline-type-top1 stx)
(dbg
("inline-type-top1" stx)
(syntax-parse stx
[(_ i-t (~and seen (:id (… …))))
<inline-check-seen>
(replace-in-type #'(Let ([id-~> second-step-marker-expander]) i-t)
#'(<inline-type-top1-replacement>
<inline-type-top1-nodes>))])))]
@chunk[<inline-type-top1-replacement>
[second-step-mapping/node-of-first ;; from
(inline-type-top1 result-type (mapping/node . seen))] ;; to
…]
@chunk[<inline-type-top1-nodes>
[node ;second-step-node-of-first ;; generated by the first pass
mapping/node-index] ;; new type
…]
@chunk[<inline-instance-top2> @chunk[<inline-instance-top2>
;; Call the second step graph constructor: ;; Call the second step graph constructor:
(name #:roots (ann (cdr LAST-ACCUMULATOR) (name #:roots (ann (cdr LAST-ACCUMULATOR)
@ -488,10 +479,10 @@ layer of actual nodes. We do this in three steps:
@chunk[<inline-instance-top3> @chunk[<inline-instance-top3>
(replace-in-instance #'TYPE?? (replace-in-instance #'TYPE??
#'([mapping/node-index ;; from #'([mapping/node-index ;; from
(name node) ;; to (name node) ;; to
mapping/node-index? ;; pred? mapping/node-index? ;; pred?
(λ ([idx : mapping/node-index]) ;; fun (λ ([idx : mapping/node-index]) ;; fun
(VECTOR-REF ??? (constructor-values idx))) (VECTOR-REF ??? (constructor-values idx)))
]))] ]))]
@ -732,8 +723,7 @@ encapsulating the result types of mappings.
"rewrite-type.lp2.rkt" #|debug|# "rewrite-type.lp2.rkt" #|debug|#
syntax/id-set syntax/id-set
racket/format racket/format
mischief/transform mischief/transform)
(submod "../type-expander/type-expander.lp2.rkt" expander))
(rename-in "../lib/low.rkt" [~> threading:~>]) (rename-in "../lib/low.rkt" [~> threading:~>])
"graph.lp2.rkt" "graph.lp2.rkt"
"get.lp2.rkt" "get.lp2.rkt"
@ -747,9 +737,7 @@ encapsulating the result types of mappings.
racket/splicing) racket/splicing)
(provide define-graph/rich-return (provide define-graph/rich-return
(for-syntax dbg) ;; DEBUG (for-syntax dbg) ;; DEBUG
); ~>) )
;(define-syntax-parameter ~> (make-rename-transformer #'threading:~>))
(require (for-syntax racket/pretty)) (require (for-syntax racket/pretty))

5
graph-lib/lib/low/list.rkt
View File

@ -3,7 +3,10 @@
(define-typed/untyped-modules #:no-test (define-typed/untyped-modules #:no-test
(provide indexof (provide indexof
replace-first replace-first
map+fold) map+fold
AListof)
(define-type (AListof K V) (Listof (Pairof K V)))
(: indexof (∀ (A B) (→ A (Listof B) (→ A B Any) (U #f Integer)))) (: indexof (∀ (A B) (→ A (Listof B) (→ A B Any) (U #f Integer))))
(define (indexof elt lst [compare equal?]) (define (indexof elt lst [compare equal?])