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

Literal vectors are now given HeterogenousVector types to preserve

Browse Source 
length information.
This commit is contained in:
Vincent St-Amour 2010-07-01 15:24:52 -04:00
parent 25cb5ef568
commit 8c25e46141
2 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -154,10 +154,10 @@
[tc-e (void) -Void] [tc-e (void) -Void]
[tc-e (void 3 4) -Void] [tc-e (void 3 4) -Void]
[tc-e (void #t #f '(1 2 3)) -Void] [tc-e (void #t #f '(1 2 3)) -Void]
[tc-e/t #(3 4 5) (make-Vector -Nat)] [tc-e/t #(3 4 5) (make-HeterogenousVector (list -Nat -Nat -Nat))]
[tc-e/t '(2 3 4) (-lst* -PositiveFixnum -PositiveFixnum -PositiveFixnum)] [tc-e/t '(2 3 4) (-lst* -PositiveFixnum -PositiveFixnum -PositiveFixnum)]
[tc-e/t '(2 3 #t) (-lst* -PositiveFixnum -PositiveFixnum (-val #t))] [tc-e/t '(2 3 #t) (-lst* -PositiveFixnum -PositiveFixnum (-val #t))]
[tc-e/t #(2 3 #t) (make-Vector (t:Un -Nat (-val #t)))] [tc-e/t #(2 3 #t) (make-HeterogenousVector (list -Nat -Nat (-val #t)))]
[tc-e/t '(#t #f) (-lst* (-val #t) (-val #f))] [tc-e/t '(#t #f) (-lst* (-val #t) (-val #f))]
[tc-e/t (plambda: (a) ([l : (Listof a)]) (car l)) [tc-e/t (plambda: (a) ([l : (Listof a)]) (car l))
(make-Poly '(a) (t:-> (make-Listof (-v a)) (-v a)))] (make-Poly '(a) (t:-> (make-Listof (-v a)) (-v a)))]

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

@ -80,9 +80,8 @@
[t (in-list ts)]) [t (in-list ts)])
(tc-literal l t)))] (tc-literal l t)))]
;; errors are handled elsewhere ;; errors are handled elsewhere
[_ (make-Vector (apply Un [_ (make-HeterogenousVector (for/list ([l (syntax-e #'i)])
(for/list ([l (syntax-e #'i)]) (generalize (tc-literal l #f))))])]
(generalize (tc-literal l #f)))))])]
[(~var i (3d hash?)) [(~var i (3d hash?))
(let* ([h (syntax-e #'i)] (let* ([h (syntax-e #'i)]
[ks (hash-map h (lambda (x y) (tc-literal x)))] [ks (hash-map h (lambda (x y) (tc-literal x)))]