From c9972ae31c50211ebd8834582ffe5f6dcb009439 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 20 Nov 2012 17:42:16 -0500
Subject: [PATCH] Add new versions of for/hash: and co that the typechecker can
 handle.

Based on Eric Dobson's implementation.

Closes PR13248. Closes PR13249.

original commit: 95d51fc8928145fb6f82c8c877e1efcb92432128
---
 .../tests/typed-racket/succeed/for-hash.rkt   | 78 +++++++++++++++++++
 collects/typed-racket/base-env/prims.rkt      | 42 ++++++++--
 2 files changed, 113 insertions(+), 7 deletions(-)
 create mode 100644 collects/tests/typed-racket/succeed/for-hash.rkt

diff --git a/collects/tests/typed-racket/succeed/for-hash.rkt b/collects/tests/typed-racket/succeed/for-hash.rkt
new file mode 100644
index 00000000..b2c96973
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/for-hash.rkt
@@ -0,0 +1,78 @@
+#lang typed/racket/base
+
+(require typed/rackunit)
+
+(check-pred
+ hash?
+ (for/hash: : (HashTable Integer Symbol)
+            ((a (list 1 2 3)))
+  (values a 'a)))
+
+(check-pred
+ hash?
+ (for/hash: : (HashTable Integer Symbol)
+            ((a (list 1 2 3))
+             (b '(a b c)))
+  (values a b)))
+
+(check-pred
+ hash?
+ (for*/hasheq: : (HashTable Integer Symbol)
+             ((a (list 1 2 3))
+              (b '(a b c)))
+  (values a b)))
+
+
+(check-pred
+ hash-eq?
+ (for/hasheq: : (HashTable Integer Symbol)
+            ((a (list 1 2 3)))
+  (values a 'a)))
+
+(check-pred
+ hash-eq?
+ (for/hasheq: : (HashTable Integer Symbol)
+            ((a (list 1 2 3))
+             (b '(a b c)))
+  (values a b)))
+
+(check-pred
+ hash-eq?
+ (for*/hasheq: : (HashTable Integer Symbol)
+             ((a (list 1 2 3))
+              (b '(a b c)))
+  (values a b)))
+
+
+(check-pred
+ hash-eqv?
+ (for/hasheqv: : (HashTable Integer Symbol)
+            ((a (list 1 2 3)))
+  (values a 'a)))
+
+(check-pred
+ hash-eqv?
+ (for/hasheqv: : (HashTable Integer Symbol)
+            ((a (list 1 2 3))
+             (b '(a b c)))
+  (values a b)))
+
+(check-pred
+ hash-eqv?
+ (for*/hasheqv: : (HashTable Integer Symbol)
+             ((a (list 1 2 3))
+              (b '(a b c)))
+  (values a b)))
+
+
+
+(for*/hash: : (HashTable Number Number)
+            ((v : Number '(1 2 3))
+             (x : Number '(4 5 6)))
+     (values v x))
+
+
+
+(for/hash: : (HashTable Symbol Symbol)
+    ((v : Symbol '(a b c)))
+  (values v v))
diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt
index 67a0251d..794b8075 100644
--- a/collects/typed-racket/base-env/prims.rkt
+++ b/collects/typed-racket/base-env/prims.rkt
@@ -749,13 +749,10 @@ This file defines two sorts of primitives. All of them are provided into any mod
      (quasisyntax/loc
          stx
        (begin (define-syntax name (define-for-variant #'untyped-name)) ...))]))
-;; for/hash{,eq,eqv}:, for/vector:, for/flvector:, for/and:, for/first: and
+;; for/vector:, for/flvector:, for/and:, for/first: and
 ;; for/last:'s expansions can't currently be handled by the typechecker.
 (define-for-variants
   (for/list: for/list)
-  (for/hash: for/hash)
-  (for/hasheq: for/hasheq)
-  (for/hasheqv: for/hasheqv)
   (for/and: for/and)
   (for/or: for/or)
   (for/first: for/first)
@@ -842,9 +839,6 @@ This file defines two sorts of primitives. All of them are provided into any mod
               ...))]))
 (define-for*-variants
   (for*/list: for*/list)
-  (for*/hash: for*/hash)
-  (for*/hasheq: for*/hasheq)
-  (for*/hasheqv: for*/hasheqv)
   (for*/and: for*/and)
   (for*/or: for*/or)
   (for*/first: for*/first)
@@ -924,6 +918,40 @@ This file defines two sorts of primitives. All of them are provided into any mod
               ...))]))
 (define-for/sum:-variants (for/sum: for/fold:) (for*/sum: for*/fold:))
 
+(define-for-syntax (define-for/hash:-variant hash-maker)
+  (lambda (stx)
+    (syntax-parse stx
+      #:literals (:)
+      ((_ (~seq : return-annotation:expr)
+          (bind:optionally-annotated-binding ...) body:expr ...)
+       (quasisyntax/loc stx
+         (for/fold: : return-annotation
+           ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))
+           (bind ...)
+           (let-values (((key val) (let () body ...)))
+             (hash-set return-hash key val))))))))
+
+(define-syntax for/hash:    (define-for/hash:-variant #'make-immutable-hash))
+(define-syntax for/hasheq:  (define-for/hash:-variant #'make-immutable-hasheq))
+(define-syntax for/hasheqv: (define-for/hash:-variant #'make-immutable-hasheqv))
+
+(define-for-syntax (define-for*/hash:-variant hash-maker)
+  (lambda (stx)
+    (syntax-parse stx
+      #:literals (:)
+      ((_ (~seq : return-annotation:expr)
+          (bind:optionally-annotated-binding ...) body:expr ...)
+       (quasisyntax/loc stx
+         (for*/fold: : return-annotation
+           ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))
+           (bind ...)
+           (let-values (((key val) (let () body ...)))
+             (hash-set return-hash key val))))))))
+
+(define-syntax for*/hash:    (define-for*/hash:-variant #'make-immutable-hash))
+(define-syntax for*/hasheq:  (define-for*/hash:-variant #'make-immutable-hasheq))
+(define-syntax for*/hasheqv: (define-for*/hash:-variant #'make-immutable-hasheqv))
+
 
 (define-syntax (provide: stx)
   (syntax-parse stx