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

Calls to vector now return heterogenous vectors, to preserve length

Browse Source 
information.
This commit is contained in:
Vincent St-Amour 2010-07-01 18:32:21 -04:00
parent 843621398b
commit f79f617ee8
2 changed files with 30 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/tests/racket/benchmarks/common/typed/paraffins.rktl
View File

@ -10,7 +10,7 @@
(: rads-of-size (Integer -> (Listof Radical))) (: rads-of-size (Integer -> (Listof Radical)))
(define (rads-of-size n) (define (rads-of-size n)
(let: loop1 : (Listof Radical) (let: loop1 : (Listof Radical)
((ps : (Listof (Vectorof Integer)) ((ps : (Listof (Vector Integer Integer Integer))
(three-partitions (- n 1))) (three-partitions (- n 1)))
(lst : (Listof Radical) (lst : (Listof Radical)
'())) '()))
@ -48,10 +48,11 @@
lst))) lst)))
(if (null? rads3) (if (null? rads3)
lst lst
(cons (vector 'C (cons (ann (vector 'C
(car rads1) (car rads1)
(car rads2) (car rads2)
(car rads3)) (car rads3))
Radical)
(loop4 (cdr rads3) (loop4 (cdr rads3)
lst)))))))))))) lst))))))))))))
@ -73,16 +74,17 @@
lst))) lst)))
(if (null? rads2) (if (null? rads2)
lst lst
(cons (vector 'BCP (cons (ann (vector 'BCP
(car rads1) (car rads1)
(car rads2)) (car rads2))
Radical)
(loop2 (cdr rads2) (loop2 (cdr rads2)
lst)))))))) lst))))))))
(: ccp-generator (Integer -> (Listof Radical))) (: ccp-generator (Integer -> (Listof Radical)))
(define (ccp-generator j) (define (ccp-generator j)
(let: loop1 : (Listof Radical) (let: loop1 : (Listof Radical)
((ps : (Listof (Vectorof Integer)) ((ps : (Listof (Vector Integer Integer Integer Integer))
(four-partitions (- j 1))) (four-partitions (- j 1)))
(lst : (Listof Radical) (lst : (Listof Radical)
'())) '()))
@ -127,11 +129,12 @@
lst))) lst)))
(if (null? rads4) (if (null? rads4)
lst lst
(cons (vector 'CCP (cons (ann (vector 'CCP
(car rads1) (car rads1)
(car rads2) (car rads2)
(car rads3) (car rads3)
(car rads4)) (car rads4))
Radical)
(loop5 (cdr rads4) (loop5 (cdr rads4)
lst)))))))))))))) lst))))))))))))))
@ -143,10 +146,10 @@
(vector-set! radicals i (rads-of-size i)) (vector-set! radicals i (rads-of-size i))
(loop (+ i 1))))))) (loop (+ i 1)))))))
(: three-partitions (Integer -> (Listof (Vectorof Integer)))) (: three-partitions (Integer -> (Listof (Vector Integer Integer Integer))))
(define (three-partitions m) (define (three-partitions m)
(let: loop1 : (Listof (Vectorof Integer)) (let: loop1 : (Listof (Vector Integer Integer Integer))
((lst : (Listof (Vectorof Integer)) '()) ((lst : (Listof (Vector Integer Integer Integer)) '())
(nc1 : Integer (quotient m 3))) (nc1 : Integer (quotient m 3)))
(if (< nc1 0) (if (< nc1 0)
lst lst
@ -155,16 +158,16 @@
(if (< nc2 nc1) (if (< nc2 nc1)
(loop1 lst (loop1 lst
(- nc1 1)) (- nc1 1))
(loop2 (cons (vector nc1 (loop2 (cons (vector (ann nc1 Integer)
nc2 (ann nc2 Integer)
(- m (+ nc1 nc2))) (- m (+ nc1 nc2)))
lst) lst)
(- nc2 1))))))) (- nc2 1)))))))
(: four-partitions (Integer -> (Listof (Vectorof Integer)))) (: four-partitions (Integer -> (Listof (Vector Integer Integer Integer Integer))))
(define (four-partitions m) (define (four-partitions m)
(let: loop1 : (Listof (Vectorof Integer)) (let: loop1 : (Listof (Vector Integer Integer Integer Integer))
((lst : (Listof (Vectorof Integer)) '()) ((lst : (Listof (Vector Integer Integer Integer Integer)) '())
(nc1 : Integer (quotient m 4))) (nc1 : Integer (quotient m 4)))
(if (< nc1 0) (if (< nc1 0)
lst lst
@ -178,9 +181,9 @@
(nc3 (quotient (- m (+ nc1 nc2)) 2))) (nc3 (quotient (- m (+ nc1 nc2)) 2)))
(if (< nc3 start) (if (< nc3 start)
(loop2 lst (- nc2 1)) (loop2 lst (- nc2 1))
(loop3 (cons (vector nc1 (loop3 (cons (vector (ann nc1 Integer)
nc2 (ann nc2 Integer)
nc3 (ann nc3 Integer)
(- m (+ nc1 (+ nc2 nc3)))) (- m (+ nc1 (+ nc2 nc3))))
lst) lst)
(- nc3 1)))))))))) (- nc3 1))))))))))

7
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -623,11 +623,8 @@
expected))] expected))]
;; since vectors are mutable, if there is no expected type, we want to generalize the element type ;; 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 (lambda (x) (ret (make-HeterogenousVector (map (lambda (x) (generalize (tc-expr/t x)))
(match (single-value x) (syntax->list #'(args ...)))))]
[(tc-result1: t) (ret (generalize t))]))
(syntax->list #'(args ...)))])
(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 ;; 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) [(#%plain-app (~and op (~literal make-vector)) n elt)