diff --git a/typed-racket-lib/info.rkt b/typed-racket-lib/info.rkt index 00b41e622..29dc8d3be 100644 --- a/typed-racket-lib/info.rkt +++ b/typed-racket-lib/info.rkt @@ -2,7 +2,7 @@ (define collection 'multi) -(define deps '(("base" #:version "8.8.0.7") +(define deps '(("base" #:version "8.12.0.14") "source-syntax" "pconvert-lib" "compatibility-lib" ;; to assign types 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 16cb86269..b83246dae 100644 --- a/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -22,7 +22,9 @@ racket/keyword racket/private/stx (only-in mzscheme make-namespace) - (only-in racket/match/runtime match:error matchable? match-equality-test syntax-srclocs)) + (only-in racket/match/runtime match:error matchable? match-equality-test syntax-srclocs + hash-state-step hash-shortcut-step + invoke-thunk hash-state hash-state-closed? hash-state-residue undef user-def)) "base-structs.rkt" racket/file (only-in racket/private/pre-base new-apply-proc) @@ -1360,6 +1362,29 @@ [matchable? (unsafe-shallow:make-pred-ty (Un -String -Bytes))] [syntax-srclocs (Univ . -> . Univ)] +;; hash table pattern matching +[hash-state (-poly (a b) (-> (-HT a b) (-lst a) (-lst b) + (-prefab 'hash-state (-HT a b) (-lst a) (-lst b))))] + +[hash-state-step + (-poly (a c) (-> a (-> (Un c -Unsafe-Undefined)) Univ + (-poly (b) (-> (-prefab 'hash-state (-HT a b) (-lst a) (-lst b)) + (-values (list B (-> (Un b c)) + (-prefab 'hash-state + (-HT a b) + (-lst a) + (-lst b))))))))] +[hash-shortcut-step + (-poly (a c) (-> a (-> (Un c -Unsafe-Undefined)) + (-poly (b) (-> (-HT a b) + (-values (list B (-> (Un b c))))))))] + +[invoke-thunk (-poly (a) (-> (-> a) a))] +[hash-state-closed? (-poly (a b) (-> (-prefab 'hash-state (-HT a b) (-lst a) (-lst b)) B))] +[hash-state-residue (-poly (a b) (-> (-prefab 'hash-state (-HT a b) (-lst a) (-lst b)) (-HT a b)))] +[undef -Unsafe-Undefined] +[user-def Univ] + ;; Section 10.1 [values (-polydots (a b) (cl->* (-> (-values null)) diff --git a/typed-racket-test/fail/match-hash-pattern.rkt b/typed-racket-test/fail/match-hash-pattern.rkt new file mode 100644 index 000000000..05aeae49b --- /dev/null +++ b/typed-racket-test/fail/match-hash-pattern.rkt @@ -0,0 +1,5 @@ +#lang typed/racket + +(match (hash 1 "2" 3 "4") + [(hash* [1 #{x : String} #:default #f] [3 #{y : String}]) + (list x y)]) diff --git a/typed-racket-test/succeed/match-hash-pattern.rkt b/typed-racket-test/succeed/match-hash-pattern.rkt new file mode 100644 index 000000000..6a3479060 --- /dev/null +++ b/typed-racket-test/succeed/match-hash-pattern.rkt @@ -0,0 +1,32 @@ +#lang typed/racket + +(match (hash 1 "2" 3 "4") + [(hash 1 #{x : String} 3 #{y : String}) + (list x y)]) + +(match (hash 1 "2" 3 "4") + [(hash* [1 #{x : String}] [3 #{y : String}]) + (list x y)]) + +(match (hash 1 "2" 3 "4") + [(hash* [1 #{x : (U String Symbol)} #:default 'a] [3 #{y : (U String Boolean)} #:default #t]) + (list x y)]) + +(match (hash 1 "2" 3 "4") + [(hash* [1 #{x : (U String Symbol)} #:default 'a] [3 #{y : (U String Boolean)} #:default #t] #:closed) + (list x y)]) + +(match (hash 1 "2" 3 "4") + [(hash* [1 #{x : (U String False)} #:default #f] [3 #{y : String}]) + (list x y)]) + +(match (hash 1 "2" 3 "4") + [(hash* [1 #{x : (U String False)} #:default #f] + [3 #{y : String}] #:closed) + (list x y)]) + +(match (hash 1 "2" 3 "4") + [(hash* [1 #{x : (U String False)} #:default #f] + [3 #{y : String}] + #:rest #{ht : (HashTable Integer String)}) + (list x y ht)])