diff --git a/collects/typed-scheme/rep/free-variance.rkt b/collects/typed-scheme/rep/free-variance.rkt index 41fc238c..3e9471d9 100644 --- a/collects/typed-scheme/rep/free-variance.rkt +++ b/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 () diff --git a/collects/typed-scheme/rep/rep-utils.rkt b/collects/typed-scheme/rep/rep-utils.rkt index ade55c9f..8432cf57 100644 --- a/collects/typed-scheme/rep/rep-utils.rkt +++ b/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))) diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt index 985685c9..3fffd5ab 100644 --- a/collects/typed-scheme/rep/type-rep.rkt +++ b/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])