From c78a25d9f1d5ea76477932a8f577c5f66ff3fe56 Mon Sep 17 00:00:00 2001 From: Ben Greenman Date: Fri, 30 Jun 2017 01:32:26 -0400 Subject: [PATCH] type-contract: use 'Un' to check overlapping hash key types --- .../typed-racket/private/type-contract.rkt | 24 +++++++------------ 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/typed-racket-lib/typed-racket/private/type-contract.rkt b/typed-racket-lib/typed-racket/private/type-contract.rkt index 55bf7aad..f2f02979 100644 --- a/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -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)