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

Corrected the typed versions of some benchmarks to be closer to the

Browse Source 
untyped versions.
This commit is contained in:
Vincent St-Amour 2010-05-21 16:03:49 -04:00
parent 4cdfbb28d7
commit 44a7a71923
8 changed files with 65 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
collects/tests/racket/benchmarks/common/ctak-typed.rktl
View File

@ -23,36 +23,36 @@
(: ctak (Integer Integer Integer -> Integer))
(define (ctak x y z)
((inst call-with-current-continuation Integer Integer)
(lambda (k)
(call-with-current-continuation
(lambda: ((k : (Integer -> Nothing)))
(ctak-aux k x y z))))
(: ctak-aux ((Integer -> Integer) Integer Integer Integer -> Integer))
(define (ctak-aux k x y z)
(cond ((not (< y x)) ;xy
(k z))
(else ((inst call-with-current-continuation Integer Integer)
(lambda (dummy)
(ctak-aux
k
((inst call-with-current-continuation Integer Integer)
(lambda (k)
(ctak-aux k
(- x 1)
y
z)))
((inst call-with-current-continuation Integer Integer)
(lambda (k)
(ctak-aux k
(- y 1)
z
x)))
((inst call-with-current-continuation Integer Integer)
(lambda (k)
(ctak-aux k
(- z 1)
x
y)))))))))
(else (call-with-current-continuation
(let ([v (ctak-aux
k
(call-with-current-continuation
(lambda: ((k : (Integer -> Nothing)))
(ctak-aux k
(- x 1)
y
z)))
(call-with-current-continuation
(lambda: ((k : (Integer -> Nothing)))
(ctak-aux k
(- y 1)
z
x)))
(call-with-current-continuation
(lambda: ((k : (Integer -> Nothing)))
(ctak-aux k
(- z 1)
x
y))))])
(lambda (dummy) v))))))
;;; call: (ctak 18 12 6)

14
collects/tests/racket/benchmarks/common/div-typed.rktl
View File

@ -33,21 +33,21 @@
(cond ((null? l) '())
(else (cons (car l) (recursive-div2 (cddr l))))))
(: test-1 ((Listof Any) -> (Listof Any)))
(: test-1 ((Listof Any) -> Void))
(define (test-1 l)
(do: : (Listof Any)
(do: : Void
((i : Integer 3000 (- i 1)))
((= i 0) '())
((= i 0))
(iterative-div2 l)
(iterative-div2 l)
(iterative-div2 l)
(iterative-div2 l)))
(: test-2 ((Listof Any) -> (Listof Any)))
(: test-2 ((Listof Any) -> Void))
(define (test-2 l)
(do: : (Listof Any)
(do: : Void
((i : Integer 3000 (- i 1)))
((= i 0) '())
((= i 0))
(recursive-div2 l)
(recursive-div2 l)
(recursive-div2 l)
@ -58,7 +58,7 @@
(let ((input (with-input-from-file "input.txt" read)))
(time (let: loop : (Pair Void Void)
((n : Integer 200) (v : (U Integer (Listof Any)) 0))
((n : Integer 200) (v : (Pair Void Void) (cons (void) (void))))
(if (zero? n)
v
(loop (- n 1)

18
collects/tests/racket/benchmarks/common/fft-typed.rktl
View File

@ -81,9 +81,9 @@
(set! i (+ i 1))
(cond ((< i n)
(l3))))
(do: : Null
(do: : Void
((l : Integer 1 (+ l 1))) ;loop thru stages (syntax converted
((> l m) '()) ; from old MACLISP style \bs)
((> l m)) ; from old MACLISP style \bs)
(set! le (expt 2 l))
(set! le1 (quotient le 2))
(set! ur 1.0)
@ -91,13 +91,13 @@
(set! wr (cos (/ pi le1)))
(set! wi (sin (/ pi le1)))
;; loop thru butterflies
(do: : Null
(do: : Void
((j : Integer 1 (+ j 1)))
((> j le1) '())
((> j le1))
;; do a butterfly
(do: : Null
(do: : Void
((i : Integer j (+ i le)))
((> i n) '())
((> i n))
(set! ip (+ i le1))
(set! tr (- (* (vector-ref ar ip) ur)
(* (vector-ref ai ip) ui)))
@ -115,11 +115,11 @@
;;; the timer which does 10 calls on fft
(: fft-bench ( -> Null))
(: fft-bench ( -> Void))
(define (fft-bench)
(do: : Null
(do: : Void
((ntimes : Integer 0 (+ ntimes 1)))
((= ntimes 5000) '())
((= ntimes 5000))
(fft *re* *im*)))
;;; call: (fft-bench)

2
collects/tests/racket/benchmarks/common/fft.sch
View File

@ -71,7 +71,7 @@
(let l6 ()
(cond ((< k j)
(set! j (- j k))
(set! k (/ k 2))
(set! k (quotient k 2))
(l6))))
(set! j (+ j k))
(set! i (+ i 1))

12
collects/tests/racket/benchmarks/common/graphs-typed.rktl
View File

@ -141,7 +141,7 @@
state))))
; Iterate over the integers [0, limit).
(: gnatural-for-each (Integer (Integer -> Any) -> Null))
(: gnatural-for-each (Integer (Integer -> Any) -> Void))
(define gnatural-for-each
(lambda (limit proc!)
'(assert (and (integer? limit)
@ -150,10 +150,10 @@
limit)
'(assert (procedure? proc!)
proc!)
(do: : Null
(do: : Void
((i : Integer 0
(+ i 1)))
((= i limit) '())
((= i limit))
(proc! i))))
(: natural-for-all? (Integer (Integer -> Boolean) -> Boolean))
@ -686,10 +686,8 @@
(lambda: ((t : Integer))
(if (vector-ref from-m t)
(begin ; [wdc - was when]
(vector-set! from-f t #t)
#t)
#t)))
#t)
(vector-set! from-f t #t))
#t))))
#t)))))))
res)))

18
collects/tests/racket/benchmarks/common/mazefun-typed.rktl
View File

@ -150,7 +150,7 @@
(make-matrix n m (lambda: ((i : Integer) (j : Integer))
(if (and (even? i) (even? j))
(cons i j)
'(0 . 0)))))
#f))))
(possible-holes
(concat
(for 0 n (lambda: ((i : Integer))
@ -166,13 +166,14 @@
(lambda (cave)
(matrix-map (lambda (x) (if x '_ '*)) cave)))
(: pierce (Pos (Matrix Pos) -> (Matrix Pos)))
(: pierce (Pos (Matrix (Option Pos)) -> (Matrix (Option Pos))))
(define pierce
(lambda (pos cave)
(let: ((i : Integer (car pos)) (j : Integer (cdr pos)))
(matrix-write cave i j pos))))
(: pierce-randomly ((Listof Pos) (Matrix Pos) -> (Matrix Pos)))
(: pierce-randomly ((Listof Pos) (Matrix (Option Pos))
-> (Matrix (Option Pos))))
(define pierce-randomly
(lambda (possible-holes cave)
(if (null? possible-holes)
@ -181,7 +182,7 @@
(pierce-randomly (cdr possible-holes)
(try-to-pierce hole cave))))))
(: try-to-pierce (Pos (Matrix Pos) -> (Matrix Pos)))
(: try-to-pierce (Pos (Matrix (Option Pos)) -> (Matrix (Option Pos))))
(define try-to-pierce
(lambda (pos cave)
(let ((i (car pos)) (j (cdr pos)))
@ -192,24 +193,25 @@
ncs))
cave
(pierce pos
(foldl (lambda: ((c : (Matrix Pos)) (nc : Pos))
(foldl (lambda: ((c : (Matrix (Option Pos))) (nc : Pos))
(change-cavity c nc pos))
cave
ncs)))))))
(: change-cavity ((Matrix Pos) Pos Pos -> (Matrix Pos)))
(: change-cavity ((Matrix (Option Pos)) Pos Pos -> (Matrix (Option Pos))))
(define change-cavity
(lambda (cave pos new-cavity-id)
(let ((i (car pos)) (j (cdr pos)))
(change-cavity-aux cave pos new-cavity-id (matrix-read cave i j)))))
(: change-cavity-aux ((Matrix Pos) Pos Pos Pos -> (Matrix Pos)))
(: change-cavity-aux ((Matrix (Option Pos)) Pos Pos (Option Pos)
-> (Matrix (Option Pos))))
(define change-cavity-aux
(lambda (cave pos new-cavity-id old-cavity-id)
(let ((i (car pos)) (j (cdr pos)))
(let ((cavity-id (matrix-read cave i j)))
(if (equal? cavity-id old-cavity-id)
(foldl (lambda: ((c : (Matrix Pos)) (nc : Pos))
(foldl (lambda: ((c : (Matrix (Option Pos))) (nc : Pos))
(change-cavity-aux c nc new-cavity-id old-cavity-id))
(matrix-write cave i j new-cavity-id)
(neighboring-cavities pos cave))

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

@ -1,7 +1,5 @@
;;; PARAFFINS -- Compute how many paraffins exist with N carbon atoms.
(require/typed scheme/base (collect-garbage ( -> Void)))
(define-type Radical (Rec Radical (U 'C 'H 'BCP 'CCP (Vectorof Radical))))
(: gen (Integer -> (Vectorof (Listof Radical))))

18
collects/tests/racket/benchmarks/common/puzzle-typed.rktl
View File

@ -89,14 +89,14 @@
(+ (vector-ref *piececount* (vector-ref *class* i)) 1))))
(: trial (Integer -> Boolean))
(: trial (Integer -> Any))
(define (trial j)
(let: ((k : Integer 0))
(call-with-current-continuation
(lambda: ((return : (Boolean -> Nothing)))
(do: : Boolean
(do: : Any
((i : Integer 0 (+ i 1)))
((> i typemax) (set! *kount* (+ *kount* 1)) #f)
((> i typemax) (set! *kount* (+ *kount* 1)) '())
(cond
((not
(zero?
@ -123,15 +123,15 @@
(: definePiece (Integer Integer Integer Integer -> Void))
(define (definePiece iclass ii jj kk)
(let: ((index : Integer 0))
(do: : Null
(do: : Void
((i : Integer 0 (+ i 1)))
((> i ii) '())
(do: : Null
((> i ii))
(do: : Void
((j : Integer 0 (+ j 1)))
((> j jj) '())
(do: : Null
((> j jj))
(do: : Void
((k : Integer 0 (+ k 1)))
((> k kk) '())
((> k kk))
(set! index (+ i (* *d* (+ j (* *d* k)))))
(vector-set! (vector-ref *p* *iii*) index #t))))
(vector-set! *class* *iii* iclass)