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

Make tc-let do unions correctly.

Browse Source
This commit is contained in:
Eric Dobson 2013-02-11 08:26:04 -08:00 committed by Vincent St-Amour
parent 60959467cf
commit b4beabc977
2 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -611,6 +611,16 @@
[tc-e (letrec: ([x : Number (values 1)]) (add1 x)) N] [tc-e (letrec: ([x : Number (values 1)]) (add1 x)) N]
[tc-e (let ()
(: complicated Boolean)
(define complicated #f)
(: undefined Undefined)
(define undefined (letrec: ((x : Undefined x)) x))
(letrec: ((x : Undefined (if complicated undefined undefined))
(y : Undefined (if complicated x undefined)))
y))
-Undefined]
[tc-err (let ([x (add1 5)]) [tc-err (let ([x (add1 5)])
(set! x "foo") (set! x "foo")
x)] x)]

7
collects/typed-racket/typecheck/tc-let-unit.rkt
View File

@ -3,7 +3,7 @@
(require (rename-in "../utils/utils.rkt" [infer r:infer]) (require (rename-in "../utils/utils.rkt" [infer r:infer])
"signatures.rkt" "tc-metafunctions.rkt" "tc-subst.rkt" "signatures.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
"check-below.rkt" "check-below.rkt"
(types utils abbrev) (types utils abbrev union)
(private type-annotation parse-type) (private type-annotation parse-type)
(env lexical-env type-alias-env global-env type-env-structs) (env lexical-env type-alias-env global-env type-env-structs)
(rep type-rep filter-rep object-rep) (rep type-rep filter-rep object-rep)
@ -165,10 +165,7 @@
(s:member x safe-bindings bound-identifier=?)) (s:member x safe-bindings bound-identifier=?))
l) l)
types-from-user types-from-user
(map (λ (x) (make-Union (if (type<? x -Undefined) (map (λ (x) (Un x -Undefined)) types-from-user)))))
(list x -Undefined)
(list -Undefined x))))
types-from-user)))))
names)) names))
;; types the user gave. check against that to error if we could get undefined ;; types the user gave. check against that to error if we could get undefined
(map (λ (l) (ret (map get-type l))) names) (map (λ (l) (ret (map get-type l))) names)