suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improve types for literal hash tables

Browse Source 
original commit: a5c7175e465111bcce3ae51cab14b966f6bc6020
This commit is contained in:
Sam Tobin-Hochstadt 2012-01-22 14:10:52 -05:00
parent a7230e3779
commit 4e9604460a
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -103,10 +103,16 @@
[_ (make-HeterogenousVector (for/list ([l (syntax-e #'i)])
(generalize (tc-literal l #f))))])]
[(~var i (3d hash?))
(let* ([h (syntax-e #'i)]
[ks (hash-map h (lambda (x y) (tc-literal x)))]
[vs (hash-map h (lambda (x y) (tc-literal y)))])
(make-Hashtable (generalize (apply Un ks)) (generalize (apply Un vs))))]
(match expected
[(Hashtable: k v)
(let* ([h (syntax-e #'i)]
[ks (hash-map h (lambda (x y) (tc-literal x k)))]
[vs (hash-map h (lambda (x y) (tc-literal y v)))])
(make-Hashtable (generalize (check-below (apply Un ks)) k) (generalize (check-below (apply Un vs)))))]
[_ (let* ([h (syntax-e #'i)]
[ks (hash-map h (lambda (x y) (tc-literal x)))]
[vs (hash-map h (lambda (x y) (tc-literal y)))])
(make-Hashtable (generalize (apply Un ks)) (generalize (apply Un vs))))])]
[(a . b) (-pair (tc-literal #'a) (tc-literal #'b))]
[_ Univ]))