From 79c93700c72621d07a139d5681a410d514a0724f Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 5 Mar 2010 21:52:54 +0000
Subject: [PATCH] Fix PR 10813

svn: r18477

original commit: 87f978e59ecb88b19391e2210b6b3cb550e4df25
---
 collects/tests/typed-scheme/fail/bad-hash-ref.ss | 16 ++++++++++++++++
 collects/tests/typed-scheme/succeed/hash-ref.ss  |  2 +-
 collects/typed-scheme/private/base-env.ss        | 12 ++++--------
 3 files changed, 21 insertions(+), 9 deletions(-)
 create mode 100644 collects/tests/typed-scheme/fail/bad-hash-ref.ss

diff --git a/collects/tests/typed-scheme/fail/bad-hash-ref.ss b/collects/tests/typed-scheme/fail/bad-hash-ref.ss
new file mode 100644
index 00000000..05d7a1b6
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/bad-hash-ref.ss
@@ -0,0 +1,16 @@
+#lang typed/scheme
+
+(: table (HashTable Integer (-> Integer)))
+(define table
+  (make-immutable-hash null))
+
+(: lookup (Integer -> Integer))
+(define (lookup n)
+
+  (: thunk (-> Integer))
+  (define thunk
+    (hash-ref table n (lambda () 0)))
+ 
+  (thunk))
+
+(lookup 1)
\ No newline at end of file
diff --git a/collects/tests/typed-scheme/succeed/hash-ref.ss b/collects/tests/typed-scheme/succeed/hash-ref.ss
index 873d7be9..acd8587e 100644
--- a/collects/tests/typed-scheme/succeed/hash-ref.ss
+++ b/collects/tests/typed-scheme/succeed/hash-ref.ss
@@ -3,7 +3,7 @@
 (module m typed-scheme
   (define x ({inst make-hash Symbol Number}))
   (hash-ref! x 'key (lambda () 1))
-  (hash-ref x 'key 7)
+  (hash-ref x 'key (lambda () 7))
   (provide x))
 
 (module n scheme
diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index 5649c444..0e092355 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -409,20 +409,16 @@
 [hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
 [hash-ref (-poly (a b c)
                  (cl-> [((-HT a b) a) b]
-                       [((-HT a b) a (-> c)) (Un b c)]
-                       [((-HT a b) a c) (Un b c)]))]
+                       [((-HT a b) a (-> c)) (Un b c)]))]
 [hash-ref! (-poly (a b)
-                  (cl-> [((-HT a b) a (-> b)) b]
-                        [((-HT a b) a b) b]))]
+                  (cl-> [((-HT a b) a (-> b)) b]))]
 [hash-has-key? (-poly (a b) (-> (-HT a b) a B))]
 [hash-update! (-poly (a b)
                      (cl-> [((-HT a b) a (-> b b)) -Void]
-                           [((-HT a b) a (-> b b) (-> b)) -Void]
-                           [((-HT a b) a (-> b b) b) -Void]))]
+                           [((-HT a b) a (-> b b) (-> b)) -Void]))]
 [hash-update (-poly (a b)
                     (cl-> [((-HT a b) a (-> b b)) (-HT a b)]
-                          [((-HT a b) a (-> b b) (-> b)) (-HT a b)]
-                          [((-HT a b) a (-> b b) b) (-HT a b)]))]
+                          [((-HT a b) a (-> b b) (-> b)) (-HT a b)]))]
 [hash-remove (-poly (a b) ((-HT a b) a . -> . (-HT a b)))]
 [hash-remove! (-poly (a b) ((-HT a b) a . -> . -Void))]
 [hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]