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

Fixed most bugs related to ~> type expander

Browse Source
This commit is contained in:
Georges Dupéron 2016-02-26 00:42:34 +01:00
parent e723dacc41
commit 876c4d272f
8 changed files with 459 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

367
graph-lib/graph/__DEBUG_graph6.rkt
View File

@ -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)
;(blah)

25
graph-lib/graph/__DEBUG_graph6B.rkt
View File

@ -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)
(define-syntax (goo stx)
(syntax-case stx ()
[(_ T)
#`(frozen (define-type-expander (#,(datum->syntax #'T #'te) stx) #'Number)
T)]))
(goo te)

42
graph-lib/graph/__DEBUG_graph6C.rkt Normal file
View File

@ -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)

42
graph-lib/graph/__DEBUG_graph6D.rkt Normal file
View File

@ -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)

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

@ -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 [<first-pass-type-expander>]
[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] …)
;<first-pass-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[<first-pass-type-expander>
(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

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

@ -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[<pass-to-second-step>
@ -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 <signature>
<define-ids/first-step>
(debug-template debug
(begin ; Can't use (let () …) because of TR bug #192
<first-step-definitions>
<first-step-bindings>)))]
;; Can't use (let () …) because of TR bug #262
;; https://github.com/racket/typed-racket/issues/262
(begin
<first-step-definitions>
<first-step-bindings>)))]
@subsubsection{Second step}
@ -376,7 +378,7 @@ It will be called from the first step with the following syntax:
@chunk[<second-step>
(define-syntax/parse <signature-second-step>
<define-ids/second-step>
(template ;debug-template debug
(debug-template debug
(begin
(begin <define-mapping-function>) …
@ -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:

11
graph-lib/graph/rewrite-type.lp2.rkt
View File

@ -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)
<replace-in-type-substitute>
<replace-in-type-other-cases>))]
@ -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 ...)
<replace-in-tagged-union-instance>]
[_ (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[<replace-fold-union>
(syntax-parse ta
#:context 'replace-fold-union-5
[((~literal List) ((~literal quote) tag:id) b ...)
<replace-fold-union-tagged-list>]
[((~literal Pairof) ((~literal quote) tag:id) b)
@ -583,6 +591,7 @@ one for @tc[replace-in-type]:
@CHUNK[<template-metafunctions>
(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[<template-metafunctions>
(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] …))]))]

6
graph-lib/type-expander/type-expander.lp2.rkt
View File

@ -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