Cleanup type-env-structs.

Removes all unused functions and cleans up the remaining ones to have
more consistent and simpler APIs.

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

@@ -7,7 +7,6 @@
 ;; but split here for performance
 
 (require "../utils/utils.rkt"
-         syntax/id-table
          racket/keyword-transform racket/list
          (for-syntax syntax/parse racket/base)
          (contract-req)
@@ -20,10 +19,10 @@
 (provide lexical-env with-lexical-env with-lexical-env/extend
          update-type/lexical)
 (provide/cond-contract
- [lookup-type/lexical ((identifier?) (prop-env? #:fail (or/c #f (-> any/c #f))) . ->* . (or/c Type/c #f))])
+ [lookup-type/lexical ((identifier?) (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))))
+(define lexical-env (make-parameter empty-prop-env))
 
 ;; run code in a new env
 (define-syntax-rule (with-lexical-env e . b)
@@ -31,7 +30,8 @@
 
 ;; run code in an extended env
 (define-syntax-rule (with-lexical-env/extend is ts . b)
-  (with-lexical-env (extend/values is ts (lexical-env)) . b))
+  (with-lexical-env (extend/values (lexical-env) is ts) . b))
+
 
 ;; find the type of identifier i, looking first in the lexical env, then in the top-level env
 ;; identifier -> Type

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/type-env-structs.rkt

@@ -1,102 +1,54 @@
 #lang racket/base
 
 (require racket/dict racket/match 
-         (prefix-in r: "../utils/utils.rkt")
+         syntax/id-table
-         (r:contract-req)
+         (except-in "../utils/utils.rkt" env)
-         (r:rep filter-rep)
+         (contract-req)
-         (except-in (r:utils tc-utils) make-env))
+         (rep filter-rep type-rep)
+         (except-in (utils tc-utils) make-env))
 
-(provide extend
+;; types is a free-id-table of identifiers to types
-         env?
-         lookup
-         extend-env
-         extend/values
-         env-map
-         make-empty-env
-         env-filter
-         env-keys+vals
-         env-props
-         replace-props
-         prop-env? make-empty-prop-env)
-
-;; eq? has the type of equal?, and l is an alist (with conses!)
 ;; props is a list of known propositions
-(r:define-struct/cond-contract env ([l (and/c (not/c dict-mutable?) dict?)])
+(define-struct/cond-contract env ([types immutable-free-id-table?] [props (listof Filter/c)])
   #:transparent
   #:property prop:custom-write
   (lambda (e prt mode)
-           (fprintf prt "(env ~a)" (dict-map (env-l e) list))))
+    (fprintf prt "(env ~a ~a)" (free-id-table-map (env-types e) list) (env-props e))))
-(r:define-struct/cond-contract (prop-env env) ([props (listof Filter/c)])
-         #:transparent
-         #:property prop:custom-write
-         (lambda (e prt mode)
-           (fprintf prt "(env ~a ~a)" (dict-map (env-l e) list) (prop-env-props e))))
 
-(define (mk-env orig dict)
+(provide/cond-contract
-  (match orig
+  [env? predicate/c]
-    [(prop-env _ p) (prop-env dict p)]
+  [extend (env? identifier? Type/c . -> . env?)]
-    [_ (env dict)]))
+  [extend/values (env? (listof identifier?) (listof Type/c) . -> . env?)]
+  [lookup (env? identifier? (identifier? . -> . any) . -> . any)]
+  [env-props (env? . -> . (listof Filter/c))]
+  [replace-props (env? (listof Filter/c) . -> . env?)]
+  [empty-prop-env env?])
 
-(define (env-filter f e)
+(define empty-prop-env
-  (match e
+  (env
-    [(env l)
+    (make-immutable-free-id-table)
-     (mk-env e
+    null))
-             (for/fold ([h l])
-                       ([(k v) (in-dict l)]
-                        #:unless (f (cons k v)))
-               (dict-remove h k)))]))
 
-(r:define/cond-contract (make-empty-env dict)
-       (dict? . -> . env?)
-       (env dict))
-
-(r:define/cond-contract (make-empty-prop-env dict)
-       (dict? . -> . prop-env?)
-       (prop-env dict null))
-
-(r:define/cond-contract (env-props e)
-       (prop-env? . -> . (listof Filter/c))
-       (prop-env-props e))
-
-(define (env-keys+vals e)
-  (match e
-    [(env l) (for/list ([(k v) (in-dict l)]) (cons k v))]))
-
-(r:define/cond-contract (env-map f e)
-  ((any/c any/c . -> . any/c) env? . -> . env?)
-  (mk-env e (dict-map f (env-l e))))
-
-;; extend that works on single arguments
-(define (extend e k v)
-  (match e
-    [(env l) (mk-env e (dict-set l k v))]
-    [_ (int-err "extend: expected environment, got ~a" e)]))
-
-(define (extend-env ks vs e)
-  (match e
-    [(env l) (mk-env e (for/fold ([h l])
-                         ([k (in-list ks)] [v (in-list vs)]) (dict-set h k v)))]
-    [_ (int-err "extend-env: expected environment, got ~a" e)]))
 
 (define (replace-props e props)
   (match e
-    [(prop-env l p)
+    [(env tys _)
-     (prop-env l props)]))
+     (env tys props)]))
 
 (define (lookup e key fail)
   (match e
-    [(env l) (dict-ref l key (λ () (fail key)))]
+    [(env tys _) (free-id-table-ref tys key (λ () (fail key)))]))
-    [_ (int-err "lookup: expected environment, got ~a" e)]))
 
 
-;; takes two lists of sets to be added, which are either added one at a time, if the
+;; extend that works on single arguments
-;; elements are not lists, or all at once, if the elements are lists
+(define (extend e k v)
-(define (extend/values kss vss env)
+  (extend/values e (list k) (list v)))
-  (foldr (lambda (ks vs env)
-           (cond [(and (list? ks) (list? vs))
-                  (extend-env ks vs env)]
-                 [(or (list? ks) (list? vs))
-                  (int-err "not both lists in extend/values: ~a ~a" ks vs)]
-                 [else (extend env ks vs)]))
-         env kss vss))
 
+;; takes two lists of identifiers and types to be added
+(define (extend/values e ks vs)
+  (match e
+    [(env tys p)
+     (env
+       (for/fold ([tys tys]) ([k (in-list ks)] [v (in-list vs)])
+         (free-id-table-set tys k v))
+       p)]))

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

@@ -67,8 +67,8 @@
            (values e-ts null)]))))
   ;; extend the lexical environment for checking the body
   (with-lexical-env/extend
-    namess
+    (append* namess)
-    expected-types
+    (append* expected-types)
     (replace-names
       (get-names+objects namess expected-results)
       (with-lexical-env/extend-props