Skip to content

Commit f98a5d9

Browse files
NoahStoryMNoahStoryM
committed
Only refine hash operators whose type can be considered as subtype of the older.
1 parent 979dff9 commit f98a5d9

File tree

2 files changed

+35
-47
lines changed

2 files changed

+35
-47
lines changed

‎typed-racket-lib/typed-racket/base-env/base-env.rkt‎

Lines changed: 15 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -964,10 +964,10 @@
964964
[make-immutable-hasheq (-poly (a b) (->opt [(-lst (-pair a b))] (-Immutable-HT a b)))]
965965
[make-immutable-hasheqv (-poly (a b) (->opt [(-lst (-pair a b))] (-Immutable-HT a b)))]
966966

967-
[hash-set (-poly (a b) ((-Immutable-HT a b) a b . -> . (-Immutable-HT a b)))]
968-
[hash-set* (-poly (a b) (->* (list (-Immutable-HT a b)) (make-Rest (list a b)) (-Immutable-HT a b)))]
969-
[hash-set! (-poly (a b) ((Un (-Mutable-HT a b) (-Weak-HT a b)) a b . -> . -Void))]
970-
[hash-set*! (-poly (a b) (->* (list (Un (-Mutable-HT a b) (-Weak-HT a b))) (make-Rest (list a b)) -Void))]
967+
[hash-set (-poly (a b) ((-HT a b) a b . -> . (-Immutable-HT a b)))]
968+
[hash-set* (-poly (a b) (->* (list (-HT a b)) (make-Rest (list a b)) (-Immutable-HT a b)))]
969+
[hash-set! (-poly (a b) ((-HT a b) a b . -> . -Void))]
970+
[hash-set*! (-poly (a b) (->* (list (-HT a b)) (make-Rest (list a b)) -Void))]
971971
[hash-ref (-poly (a b c)
972972
(cl-> [((-HT a b) a) b]
973973
[((-HT a b) a (-val #f)) (-opt b)]
@@ -978,16 +978,18 @@
978978
[hash-ref! (-poly (a b) (-> (-HT a b) a (-> b) b))]
979979
[hash-has-key? (-HashTableTop Univ . -> . B)]
980980
[hash-update! (-poly (a b)
981-
(cl-> [((Un (-Mutable-HT a b) (-Weak-HT a b)) a (-> b b)) -Void]
982-
[((Un (-Mutable-HT a b) (-Weak-HT a b)) a (-> b b) (-> b)) -Void]))]
981+
(cl-> [((-HT a b) a (-> b b)) -Void]
982+
[((-HT a b) a (-> b b) (-> b)) -Void]))]
983983
[hash-update (-poly (a b)
984-
(cl-> [((-Immutable-HT a b) a (-> b b)) (-Immutable-HT a b)]
985-
[((-Immutable-HT a b) a (-> b b) (-> b)) (-Immutable-HT a b)]))]
986-
[hash-remove (-poly (a b) (-> (-Immutable-HT a b) Univ (-Immutable-HT a b)))]
987-
[hash-remove! (-poly (a b) (cl-> [((Un (-Mutable-HT a b) (-Weak-HT a b)) a) -Void]
988-
[((Un -Mutable-HashTableTop -Weak-HashTableTop) a) -Void]))]
989-
[hash-clear! (-> -Mutable-HashTableTop -Void)]
990-
[hash-clear (-poly (a b) (-> (-Immutable-HT a b) (-Immutable-HT a b)))]
984+
(cl-> [((-HT a b) a (-> b b)) (-Immutable-HT a b)]
985+
[((-HT a b) a (-> b b) (-> b)) (-Immutable-HT a b)]))]
986+
[hash-remove (-poly (a b) (cl-> [((-HT a b) Univ) (-Immutable-HT a b)]
987+
[(-HashTableTop Univ) (-Immutable-HT Univ Univ)]))]
988+
[hash-remove! (-poly (a b) (cl-> [((-HT a b) a) -Void]
989+
[(-HashTableTop a) -Void]))]
990+
[hash-clear! (-> -HashTableTop -Void)]
991+
[hash-clear (-poly (a b) (cl-> [((-HT a b)) (-Immutable-HT a b)]
992+
[(-HashTableTop) (-Immutable-HT Univ Univ)]))]
991993
[hash-copy-clear (-poly (a b) (cl-> [((-Immutable-HT a b)) (-Immutable-HT a b)]
992994
[((-Mutable-HT a b)) (-Mutable-HT a b)]
993995
[(-Mutable-HashTableTop) -Mutable-HashTableTop]

‎typed-racket-lib/typed-racket/base-env/prims.rkt‎

Lines changed: 20 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -448,8 +448,7 @@ the typed racket language.
448448
for-stx
449449
#'(values accum.ty ...))
450450
for-stx)))]))
451-
(values (make #'for/fold)
452-
(make #'for/foldr))))
451+
(values (make #'for/fold) (make #'for/foldr))))
453452

454453
(define-syntax (for*: stx)
455454
(syntax-parse stx #:literals (: Void)
@@ -601,43 +600,30 @@ the typed racket language.
601600
(for/set: for/fold: for/set #f set-add (set) #%expression)
602601
(for*/set: for*/fold: for*/set #t set-add (set) #%expression)))
603602

604-
(define-for-syntax (define-for/hash:-variant hash-maker)
605-
(lambda (stx)
606-
(syntax-parse stx
607-
[(_ a1:optional-standalone-annotation*
608-
clause:for-clauses
609-
a2:optional-standalone-annotation*
610-
body ...) ; body is not always an expression, can be a break-clause
611-
(define a.ty (or (attribute a2.ty) (attribute a1.ty) #'(Immutable-HashTable Any Any)))
612-
(quasisyntax/loc stx
613-
(for/fold: : #,a.ty
614-
((return-hash : #,a.ty (ann (#,hash-maker null) #,a.ty)))
615-
(clause.expand ... ...)
616-
(let-values (((key val) (let () body ...)))
617-
(hash-set return-hash key val))))])))
603+
(begin-for-syntax
604+
(define-values (define-for/hash:-variant define-for*/hash:-variant)
605+
(let ()
606+
(define ((make for/folder:) hash-maker)
607+
(lambda (stx)
608+
(syntax-parse stx
609+
[(_ a1:optional-standalone-annotation*
610+
clause:for-clauses
611+
a2:optional-standalone-annotation*
612+
body ...) ; body is not always an expression, can be a break-clause
613+
(define a.ty (or (attribute a2.ty) (attribute a1.ty) #'(Immutable-HashTable Any Any)))
614+
(quasisyntax/loc stx
615+
(#,for/folder: : #,a.ty
616+
((return-hash : #,a.ty (ann (#,hash-maker null) #,a.ty)))
617+
(clause.expand ... ...)
618+
(let-values (((key val) (let () body ...)))
619+
(hash-set return-hash key val))))])))
620+
621+
(values (make #'for/fold:) (make #'for*/fold:)))))
618622

619623
(define-syntax for/hash: (define-for/hash:-variant #'make-immutable-hash))
620624
(define-syntax for/hasheq: (define-for/hash:-variant #'make-immutable-hasheq))
621625
(define-syntax for/hasheqv: (define-for/hash:-variant #'make-immutable-hasheqv))
622626

623-
(define-for-syntax (define-for*/hash:-variant hash-maker)
624-
(lambda (stx)
625-
(syntax-parse stx
626-
#:literals (:)
627-
[(_ a1:optional-standalone-annotation*
628-
clause:for-clauses
629-
a2:optional-standalone-annotation*
630-
body ...) ; body is not always an expression, can be a break-clause
631-
(define a.ty (or (attribute a2.ty) (attribute a1.ty)))
632-
(quasisyntax/loc stx
633-
(for*/fold: #,@(if a.ty #`(: #,a.ty) #'())
634-
#,(if a.ty
635-
#`((return-hash : #,a.ty (ann (#,hash-maker null) #,a.ty)))
636-
#`((return-hash (#,hash-maker null))))
637-
(clause.expand* ... ...)
638-
(let-values (((key val) (let () body ...)))
639-
(hash-set return-hash key val))))])))
640-
641627
(define-syntax for*/hash: (define-for*/hash:-variant #'make-immutable-hash))
642628
(define-syntax for*/hasheq: (define-for*/hash:-variant #'make-immutable-hasheq))
643629
(define-syntax for*/hasheqv: (define-for*/hash:-variant #'make-immutable-hasheqv))

0 commit comments

Comments
 (0)