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

Fix handling of filters that refer to out-of-scope vars

Browse Source 
svn: r14574
This commit is contained in:
Sam Tobin-Hochstadt 2009-04-21 16:13:00 +00:00
parent b1b5fe4816
commit 60325b670c
3 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
View File

@ -87,7 +87,7 @@
(+ 1 (car x))
5))
N]
(tc-e (if (let ([y 12]) y) 3 4) -Integer)
(tc-e 3 -Integer)
(tc-e "foo" -String)
(tc-e (+ 3 4) -Integer)
@ -496,10 +496,10 @@
[tc-e (raise-type-error 'foo "bar" 7 (list 5)) (Un)]
#;[tc-e
(let ((x '(1 3 5 7 9)))
(do: : Number ((x : (list-of Number) x (cdr x))
(sum : Number 0 (+ sum (car x))))
((null? x) sum)))
(let ((x '(1 3 5 7 9)))
(do: : Number ((x : (list-of Number) x (cdr x))
(sum : Number 0 (+ sum (car x))))
((null? x) sum)))
N]
@ -541,10 +541,10 @@
[tc-e `(4 ,@'(3)) (-pair N (-lst N))]
[tc-e
(let ((x '(1 3 5 7 9)))
(do: : Number ((x : (Listof Number) x (cdr x))
(sum : Number 0 (+ sum (car x))))
((null? x) sum)))
(let ((x '(1 3 5 7 9)))
(do: : Number ((x : (Listof Number) x (cdr x))
(sum : Number 0 (+ sum (car x))))
((null? x) sum)))
N]
[tc-e (if #f 1 'foo) (-val 'foo)]

6
collects/typed-scheme/env/lexical-env.ss vendored
View File

@ -25,7 +25,7 @@
;; find the type of identifier i, looking first in the lexical env, then in the top-level env
;; identifer -> Type
(define (lookup-type/lexical i)
(define (lookup-type/lexical i [fail #f])
(lookup (lexical-env) i
(lambda (i) (lookup-type
i (lambda ()
@ -33,7 +33,7 @@
=>
(lambda (a)
(-lst (substitute Univ (cdr a) (car a))))]
[else (lookup-fail i)]))))))
[else ((or fail lookup-fail) i)]))))))
;; refine the type of i in the lexical env
;; (identifier type -> type) identifier -> environment
@ -43,7 +43,7 @@
(define (update f k env)
(parameterize
([current-orig-stx k])
(let* ([v (lookup-type/lexical k)]
(let* ([v (lookup-type/lexical k (lambda _ Univ))]
[new-v (f k v)]
[new-env (extend env k new-v)])
new-env)))

6
collects/typed-scheme/typecheck/tc-if-unit.ss
View File

@ -45,7 +45,8 @@
(syntax-rules ()
[(check-rest f v)
(with-update-type/lexical f v (loop (cdr effs)))]
[(check-rest f t v) (check-rest (type-op f t) v)]))
[(check-rest f t v)
(check-rest (type-op f t) v)]))
(if (null? effs)
;; base case
(let* ([reachable? (not (unbox flag))])
@ -83,7 +84,8 @@
;; just replace the type of v with (-val #f)
[(Var-False-Effect: v) (check-rest (lambda (_ old) (-val #f)) v)]
;; v cannot have type (-val #f)
[(Var-True-Effect: v) (check-rest *remove (-val #f) v)])))))
[(Var-True-Effect: v)
(check-rest *remove (-val #f) v)])))))
;; the main function
(define (tc/if-twoarm tst thn els)