diff --git a/typed-racket-lib/typed-racket/base-env/base-env.rkt b/typed-racket-lib/typed-racket/base-env/base-env.rkt index 7ae2aafd2..ef78fc3ee 100644 --- a/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -1055,7 +1055,7 @@ [(-Mutable-HashTableTop) -Mutable-HashTableTop] [((-Weak-HT a b)) (-Weak-HT a b)] [(-Weak-HashTableTop) -Weak-HashTableTop] - [((-HT a b)) (-HT a b)]))] + [((-HT a b)) (Un (-Mutable-HT a b) (-Weak-HT a b))]))] [eq-hash-code (-> Univ -Fixnum)] [eqv-hash-code (-> Univ -Fixnum)] [equal-hash-code (-> Univ -Fixnum)] diff --git a/typed-racket-lib/typed-racket/base-env/prims.rkt b/typed-racket-lib/typed-racket/base-env/prims.rkt index 2a26ad6c4..89598a244 100644 --- a/typed-racket-lib/typed-racket/base-env/prims.rkt +++ b/typed-racket-lib/typed-racket/base-env/prims.rkt @@ -579,48 +579,32 @@ the typed racket language. (for/set: for/fold: for/set #f set-add (set) #%expression) (for*/set: for*/fold: for*/set #t set-add (set) #%expression))) -(define-for-syntax (define-for/hash:-variant hash-maker) - (lambda (stx) - (syntax-parse stx - [(_ a1:optional-standalone-annotation* - clause:for-clauses - a2:optional-standalone-annotation* - body ...) ; body is not always an expression, can be a break-clause - (define a.ty (or (attribute a2.ty) (attribute a1.ty))) - (if a.ty - (quasisyntax/loc stx - (for/fold: : #,a.ty - ((return-hash : #,a.ty (ann (#,hash-maker null) #,a.ty))) - (clause.expand ... ...) - (let-values (((key val) (let () body ...))) - (hash-set return-hash key val)))) - (syntax/loc stx - (for/hash (clause.expand ... ...) - body ...)))]))) +(begin-for-syntax + (define-values (define-for/hash:-variant define-for*/hash:-variant) + (let () + (define ((make for*? for/folder:) hash-maker) + (lambda (stx) + (syntax-parse stx + [(_ a1:optional-standalone-annotation* + clause:for-clauses + a2:optional-standalone-annotation* + body ...) ; body is not always an expression, can be a break-clause + (define a.ty (or (attribute a2.ty) (attribute a1.ty) #'(Immutable-HashTable Any Any))) + (quasisyntax/loc stx + (#,for/folder: : #,a.ty + ((return-hash : #,a.ty (ann (#,hash-maker null) #,a.ty))) + #,(if for*? + #'(clause.expand* ... ...) + #'(clause.expand ... ...)) + (let-values (((key val) (let () body ...))) + (hash-set return-hash key val))))]))) + (values (make #f #'for/fold:) (make #t #'for*/fold:))))) (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 for/hashalw: (define-for/hash:-variant #'make-immutable-hashalw)) -(define-for-syntax (define-for*/hash:-variant hash-maker) - (lambda (stx) - (syntax-parse stx - #:literals (:) - [(_ a1:optional-standalone-annotation* - clause:for-clauses - a2:optional-standalone-annotation* - body ...) ; body is not always an expression, can be a break-clause - (define a.ty (or (attribute a2.ty) (attribute a1.ty))) - (quasisyntax/loc stx - (for*/fold: #,@(if a.ty #`(: #,a.ty) #'()) - #,(if a.ty - #`((return-hash : #,a.ty (ann (#,hash-maker null) #,a.ty))) - #`((return-hash (#,hash-maker null)))) - (clause.expand* ... ...) - (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)) diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt index 1402d0253..731f3667b 100644 --- a/typed-racket-test/unit-tests/typecheck-tests.rkt +++ b/typed-racket-test/unit-tests/typecheck-tests.rkt @@ -2646,8 +2646,8 @@ [tc-e (assoc 3 '((a . 5) (b . 7))) (t:Un (-val #f) (-pair (one-of/c 'a 'b) -PosByte))] [tc-e (set-remove (set 1 2 3) 'a) (-set -PosByte)] ;; don't return HashTableTop - [tc-e (hash-remove #hash((a . 5) (b . 7)) 3) (-Immutable-HT -Symbol -Integer)] - [tc-e (hash-remove #hash((a . 5) (b . 7)) 3) (-Immutable-HT -Symbol -Integer)] + [tc-e (hash-remove #hash((a . 5) (b . 7)) 'a) (-Immutable-HT -Symbol -Integer)] + [tc-e (hash-remove #hash((a . 5) (b . 7)) 3) (-Immutable-HT -Symbol -Integer)] ;; these should actually work [tc-e (vector-memq 3 #(a b c)) (t:Un (-val #f) -Index)] [tc-e (vector-memv 3 #(a b c)) (t:Un (-val #f) -Index)] @@ -2788,30 +2788,33 @@ -FlVector] ;; for/hash, for*/hash - PR 14306 - [tc-e (for/hash: : (HashTable Symbol String) + [tc-e (for/hash: : (Immutable-HashTable Symbol String) ([x (in-list '(x y z))] [y (in-list '("a" "b" "c"))] #:when (eq? x 'x)) (values x y)) - #:ret (tc-ret (-HT -Symbol -String))] - [tc-e (for*/hash: : (HashTable Symbol String) + #:ret (tc-ret (-Immutable-HT -Symbol -String))] + [tc-e (for*/hash: : (Immutable-HashTable Symbol String) ([k (in-list '(x y z))] [v (in-list '("a" "b"))] #:when (eq? k 'x)) (values k v)) - #:ret (tc-ret (-HT -Symbol -String))] + #:ret (tc-ret (-Immutable-HT -Symbol -String))] ;; PR 13937 [tc-e (let () (: foo ((HashTable String Symbol) -> (HashTable Symbol String))) (define (foo map) - (for/hash : (HashTable Symbol String) + (for/hash : (Immutable-HashTable Symbol String) ([(str sym) map]) (values sym str))) (foo #hash(("foo" . foo)))) (-HT -Symbol -String)] ;; for/hash doesn't always need a return annotation inside + [tc-e/t (for/hash ([(k v) (in-hash #hash(("a" . a)))]) + (values v k)) + (-Immutable-HT Univ Univ)] [tc-e/t (let () (tr:define h : (HashTable Any Any) (for/hash ([(k v) (in-hash #hash(("a" . a)))])