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

fix literal hashtables and pairs

Browse Source 
original commit: abc83496b358557a96af72dbd3d8ffecf5982c9a
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-03 11:31:27 -04:00
commit bb79a8eb11
3 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/typed-scheme/typecheck/tc-expr-unit.rkt
View File

@ -68,6 +68,12 @@
[_ (make-Vector (apply Un
(for/list ([l (syntax-e #'i)])
(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 (apply Un ks) (apply Un vs)))]
[(a . b) (-pair (tc-literal #'a) (tc-literal #'b))]
[_ Univ]))

2
collects/typed/framework/framework.rkt
View File

@ -35,7 +35,7 @@
((Instance Horizontal-Panel%) ((Instance Button%) (Instance Event%) -> Void) ((Instance Button%) (Instance Event%) -> Void) -> (values Any Any))])
(require/typed/provide "prefs-contract.ss"
[preferences:get-drscheme:large-letters-font (-> (U #f (Pair String Integer)))])
[preferences:get-drracket:large-letters-font (-> (U #f (Pair String Integer)))])
(require (only-in "prefs-contract.ss" preferences:get))
(provide preferences:get)

6
collects/typed/framework/prefs-contract.rkt
View File

@ -4,10 +4,10 @@
framework/framework)
(provide (rename-out [-preferences:get preferences:get])
preferences:get-drscheme:large-letters-font)
preferences:get-drracket:large-letters-font)
(define (preferences:get-drscheme:large-letters-font)
(preferences:get 'drscheme:large-letters-font))
(define (preferences:get-drracket:large-letters-font)
(preferences:get 'drracket:large-letters-font))
(define-syntax (-preferences:get stx)
(syntax-case stx (quote)