Add with-lexical-env/extend-props.

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/lexical-env.rkt

@@ -18,7 +18,7 @@
          (except-in (types utils abbrev kw-types) -> ->* one-of/c))
 
 (provide lexical-env with-lexical-env with-lexical-env/extend
-         with-lexical-env/extend/props update-type/lexical)
+         update-type/lexical)
 (provide/cond-contract
  [lookup-type/lexical ((identifier?) (prop-env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type/c #f))])
 
@@ -33,10 +33,6 @@
 (define-syntax-rule (with-lexical-env/extend is ts . b)
   (with-lexical-env (extend/values is ts (lexical-env)) . b))
 
-;; run code in an extended env and with replaced props
-(define-syntax-rule (with-lexical-env/extend/props is ts ps . b)
-  (with-lexical-env (replace-props (extend/values is ts (lexical-env)) ps) . b))
-
 ;; find the type of identifier i, looking first in the lexical env, then in the top-level env
 ;; identifier -> Type
 (define (lookup-type/lexical i [env (lexical-env)] #:fail [fail #f])

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-envops.rkt

@@ -2,23 +2,24 @@
 
 (require (rename-in "../utils/utils.rkt" [infer infer-in]))
 (require racket/match
-         unstable/list
+         (only-in unstable/list list-update)
          (contract-req)
          (infer-in infer)
          (rep type-rep filter-rep object-rep rep-utils)
          (utils tc-utils)
          (types resolve subtype remove-intersect union)
-         (only-in (env type-env-structs lexical-env)
-                  env? update-type/lexical env-map env-props replace-props)
+         (env type-env-structs lexical-env)
          (rename-in (types abbrev)
                     [-> -->]
                     [->* -->*]
                     [one-of/c -one-of/c])
          (typecheck tc-metafunctions))
 
+(provide
+  with-lexical-env/extend-props)
 (provide/cond-contract
- [env+ (([e env?] [fs (listof Filter/c)] [bx (box/c boolean?)])
-        #:pre (bx) (unbox bx) . ->i . [_ env?])])
+  [env+ (([e env?] [fs (listof Filter/c)] [bx (box/c boolean?)])
+         #:pre (bx) (unbox bx) . ->i . [_ env?])])
 
 (define/cond-contract (update t ft pos? lo)
   (Type/c Type/c boolean? (listof PathElem?) . -> . Type/c)
@@ -76,3 +77,6 @@
          x Γ)]
       [_ Γ])))
 
+;; run code in an extended env and with replaced props
+(define-syntax-rule (with-lexical-env/extend-props  ps . b)
+  (with-lexical-env (env+ (lexical-env) ps (box #t)) . b))

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

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

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

@@ -8,7 +8,7 @@
               global-env type-env-structs scoped-tvar-env)
          (rep type-rep filter-rep)
          syntax/free-vars
-         (typecheck signatures tc-metafunctions tc-subst internal-forms)
+         (typecheck signatures tc-metafunctions tc-subst internal-forms tc-envops)
          (utils tarjan)
          racket/match (contract-req)
          racket/list
@@ -60,23 +60,22 @@
                                       (-imp (-filter (-val #f) n) f-))))))]
           [(tc-results: e-ts (list (NoFilter:) ...) _)
            (values e-ts null)]))))
-  (define-values (p1 p2)
-    (combine-props (apply append props) (env-props (lexical-env)) (box #t)))
   ;; extend the lexical environment for checking the body
-  (with-lexical-env/extend/props
+  (with-lexical-env/extend
     namess
     expected-types
-    (append p1 p2)
-    ;; type-check the rhs exprs
-    (for-each expr->type
-              exprs
-              expected-results)
-    ;; typecheck the body
-    (replace-names
-     (get-names+objects namess expected-results)
-     (if expected
-         (tc-body/check body (erase-filter expected))
-         (tc-body body)))))
+    (with-lexical-env/extend-props
+      (apply append props)
+      ;; type-check the rhs exprs
+      (for-each expr->type
+                exprs
+                expected-results)
+      ;; typecheck the body
+      (replace-names
+       (get-names+objects namess expected-results)
+       (if expected
+           (tc-body/check body (erase-filter expected))
+           (tc-body body))))))
 
 (define (tc-expr/maybe-expected/t e names)
   (syntax-parse names