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

Fix contract for update-type/lexical.

Browse Source 
original commit: 62ad7846b9ff656e3f9fd5064e3ff654d9f53c73
This commit is contained in:
Vincent St-Amour 2011-06-24 15:09:21 -04:00
parent 98155d2366
commit 6fcdd9ce43
1 changed files with 20 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/typed-scheme/env/lexical-env.rkt vendored
View File

@ -10,6 +10,7 @@
"type-env-structs.rkt"
"global-env.rkt"
unstable/mutated-vars syntax/id-table
(for-syntax syntax/parse syntax/parse/experimental/contract racket/base)
(only-in scheme/contract ->* -> or/c any/c listof cons/c)
(utils tc-utils)
(only-in (rep type-rep) Type/c)
@ -17,10 +18,9 @@
(except-in (types utils convenience) -> ->*))
(provide lexical-env with-lexical-env with-lexical-env/extend
with-lexical-env/extend/props)
with-lexical-env/extend/props update-type/lexical)
(provide/cond-contract
[lookup-type/lexical ((identifier?) (prop-env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type/c #f))]
[update-type/lexical (((identifier? Type/c . -> . Type/c) identifier?) (prop-env?) . ->* . env?)])
[lookup-type/lexical ((identifier?) (prop-env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type/c #f))])
;; the current lexical environment
(define lexical-env (make-parameter (make-empty-prop-env (make-immutable-free-id-table))))
@ -45,16 +45,20 @@
;; refine the type of i in the lexical env
;; (identifier type -> type) identifier -> environment
;; a macro for inlining :(
(define-syntax-rule (update-type/lexical f i env)
;; check if i is ever the target of a set!
(if (is-var-mutated? i)
;; if it is, we do nothing
env
;; otherwise, refine the type
(parameterize
([current-orig-stx i])
(let* ([v (lookup-type/lexical i env #:fail (lambda _ Univ))]
[new-v (f i v)]
[new-env (extend env i new-v)])
new-env))))
(define-syntax (update-type/lexical stx)
(syntax-parse stx
[(_ f i env)
#:declare f (expr/c #'(identifier? Type/c . -> . Type/c))
#:declare i (expr/c #'identifier?)
#:declare env (expr/c #'prop-env?)
;; check if i is ever the target of a set!
#'(if (is-var-mutated? i)
;; if it is, we do nothing
env
;; otherwise, refine the type
(parameterize
([current-orig-stx i])
(let* ([v (lookup-type/lexical i env #:fail (lambda _ Univ))]
[new-v (f i v)]
[new-env (extend env i new-v)])
new-env)))]))