diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt index 3332e47c3b..afb1f099ae 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt @@ -8,7 +8,7 @@ (infer-in infer) (rep type-rep filter-rep object-rep rep-utils) (utils tc-utils) - (types resolve subtype remove-intersect union) + (types resolve subtype remove-intersect union filter-ops) (env type-env-structs lexical-env) (rename-in (types abbrev) [-> -->] @@ -78,11 +78,14 @@ 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-splicing-syntax-class flag [pattern (~seq #:flag v:expr)] [pattern (~seq) #:with v #'(box #t)]) (syntax-parse stx [(_ 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)))))])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt index 8c75c5ab67..5637ee0372 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt @@ -353,7 +353,7 @@ [(tc-results: _ (list (FilterSet: f+ f-) ...) _ _ _) (map -or f+ f-)])) (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. ;; if the body is empty, the type is Void. diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-if.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-if.rkt index f4ef73bebf..01a88d4d47 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-if.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-if.rkt @@ -35,10 +35,10 @@ (define flag- (box #t)) (define results-t (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 (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 ;; since we may typecheck a given piece of code multiple times in different diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt index 456213b9fc..0119e336f5 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt @@ -73,11 +73,9 @@ exprs expected-results) ;; typecheck the body - (add-unconditional-prop - (if expected - (tc-body/check body (erase-filter expected)) - (tc-body body)) - (apply -and (apply append props))))))) + (if expected + (tc-body/check body (erase-filter expected)) + (tc-body body)))))) (define (tc-expr/maybe-expected/t e names) (syntax-parse names