From 4e9604460a63b46659bc1cc063949a8055fe1cef Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sun, 22 Jan 2012 14:10:52 -0500 Subject: [PATCH] improve types for literal hash tables original commit: a5c7175e465111bcce3ae51cab14b966f6bc6020 --- collects/typed-racket/typecheck/tc-expr-unit.rkt | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/collects/typed-racket/typecheck/tc-expr-unit.rkt b/collects/typed-racket/typecheck/tc-expr-unit.rkt index 40d5bff2..c0606843 100644 --- a/collects/typed-racket/typecheck/tc-expr-unit.rkt +++ b/collects/typed-racket/typecheck/tc-expr-unit.rkt @@ -103,10 +103,16 @@ [_ (make-HeterogenousVector (for/list ([l (syntax-e #'i)]) (generalize (tc-literal l #f))))])] [(~var i (3d hash?)) - (let* ([h (syntax-e #'i)] - [ks (hash-map h (lambda (x y) (tc-literal x)))] - [vs (hash-map h (lambda (x y) (tc-literal y)))]) - (make-Hashtable (generalize (apply Un ks)) (generalize (apply Un vs))))] + (match expected + [(Hashtable: k v) + (let* ([h (syntax-e #'i)] + [ks (hash-map h (lambda (x y) (tc-literal x k)))] + [vs (hash-map h (lambda (x y) (tc-literal y v)))]) + (make-Hashtable (generalize (check-below (apply Un ks)) k) (generalize (check-below (apply Un vs)))))] + [_ (let* ([h (syntax-e #'i)] + [ks (hash-map h (lambda (x y) (tc-literal x)))] + [vs (hash-map h (lambda (x y) (tc-literal y)))]) + (make-Hashtable (generalize (apply Un ks)) (generalize (apply Un vs))))])] [(a . b) (-pair (tc-literal #'a) (tc-literal #'b))] [_ Univ]))