type-contract: use 'Un' to check overlapping hash key types

This commit is contained in:
Ben Greenman 2017-06-30 01:32:26 -04:00 committed by GitHub
parent b7a55aa9ba
commit c78a25d9f1

View File

@ -385,21 +385,15 @@
(if (or (null? hts) (null? (cdr hts)))
#false ;; too few types, don't merge
(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))))))
(for/lists (_1 _2) ([ht (in-list hts)])
(match ht
[(or (Immutable-HashTable: k v)
(Mutable-HashTable: k v)
(Weak-HashTable: k v))
(values k v)]
[_
(raise-arguments-error 'hash-types->sc "expected hash/kv?" "given" ht "element of" hts)]))])
(hash/sc (t->sc (apply Un kts)) (t->sc (apply Un vts))))))
(define (only-untyped sc)
(if (from-typed? typed-side)
(and/sc sc any-wrap/sc)