Refactor environments.

- mapping stored as dict
 - use id tables for identifiers
 - use env-filter instead of filter
 - eliminate spurious use of conses

collects/typed-scheme/env/lexical-env.rkt

@@ -3,6 +3,7 @@
 (require "../utils/utils.rkt"
 	 "type-environments.rkt" 
 	 "type-env.rkt"
+	 unstable/mutated-vars syntax/id-table
          (only-in scheme/contract ->* -> or/c any/c listof cons/c)
          (utils tc-utils)
          (only-in (rep type-rep) Type/c)
@@ -16,7 +17,7 @@
  [update-type/lexical (((identifier? Type/c . -> . Type/c) identifier?) (env?) . ->* . env?)])
 
 ;; the current lexical environment
-(define lexical-env (make-parameter (make-empty-env free-identifier=?)))
+(define lexical-env (make-parameter (make-empty-env (make-immutable-free-id-table))))
 
 ;; run code in a new env
 (define-syntax-rule (with-lexical-env e . b)

collects/typed-scheme/env/type-env.rkt

@@ -1,5 +1,8 @@
 #lang scheme/base
 
+;; Top-level type environment
+;; maps identifiers to their types, updated by mutation
+
 (require "../utils/utils.rkt" 
 	 syntax/id-table
          (utils tc-utils)

collects/typed-scheme/env/type-environments.rkt

@@ -1,6 +1,6 @@
 #lang scheme/base  
 
-(require scheme/contract
+(require scheme/contract unstable/sequence racket/dict syntax/id-table
          (prefix-in r: "../utils/utils.rkt")
          scheme/match (r:rep filter-rep rep-utils type-rep) unstable/struct
          (except-in (r:utils tc-utils) make-env)
@@ -15,8 +15,8 @@
          dotted-env
          initial-tvar-env
          env-map
+         make-empty-env
          env-filter
-         env-vals
          env-keys+vals
          env-props
          replace-props
@@ -24,58 +24,60 @@
 
 ;; eq? has the type of equal?, and l is an alist (with conses!)
 ;; props is a list of known propositions
-(r:d-s/c env ([eq? (any/c any/c . -> . boolean?)] [l (listof pair?)] [props (listof Filter/c)]) #:transparent)
-
-(define (env-vals e)
-  (map cdr (env-l e)))
-
-(define (env-keys+vals e)
-  (env-l e))
+(r:d-s/c env ([l (and/c (not/c dict-mutable?) dict?)] [props (listof Filter/c)]) #:transparent)
 
 (define (env-filter f e)
   (match e
-    [(struct env (eq? l props))
-    (make-env eq? (filter f l) props)]))
+    [(struct env (l props))
+     (make-env (for/fold ([h l])
+                 ([(k v) (in-dict l)]
+                  #:when (not (f (cons k v))))
+                 (dict-remove h k))
+               props)]))
 
-(define (make-empty-env p?) (make-env p? null null))
+(r:d/c (make-empty-env dict)
+       (dict? . -> . env?)
+       (make-env dict null))
+
+(define (env-keys+vals e)
+  (match e
+    [(env l _) (for/list ([(k v) (in-dict l)]) (cons k v))]))
 
 ;; the initial type variable environment - empty
 ;; this is used in the parsing of types
-(define initial-tvar-env (make-empty-env eq?))
+(define initial-tvar-env (make-empty-env #hasheq()))
 
 ;; a parameter for the current type variables
 (define current-tvars (make-parameter initial-tvar-env))  
 
 ;; the environment for types of ... variables
-(define dotted-env (make-parameter (make-empty-env free-identifier=?)))
+(define dotted-env (make-parameter (make-empty-env (make-immutable-free-id-table))))
 
 (r:d/c (env-map f e)
-  ((pair? . -> . pair?) env? . -> . env?)
-  (make-env (env-eq? e) (map f (env-l e)) (env-props e)))
+  ((any/c any/c . -> . any/c) env? . -> . env?)
+  (make-env (dict-map f (env-l e)) (env-props e)))
 
 ;; extend that works on single arguments
 (define (extend e k v) 
   (match e
-    [(struct env (f l p)) (make-env f (cons (cons k v) l) p)]
+    [(env l p) (make-env (dict-set l k v) p)]
     [_ (int-err "extend: expected environment, got ~a" e)]))
 
 (define (extend-env ks vs e)
   (match e
-    [(struct env (f l p)) (make-env f (append (map cons ks vs) l) p)]
+    [(env l p) (make-env (for/fold ([h l])
+                           ([k (in-list ks)] [v (in-list vs)]) (dict-set h k v))
+                         p)]
     [_ (int-err "extend-env: expected environment, got ~a" e)]))
 
 (define (replace-props e props)
   (match e
-    [(struct env (f l p))
-     (make-env f l props)]))
+    [(env l p)
+     (make-env l props)]))
 
 (define (lookup e key fail)
   (match e
-    [(struct env (f? l p))
-     (let loop ([l l])
-       (cond [(null? l) (fail key)]
-             [(f? (caar l) key) (cdar l)]
-             [else (loop (cdr l))]))]
+    [(env l p) (dict-ref l key (λ () (fail key)))]
     [_ (int-err "lookup: expected environment, got ~a" e)]))
 
 
@@ -87,12 +89,10 @@
                   (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 (list ks) (list vs) env)]))
+                 [else (extend env ks vs)]))
          env kss vss))
 
 ;; run code in an extended dotted env
 (define-syntax with-dotted-env/extend
   (syntax-rules ()
-    [(_ i t v . b) (parameterize ([dotted-env (extend/values (list i) (list (cons t v)) (dotted-env))]) . b)]))
-
-(r:p/c [make-empty-env ((-> any/c any/c any/c) . -> . env?)])
+    [(_ i t v . b) (parameterize ([dotted-env (extend (dotted-env) i (cons t v))]) . b)]))

collects/typed-scheme/private/parse-type.rkt

@@ -239,8 +239,7 @@
                               (syntax-e #'bound))))))]
       [(dom:expr ... rest:expr _:ddd (~and kw t:->) rng)
        (add-type-name-reference #'kw)
-       (let ([bounds (filter (compose Dotted? cdr)
-                             (env-keys+vals (current-tvars)))])
+       (let ([bounds (env-keys+vals (env-filter (compose Dotted? cdr) (current-tvars)))])
          (when (null? bounds)
            (tc-error/stx stx "No type variable bound with ... in scope for ... type"))
          (unless (null? (cdr bounds))
@@ -363,7 +362,7 @@
                               (syntax-e #'bound))))]
       [((~and kw values) tys ... dty _:ddd)
        (add-type-name-reference #'kw)
-       (let ([bounds (filter (compose Dotted? cdr) (env-keys+vals (current-tvars)))])
+       (let ([bounds (env-keys+vals (env-filter (compose Dotted? cdr) (current-tvars)))])
          (when (null? bounds)
            (tc-error/stx stx "No type variable bound with ... in scope for ... type"))
          (unless (null? (cdr bounds))

collects/typed-scheme/typecheck/tc-envops.rkt

@@ -70,7 +70,7 @@
   (define-values (props atoms) (combine-props fs (env-props env) flag))
   (for/fold ([Γ (replace-props env (append atoms props))]) ([f atoms])
     (match f
-      [(Bot:) (set-box! flag #f) (env-map (lambda (x) (cons (car x) (Un))) Γ)]
+      [(Bot:) (set-box! flag #f) (env-map (lambda (k v) (Un)) Γ)]
       [(or (TypeFilter: _ _ x) (NotTypeFilter: _ _ x))
        (update-type/lexical (lambda (x t) (let ([new-t (update t f)])
                                             (when (type-equal? new-t (Un))