From 2f3e9fc655283f4ab375c7aaebab39f45df9f45e Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sun, 8 May 2011 14:52:05 -0400
Subject: [PATCH] Add types for `in-hash' etc.

---
 .../typed-scheme/unit-tests/typecheck-tests.rkt  | 16 +++++++++++++---
 .../typed-scheme/private/base-special-env.rkt    | 13 +++++++++++++
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index aa7b5f6f19..9f73c7fc10 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -26,7 +26,8 @@
 	             (private #;base-env #;base-env-numeric
 			      base-env-indexing base-special-env))
          (for-template (private #;base-env base-types base-types-extra
-				#;base-env-numeric base-special-env
+				#;base-env-numeric 
+                                base-special-env
 				base-env-indexing))
          (for-syntax syntax/kerncase syntax/parse))
 
@@ -34,8 +35,8 @@
          (prefix-in n: (private base-env-numeric)))
 
 (provide typecheck-tests g tc-expr/expand)
-
-(b:init) (n:init) (initialize-structs) (initialize-indexing)
+ 
+(b:init) (n:init) (initialize-structs) (initialize-indexing) (initialize-special)
 
 (define N -Number)
 (define B -Boolean)
@@ -858,6 +859,15 @@
         [tc-e ((inst map Number (Pairof Number Number)) car (ann (list (cons 1 2) (cons 2 3) (cons 4 5)) (Listof (Pairof Number Number))))
               (-lst -Number)]
         [tc-err (list (values 1 2))]
+        
+        #| ;; should work but don't (test harness problems)
+        [tc-e (for/list ([(k v) (in-hash #hash((1 . 2)))]) 0) (-lst -Zero)]
+        [tc-e (in-list (list 1 2 3)) (-seq -Integer)]
+        [tc-e (in-vector (vector 1 2 3)) (-seq -Integer)]
+        |#
+        [tc-e (in-hash #hash((1 . 2))) (-seq -Integer -Integer)]
+        [tc-e (in-hash-keys #hash((1 . 2))) (-seq -Integer)]
+        [tc-e (in-hash-values #hash((1 . 2))) (-seq -Integer)]
         )
   (test-suite
    "check-type tests"
diff --git a/collects/typed-scheme/private/base-special-env.rkt b/collects/typed-scheme/private/base-special-env.rkt
index 7012d33d2a..1927d1ac49 100644
--- a/collects/typed-scheme/private/base-special-env.rkt
+++ b/collects/typed-scheme/private/base-special-env.rkt
@@ -101,6 +101,19 @@
      [(i-n _ ...)
       #'i-n])
    (->opt -Bytes [-Int (-opt -Int) -Int] (-seq -Byte))]
+  ;; in-hash and friends
+  [(syntax-parse (local-expand #'(in-hash #hash((1 . 2))) 'expression #f)
+     [(i-n _ ...)
+      #'i-n])
+   (-poly (a b) (-> (-HT a b) (-seq a b)))]
+  [(syntax-parse (local-expand #'(in-hash-keys #hash((1 . 2))) 'expression #f)
+     [(i-n _ ...)
+      #'i-n])
+   (-poly (a b) (-> (-HT a b) (-seq a)))]
+  [(syntax-parse (local-expand #'(in-hash-values #hash((1 . 2))) 'expression #f)
+     [(i-n _ ...)
+      #'i-n])
+   (-poly (a b) (-> (-HT a b) (-seq b)))]
   ;; in-port
   [(syntax-parse (local-expand #'(in-port) 'expression #f)
      [(i-n _ ...)