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

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

@ -623,11 +623,8 @@
expected))]
;; since vectors are mutable, if there is no expected type, we want to generalize the element type
[(or #f (tc-result1: _))
(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))]
(ret (make-HeterogenousVector (map (lambda (x) (generalize (tc-expr/t x)))
(syntax->list #'(args ...)))))]
[_ (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)