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

Move the unconditional prop addition to with-lexical-env/extend-props.

Browse Source
This commit is contained in:
Eric Dobson 2014-05-24 10:12:25 -07:00
parent 13bcc61fd4
commit 9b42fca050
4 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt
View File

@ -8,7 +8,7 @@
(infer-in infer) (infer-in infer)
(rep type-rep filter-rep object-rep rep-utils) (rep type-rep filter-rep object-rep rep-utils)
(utils tc-utils) (utils tc-utils)
(types resolve subtype remove-intersect union) (types resolve subtype remove-intersect union filter-ops)
(env type-env-structs lexical-env) (env type-env-structs lexical-env)
(rename-in (types abbrev) (rename-in (types abbrev)
[-> -->] [-> -->]
@ -78,11 +78,14 @@
x Γ)] x Γ)]
[_ Γ]))) [_ Γ])))
;; run code in an extended env and with replaced props ;; run code in an extended env and with replaced props. Requires the body to return a tc-results.
;; TODO make this only add the new prop instead of the entire environment once tc-id is fixed to
;; include the interesting props in its filter.
(define-syntax (with-lexical-env/extend-props stx) (define-syntax (with-lexical-env/extend-props stx)
(define-splicing-syntax-class flag (define-splicing-syntax-class flag
[pattern (~seq #:flag v:expr)] [pattern (~seq #:flag v:expr)]
[pattern (~seq) #:with v #'(box #t)]) [pattern (~seq) #:with v #'(box #t)])
(syntax-parse stx (syntax-parse stx
[(_ ps flag:flag . b) [(_ ps flag:flag . b)
#'(with-lexical-env (env+ (lexical-env) ps flag.v) . b)])) #'(with-lexical-env (env+ (lexical-env) ps flag.v)
(add-unconditional-prop (let () . b) (apply -and (env-props (lexical-env)))))]))

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

@ -353,7 +353,7 @@
[(tc-results: _ (list (FilterSet: f+ f-) ...) _ _ _) [(tc-results: _ (list (FilterSet: f+ f-) ...) _ _ _)
(map -or f+ f-)])) (map -or f+ f-)]))
(with-lexical-env/extend-props props (with-lexical-env/extend-props props
(add-unconditional-prop (k) (apply -and props)))) (k)))
;; type-check a body of exprs, producing the type of the last one. ;; type-check a body of exprs, producing the type of the last one.
;; if the body is empty, the type is Void. ;; if the body is empty, the type is Void.

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-if.rkt
View File

@ -35,10 +35,10 @@
(define flag- (box #t)) (define flag- (box #t))
(define results-t (define results-t
(with-lexical-env/extend-props (list fs+) #:flag flag+ (with-lexical-env/extend-props (list fs+) #:flag flag+
(add-unconditional-prop (tc thn (unbox flag+)) (apply -and (env-props (lexical-env)))))) (tc thn (unbox flag+))))
(define results-u (define results-u
(with-lexical-env/extend-props (list fs-) #:flag flag- (with-lexical-env/extend-props (list fs-) #:flag flag-
(add-unconditional-prop (tc els (unbox flag-)) (apply -and (env-props (lexical-env)))))) (tc els (unbox flag-))))
;; record reachability ;; record reachability
;; since we may typecheck a given piece of code multiple times in different ;; since we may typecheck a given piece of code multiple times in different

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

@ -73,11 +73,9 @@
exprs exprs
expected-results) expected-results)
;; typecheck the body ;; typecheck the body
(add-unconditional-prop
(if expected (if expected
(tc-body/check body (erase-filter expected)) (tc-body/check body (erase-filter expected))
(tc-body body)) (tc-body body))))))
(apply -and (apply append props)))))))
(define (tc-expr/maybe-expected/t e names) (define (tc-expr/maybe-expected/t e names)
(syntax-parse names (syntax-parse names