Part 3 of inline-instance-top works!
This commit is contained in:
Georges Dupéron
parent
d175d154c3
commit
cd150cf2b3
|
|
@ -14,6 +14,7 @@
|
||||||
(for-syntax syntax/parse)
|
(for-syntax syntax/parse)
|
||||||
(for-syntax syntax/parse/experimental/template))
|
(for-syntax syntax/parse/experimental/template))
|
||||||
|
|
||||||
|
|
||||||
#|
|
#|
|
||||||
(require "__DEBUG_graph6B.rkt")
|
(require "__DEBUG_graph6B.rkt")
|
||||||
|
|
||||||
|
|
@ -50,7 +51,10 @@
|
||||||
: (Listof Street)
|
: (Listof Street)
|
||||||
(map Street snames)])
|
(map Street snames)])
|
||||||
|
|
||||||
;(grr3 '(("a" "b") ("c")))
|
(% (x y) = ((car DBG) '(("a" "b" "c") ("d")))
|
||||||
|
in
|
||||||
|
(list (get x streets … sname)
|
||||||
|
(get y streets … sname)))
|
||||||
|
|
||||||
#;(super-define-graph/rich-return
|
#;(super-define-graph/rich-return
|
||||||
grr4
|
grr4
|
||||||
|
|
@ -84,330 +88,3 @@
|
||||||
(dg grra)
|
(dg grra)
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; DEBUG:
|
|
||||||
(require (for-syntax racket/format
|
|
||||||
"rewrite-type.lp2.rkt"
|
|
||||||
racket/syntax
|
|
||||||
syntax/parse
|
|
||||||
(submod "../lib/low.rkt" untyped))
|
|
||||||
(for-syntax syntax/parse
|
|
||||||
syntax/parse/experimental/template
|
|
||||||
racket/syntax
|
|
||||||
(submod "../lib/low.rkt" untyped)
|
|
||||||
"rewrite-type.lp2.rkt" #|debug|#
|
|
||||||
syntax/id-set
|
|
||||||
racket/format
|
|
||||||
mischief/transform)
|
|
||||||
(rename-in "../lib/low.rkt" [~> threading:~>])
|
|
||||||
"graph.lp2.rkt"
|
|
||||||
"get.lp2.rkt"
|
|
||||||
"../type-expander/type-expander.lp2.rkt"
|
|
||||||
"../type-expander/multi-id.lp2.rkt"
|
|
||||||
"adt.lp2.rkt" ; debug
|
|
||||||
"fold-queues.lp2.rkt"; debug
|
|
||||||
"rewrite-type.lp2.rkt"; debug
|
|
||||||
"meta-struct.rkt"; debug
|
|
||||||
racket/stxparam
|
|
||||||
racket/splicing)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#;(define-graph
|
|
||||||
grr31/first-step
|
|
||||||
#:definitions
|
|
||||||
((define-type-expander
|
|
||||||
(~> stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ (~datum m-cities))
|
|
||||||
(template
|
|
||||||
(U
|
|
||||||
(grr31/first-step
|
|
||||||
#:placeholder
|
|
||||||
m-cities4/node)
|
|
||||||
(Listof
|
|
||||||
(grr31/first-step
|
|
||||||
#:placeholder
|
|
||||||
City)))))
|
|
||||||
((_ (~datum m-streets))
|
|
||||||
(template
|
|
||||||
(U
|
|
||||||
(grr31/first-step
|
|
||||||
#:placeholder
|
|
||||||
m-streets5/node)
|
|
||||||
(Listof
|
|
||||||
(grr31/first-step
|
|
||||||
#:placeholder
|
|
||||||
Street)))))))
|
|
||||||
(define-type-expander
|
|
||||||
(first-step-expander2 stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ (~datum m-cities))
|
|
||||||
#'(U
|
|
||||||
m-cities4/node
|
|
||||||
(Listof City)))
|
|
||||||
((_ (~datum m-streets))
|
|
||||||
#'(U
|
|
||||||
m-streets5/node
|
|
||||||
(Listof Street))))))
|
|
||||||
(City
|
|
||||||
(streets
|
|
||||||
:
|
|
||||||
(Let
|
|
||||||
(~> first-step-expander2)
|
|
||||||
(~> m-streets)))
|
|
||||||
((City2/simple-mapping
|
|
||||||
(streets
|
|
||||||
:
|
|
||||||
(~> m-streets)))
|
|
||||||
(City streets)))
|
|
||||||
(Street
|
|
||||||
(sname
|
|
||||||
:
|
|
||||||
(Let
|
|
||||||
(~> first-step-expander2)
|
|
||||||
String))
|
|
||||||
((Street3/simple-mapping
|
|
||||||
(sname : String))
|
|
||||||
(Street sname)))
|
|
||||||
(m-cities4/node
|
|
||||||
(returned : (Listof City))
|
|
||||||
((m-cities
|
|
||||||
(cnames
|
|
||||||
:
|
|
||||||
(Listof
|
|
||||||
(Listof bubble))))
|
|
||||||
(m-cities4/node
|
|
||||||
(let ((City
|
|
||||||
City2/simple-mapping)
|
|
||||||
(Street
|
|
||||||
Street3/simple-mapping))
|
|
||||||
(define (strings→city
|
|
||||||
(s
|
|
||||||
:
|
|
||||||
(Listof
|
|
||||||
blob)))
|
|
||||||
(City (m-streets s)))
|
|
||||||
(map
|
|
||||||
strings→city
|
|
||||||
cnames)))))
|
|
||||||
(m-streets5/node
|
|
||||||
(returned
|
|
||||||
:
|
|
||||||
(Listof Street))
|
|
||||||
((m-streets
|
|
||||||
(snames
|
|
||||||
:
|
|
||||||
(Listof String)))
|
|
||||||
(m-streets5/node
|
|
||||||
(let ((City
|
|
||||||
City2/simple-mapping)
|
|
||||||
(Street
|
|
||||||
Street3/simple-mapping))
|
|
||||||
(map
|
|
||||||
Street
|
|
||||||
snames))))))
|
|
||||||
|
|
||||||
|
|
||||||
#;(define-graph
|
|
||||||
grr3
|
|
||||||
#:definitions
|
|
||||||
((define-type-expander
|
|
||||||
(~>-to-result-type stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ (~datum m-cities)) #'(Listof City))
|
|
||||||
((_ (~datum m-streets)) #'(Listof Street))))
|
|
||||||
(define-type
|
|
||||||
m-cities10/node-marker
|
|
||||||
(Listof (grr3 #:placeholder City));
|
|
||||||
#;(U (grr31/first-step m-cities4/node) (Listof (grr31/first-step City))))
|
|
||||||
(define-type
|
|
||||||
m-streets11/node-marker
|
|
||||||
(Listof (grr3 #:placeholder Street));
|
|
||||||
#;(U (grr31/first-step m-streets5/node) (Listof (grr31/first-step Street))))
|
|
||||||
(define-type-expander
|
|
||||||
(second-step-marker-expander stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ (~datum m-cities)) #'m-cities10/node-marker)
|
|
||||||
((_ (~datum m-streets)) #'m-streets11/node-marker)))
|
|
||||||
(define-type
|
|
||||||
second-step-m-cities16/node-of-first
|
|
||||||
(grr31/first-step m-cities4/node))
|
|
||||||
(define-type
|
|
||||||
second-step-m-streets17/node-of-first
|
|
||||||
(grr31/first-step m-streets5/node))
|
|
||||||
(define-type second-step-City18-of-first (grr31/first-step City))
|
|
||||||
(define-type second-step-Street19-of-first (grr31/first-step Street))
|
|
||||||
(define-type-expander
|
|
||||||
(second-step-marker2-expander stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ (~datum m-cities))
|
|
||||||
#'(U
|
|
||||||
second-step-m-cities16/node-of-first
|
|
||||||
(Listof City #;(grr31/first-step City))))
|
|
||||||
((_ (~datum m-streets))
|
|
||||||
#'(U
|
|
||||||
second-step-m-streets17/node-of-first
|
|
||||||
(Listof Street #;(grr31/first-step Street)))))) ;;;;;;;;;SHOULD BE A MARKER! (done here)
|
|
||||||
(define-type-expander
|
|
||||||
(inline-type* stx)
|
|
||||||
(dbg
|
|
||||||
("inline-type*" stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ i-tyy (~and seen (:id …)) (~optional msg))
|
|
||||||
(when (attribute msg) (displayln (syntax-e #'msg)))
|
|
||||||
(define/with-syntax replt #'i-tyy)
|
|
||||||
#'(inline-type replt seen)))))
|
|
||||||
(define-type-expander
|
|
||||||
(inline-type stx)
|
|
||||||
(dbg
|
|
||||||
("inline-type" stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ i-t (~and seen (:id …)))
|
|
||||||
(let ((seen-list (syntax->list #'seen)))
|
|
||||||
(when (and
|
|
||||||
(not (null? seen-list))
|
|
||||||
(member (car seen-list) (cdr seen-list) free-identifier=?))
|
|
||||||
(raise-syntax-error
|
|
||||||
'define-graph/rich-returns
|
|
||||||
(~a
|
|
||||||
"Cycles in types are not allowed."
|
|
||||||
" The following types were already inlined: "
|
|
||||||
(syntax->datum #'seen)
|
|
||||||
", but "
|
|
||||||
#'t
|
|
||||||
" appeared a second time.")
|
|
||||||
#'t)))
|
|
||||||
(replace-in-type
|
|
||||||
#'(Let ((~> second-step-marker-expander)) i-t)
|
|
||||||
#'((second-step-m-cities16/node-of-first
|
|
||||||
(inline-type* (Listof City) (m-cities4/node . seen)))
|
|
||||||
(second-step-m-streets17/node-of-first
|
|
||||||
(inline-type* (Listof Street) (m-streets5/node . seen)))
|
|
||||||
(City (grr3 #:placeholder City))
|
|
||||||
(Street (grr3 #:placeholder Street))))))))
|
|
||||||
(define-syntax (inline-instance* stx)
|
|
||||||
(dbg
|
|
||||||
("inline-instance*" stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ i-ty seen)
|
|
||||||
(define/with-syntax
|
|
||||||
replt
|
|
||||||
(replace-in-type
|
|
||||||
#'(Let (~> second-step-marker2-expander) i-ty)
|
|
||||||
#'((City second-step-City18-of-first)
|
|
||||||
(Street second-step-Street19-of-first))))
|
|
||||||
(displayln (list "replt=" #'replt))
|
|
||||||
#'(inline-instance replt seen)))))
|
|
||||||
(define-syntax (inline-instance stx)
|
|
||||||
(dbg
|
|
||||||
("inline-instance" stx)
|
|
||||||
(syntax-parse
|
|
||||||
stx
|
|
||||||
((_ i-t (~and seen (:id …)))
|
|
||||||
(define/with-syntax typp #'i-t)
|
|
||||||
(define/with-syntax
|
|
||||||
repl
|
|
||||||
(replace-in-instance
|
|
||||||
#'typp
|
|
||||||
#'((second-step-m-cities16/node-of-first
|
|
||||||
(inline-type* (Listof City) (m-cities4/node . seen) "RESSSS")
|
|
||||||
(grr31/first-step #:? m-cities4/node)
|
|
||||||
(λ ((x : second-step-m-cities16/node-of-first))
|
|
||||||
((inline-instance* (Listof City) (m-cities4/node . seen))
|
|
||||||
(get x returned))))
|
|
||||||
(second-step-m-streets17/node-of-first
|
|
||||||
(inline-type* (Listof Street) (m-streets5/node . seen) "RESSSS")
|
|
||||||
(grr31/first-step #:? m-streets5/node)
|
|
||||||
(λ ((x : second-step-m-streets17/node-of-first))
|
|
||||||
((inline-instance* (Listof Street) (m-streets5/node . seen))
|
|
||||||
(get x returned))))
|
|
||||||
(second-step-City18-of-first
|
|
||||||
(grr3 #:placeholder City)
|
|
||||||
(grr31/first-step #:? City)
|
|
||||||
City6/extract/mapping)
|
|
||||||
(second-step-Street19-of-first
|
|
||||||
(grr3 #:placeholder Street)
|
|
||||||
(grr31/first-step #:? Street)
|
|
||||||
Street7/extract/mapping))))
|
|
||||||
(displayln (list "i-t=" #'typp))
|
|
||||||
(let ((seen-list (syntax->list #'seen)))
|
|
||||||
(when (and
|
|
||||||
(not (null? seen-list))
|
|
||||||
(member (car seen-list) (cdr seen-list) free-identifier=?))
|
|
||||||
(raise-syntax-error
|
|
||||||
'define-graph/rich-returns
|
|
||||||
(~a
|
|
||||||
"Cycles in types are not allowed."
|
|
||||||
" The following types were already inlined: "
|
|
||||||
(syntax->datum #'seen)
|
|
||||||
", but "
|
|
||||||
#'t
|
|
||||||
" appeared a second time.")
|
|
||||||
#'t)))
|
|
||||||
#'repl)))))
|
|
||||||
(City
|
|
||||||
(streets : (Let (~> ~>-to-result-type) (~> m-streets)))
|
|
||||||
((City6/extract/mapping (from : (grr31/first-step City)))
|
|
||||||
(City ((inline-instance* (~> m-streets) ())
|
|
||||||
#;(λ ((val : (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))))
|
|
||||||
(first-value
|
|
||||||
((λ ((val : (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))) (acc : Void))
|
|
||||||
:
|
|
||||||
(values m-streets11/node-marker ;(U (inline-type* (Listof Street) (m-streets5/node) "RE1234")
|
|
||||||
; (Listof (grr31/first-step Street)))
|
|
||||||
Void)
|
|
||||||
(cond
|
|
||||||
(((grr31/first-step #:? m-streets5/node) val)
|
|
||||||
((ann
|
|
||||||
(λ ((x : second-step-m-streets17/node-of-first) (acc : Void))
|
|
||||||
(values ((λ ((x : second-step-m-streets17/node-of-first)) ((inline-instance* (Listof Street) (m-streets5/node)) (get x returned))) x) acc))
|
|
||||||
(→ second-step-m-streets17/node-of-first Void (values (inline-type* (Listof Street) (m-streets5/node) "RESSSS") Void)))
|
|
||||||
val
|
|
||||||
acc))
|
|
||||||
(#t
|
|
||||||
((λ ((val : (Listof (grr31/first-step Street))) (acc : Void))
|
|
||||||
:
|
|
||||||
(values m-streets11/node-marker ;(Listof (grr31/first-step Street))
|
|
||||||
Void)
|
|
||||||
(let ((f
|
|
||||||
((inst foldl (grr31/first-step Street) (Pairof (Listof (grr31/first-step Street)) Void) Nothing Nothing)
|
|
||||||
(λ ((x : (grr31/first-step Street))
|
|
||||||
(acc1 : (Pairof m-streets11/node-marker;(Listof (grr31/first-step Street))
|
|
||||||
Void)))
|
|
||||||
(let-values (((res res-acc) ((inst values (grr31/first-step Street) Void) x (cdr acc1))))
|
|
||||||
(cons (cons res (car acc1)) res-acc)))
|
|
||||||
(cons '() acc)
|
|
||||||
val)))
|
|
||||||
(values (reverse (car f)) (cdr f))))
|
|
||||||
val
|
|
||||||
acc))
|
|
||||||
(else
|
|
||||||
(typecheck-fail
|
|
||||||
(U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))
|
|
||||||
"Unhandled union case in (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street))), whole type was:(U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))"))))
|
|
||||||
val
|
|
||||||
(void))))
|
|
||||||
(get from streets)))
|
|
||||||
))
|
|
||||||
(Street
|
|
||||||
(sname : (Let (~> ~>-to-result-type) String))
|
|
||||||
((Street7/extract/mapping (from : (grr31/first-step Street)))
|
|
||||||
(Street ((inline-instance* String ()) (get from sname))))))
|
|
||||||
|
|
@ -114,6 +114,8 @@ plain list.
|
||||||
(define-temp-ids "top1-accumulator-type" name)
|
(define-temp-ids "top1-accumulator-type" name)
|
||||||
(define-temp-ids "~a/constructor-top2" (mapping …))
|
(define-temp-ids "~a/constructor-top2" (mapping …))
|
||||||
(define-temp-ids "~a/accumulator" (node …))
|
(define-temp-ids "~a/accumulator" (node …))
|
||||||
|
(define-temp-ids "~a/top2-roots" (node …))
|
||||||
|
(define-temp-ids "~a/next-idx" (node …))
|
||||||
(define-temp-ids "~a/simple-mapping" (node …))
|
(define-temp-ids "~a/simple-mapping" (node …))
|
||||||
(define-temp-ids "~a/node" (mapping …))
|
(define-temp-ids "~a/node" (mapping …))
|
||||||
(define-temp-ids "~a/extract/mapping" (node …))
|
(define-temp-ids "~a/extract/mapping" (node …))
|
||||||
|
|
@ -294,7 +296,8 @@ identifier, so that it can be matched against by
|
||||||
<inline-instance-top1-types>
|
<inline-instance-top1-types>
|
||||||
<inline-instance-top1>
|
<inline-instance-top1>
|
||||||
<outer-inline>
|
<outer-inline>
|
||||||
<inline-instance-top2>]
|
<inline-instance-top2>
|
||||||
|
<inline-instance-top3>]
|
||||||
|
|
||||||
We create the inlined-node by inlining the temporary nodes
|
We create the inlined-node by inlining the temporary nodes
|
||||||
in all of its fields:
|
in all of its fields:
|
||||||
|
|
@ -380,9 +383,9 @@ layer of actual nodes. We do this in three steps:
|
||||||
…
|
…
|
||||||
|
|
||||||
(define-type top1-accumulator-type
|
(define-type top1-accumulator-type
|
||||||
(Pairof Index ;; max
|
(List (Pairof Index ;; max
|
||||||
(List (AListof mapping/node-index (name/first-step node))
|
(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)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
|
@ -442,14 +445,14 @@ layer of actual nodes. We do this in three steps:
|
||||||
[acc : top1-accumulator-type])
|
[acc : top1-accumulator-type])
|
||||||
: (values mapping/node-index-marker
|
: (values mapping/node-index-marker
|
||||||
top1-accumulator-type)
|
top1-accumulator-type)
|
||||||
(% (idx . (node/accumulator …)) = acc
|
(% ([node/next-idx . node/accumulator] …) = acc
|
||||||
new-index = (mapping/node-index idx)
|
new-index = (mapping/node-index node/next-idx)
|
||||||
in
|
in
|
||||||
(values new-index
|
(values new-index
|
||||||
(let ([node/accumulator (cons (cons new-index x)
|
(let ([node/accumulator (cons (cons new-index x)
|
||||||
node/accumulator)])
|
node/accumulator)]
|
||||||
(cons (assert (add1 idx) index?)
|
[node/next-idx (assert (add1 node/next-idx) index?)])
|
||||||
(list node/accumulator …))))))]
|
(list (cons node/next-idx node/accumulator) …)))))]
|
||||||
…]
|
…]
|
||||||
|
|
||||||
@chunk[<inline-type-top1>
|
@chunk[<inline-type-top1>
|
||||||
|
|
@ -471,7 +474,7 @@ layer of actual nodes. We do this in three steps:
|
||||||
|
|
||||||
@chunk[<inline-type-top1-nodes>
|
@chunk[<inline-type-top1-nodes>
|
||||||
[node ;second-step-node-of-first ;; generated by the first pass
|
[node ;second-step-node-of-first ;; generated by the first pass
|
||||||
mapping/node-index] ;; new type
|
mapping/node-index-marker] ;; new type
|
||||||
…]
|
…]
|
||||||
|
|
||||||
@chunk[<inline-instance-top2>
|
@chunk[<inline-instance-top2>
|
||||||
|
|
@ -484,65 +487,65 @@ layer of actual nodes. We do this in three steps:
|
||||||
|
|
||||||
@chunk[<constructor-top2-body>
|
@chunk[<constructor-top2-body>
|
||||||
first-graph = (name/first-step #:root mapping/node param …)
|
first-graph = (name/first-step #:root mapping/node param …)
|
||||||
alists = (list (!each mapping '()) …)
|
alists = (list (!each mapping '[0 . ()]) …)
|
||||||
with-indices-top1 last-acc = ((inline-instance-top1* result-type ())
|
with-indices-top1 last-acc = ((inline-instance-top1* result-type ())
|
||||||
(get first-graph returned)
|
(get first-graph returned)
|
||||||
(cons 1 alists))
|
alists)
|
||||||
(_ . (node/accumulator …)) = last-acc
|
([node/next-idx . node/accumulator] …) = last-acc
|
||||||
in
|
in
|
||||||
|
(assert (= (length node/accumulator) node/next-idx))
|
||||||
;; Call the second step graph constructor:
|
;; Call the second step graph constructor:
|
||||||
(name #:roots [node (lists (cdrs node/accumulator))] …)]
|
(% (node/top2-roots …)
|
||||||
|
= (name #:roots [node (reverse (lists (cdrs node/accumulator)))] …)
|
||||||
|
in
|
||||||
|
((replace-markers-top3 result-type
|
||||||
|
node/top2-roots …)
|
||||||
|
with-indices-top1))]
|
||||||
|
|
||||||
@chunk[<inline-instance-top3>
|
@chunk[<inline-instance-top3>
|
||||||
(replace-in-instance #'TYPE??
|
(define-syntax (replace-markers-top3 stx)
|
||||||
#'([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
|
(dbg
|
||||||
("inline-instance-top3*" stx)
|
("inline-instance-top3*" stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ i-ty seen)
|
[(_ i-ty node/top2-roots …)
|
||||||
|
(displayln (replace-in-type #'(inline-type-top1 i-ty ())
|
||||||
|
#'[]))
|
||||||
|
(replace-in-instance #'(inline-type-top1 i-ty ())
|
||||||
|
#'([mapping/node-index-marker ;; from
|
||||||
|
(name node) ;; to
|
||||||
|
mapping/node-index? ;; pred?
|
||||||
|
(λ ([idx : mapping/node-index]) ;; fun
|
||||||
|
(vector-ref node/top2-roots
|
||||||
|
(constructor-values idx)))]
|
||||||
|
…))])))
|
||||||
|
#;(define-syntax (inline-instance-top3* stx)
|
||||||
|
(dbg
|
||||||
|
("inline-instance-top3*" stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_ i-ty seen node/top2-roots …)
|
||||||
(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-top-expander)
|
||||||
i-ty)
|
i-ty)
|
||||||
#'([node second-step-node-of-first]
|
#'([node second-step-node-of-first]
|
||||||
…)))
|
…)))
|
||||||
(displayln (list "replt=" #'replt))
|
(displayln (list "replt-top=" #'replt))
|
||||||
#'(inline-instance-top3 replt seen)])))
|
#'(inline-instance-top3 replt seen node/top2-roots …)])))
|
||||||
|
|
||||||
(define-syntax (inline-instance-top3 stx)
|
#;(define-syntax (inline-instance-top3 stx)
|
||||||
(dbg
|
(dbg
|
||||||
("inline-instance-top3" stx)
|
("inline-instance-top3" stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ i-t (~and seen (:id (… …))))
|
[(_ i-t (~and seen (:id (… …))) node/top2-roots …)
|
||||||
<inline-check-seen>
|
<inline-check-seen>
|
||||||
|
;(replace-in-instance #'i-t
|
||||||
(replace-in-instance #'i-t
|
(replace-in-instance #'i-t
|
||||||
#'(<inline-instance-top3-replacement>
|
#'([mapping/node-index-marker ;; from
|
||||||
<inline-instance-top3-nodes>))])))]
|
(name node) ;; to
|
||||||
|
mapping/node-index? ;; pred?
|
||||||
@chunk[<inline-instance-top3-replacement>
|
(λ ([idx : mapping/node-index]) ;; fun
|
||||||
[second-step-mapping/node-of-first ;; from
|
(vector-ref node/top2-roots
|
||||||
(inline-type result-type (mapping/node . seen)) ;; to
|
(constructor-values idx)))]
|
||||||
(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}
|
@subsection{Inlining types}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -96,18 +96,12 @@
|
||||||
|
|
||||||
(define (format-temp-ids format . vs)
|
(define (format-temp-ids format . vs)
|
||||||
;; Introduce the binding in a fresh scope.
|
;; Introduce the binding in a fresh scope.
|
||||||
(apply format-ids (λ _ ((make-syntax-introducer) #'())) format vs))
|
(apply format-ids
|
||||||
|
(λ _ ((make-syntax-introducer) (if (syntax? format) format #'())))
|
||||||
|
format
|
||||||
|
vs))
|
||||||
|
|
||||||
;; Also in ==== syntax.rkt ====, once we split into multiple files, require it
|
(require (for-syntax (submod "stx.rkt" untyped)))
|
||||||
(begin-for-syntax
|
|
||||||
(define (syntax-cons-property stx key v)
|
|
||||||
(let ([orig (syntax-property stx key)])
|
|
||||||
(syntax-property stx key (cons v (or orig '()))))))
|
|
||||||
|
|
||||||
;; Also in ==== syntax.rkt ====, once we split into multiple files, require it
|
|
||||||
(begin-for-syntax
|
|
||||||
(define (identifier-length id) (string-length (symbol->string
|
|
||||||
(syntax-e id)))))
|
|
||||||
|
|
||||||
(begin-for-syntax
|
(begin-for-syntax
|
||||||
(define-syntax-class dotted
|
(define-syntax-class dotted
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user