suzanne.soy/phc-graph
1
0
Fork 0
Code Issues 24 Pull Requests Actions Packages Projects Releases Wiki Activity

Closes FB case 190 Rename λ-replace-in-instance to !λ-replace-in-instance

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-26 21:20:51 +01:00
parent 8bf2315281
commit 18a8938d0c
2 changed files with 28 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
test/traversal-util.rkt
View File

@ -17,6 +17,6 @@
(template (template
(begin (begin
(define-type _type-name (define-type _type-name
(∀-replace-in-type whole-type _type-to-replaceᵢ ...)) (!∀-replace-in-type whole-type _type-to-replaceᵢ ...))
(define _function-name (define _function-name
(λ-replace-in-instance whole-type _type-to-replaceᵢ ...))))))])) (!λ-replace-in-instance whole-type _type-to-replaceᵢ ...))))))]))

52
traversal.hl.rkt
View File

@ -150,14 +150,14 @@ not expressed syntactically using the @racket[Foo] identifier.
@CHUNK[<api> @CHUNK[<api>
(define-template-metafunction (replace-in-type stx) (define-template-metafunction (!replace-in-type stx)
(syntax-case stx () (syntax-case stx ()
[(_ _whole-type [_type-to-replaceᵢ _Tᵢ] …) [(_ _whole-type [_type-to-replaceᵢ _Tᵢ] …)
#`(#,(syntax-local-template-metafunction-introduce #`(#,(syntax-local-template-metafunction-introduce
(fold-τ #'(_whole-type _type-to-replaceᵢ …))) _Tᵢ …)]))] (fold-τ #'(_whole-type _type-to-replaceᵢ …))) _Tᵢ …)]))]
@CHUNK[<api> @CHUNK[<api>
(define-template-metafunction (∀-replace-in-type stx) (define-template-metafunction (!∀-replace-in-type stx)
(syntax-case stx () (syntax-case stx ()
[(_ _whole-type _type-to-replaceᵢ …) [(_ _whole-type _type-to-replaceᵢ …)
(syntax-local-template-metafunction-introduce (syntax-local-template-metafunction-introduce
@ -196,7 +196,7 @@ not expressed syntactically using the @racket[Foo] identifier.
base))))))] base))))))]
@CHUNK[<api> @CHUNK[<api>
(define-template-metafunction (replace-in-instance stx) (define-template-metafunction (!replace-in-instance stx)
(syntax-case stx () (syntax-case stx ()
[(_ _whole-type [_type-to-replaceᵢ _predicateᵢ _updateᵢ] …) [(_ _whole-type [_type-to-replaceᵢ _predicateᵢ _updateᵢ] …)
#`(#,(syntax-local-template-metafunction-introduce #`(#,(syntax-local-template-metafunction-introduce
@ -204,7 +204,7 @@ not expressed syntactically using the @racket[Foo] identifier.
{?@ _predicateᵢ _updateᵢ} …)]))] {?@ _predicateᵢ _updateᵢ} …)]))]
@CHUNK[<api> @CHUNK[<api>
(define-template-metafunction (λ-replace-in-instance stx) (define-template-metafunction (!λ-replace-in-instance stx)
(syntax-case stx () (syntax-case stx ()
[(_ _whole-type _type-to-replaceᵢ …) [(_ _whole-type _type-to-replaceᵢ …)
(syntax-local-introduce (syntax-local-introduce
@ -234,10 +234,10 @@ not expressed syntactically using the @racket[Foo] identifier.
(→ (?@ (→ Any Boolean : _Aᵢ) (→ (?@ (→ Any Boolean : _Aᵢ)
(→ _Aᵢ Acc (Values _Bᵢ Acc))) (→ _Aᵢ Acc (Values _Bᵢ Acc)))
… …
(→ (replace-in-type _whole-type (→ (!replace-in-type _whole-type
[_type-to-replaceᵢ _Aᵢ] …) [_type-to-replaceᵢ _Aᵢ] …)
Acc Acc
(Values (replace-in-type _whole-type (Values (!replace-in-type _whole-type
[_type-to-replaceᵢ _Bᵢ] …) [_type-to-replaceᵢ _Bᵢ] …)
Acc))))])]))] Acc))))])]))]
@ -264,74 +264,74 @@ not expressed syntactically using the @racket[Foo] identifier.
@CHUNK[<type-cases> @CHUNK[<type-cases>
[(Pairof X Y) [(Pairof X Y)
#'(Pairof (replace-in-type X . rec-args) #'(Pairof (!replace-in-type X . rec-args)
(replace-in-type Y . rec-args))]] (!replace-in-type Y . rec-args))]]
@CHUNK[<f-cases> @CHUNK[<f-cases>
[(Pairof X Y) [(Pairof X Y)
#'(let*-values ([(result-x acc-x) #'(let*-values ([(result-x acc-x)
((replace-in-instance X . rec-args) (car v) acc)] ((!replace-in-instance X . rec-args) (car v) acc)]
[(result-y acc-y) [(result-y acc-y)
((replace-in-instance Y . rec-args) (cdr v) acc-x)]) ((!replace-in-instance Y . rec-args) (cdr v) acc-x)])
(values (cons result-x result-y) acc-y))]] (values (cons result-x result-y) acc-y))]]
@CHUNK[<type-cases> @CHUNK[<type-cases>
[(Listof X) [(Listof X)
#'(Listof (replace-in-type X . rec-args))]] #'(Listof (!replace-in-type X . rec-args))]]
@CHUNK[<f-cases> @CHUNK[<f-cases>
[(Listof X) [(Listof X)
#'(foldl-map (replace-in-instance X . rec-args) #'(foldl-map (!replace-in-instance X . rec-args)
acc v)]] acc v)]]
@CHUNK[<type-cases> @CHUNK[<type-cases>
[(Vectorof X) [(Vectorof X)
#'(Vectorof (replace-in-type X . rec-args))]] #'(Vectorof (!replace-in-type X . rec-args))]]
@CHUNK[<ftype-cases> @CHUNK[<ftype-cases>
[(Vectorof X) [(Vectorof X)
#'(vector->immutable-vector #'(vector->immutable-vector
(list->vector (list->vector
(foldl-map (replace-in-instance X . rec-args) (foldl-map (!replace-in-instance X . rec-args)
acc acc
(vector->list v))))]] (vector->list v))))]]
@CHUNK[<type-cases> @CHUNK[<type-cases>
[(List X Y …) [(List X Y …)
#'(Pairof (replace-in-type X . rec-args) #'(Pairof (!replace-in-type X . rec-args)
(replace-in-type (List Y …) . rec-args))]] (!replace-in-type (List Y …) . rec-args))]]
@CHUNK[<f-cases> @CHUNK[<f-cases>
[(List X Y …) [(List X Y …)
#'(let*-values ([(result-x acc-x) ((replace-in-instance X . rec-args) #'(let*-values ([(result-x acc-x) ((!replace-in-instance X . rec-args)
(car v) (car v)
acc)] acc)]
[(result-y* acc-y*) ((replace-in-instance (List Y …) . rec-args) [(result-y* acc-y*) ((!replace-in-instance (List Y …) . rec-args)
(cdr v) (cdr v)
acc-x)]) acc-x)])
(values (cons result-x result-y*) acc-y*))]] (values (cons result-x result-y*) acc-y*))]]
@CHUNK[<type-cases> @CHUNK[<type-cases>
[(U _Xⱼ …) [(U _Xⱼ …)
#'(U (replace-in-type _Xⱼ . rec-args) …)]] #'(U (!replace-in-type _Xⱼ . rec-args) …)]]
@CHUNK[<f-cases> @CHUNK[<f-cases>
[(U _Xⱼ …) [(U _Xⱼ …)
#'(dispatch-union v #'(dispatch-union v
([_type-to-replaceᵢ Aᵢ _predicateᵢ] …) ([_type-to-replaceᵢ Aᵢ _predicateᵢ] …)
[_Xⱼ ((replace-in-instance _Xⱼ . rec-args) v acc)] [_Xⱼ ((!replace-in-instance _Xⱼ . rec-args) v acc)]
…)]] …)]]
@CHUNK[<type-cases> @CHUNK[<type-cases>
[(tagged _name [_fieldⱼ (~optional :colon) _Xⱼ] …) [(tagged _name [_fieldⱼ (~optional :colon) _Xⱼ] …)
#'(tagged _name [_fieldⱼ : (replace-in-type _Xⱼ . rec-args)] …)]] #'(tagged _name [_fieldⱼ : (!replace-in-type _Xⱼ . rec-args)] …)]]
@CHUNK[<f-cases> @CHUNK[<f-cases>
[(tagged _name [_fieldⱼ (~optional :colon) _Xⱼ] …) [(tagged _name [_fieldⱼ (~optional :colon) _Xⱼ] …)
#'(let*-values #'(let*-values
([(_resultⱼ acc) ([(_resultⱼ acc)
((replace-in-instance _Xⱼ . rec-args) (uniform-get v _fieldⱼ) ((!replace-in-instance _Xⱼ . rec-args) (uniform-get v _fieldⱼ)
acc)] acc)]
…) …)
(values (tagged _name #:instance [_fieldⱼ _resultⱼ] …) (values (tagged _name #:instance [_fieldⱼ _resultⱼ] …)
@ -382,10 +382,10 @@ where @racket[foldl-map] is defined as:
(for-meta 2 syntax/parse)) (for-meta 2 syntax/parse))
(provide (for-syntax with-folds (provide (for-syntax with-folds
replace-in-type !replace-in-type
∀-replace-in-type !∀-replace-in-type
replace-in-instance !replace-in-instance
λ-replace-in-instance)) !λ-replace-in-instance))
<foldl-map> <foldl-map>
<with-folds> <with-folds>
<cached> <cached>