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

Added result type annotations for all lambdas in , to catch errors more easily.

Browse Source 
That also fixed a problem with graph2.lp2.rkt (changes not committed yet), which probably was due to a type too narrow or to wide being inferred.
This commit is contained in:
Georges Dupéron 2015-11-19 21:08:39 +01:00
parent f43b08eba3
commit 758d7ef4b7
1 changed files with 35 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
graph/graph/rewrite-type.lp2.rkt
View File

@ -385,6 +385,7 @@ functions is undefined.
(recursive-replace t))] (recursive-replace t))]
@CHUNK[<recursive-replace-fold-instance> @CHUNK[<recursive-replace-fold-instance>
(define (new-type-for stx) (replace-in-type stx #'([from to] ...)))
(define (recursive-replace type) (define (recursive-replace type)
(define/with-syntax (v-cache) (generate-temporaries #'(val-cache))) (define/with-syntax (v-cache) (generate-temporaries #'(val-cache)))
(syntax-parse type (syntax-parse type
@ -400,9 +401,10 @@ functions is undefined.
(define/with-syntax (tmp2 ...) (generate-temporaries #'(a ...))) (define/with-syntax (tmp2 ...) (generate-temporaries #'(a ...)))
(define/with-syntax (new-acc ...) (generate-temporaries #'(a ...))) (define/with-syntax (new-acc ...) (generate-temporaries #'(a ...)))
(define/with-syntax (new-acc1 ... new-acc-last) #'(acc new-acc ...)) (define/with-syntax (new-acc1 ... new-acc-last) #'(acc new-acc ...))
(define/with-syntax (rec ...) (define/with-syntax (rec …) (stx-map recursive-replace #'(a …)))
(stx-map recursive-replace #'(a ...))) (define/with-syntax (new-a-type …) (stx-map new-type-for #'(a …)))
#`(λ ([val : (List a ...)] [acc : acc-type]) #`(λ ([val : (List a …)] [acc : acc-type])
: (values (List new-a-type …) acc-type)
(let*-values ([(tmp1 ...) (apply values val)] (let*-values ([(tmp1 ...) (apply values val)]
[(tmp2 new-acc) (rec tmp1 new-acc1)] [(tmp2 new-acc) (rec tmp1 new-acc1)]
...) ...)
@ -412,7 +414,10 @@ functions is undefined.
;(define/with-syntax (acc-a acc-b) (generate-temporaries #'(a b))) ;(define/with-syntax (acc-a acc-b) (generate-temporaries #'(a b)))
(define/with-syntax rec-a (recursive-replace #'a)) (define/with-syntax rec-a (recursive-replace #'a))
(define/with-syntax rec-b (recursive-replace #'b)) (define/with-syntax rec-b (recursive-replace #'b))
(define/with-syntax new-a-type (new-type-for #'a))
(define/with-syntax new-b-type (new-type-for #'b))
#`(λ ([val : (Pairof a b)] [acc : acc-type]) #`(λ ([val : (Pairof a b)] [acc : acc-type])
: (values (Pairof new-a-type new-b-type) acc-type)
(let*-values ([(tmp-a acc-a) (rec-a (car val) acc)] (let*-values ([(tmp-a acc-a) (rec-a (car val) acc)]
[(tmp-b acc-b) (rec-b (cdr val) acc-a)]) [(tmp-b acc-b) (rec-b (cdr val) acc-a)])
(values (cons tmp-a tmp-b) acc-b)))] (values (cons tmp-a tmp-b) acc-b)))]
@ -420,10 +425,14 @@ functions is undefined.
;(define/with-syntax (x) (generate-temporaries #'(x))) ;(define/with-syntax (x) (generate-temporaries #'(x)))
;(define/with-syntax (acc1) (generate-temporaries #'(acc))) ;(define/with-syntax (acc1) (generate-temporaries #'(acc)))
(define/with-syntax rec (recursive-replace #'a)) (define/with-syntax rec (recursive-replace #'a))
(define/with-syntax new-a-type (define/with-syntax new-a-type (new-type-for #'a))
(replace-in-type #'a #'([from to] ...)))
#`(λ ([val : (Listof a)] [acc : acc-type]) #`(λ ([val : (Listof a)] [acc : acc-type])
(let ([f (foldl : (values (Listof new-a-type) acc-type)
(let ([f ((inst foldl
a
(Pairof (Listof new-a-type) acc-type)
Nothing
Nothing)
(λ ([x : a] (λ ([x : a]
[acc1 : (Pairof (Listof new-a-type) acc-type)]) [acc1 : (Pairof (Listof new-a-type) acc-type)])
(let-values ([(res res-acc) (rec x (cdr acc1))]) (let-values ([(res res-acc) (rec x (cdr acc1))])
@ -437,9 +446,10 @@ functions is undefined.
(define/with-syntax (tmp2 ...) (generate-temporaries #'(a ...))) (define/with-syntax (tmp2 ...) (generate-temporaries #'(a ...)))
(define/with-syntax (new-acc ...) (generate-temporaries #'(a ...))) (define/with-syntax (new-acc ...) (generate-temporaries #'(a ...)))
(define/with-syntax (new-acc1 ... new-acc-last) #'(acc new-acc ...)) (define/with-syntax (new-acc1 ... new-acc-last) #'(acc new-acc ...))
(define/with-syntax (rec ...) (define/with-syntax (rec …) (stx-map recursive-replace #'(a …)))
(stx-map recursive-replace #'(a ...))) (define/with-syntax (new-a-type …) (stx-map new-type-for #'(a …)))
#`(λ ([val : (Vector a ...)] [acc : acc-type]) #`(λ ([val : (Vector a ...)] [acc : acc-type])
: (values (Vector new-a-type …) acc-type)
(let*-values ([(tmp1) (vector-ref val idx)] (let*-values ([(tmp1) (vector-ref val idx)]
... ...
[(tmp2 new-acc) (rec tmp1 new-acc1)] [(tmp2 new-acc) (rec tmp1 new-acc1)]
@ -450,11 +460,14 @@ functions is undefined.
;(define/with-syntax (x) (generate-temporaries #'(x))) ;(define/with-syntax (x) (generate-temporaries #'(x)))
;(define/with-syntax (acc1) (generate-temporaries #'(acc))) ;(define/with-syntax (acc1) (generate-temporaries #'(acc)))
(define/with-syntax rec (recursive-replace #'a)) (define/with-syntax rec (recursive-replace #'a))
(define/with-syntax new-a-type (define/with-syntax new-a-type (new-type-for #'a))
(replace-in-type #'a #'([from to] ...)))
#`(λ ([val : (Vectorof a)] [acc : acc-type]) #`(λ ([val : (Vectorof a)] [acc : acc-type])
: (values (Vectorof new-a-type) acc-type) : (values (Vectorof new-a-type) acc-type)
(let ([f (foldl (let ([f ((inst foldl
a
(Pairof (Listof new-a-type) acc-type)
Nothing
Nothing)
(λ ([x : a] (λ ([x : a]
[acc1 : (Pairof (Listof new-a-type) acc-type)]) [acc1 : (Pairof (Listof new-a-type) acc-type)])
(let-values ([(res res-acc) (rec x (cdr acc1))]) (let-values ([(res res-acc) (rec x (cdr acc1))])
@ -466,7 +479,9 @@ functions is undefined.
(reverse (car f)))) (reverse (car f))))
(cdr f))))] (cdr f))))]
[((~literal U) a ...) [((~literal U) a ...)
(define/with-syntax (new-a-type …) (stx-map new-type-for #'(a …)))
#`(λ ([val : (U a ...)] [acc : acc-type]) #`(λ ([val : (U a ...)] [acc : acc-type])
: (values (U new-a-type …) acc-type)
(cond (cond
#,@(stx-map (λ (ta) <replace-fold-union>) #,@(stx-map (λ (ta) <replace-fold-union>)
#'(a ...)) #'(a ...))
@ -524,22 +539,25 @@ one for @tc[replace-in-type]:
@CHUNK[<template-metafunctions> @CHUNK[<template-metafunctions>
(define-template-metafunction (tmpl-replace-in-type stx) (define-template-metafunction (tmpl-replace-in-type stx)
(syntax-parse stx (syntax-parse stx
[(_ type:expr ([from to] ...)) [(_ type:expr [from to] …)
#`#,(replace-in-type #'type #`#,(replace-in-type #'type
#'([from to] ...))]))] #'([from to] …))]))]
And one each for @tc[fold-instance] and @tc[replace-in-instance2]: And one each for @tc[fold-instance] and @tc[replace-in-instance2]:
@CHUNK[<template-metafunctions> @CHUNK[<template-metafunctions>
(define-template-metafunction (tmpl-fold-instance stx) (define-template-metafunction (tmpl-fold-instance stx)
(syntax-parse stx (syntax-parse stx
[(_ type:expr acc-type:expr (~and rules ([from to fun] ...))) [(_ type:expr acc-type:expr [from to fun] …)
#`#,(fold-instance #'type #'acc-type #'rules)])) #`(begin
"fold-instance expanded code below. Initially called with:"
'(fold-instance type acc-type [from to fun] …)
#,(fold-instance #'type #'acc-type #'([from to fun] …)))]))
(define-template-metafunction (tmpl-replace-in-instance stx) (define-template-metafunction (tmpl-replace-in-instance stx)
(syntax-parse stx (syntax-parse stx
[(_ type:expr (~and rules ([from to fun] ...))) [(_ type:expr [from to fun] …)
#`#,(replace-in-instance2 #'type #'rules)]))] #`#,(replace-in-instance2 #'type #'([from to fun] …))]))]
These metafunctions just extract the arguments for @tc[replace-in-type] and These metafunctions just extract the arguments for @tc[replace-in-type] and
@tc[replace-in-instance2], and pass them to these functions. @tc[replace-in-instance2], and pass them to these functions.