Switch to using functional hash tables for free variables.

original commit: b787c7766c3cac9a5054d6a76ec5de1a78a540c2

collects/typed-scheme/rep/free-variance.rkt

@@ -5,33 +5,30 @@
          mzlib/etc scheme/contract)
 
 (provide Covariant Contravariant Invariant Constant Dotted
-         combine-frees flip-variances without-below unless-in-table empty-hash-table
+         combine-frees flip-variances without-below unless-in-table
          fix-bound make-invariant variance?)
 
 ;; this file contains support for calculating the free variables/indexes of types
 ;; actual computation is done in rep-utils.rkt  and type-rep.rkt
 (define-values (Covariant Contravariant Invariant Constant Dotted)
   (let ()
-    (define-struct Variance () #:inspector #f)
-    (define-struct (Covariant Variance) () #:inspector #f)
-    (define-struct (Contravariant Variance) () #:inspector #f)
-    (define-struct (Invariant Variance) () #:inspector #f)
-    (define-struct (Constant Variance) () #:inspector #f)
+    (define-struct Variance () #:transparent)
+    (define-struct (Covariant Variance) () #:transparent)
+    (define-struct (Contravariant Variance) () #:transparent)
+    (define-struct (Invariant Variance) () #:transparent)
+    (define-struct (Constant Variance) () #:transparent)
     ;; not really a variance, but is disjoint with the others
-    (define-struct (Dotted Variance) () #:inspector #f)
+    (define-struct (Dotted Variance) () #:transparent)
     (values (make-Covariant) (make-Contravariant) (make-Invariant) (make-Constant) (make-Dotted))))
 
 
 (define (variance? e)
   (memq e (list Covariant Contravariant Invariant Constant Dotted)))
 
-(define empty-hash-table (make-immutable-hasheq null))
-
 ;; frees = HT[Idx,Variance] where Idx is either Symbol or Number
 ;; (listof frees) -> frees
 (define (combine-frees freess)    
-  (define ht (make-hasheq))
-  (define (combine-var v w)
+  (define ((combine-var v) w)
     (cond
       [(eq? v w) v]
       [(eq? v Dotted) w]
@@ -39,50 +36,35 @@
       [(eq? v Constant) w]
       [(eq? w Constant) v]
       [else Invariant]))
-  (for* ([old-ht (in-list freess)]
-         [(sym var) (in-hash old-ht)])
-        (let* ([sym-var (hash-ref ht sym (lambda () #f))])
-          (if sym-var
-              (hash-set! ht sym (combine-var var sym-var))
-              (hash-set! ht sym var))))
-  ht)
+  (for*/fold ([ht #hasheq()])
+    ([old-ht (in-list freess)]
+     [(sym var) (in-hash old-ht)])
+    (hash-update ht sym (combine-var var) var)))
 
 ;; given a set of free variables, change bound to ...
 ;; (if bound wasn't free, this will add it as Dotted
 ;;  appropriately so that things that expect to see
 ;;  it as "free" will -- fixes the case where the
 ;;  dotted pre-type base doesn't use the bound).
-(define (fix-bound vs bound)
-  (define vs* (hash-map* (lambda (k v) v) vs))
-  (hash-set! vs* bound Dotted)
-  vs*)
+(define (fix-bound vs bound)  
+  (hash-set vs bound Dotted))
 
 ;; frees -> frees
 (define (flip-variances vs)
-  (hash-map* 
-   (lambda (k v) 
-     (evcase v
-       [Covariant Contravariant]
-       [Contravariant Covariant]
-       [v v]))
-   vs))
+  (for/hasheq ([(k v) (in-hash vs)])
+    (values k (evcase v
+                [Covariant Contravariant]
+                [Contravariant Covariant]
+                [v v]))))
 
 (define (make-invariant vs)
-  (hash-map* 
-   (lambda (k v) Invariant)
-   vs))
-
-(define (hash-map* f ht)
-  (define new-ht (make-hasheq))
-  (for ([(k v) (in-hash ht)])
-     (hash-set! new-ht k (f k v)))
-  new-ht)
+  (for/hasheq ([(k v) (in-hash vs)])
+    (values k Invariant)))
 
 (define (without-below n frees)
-  (define new-ht (make-hasheq))
-  (for ([(k v) (in-hash frees)])
-       (when (>= k n) (hash-set! new-ht k v)))
-  new-ht)
+  (for/hasheq ([(k v) (in-hash frees)]
+               #:when (>= k n))
+    (values k v)))
 
 (define-syntax (unless-in-table stx) 
   (syntax-case stx ()

collects/typed-scheme/rep/rep-utils.rkt

@@ -47,7 +47,7 @@
   
   (define (combiner f flds)
     (syntax-parse flds
-      [() #'empty-hash-table]
+      [() #'#hasheq()]
       [(e) #`(#,f e)]
       [(e ...) #`(combine-frees (list (#,f e) ...))]))
   (define-splicing-syntax-class frees-pat
@@ -55,8 +55,8 @@
     #:attributes (f1 f2)
     (pattern (~seq f1:expr f2:expr))
     (pattern #f
-             #:with f1 #'empty-hash-table
-             #:with f2 #'empty-hash-table)
+             #:with f1 #'#hasheq()
+             #:with f2 #'#hasheq())
     (pattern e:expr
              #:with f1 #'(e Rep-free-vars)
              #:with f2 #'(e Rep-free-idxs)))

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

@@ -43,11 +43,11 @@
 
 ;; i is an nat
 (dt B ([i natural-number/c])
-    [#:frees empty-hash-table (make-immutable-hasheq (list (cons i Covariant)))]
+    [#:frees #hasheq() (make-immutable-hasheq (list (cons i Covariant)))]
     [#:fold-rhs #:base])
 
 ;; n is a Name
-(dt F ([n symbol?]) [#:frees (make-immutable-hasheq (list (cons n Covariant))) empty-hash-table] [#:fold-rhs #:base])
+(dt F ([n symbol?]) [#:frees (make-immutable-hasheq (list (cons n Covariant))) #hasheq()] [#:fold-rhs #:base])
 
 ;; id is an Identifier
 (dt Name ([id identifier?]) [#:intern (hash-id id)] [#:frees #f] [#:fold-rhs #:base])