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

Fix tc-let for mutable variables.

Browse Source 
Closes PR 14415.
This commit is contained in:
Eric Dobson 2014-03-24 22:20:21 -07:00
parent 316fc0dbf5
commit b09ced6a0c
2 changed files with 13 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
View File

@ -4,7 +4,7 @@
(except-in (types utils abbrev union filter-ops) -> ->* one-of/c) (except-in (types utils abbrev union filter-ops) -> ->* one-of/c)
(only-in (types abbrev) (-> t:->)) (only-in (types abbrev) (-> t:->))
(private type-annotation parse-type syntax-properties) (private type-annotation parse-type syntax-properties)
(env lexical-env type-alias-env type-alias-helper (env lexical-env type-alias-env type-alias-helper mvar-env
global-env type-env-structs scoped-tvar-env) global-env type-env-structs scoped-tvar-env)
(rep type-rep filter-rep) (rep type-rep filter-rep)
syntax/free-vars syntax/free-vars
@ -45,8 +45,10 @@
(for/list ([n (in-list names)] (for/list ([n (in-list names)]
[f+ (in-list fs+)] [f+ (in-list fs+)]
[f- (in-list fs-)]) [f- (in-list fs-)])
(list (-imp (-not-filter (-val #f) n) f+) (if (is-var-mutated? n)
(-imp (-filter (-val #f) n) f-)))))] (list)
(list (-imp (-not-filter (-val #f) n) f+)
(-imp (-filter (-val #f) n) f-))))))]
[((tc-results: ts (NoFilter:) _) (tc-results: e-ts (NoFilter:) _)) [((tc-results: ts (NoFilter:) _) (tc-results: e-ts (NoFilter:) _))
(values ts e-ts null)])))) (values ts e-ts null)]))))
(with-cond-contract append-region ([p1 (listof Filter?)] (with-cond-contract append-region ([p1 (listof Filter?)]

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

@ -2642,6 +2642,14 @@
#:ret (ret (-val 3) -top-filter) #:ret (ret (-val 3) -top-filter)
#:expected (ret (-val 3) -no-filter -no-obj)] #:expected (ret (-val 3) -no-filter -no-obj)]
[tc-err
(let* ([x 42]
[n x])
(set! n 43)
(if #t
(add1 "")
0))
#:ret (ret -Bottom)]
) )
(test-suite (test-suite