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

Cosmetic changes on the literate program

Browse Source
This commit is contained in:
Georges Dupéron 2016-10-03 03:38:46 +02:00
parent 922d50d02f
commit 4cc991e751
1 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
traversal.hl.rkt
View File

@ -125,8 +125,8 @@ way up, so that a simple identity function can be applied in these cases.
@chunk[<define-fold> @chunk[<define-fold>
(define-syntax define-fold (define-syntax define-fold
(syntax-parser (syntax-parser
[(_ function-name:id [(_ _function-name:id
type-name:id _type-name:id
whole-type:type whole-type:type
type-to-replaceᵢ:type …) type-to-replaceᵢ:type …)
<define-fold-prepare> <define-fold-prepare>
@ -135,24 +135,24 @@ way up, so that a simple identity function can be applied in these cases.
<define-fold-result>))]))] <define-fold-result>))]))]
@chunk[<define-fold-prepare> @chunk[<define-fold-prepare>
(define-temp-ids "Tᵢ" (type-to-replaceᵢ …)) (define-temp-ids "_Tᵢ" (type-to-replaceᵢ …))
(define-temp-ids "Aᵢ" (type-to-replaceᵢ …)) (define-temp-ids "_Aᵢ" (type-to-replaceᵢ …))
(define-temp-ids "Bᵢ" (type-to-replaceᵢ …)) (define-temp-ids "_Bᵢ" (type-to-replaceᵢ …))
(define-temp-ids "predicateᵢ" (type-to-replaceᵢ …)) (define-temp-ids "predicateᵢ" (type-to-replaceᵢ …))
(define-temp-ids "updateᵢ" (type-to-replaceᵢ …)) (define-temp-ids "updateᵢ" (type-to-replaceᵢ …))
(define/with-syntax args (template ({?@ predicateᵢ updateᵢ} …)))] (define/with-syntax _args (template ({?@ predicateᵢ updateᵢ} …)))]
@chunk[<define-fold-prepare> @chunk[<define-fold-prepare>
(type-cases (type-cases
(whole-type => the-type the-code the-defs …) (whole-type => _the-type _the-code the-defs …)
#:literals (Null Pairof Listof List Vectorof Vector) #:literals (Null Pairof Listof List Vectorof Vector)
<type-cases>)] <type-cases>)]
@chunk[<type-cases> @chunk[<type-cases>
[t [t
#:with info (findf (λ (r) (free-identifier-tree=? #'t (stx-car r))) #:with info (findf (λ (r) (free-identifier-tree=? #'t (stx-car r)))
(syntax->list #'([type-to-replaceᵢ updateᵢ Tᵢ] …))) (syntax->list #'([type-to-replaceᵢ updateᵢ _Tᵢ] …)))
#:when (attribute info) #:when (attribute info)
#:with (_ update T) #'info #:with (_ update T) #'info
=> T => T
@ -165,32 +165,32 @@ way up, so that a simple identity function can be applied in these cases.
@chunk[<type-cases> @chunk[<type-cases>
[(Pairof X Y) [(Pairof X Y)
=> (Pairof (tx Tᵢ …) (ty Tᵢ …)) => (Pairof (tx _Tᵢ …) (ty _Tᵢ …))
(let*-values ([(result-x acc-x) ((fx . args) (car v) acc)] (let*-values ([(result-x acc-x) ((fx . _args) (car v) acc)]
[(result-y acc-y) ((fy . args) (cdr v) acc-x)]) [(result-y acc-y) ((fy . _args) (cdr v) acc-x)])
(values (cons result-x result-y) acc-y)) (values (cons result-x result-y) acc-y))
(define-fold fx tx X type-to-replaceᵢ …) (define-fold fx tx X type-to-replaceᵢ …)
(define-fold fy ty Y type-to-replaceᵢ …)]] (define-fold fy ty Y type-to-replaceᵢ …)]]
@chunk[<type-cases> @chunk[<type-cases>
[(Listof X) [(Listof X)
=> (Listof (te Tᵢ …)) => (Listof (te _Tᵢ …))
(foldl-map (fe . args) acc v) (foldl-map (fe . _args) acc v)
(define-fold fe te X type-to-replaceᵢ …)]] (define-fold fe te X type-to-replaceᵢ …)]]
@chunk[<type-cases> @chunk[<type-cases>
[(Vectorof X) [(Vectorof X)
=> (Vectorof (te Tᵢ …)) => (Vectorof (te _Tᵢ …))
(vector->immutable-vector (vector->immutable-vector
(list->vector (list->vector
(foldl-map (fe . args) acc (vector->list v)))) (foldl-map (fe . _args) acc (vector->list v))))
(define-fold fe te X type-to-replaceᵢ …)]] (define-fold fe te X type-to-replaceᵢ …)]]
@chunk[<type-cases> @chunk[<type-cases>
[(List X Y ...) [(List X Y ...)
=> (Pairof (tx Tᵢ …) (ty* Tᵢ …)) => (Pairof (tx _Tᵢ …) (ty* _Tᵢ …))
(let*-values ([(result-x acc-x) ((fx . args) (car v) acc)] (let*-values ([(result-x acc-x) ((fx . _args) (car v) acc)]
[(result-y* acc-y*) ((fy* . args) (cdr v) acc-x)]) [(result-y* acc-y*) ((fy* . _args) (cdr v) acc-x)])
(values (cons result-x result-y*) acc-y*)) (values (cons result-x result-y*) acc-y*))
(define-fold fx tx X type-to-replaceᵢ …) (define-fold fx tx X type-to-replaceᵢ …)
(define-fold fy* ty* (List Y ...) type-to-replaceᵢ …)]] (define-fold fy* ty* (List Y ...) type-to-replaceᵢ …)]]
@ -235,18 +235,18 @@ where @racket[foldl-map] is defined as:
@chunk[<define-fold-result> @chunk[<define-fold-result>
the-defs … the-defs …
(define-type (type-name Tᵢ …) the-type) (define-type (_type-name _Tᵢ …) _the-type)
(: function-name (∀ (Aᵢ … Bᵢ … Acc) (: _function-name (∀ (_Aᵢ … _Bᵢ … Acc)
(→ {?@ (→ Any Boolean : Aᵢ) (→ (?@ (→ Any Boolean : _Aᵢ)
(→ Aᵢ Acc (Values Bᵢ Acc))} (→ _Aᵢ Acc (Values _Bᵢ Acc)))
… …
(→ (type-name Aᵢ …) (→ (_type-name _Aᵢ …)
Acc Acc
(Values (type-name Bᵢ …) (Values (_type-name _Bᵢ …)
Acc))))) Acc)))))
(define ((function-name . args) v acc) (define ((_function-name . _args) v acc)
the-code)] _the-code)]
@section{Putting it all together} @section{Putting it all together}