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

Add types for `in-hash' etc.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2011-05-08 14:52:05 -04:00
parent 9188e36ef1
commit 2f3e9fc655
2 changed files with 26 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -26,7 +26,8 @@
(private #;base-env #;base-env-numeric (private #;base-env #;base-env-numeric
base-env-indexing base-special-env)) base-env-indexing base-special-env))
(for-template (private #;base-env base-types base-types-extra (for-template (private #;base-env base-types base-types-extra
#;base-env-numeric base-special-env #;base-env-numeric
base-special-env
base-env-indexing)) base-env-indexing))
(for-syntax syntax/kerncase syntax/parse)) (for-syntax syntax/kerncase syntax/parse))
@ -35,7 +36,7 @@
(provide typecheck-tests g tc-expr/expand) (provide typecheck-tests g tc-expr/expand)
(b:init) (n:init) (initialize-structs) (initialize-indexing) (b:init) (n:init) (initialize-structs) (initialize-indexing) (initialize-special)
(define N -Number) (define N -Number)
(define B -Boolean) (define B -Boolean)
@ -858,6 +859,15 @@
[tc-e ((inst map Number (Pairof Number Number)) car (ann (list (cons 1 2) (cons 2 3) (cons 4 5)) (Listof (Pairof Number Number)))) [tc-e ((inst map Number (Pairof Number Number)) car (ann (list (cons 1 2) (cons 2 3) (cons 4 5)) (Listof (Pairof Number Number))))
(-lst -Number)] (-lst -Number)]
[tc-err (list (values 1 2))] [tc-err (list (values 1 2))]
#| ;; should work but don't (test harness problems)
[tc-e (for/list ([(k v) (in-hash #hash((1 . 2)))]) 0) (-lst -Zero)]
[tc-e (in-list (list 1 2 3)) (-seq -Integer)]
[tc-e (in-vector (vector 1 2 3)) (-seq -Integer)]
|#
[tc-e (in-hash #hash((1 . 2))) (-seq -Integer -Integer)]
[tc-e (in-hash-keys #hash((1 . 2))) (-seq -Integer)]
[tc-e (in-hash-values #hash((1 . 2))) (-seq -Integer)]
) )
(test-suite (test-suite
"check-type tests" "check-type tests"

13
collects/typed-scheme/private/base-special-env.rkt
View File

@ -101,6 +101,19 @@
[(i-n _ ...) [(i-n _ ...)
#'i-n]) #'i-n])
(->opt -Bytes [-Int (-opt -Int) -Int] (-seq -Byte))] (->opt -Bytes [-Int (-opt -Int) -Int] (-seq -Byte))]
;; in-hash and friends
[(syntax-parse (local-expand #'(in-hash #hash((1 . 2))) 'expression #f)
[(i-n _ ...)
#'i-n])
(-poly (a b) (-> (-HT a b) (-seq a b)))]
[(syntax-parse (local-expand #'(in-hash-keys #hash((1 . 2))) 'expression #f)
[(i-n _ ...)
#'i-n])
(-poly (a b) (-> (-HT a b) (-seq a)))]
[(syntax-parse (local-expand #'(in-hash-values #hash((1 . 2))) 'expression #f)
[(i-n _ ...)
#'i-n])
(-poly (a b) (-> (-HT a b) (-seq b)))]
;; in-port ;; in-port
[(syntax-parse (local-expand #'(in-port) 'expression #f) [(syntax-parse (local-expand #'(in-port) 'expression #f)
[(i-n _ ...) [(i-n _ ...)