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

Fix check-subforms and reenable TR contracts.

Browse Source 
original commit: 0ba8cd9586666ee37397b525bc4c127710e81542
This commit is contained in:
Eric Dobson 2014-05-06 22:42:26 -07:00
parent 129f632e04
commit 59bf67e8bf
5 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
View File

@ -9,9 +9,9 @@
(only-in (types printer) pretty-format-type))
(provide/cond-contract
[check-below (-->i ([s (-or/c Type/c tc-results/c)]
[check-below (-->i ([s (-or/c Type/c full-tc-results/c)]
[t (s) (if (Type/c? s) Type/c tc-results/c)])
[_ (s) (if (Type/c? s) Type/c tc-results/c)])]
[_ (s) (if (Type/c? s) Type/c full-tc-results/c)])]
[cond-check-below (-->i ([s (-or/c Type/c full-tc-results/c)]
[t (s) (-or/c #f (if (Type/c? s) Type/c tc-results/c))])
[_ (s) (-or/c #f (if (Type/c? s) Type/c full-tc-results/c))])]

5
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt
View File

@ -90,6 +90,7 @@
;; syntax tc-results -> tc-results
(define (check-subforms/with-handlers/check form expected)
(define body-results #f)
(find-syntax form
;; if this needs to be checked
[stx:with-type^
@ -100,8 +101,8 @@
(tc-expr/check #'stx (ret (-> (Un) (tc-results->values expected))))]
;; this is the body of the with-handlers
[stx:exn-body^
(tc-expr/check #'stx expected)])
expected)
(set! body-results (tc-expr/check #'stx expected))])
body-results)
;; typecheck the expansion of a with-handlers form
;; syntax -> void

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt
View File

@ -7,7 +7,7 @@
(define-signature tc-expr^
([cond-contracted tc-expr (syntax? . -> . full-tc-results/c)]
[cond-contracted tc-expr/check (syntax? tc-results/c . -> . tc-results/c)]
[cond-contracted tc-expr/check (syntax? tc-results/c . -> . full-tc-results/c)]
[cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)]
[cond-contracted tc-body (syntax? . -> . full-tc-results/c)]
[cond-contracted tc-body/check (syntax? tc-results/c . -> . full-tc-results/c)]
@ -15,9 +15,9 @@
[cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))
(define-signature check-subforms^
([cond-contracted check-subforms/ignore (syntax? . -> . any)]
[cond-contracted check-subforms/with-handlers (syntax? . -> . any)]
[cond-contracted check-subforms/with-handlers/check (syntax? tc-results/c . -> . any)]))
([cond-contracted check-subforms/ignore (syntax? . -> . void?)]
[cond-contracted check-subforms/with-handlers (syntax? . -> . full-tc-results/c)]
[cond-contracted check-subforms/with-handlers/check (syntax? tc-results/c . -> . full-tc-results/c)]))
(define-signature check-class^
([cond-contracted check-class (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -86,7 +86,7 @@
;; tc-expr/check : syntax tc-results -> tc-results
(define/cond-contract (tc-expr/check/internal form expected)
(--> syntax? tc-results/c tc-results/c)
(--> syntax? tc-results/c full-tc-results/c)
(parameterize ([current-orig-stx form])
;(printf "form: ~a\n" (syntax-object->datum form))
;; the argument must be syntax

6
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -2910,6 +2910,12 @@
(ann (for/list ([z #"foobar"]) (add1 z)) (Listof Integer))
(-lst -Int)]
[tc-e
(with-handlers ([exn:fail? (λ (exn) 4)])
5)
#:ret (ret -Nat -true-filter)
#:expected (ret -Nat -no-filter)]
)
(test-suite
"tc-literal tests"