diff --git a/graph-lib/graph/__DEBUG_graph6.rkt b/graph-lib/graph/__DEBUG_graph6.rkt index 7a5549af..0e15d65e 100644 --- a/graph-lib/graph/__DEBUG_graph6.rkt +++ b/graph-lib/graph/__DEBUG_graph6.rkt @@ -11,68 +11,331 @@ "fold-queues.lp2.rkt"; debug "rewrite-type.lp2.rkt"; debug "meta-struct.rkt"; debug + racket/splicing; debug (for-syntax syntax/parse) (for-syntax syntax/parse/experimental/template)) +#| (require "__DEBUG_graph6B.rkt") (frozen (~>)) +|# + + (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)]) + ([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)]) + + +;(first-step '(("a" "b") ("c" "d"))) + + + + + + + +#;(begin + (define-multi-id + first-step + #:type-expander + (λ (stx) + (syntax-parse + stx + ((_ (~datum City)) #'City45/with-promises-type) + ((_ (~datum Street)) #'Street46/with-promises-type) + ((_ (~datum m-cities3/node)) #'m-cities3/node47/with-promises-type) + ((_ (~datum m-streets4/node)) #'m-streets4/node48/with-promises-type) + ((_ #:incomplete (~datum City)) #'City25/incomplete-type) + ((_ #:incomplete (~datum Street)) #'Street26/incomplete-type) + ((_ #:incomplete (~datum m-cities3/node)) + #'m-cities3/node27/incomplete-type) + ((_ #:incomplete (~datum m-streets4/node)) + #'m-streets4/node28/incomplete-type) + ((_ #:make-incomplete (~datum City)) + #'(→ streets41/incomplete-type City25/incomplete-type)) + ((_ #:make-incomplete (~datum Street)) + #'(→ sname42/incomplete-type Street26/incomplete-type)) + ((_ #:make-incomplete (~datum m-cities3/node)) + #'(→ returned43/incomplete-type m-cities3/node27/incomplete-type)) + ((_ #:make-incomplete (~datum m-streets4/node)) + #'(→ returned44/incomplete-type m-streets4/node28/incomplete-type)) + ((_ #:incomplete (~datum City) fld) + (syntax-parse #'fld ((~datum streets) #'streets41/incomplete-type))) + ((_ #:incomplete (~datum Street) fld) + (syntax-parse #'fld ((~datum sname) #'sname42/incomplete-type))) + ((_ #:incomplete (~datum m-cities3/node) fld) + (syntax-parse #'fld ((~datum returned) #'returned43/incomplete-type))) + ((_ #:incomplete (~datum m-streets4/node) fld) + (syntax-parse #'fld ((~datum returned) #'returned44/incomplete-type))) + ((_ #:make-placeholder (~datum City)) + #'(→ (~> m-streets) City21/placeholder-type)) + ((_ #:make-placeholder (~datum Street)) + #'(→ String Street22/placeholder-type)) + ((_ #:make-placeholder (~datum m-cities3/node)) + #'(→ (Listof (Listof String)) m-cities3/node23/placeholder-type)) + ((_ #:make-placeholder (~datum m-streets4/node)) + #'(→ (Listof String) m-streets4/node24/placeholder-type)) + ((_ #:placeholder (~datum City)) #'City21/placeholder-type) + ((_ #:placeholder (~datum Street)) #'Street22/placeholder-type) + ((_ #:placeholder (~datum m-cities3/node)) + #'m-cities3/node23/placeholder-type) + ((_ #:placeholder (~datum m-streets4/node)) + #'m-streets4/node24/placeholder-type))) + #:call + (λ (stx) + (syntax-parse + stx + ((_ #:λroot (~datum City)) #'City5/constructor) + ((_ #:λroot (~datum Street)) #'Street6/constructor) + ((_ #:λroot (~datum m-cities3/node)) #'m-cities3/node7/constructor) + ((_ #:λroot (~datum m-streets4/node)) #'m-streets4/node8/constructor) + ((_ #:root (~datum City) . rest) + (syntax/loc stx (City5/constructor . rest))) + ((_ #:root (~datum Street) . rest) + (syntax/loc stx (Street6/constructor . rest))) + ((_ #:root (~datum m-cities3/node) . rest) + (syntax/loc stx (m-cities3/node7/constructor . rest))) + ((_ #:root (~datum m-streets4/node) . rest) + (syntax/loc stx (m-streets4/node8/constructor . rest))) + ((_ . rest) (syntax/loc stx (City5/constructor . rest))))) + #:id + (λ (stx) #'City5/constructor)) + (begin + (: City9/make-placeholder City13/make-placeholder-type) + (define (City9/make-placeholder streets) + (City17/placeholder-struct (list streets)))) + (begin + (: Street10/make-placeholder Street14/make-placeholder-type) + (define (Street10/make-placeholder sname) + (Street18/placeholder-struct (list sname)))) + (begin + (: + m-cities3/node11/make-placeholder + m-cities3/node15/make-placeholder-type) + (define (m-cities3/node11/make-placeholder cnames) + (m-cities3/node19/placeholder-struct (list cnames)))) + (begin + (: + m-streets4/node12/make-placeholder + m-streets4/node16/make-placeholder-type) + (define (m-streets4/node12/make-placeholder snames) + (m-streets4/node20/placeholder-struct (list snames)))) + (begin + (: City29/make-incomplete City33/make-incomplete-type) + (define (City29/make-incomplete streets) + (list 'City37/incomplete-tag streets))) + (begin + (: Street30/make-incomplete Street34/make-incomplete-type) + (define (Street30/make-incomplete sname) + (list 'Street38/incomplete-tag sname))) + (begin + (: m-cities3/node31/make-incomplete m-cities3/node35/make-incomplete-type) + (define (m-cities3/node31/make-incomplete returned) + (list 'm-cities3/node39/incomplete-tag returned))) + (begin + (: + m-streets4/node32/make-incomplete + m-streets4/node36/make-incomplete-type) + (define (m-streets4/node32/make-incomplete returned) + (list 'm-streets4/node40/incomplete-tag returned))) + (begin (struct (A) City17/placeholder-struct ((f : A)) #:transparent)) + (begin (struct (A) Street18/placeholder-struct ((f : A)) #:transparent)) + (begin + (struct (A) m-cities3/node19/placeholder-struct ((f : A)) #:transparent)) + (begin + (struct (A) m-streets4/node20/placeholder-struct ((f : A)) #:transparent)) + (begin (struct City49/index-type ((i : Index)) #:transparent)) + (begin (struct Street50/index-type ((i : Index)) #:transparent)) + (begin (struct m-cities3/node51/index-type ((i : Index)) #:transparent)) + (begin (struct m-streets4/node52/index-type ((i : Index)) #:transparent)) + (splicing-let + ((City1/simple-mapping City9/make-placeholder) + (Street2/simple-mapping Street10/make-placeholder) + (m-cities m-cities3/node11/make-placeholder) + (m-streets m-streets4/node12/make-placeholder) + (City City29/make-incomplete) + (Street Street30/make-incomplete) + (m-cities3/node m-cities3/node31/make-incomplete) + (m-streets4/node m-streets4/node32/make-incomplete)) + (begin + (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) + (displayln (format "first-step-expander2: ~a" stx)) + (syntax-parse + stx + ((_ (~datum m-cities)) #'(U m-cities3/node (Listof City))) + ((_ (~datum m-streets)) #'(U m-streets4/node (Listof Street)))))) + (define-graph-second-step + ((City5/constructor + Street6/constructor + m-cities3/node7/constructor + m-streets4/node8/constructor) + City5/constructor + (City9/make-placeholder + Street10/make-placeholder + m-cities3/node11/make-placeholder + m-streets4/node12/make-placeholder) + (City13/make-placeholder-type + Street14/make-placeholder-type + m-cities3/node15/make-placeholder-type + m-streets4/node16/make-placeholder-type) + (City17/placeholder-struct + Street18/placeholder-struct + m-cities3/node19/placeholder-struct + m-streets4/node20/placeholder-struct) + (City21/placeholder-type + Street22/placeholder-type + m-cities3/node23/placeholder-type + m-streets4/node24/placeholder-type) + (City25/incomplete-type + Street26/incomplete-type + m-cities3/node27/incomplete-type + m-streets4/node28/incomplete-type) + (City29/make-incomplete + Street30/make-incomplete + m-cities3/node31/make-incomplete + m-streets4/node32/make-incomplete) + (City33/make-incomplete-type + Street34/make-incomplete-type + m-cities3/node35/make-incomplete-type + m-streets4/node36/make-incomplete-type) + (City37/incomplete-tag + Street38/incomplete-tag + m-cities3/node39/incomplete-tag + m-streets4/node40/incomplete-tag) + ((streets41/incomplete-type) + (sname42/incomplete-type) + (returned43/incomplete-type) + (returned44/incomplete-type)) + (City45/with-promises-type + Street46/with-promises-type + m-cities3/node47/with-promises-type + m-streets4/node48/with-promises-type) + City45/with-promises-type + (City49/index-type + Street50/index-type + m-cities3/node51/index-type + m-streets4/node52/index-type)) + (first-step + #:debug + #: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) + (displayln (format "first-step-expander2: ~a" 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) (U (Pairof '~> (U)) (~> m-streets)))) + ((City1/simple-mapping (streets : (~> m-streets))) (City streets))) + (Street + (sname : (Let (~> first-step-expander2) (U (Pairof '~> (U)) 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))))))))) + + + + + + + #;(define-syntax (blah stx) - #'(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)))) + #'(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 - (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))) + (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 - (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) - (map Street snames)))))))) + (returned : (Listof Street)) + ((m-streets (snames : (Listof String))) + (m-streets4/node + (let ((City City1/simple-mapping) (Street Street2/simple-mapping)) + (map Street snames)))))))) -;(blah) \ No newline at end of file +;(blah) diff --git a/graph-lib/graph/__DEBUG_graph6B.rkt b/graph-lib/graph/__DEBUG_graph6B.rkt index 07455c41..16608eec 100644 --- a/graph-lib/graph/__DEBUG_graph6B.rkt +++ b/graph-lib/graph/__DEBUG_graph6B.rkt @@ -5,21 +5,36 @@ "graph.lp2.rkt" "get.lp2.rkt" "../type-expander/type-expander.lp2.rkt" + (for-syntax (submod "../type-expander/type-expander.lp2.rkt" expander)) "../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/splicing (for-syntax syntax/parse) (for-syntax syntax/parse/experimental/template)) +(define-syntax (d-exp stx) + (syntax-case stx () + [(_ T) + (displayln (expand-type #'T)) + #'(begin (: x T) + (define x 1))])) + (define-syntax (frozen stx) (syntax-parse stx - [(_ a) + [(_ def a) #'(begin - (define-type-expander (te stx) #'Number) - (: x (Let [~> te] a)) - (define x 1))])) + (splicing-let () + def + (d-exp a)))])) -(provide frozen) \ No newline at end of file +(define-syntax (goo stx) + (syntax-case stx () + [(_ T) + #`(frozen (define-type-expander (#,(datum->syntax #'T #'te) stx) #'Number) + T)])) + +(goo te) \ No newline at end of file diff --git a/graph-lib/graph/__DEBUG_graph6C.rkt b/graph-lib/graph/__DEBUG_graph6C.rkt new file mode 100644 index 00000000..e8ad0955 --- /dev/null +++ b/graph-lib/graph/__DEBUG_graph6C.rkt @@ -0,0 +1,42 @@ +#lang typed/racket + +(require "graph-6-rich-returns.lp2.rkt" + "../lib/low.rkt" + "graph.lp2.rkt" + "get.lp2.rkt" + "../type-expander/type-expander.lp2.rkt" + (for-syntax (submod "../type-expander/type-expander.lp2.rkt" expander)) + "../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/splicing + (for-syntax syntax/parse) + (for-syntax syntax/parse/experimental/template)) + +(define-syntax (d-exp stx) + (syntax-case stx () + [(_ a) #'(begin (define x a) x)])) + +(define-syntax (frozen stx) + (syntax-parse stx + [(_ def val a) + #`(begin (let ((#,(datum->syntax #'a (syntax->datum #'def)) val)) + (d-exp a)))])) + +(define-syntax (goo stx) + (syntax-case stx () + [(_ a) + #`(frozen #,(datum->syntax #'a #'te) 9 + a)])) + +(goo te) + +(define-syntax (lake stx) + (syntax-parse stx + [(_ val a) + #`(let ((#,(datum->syntax stx 'te) val)) a)])) + +(lake 3 te) \ No newline at end of file diff --git a/graph-lib/graph/__DEBUG_graph6D.rkt b/graph-lib/graph/__DEBUG_graph6D.rkt new file mode 100644 index 00000000..fe48dbf7 --- /dev/null +++ b/graph-lib/graph/__DEBUG_graph6D.rkt @@ -0,0 +1,42 @@ +#lang typed/racket + +(require "graph-6-rich-returns.lp2.rkt" + "../lib/low.rkt" + "graph.lp2.rkt" + "get.lp2.rkt" + "../type-expander/type-expander.lp2.rkt" + (for-syntax (submod "../type-expander/type-expander.lp2.rkt" expander)) + "../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/splicing + (for-syntax syntax/parse) + (for-syntax syntax/parse/experimental/template)) + +(define-syntax (d-exp stx) + (syntax-case stx () + [(_ a) #'(begin (define x a) x)])) + +(define-syntax (frozen stx) + (syntax-parse stx + [(_ def val a) + #`(begin (define def val) ;#,(datum->syntax #'a (syntax->datum #'(define def val))) + (d-exp a))])) + +(define-syntax (goo stx) + (syntax-case stx () + [(_ a) + #`(frozen #,(datum->syntax #'a 'te) 9 + a)])) + +(goo te) + +(define-syntax (lake stx) + (syntax-parse stx + [(_ val a) + #`(let ((#,(datum->syntax stx 'tea) val)) a)])) + +(lake 3 tea) \ No newline at end of file diff --git a/graph-lib/graph/graph-6-rich-returns.lp2.rkt b/graph-lib/graph/graph-6-rich-returns.lp2.rkt index 3f4492bf..e4a5708a 100644 --- a/graph-lib/graph/graph-6-rich-returns.lp2.rkt +++ b/graph-lib/graph/graph-6-rich-returns.lp2.rkt @@ -104,13 +104,13 @@ plain list. (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 stx #'~> stx)) + (define/with-syntax ~>-id (datum->syntax #'name '~>)) (template - (debug + ;(debug (begin (define-graph first-step #:definitions [] - [node [field c (Let [~> first-step-expander2] (U (Pairof '~>-id (U)) field-type))] … + [node [field c (Let [~>-id first-step-expander2] field-type)] … [(node/simple-mapping [field c field-type] …) ;] …) (node field …)]] … @@ -119,14 +119,16 @@ plain list. (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[ - (define-type-expander (~> stx) + ;; 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 @@ -165,7 +167,7 @@ encapsulating the result types of mappings. "../lib/low/multiassoc-syntax.rkt" "rewrite-type.lp2.rkt"; debug ) - "../lib/low.rkt" + (rename-in "../lib/low.rkt" [~> threading:~>]) "graph.lp2.rkt" "get.lp2.rkt" "../type-expander/type-expander.lp2.rkt" @@ -175,8 +177,11 @@ encapsulating the result types of mappings. "fold-queues.lp2.rkt"; debug "rewrite-type.lp2.rkt"; debug "meta-struct.rkt"; debug - ) - (provide define-graph/rich-return) + 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) @@ -246,7 +251,7 @@ encapsulating the result types of mappings. -(begin +#;(begin (define-graph first-step #:definitions diff --git a/graph-lib/graph/graph.lp2.rkt b/graph-lib/graph/graph.lp2.rkt index ee3e3951..42019bb6 100644 --- a/graph-lib/graph/graph.lp2.rkt +++ b/graph-lib/graph/graph.lp2.rkt @@ -213,9 +213,9 @@ We derive identifiers for these based on the @tc[node] name: (define-temp-ids "~a/make-incomplete-type" (node …)) (define-temp-ids "~a/incomplete-tag" (node …)) (define-temp-ids "~a/incomplete-type" ((field …) …)) - + (define-temp-ids "~a/with-promises-type" (node …) #:first-base root) - + (define-temp-ids "~a/index-type" (node …))] @chunk[ @@ -226,7 +226,7 @@ We derive identifiers for these based on the @tc[node] name: (node/make-placeholder-type …) (node/placeholder-struct …) (node/placeholder-type …) - + (node/incomplete-type …) (node/make-incomplete …) (node/make-incomplete-type …) @@ -354,9 +354,11 @@ The first step macro is defined as follows: (define-syntax/parse (debug-template debug - (begin ; Can't use (let () …) because of TR bug #192 - - )))] + ;; Can't use (let () …) because of TR bug #262 + ;; https://github.com/racket/typed-racket/issues/262 + (begin + + )))] @subsubsection{Second step} @@ -376,7 +378,7 @@ It will be called from the first step with the following syntax: @chunk[ (define-syntax/parse - (template ;debug-template debug + (debug-template debug (begin (begin ) … @@ -737,7 +739,7 @@ via @tc[(g Street)]. (syntax-parse #'fld [(~datum field) #'field/incomplete-type] …)] … [(_ #:make-placeholder (~datum node)) - #'(→ param-type … node/placeholder-type)] … + #'node/make-placeholder-type] … [(_ #:placeholder (~datum node)) #'node/placeholder-type] …))] We will be able to use this type expander in function types, for example: diff --git a/graph-lib/graph/rewrite-type.lp2.rkt b/graph-lib/graph/rewrite-type.lp2.rkt index 078a1442..430f03b6 100644 --- a/graph-lib/graph/rewrite-type.lp2.rkt +++ b/graph-lib/graph/rewrite-type.lp2.rkt @@ -87,7 +87,11 @@ calls itself on the components of the type. (define-for-syntax (replace-in-type t r) (define (recursive-replace new-t) (replace-in-type new-t r)) (define/with-syntax ([from to] ...) r) + #;(displayln (format "~a\n=> ~a" + (syntax->datum t) + (syntax->datum (expand-type t)))) (syntax-parse (expand-type t) + #:context #'(replace-in-type t r) ))] @@ -169,6 +173,7 @@ The other cases are similarly defined: (define/with-syntax val stx-val) (define/with-syntax (v-cache) (generate-temporaries #'(val-cache))) (syntax-parse type + #:context 'recursive-replace-2 [x:id #:attr assoc-from-to (cdr-stx-assoc #'x #'((from . (to . fun)) ...)) #:when (attribute assoc-from-to) @@ -222,6 +227,7 @@ TODO: we currently don't check that each @tc[tag] is distinct. (define (replace-in-union stx-v-cache t r) (define/with-syntax v-cache stx-v-cache) (syntax-parse t + #:context 'replace-in-union-3 [((~literal List) ((~literal quote) tag:id) b ...) ] [_ (raise-syntax-error @@ -399,6 +405,7 @@ functions is undefined. (define (recursive-replace type) (define/with-syntax (v-cache) (generate-temporaries #'(val-cache))) (syntax-parse type + #:context 'recursive-replace-4 [x:id #:attr assoc-from-to-fun (stx-assoc #'x #'((from to fun) ...)) #:when (attribute assoc-from-to-fun) @@ -511,6 +518,7 @@ functions is undefined. @CHUNK[ (syntax-parse ta + #:context 'replace-fold-union-5 [((~literal List) ((~literal quote) tag:id) b ...) ] [((~literal Pairof) ((~literal quote) tag:id) b) @@ -583,6 +591,7 @@ one for @tc[replace-in-type]: @CHUNK[ (define-template-metafunction (tmpl-replace-in-type stx) (syntax-parse stx + #:context 'tmple-replace-in-type-6 [(_ (~optional (~and debug? #:debug)) type:expr [from to] …) (when (attribute debug?) (displayln (format "~a" stx))) @@ -597,6 +606,7 @@ And one each for @tc[fold-instance] and @tc[replace-in-instance2]: @CHUNK[ (define-template-metafunction (tmpl-fold-instance stx) (syntax-parse stx + #:context 'tmpl-fold-instance-7 [(_ type:expr acc-type:expr [from to pred? fun] …) #`(begin "fold-instance expanded code below. Initially called with:" @@ -607,6 +617,7 @@ And one each for @tc[fold-instance] and @tc[replace-in-instance2]: (define-template-metafunction (tmpl-replace-in-instance stx) (syntax-parse stx + #:context 'tmpl-replace-in-instance-8 [(_ type:expr [from to fun] …) #`#,(replace-in-instance2 #'type #'([from to fun] …))]))] diff --git a/graph-lib/type-expander/type-expander.lp2.rkt b/graph-lib/type-expander/type-expander.lp2.rkt index c5067ae2..8a941af3 100644 --- a/graph-lib/type-expander/type-expander.lp2.rkt +++ b/graph-lib/type-expander/type-expander.lp2.rkt @@ -132,7 +132,11 @@ else. (type-expander-nested-application env)) . args) ;; TODO: test #:with expanded-once - #'(nested-application.expanded-once . args))) + #'(nested-application.expanded-once . args)) + (pattern (~datum ~>) + #:with expanded-once #'() + #:when (displayln (format "dict = ~a" (dict->list env))) + #:when #f)) (define-syntax-class fa (pattern (~or (~literal ∀) (~literal All)))) (syntax-parse stx