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

Fix error in use of tc-error/delayed.

Browse Source 
Fix expansion of with-handlers:
add test

svn: r11875

original commit: cd6a37ff4c83505ceef5fbc747235160d03d2aee
This commit is contained in:
Sam Tobin-Hochstadt 2008-09-25 19:35:00 +00:00
parent bd6862fae4
commit e7bc490d7f
3 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/typed-scheme/succeed/with-handlers.ss Normal file
View File

@ -0,0 +1,10 @@
#lang typed-scheme
(define: (f [i : Integer]) : (Pair String Char)
(cons "foo" #\space))
(define: (is-happiness-a-warm-gun?) : Boolean
(with-handlers ([integer? (lambda: ([x : Any]) #t)])
(f 42)
#t))

2
collects/typed-scheme/private/prims.ss
View File

@ -301,7 +301,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax->list #'(pred? ...)))]
[(action* ...)
(map (lambda (s) (syntax-property s 'typechecker:exn-handler #t)) (syntax->list #'(action ...)))]
[body* (syntax-property #'(begin . body) 'typechecker:exn-body #t)])
[body* (syntax-property #'(let-values () . body) 'typechecker:exn-body #t)])
(syntax-property #'(with-handlers ([pred?* action*] ...) body*)
'typechecker:with-handlers
#t))]))

11
collects/typed-scheme/private/type-annotation.ss
View File

@ -103,16 +103,19 @@
(match ty
[(Values: tys)
(if (not (= (length stxs) (length tys)))
(tc-error/delayed #:ret (map (lambda _ (Un)) stxs)
(begin
(tc-error/delayed
"Expression should produce ~a values, but produces ~a values of types ~a"
(length stxs) (length tys) (stringify tys))
(map (lambda _ (Un)) stxs))
(map (lambda (stx ty a)
(cond [a => (lambda (ann) (check-type stx ty ann) #;(log/extra stx ty ann) ann)]
[else #;(log/noann stx ty) ty]))
stxs tys anns))]
[ty (tc-error/delayed #:ret (map (lambda _ (Un)) stxs)
"Expression should produce ~a values, but produces one values of type "
(length stxs) ty)]))))]))
[ty (tc-error/delayed
"Expression should produce ~a values, but produces one values of type ~a"
(length stxs) ty)
(map (lambda _ (Un)) stxs)]))))]))
;; check that e-type is compatible with ty in context of stx