Generalize hash table literals and subtypes of symbol.

Closes PR 11670.
This commit is contained in:
Vincent St-Amour 2011-01-26 11:37:56 -05:00
parent 630dee7227
commit 2bd0145603
4 changed files with 5 additions and 3 deletions

View File

@ -88,7 +88,7 @@
[meeting-ch : MeetingChannel (make-channel)])
(place meeting-ch n)
(newline)
(for ([init inits])
(for: ([init : Color inits])
(printf " ~a" init)
(creature init meeting-ch result-ch))
(newline)

View File

@ -872,7 +872,8 @@
(tc-l #"foo" -Bytes)
[tc-l () (-val null)]
[tc-l (3 . 4) (-pair -PositiveFixnum -PositiveFixnum)]
[tc-l #hash((1 . 2) (3 . 4)) (make-Hashtable -PositiveFixnum -PositiveFixnum)])
[tc-l #hash((1 . 2) (3 . 4)) (make-Hashtable -Integer -Integer)]
[tc-l #hasheq((a . q) (b . w)) (make-Hashtable -Symbol -Symbol)])
))

View File

@ -96,7 +96,7 @@
(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 (apply Un ks) (apply Un vs)))]
(make-Hashtable (generalize (apply Un ks)) (generalize (apply Un vs))))]
[(a . b) (-pair (tc-literal #'a) (tc-literal #'b))]
[_ Univ]))

View File

@ -47,6 +47,7 @@
t-new
(exit t)))]
[(ListDots: t bound) (-lst (substitute Univ bound t))]
[(? (lambda (t) (subtype t -Symbol))) -Symbol]
[_ (exit t)]))))