Generalization is now done on vector types.
This commit is contained in:
parent
06279de2ca
commit
636fca1a83
|
@ -278,7 +278,6 @@
|
||||||
;
|
;
|
||||||
; The components tx, ty, and tz are the translation vector.
|
; The components tx, ty, and tz are the translation vector.
|
||||||
|
|
||||||
(: tfo-id (Vectorof Float))
|
|
||||||
(define tfo-id ; the identity transformation matrix
|
(define tfo-id ; the identity transformation matrix
|
||||||
'#(1.0 0.0 0.0
|
'#(1.0 0.0 0.0
|
||||||
0.0 1.0 0.0
|
0.0 1.0 0.0
|
||||||
|
|
|
@ -12,7 +12,7 @@
|
||||||
(define N.0 (exact->inexact N))
|
(define N.0 (exact->inexact N))
|
||||||
(define 2/N (/ 2.0 N.0))
|
(define 2/N (/ 2.0 N.0))
|
||||||
(define Crs
|
(define Crs
|
||||||
(let: ([v : (Vectorof Float) (make-vector N 0.0)])
|
(let ([v (make-vector N 0.0)])
|
||||||
(for ([x (in-range N)])
|
(for ([x (in-range N)])
|
||||||
(vector-set! v x (- (/ (* 2 x) N.0) 1.5)))
|
(vector-set! v x (- (/ (* 2 x) N.0) 1.5)))
|
||||||
v))
|
v))
|
||||||
|
|
|
@ -8,8 +8,8 @@
|
||||||
|
|
||||||
(: Approximate (Natural -> Float))
|
(: Approximate (Natural -> Float))
|
||||||
(define (Approximate n)
|
(define (Approximate n)
|
||||||
(let: ([u : (Vectorof Float) (make-vector n 1.0)]
|
(let ([u (make-vector n 1.0)]
|
||||||
[v : (Vectorof Float) (make-vector n 0.0)])
|
[v (make-vector n 0.0)])
|
||||||
;; 20 steps of the power method
|
;; 20 steps of the power method
|
||||||
(for: : Void ([i : Natural (in-range 10)])
|
(for: : Void ([i : Natural (in-range 10)])
|
||||||
(MultiplyAtAv n u v)
|
(MultiplyAtAv n u v)
|
||||||
|
@ -51,7 +51,7 @@
|
||||||
;; multiply vector v by matrix A and then by matrix A transposed
|
;; multiply vector v by matrix A and then by matrix A transposed
|
||||||
(: MultiplyAtAv (Natural (Vectorof Float) (Vectorof Float) -> Void))
|
(: MultiplyAtAv (Natural (Vectorof Float) (Vectorof Float) -> Void))
|
||||||
(define (MultiplyAtAv n v AtAv)
|
(define (MultiplyAtAv n v AtAv)
|
||||||
(let: ([u : (Vectorof Float) (make-vector n 0.0)])
|
(let ([u (make-vector n 0.0)])
|
||||||
(MultiplyAv n v u)
|
(MultiplyAv n v u)
|
||||||
(MultiplyAtv n u AtAv)))
|
(MultiplyAtv n u AtAv)))
|
||||||
|
|
||||||
|
|
13
collects/tests/typed-scheme/succeed/generalize-vectors.rkt
Normal file
13
collects/tests/typed-scheme/succeed/generalize-vectors.rkt
Normal file
|
@ -0,0 +1,13 @@
|
||||||
|
#lang typed/scheme
|
||||||
|
|
||||||
|
(define x (vector 1.0 2.0)) ; should generalize to (Vectorof Float) even though it only contains Nonnegative-Floats
|
||||||
|
(vector-set! x 0 -2.0)
|
||||||
|
|
||||||
|
(define y (make-vector 2 1.0))
|
||||||
|
(vector-set! y 0 -2.0)
|
||||||
|
|
||||||
|
(define z #(1.0 2.0))
|
||||||
|
(ann z (Vectorof Float))
|
||||||
|
|
||||||
|
(define w (build-vector 3 (lambda: ((x : Integer)) (add1 x))))
|
||||||
|
(vector-set! w 0 -2)
|
|
@ -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 -PositiveFixnum)]
|
[tc-e/t #(3 4 5) (make-Vector -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 -PositiveFixnum (-val #t)))]
|
[tc-e/t #(2 3 #t) (make-Vector (t:Un -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)))]
|
||||||
|
|
|
@ -621,17 +621,51 @@
|
||||||
(tc/funapp #'op #'(args ...) (single-value #'op) arg-tys expected))
|
(tc/funapp #'op #'(args ...) (single-value #'op) arg-tys expected))
|
||||||
(check-below (for/first ([t ts]) (loop (ret t)))
|
(check-below (for/first ([t ts]) (loop (ret t)))
|
||||||
expected))]
|
expected))]
|
||||||
|
;; since vectors are mutable, if there is no expected type, we want to generalize the element type
|
||||||
[(or #f (tc-result1: _))
|
[(or #f (tc-result1: _))
|
||||||
(let ([arg-tys (map single-value (syntax->list #'(args ...)))])
|
(let ([arg-tys (map (lambda (x)
|
||||||
|
(match (single-value x)
|
||||||
|
[(tc-result1: t) (ret (generalize t))]))
|
||||||
|
(syntax->list #'(args ...)))])
|
||||||
(tc/funapp #'op #'(args ...) (single-value #'op) arg-tys expected))]
|
(tc/funapp #'op #'(args ...) (single-value #'op) arg-tys expected))]
|
||||||
[_ (int-err "bad expected: ~a" expected)]))]
|
[_ (int-err "bad expected: ~a" expected)]))]
|
||||||
|
;; since vectors are mutable, if there is no expected type, we want to generalize the element type
|
||||||
|
[(#%plain-app (~and op (~literal make-vector)) n elt)
|
||||||
|
(match expected
|
||||||
|
[(tc-result1: (Vector: t))
|
||||||
|
(tc-expr/check #'n (ret -Integer))
|
||||||
|
(tc-expr/check #'elt (ret t))
|
||||||
|
expected]
|
||||||
|
[(or #f (tc-result1: _))
|
||||||
|
(tc/funapp #'op #'(n elt) (single-value #'op)
|
||||||
|
(list (single-value #'n)
|
||||||
|
(match (single-value #'elt)
|
||||||
|
[(tc-result1: t) (ret (generalize t))]))
|
||||||
|
expected)]
|
||||||
|
[_ (int-err "bad expected: ~a" expected)])]
|
||||||
|
[(#%plain-app (~and op (~literal build-vector)) n proc)
|
||||||
|
(match expected
|
||||||
|
[(tc-result1: (Vector: t))
|
||||||
|
(tc-expr/check #'n (ret -Integer))
|
||||||
|
(tc-expr/check #'proc (ret (-NonnegativeFixnum . -> . t)))
|
||||||
|
expected]
|
||||||
|
[(or #f (tc-result1: _))
|
||||||
|
(tc/funapp #'op #'(n elt) (single-value #'op)
|
||||||
|
(list (single-value #'n)
|
||||||
|
(match (tc/funapp #'proc #'(1) ; valid nonnegative-fixnum
|
||||||
|
(single-value #'proc)
|
||||||
|
(list (ret -NonnegativeFixnum))
|
||||||
|
#f)
|
||||||
|
[(tc-result1: t) (ret (-> -NonnegativeFixnum (generalize t)))]))
|
||||||
|
expected)]
|
||||||
|
[_ (int-err "bad expected: ~a" expected)])]
|
||||||
;; special case for `-' used like `sub1'
|
;; special case for `-' used like `sub1'
|
||||||
[(#%plain-app (~and op (~literal -)) v (~and arg2 ((~literal quote) 1)))
|
[(#%plain-app (~and op (~literal -)) v (~and arg2 ((~literal quote) 1)))
|
||||||
(add-typeof-expr #'arg2 (ret -PositiveFixnum))
|
(add-typeof-expr #'arg2 (ret -PositiveFixnum))
|
||||||
(match-let ([(tc-result1: t) (single-value #'v)])
|
(match-let ([(tc-result1: t) (single-value #'v)])
|
||||||
(cond
|
(cond
|
||||||
[(subtype t -PositiveFixnum) (ret (Un -Zero -PositiveFixnum))]
|
[(subtype t -PositiveFixnum) (ret -NonnegativeFixnum)]
|
||||||
[(subtype t (Un -Zero -PositiveFixnum)) (ret -Fixnum)]
|
[(subtype t -NonnegativeFixnum) (ret -Fixnum)]
|
||||||
[(subtype t -ExactPositiveInteger) (ret -Nat)]
|
[(subtype t -ExactPositiveInteger) (ret -Nat)]
|
||||||
[else (tc/funapp #'op #'(v arg2) (single-value #'op) (list (ret t) (single-value #'arg2)) expected)]))]
|
[else (tc/funapp #'op #'(v arg2) (single-value #'op) (list (ret t) (single-value #'arg2)) expected)]))]
|
||||||
;; call-with-values
|
;; call-with-values
|
||||||
|
|
|
@ -82,7 +82,7 @@
|
||||||
;; errors are handled elsewhere
|
;; errors are handled elsewhere
|
||||||
[_ (make-Vector (apply Un
|
[_ (make-Vector (apply Un
|
||||||
(for/list ([l (syntax-e #'i)])
|
(for/list ([l (syntax-e #'i)])
|
||||||
(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)))]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user