suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

patch: check duplicates before making an or/c for hash keys

Browse Source 
The contract for `(U (I-Hash k1 v1) (M-Hash k2 v2) (W-Hash k3 v3))`
 is now `(hash/c (or/c k1 k2 k3) (or/c v1 v2 v3))`
 ONLY WHEN the key and value types are distinct.
The contract should no longer include duplicate key or value types.
This commit is contained in:
Ben Greenman 2017-06-27 01:38:18 -04:00 committed by GitHub
parent fae58e140d
commit 6c2a7eb512
2 changed files with 25 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
typed-racket-lib/typed-racket/private/type-contract.rkt
View File

@ -384,17 +384,22 @@
(define (hash-types->sc hts)
(if (or (null? hts) (null? (cdr hts)))
#false ;; too few types, don't merge
(let-values ([(key-scs val-scs)
(for/lists (ks vs)
([ht (in-list hts)])
(match ht
[(or (Immutable-HashTable: k v)
(Mutable-HashTable: k v)
(Weak-HashTable: k v))
(values (t->sc k) (t->sc v))]
[_
(raise-arguments-error 'hash-types->sc "expected hash/kv?" "given" ht "element of" hts)]))])
(hash/sc (apply or/sc key-scs) (apply or/sc val-scs)))))
(let-values ([(kts vts)
(let loop ([kts '()]
[vts '()]
[hts hts])
(if (null? hts)
(values kts vts)
(match (car hts)
[(or (Immutable-HashTable: k v)
(Mutable-HashTable: k v)
(Weak-HashTable: k v))
(loop (if (member k kts) kts (cons k kts))
(if (member v vts) vts (cons v vts))
(cdr hts))]
[ht
(raise-arguments-error 'hash-types->sc "expected hash/kv?" "given" ht "element of" hts)])))])
(hash/sc (apply or/sc (map t->sc kts)) (apply or/sc (map t->sc vts))))))
(define (only-untyped sc)
(if (from-typed? typed-side)
(and/sc sc any-wrap/sc)

9
typed-racket-test/succeed/pr390-variation-6.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang racket/base
(module t typed/racket
(provide h)
(define h : (U (Immutable-HashTable Symbol Any) (Mutable-HashTable Symbol Any))
(hash 'a 1)))
(require 't)
(hash-ref h 'a)