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

Ported some of the common benchmarks to Typed Scheme.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-05-04 18:53:15 -04:00 committed by Vincent St-Amour
parent 3e757d0fb1
commit 46fdef3f3f
4 changed files with 191 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/racket/benchmarks/common/auto.rkt
View File

@ -397,6 +397,14 @@ exec racket -qu "$0" ${1+"$@"}
clean-up-zo
(append '(nucleic2)
mutable-pair-progs))
(make-impl 'typed-scheme
void
mk-racket
(lambda (bm)
(system (format "racket -u ~a-typed.rkt" bm)))
extract-racket-times
clean-up-zo
mutable-pair-progs)
(make-impl 'chicken
void
(run-mk "mk-chicken.rktl")

41
collects/tests/racket/benchmarks/common/cpstack-typed.rkt Normal file
View File

@ -0,0 +1,41 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; File: cpstak.sch
; Description: continuation-passing version of TAK
; Author: Will Clinger
; Created: 20-Aug-87
; Modified: 3-May-10 (Vincent St-Amour)
; Language: Typed Scheme
; Status: Public Domain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CPSTAK -- A continuation-passing version of the TAK benchmark.
;;; A good test of first class procedures and tail recursion.
(module cpstack-typed typed/scheme
(: cpstak (Integer Integer Integer -> Integer))
(define (cpstak x y z)
(: tak (Integer Integer Integer (Integer -> Integer) -> Integer))
(define (tak x y z k)
(if (not (< y x))
(k z)
(tak (- x 1)
y
z
(lambda (v1)
(tak (- y 1)
z
x
(lambda (v2)
(tak (- z 1)
x
y
(lambda (v3)
(tak v1 v2 v3 k)))))))))
(tak x y z (lambda (a) a)))
;;; call: (cpstak 18 12 6)
(time (cpstak 18 12 2))
)

71
collects/tests/racket/benchmarks/common/deriv-typed.rkt Normal file
View File

@ -0,0 +1,71 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; File: deriv.sch
; Description: The DERIV benchmark from the Gabriel tests.
; Author: Vaughan Pratt
; Created: 8-Apr-85
; Modified: 10-Apr-85 14:53:50 (Bob Shaw)
; 23-Jul-87 (Will Clinger)
; 9-Feb-88 (Will Clinger)
; 3-May-10 (Vincent St-Amour)
; Language: Typed Scheme
; Status: Public Domain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DERIV -- Symbolic derivative benchmark written by Vaughn Pratt.
;;; It uses a simple subset of Lisp and does a lot of CONSing.
; Returns the wrong answer for quotients.
; Fortunately these aren't used in the benchmark.
(module deriv-typed typed/scheme
(define-type Deriv (Rec Deriv (U Number
Symbol
(Pair (U '+ '- '* '/)
(Listof Deriv)))))
(: deriv-aux (Deriv -> Deriv))
(define (deriv-aux a) (list '/ (deriv a) a))
(: deriv (Deriv -> Deriv))
(define (deriv a)
(cond
((not (pair? a))
(cond ((eq? a 'x) 1) (else 0)))
((eq? (car a) '+)
(cons '+ (map deriv (cdr a))))
((eq? (car a) '-)
(cons '- (map deriv
(cdr a))))
((eq? (car a) '*)
(list '*
a
(ann (cons '+ (map deriv-aux (cdr a))) Deriv)))
((eq? (car a) '/)
(list '-
(list '/
(deriv (cadr a))
(caddr a))
(list '/
(cadr a)
(list '*
(caddr a)
(caddr a)
(deriv (caddr a))))))
(else 'error)))
(: run ( -> Void))
(define (run)
(do ((i 0 (+ i 1)))
((= i 50000))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5))
(deriv '(+ (* 3 x x) (* a x x) (* b x) 5))))
;;; call: (run)
(time (run))
)

71
collects/tests/racket/benchmarks/common/div-typed.rkt Normal file
View File

@ -0,0 +1,71 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; File: div.sch
; Description: DIV benchmarks
; Author: Richard Gabriel
; Created: 8-Apr-85
; Modified: 19-Jul-85 18:28:01 (Bob Shaw)
; 23-Jul-87 (Will Clinger)
; 3-May-10 (Vincent St-Amour)
; Language: Typed Scheme
; Status: Public Domain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; DIV2 -- Benchmark which divides by 2 using lists of n ()'s.
;;; This file contains a recursive as well as an iterative test.
(module div-typed typed/scheme
(: create-n (Integer -> (Listof Any)))
(define (create-n n)
(do ((n n (- n 1))
(a '() (cons '() a)))
((= n 0) a)))
(: *ll* (Listof Any))
(define *ll* (create-n 200))
(: iterative-div2 ((Listof Any) -> (Listof Any)))
(define (iterative-div2 l)
(do ((l l (cddr l))
(a '() (cons (car l) a)))
((null? l) a)))
(: recursive-div2 ((Listof Any) -> (Listof Any)))
(define (recursive-div2 l)
(cond ((null? l) '())
(else (cons (car l) (recursive-div2 (cddr l))))))
(: test-1 ((Listof Any) -> (Listof Any)))
(define (test-1 l)
(do: : (Listof Any)
((i : Integer 3000 (- i 1)))
((= i 0) '())
(iterative-div2 l)
(iterative-div2 l)
(iterative-div2 l)
(iterative-div2 l)))
(: test-2 ((Listof Any) -> (Listof Any)))
(define (test-2 l)
(do: : (Listof Any)
((i : Integer 3000 (- i 1)))
((= i 0) '())
(recursive-div2 l)
(recursive-div2 l)
(recursive-div2 l)
(recursive-div2 l)))
;;; for the iterative test call: (test-1 *ll*)
;;; for the recursive test call: (test-2 *ll*)
(let ((input (with-input-from-file "input.txt" read)))
(time (let: loop : (U Integer (Listof Any))
((n : Integer 10) (v : (U Integer (Listof Any)) 0))
(if (zero? n)
v
(loop (- n 1)
(cons
(test-1 (if input *ll* '()))
(test-2 (if input *ll* '()))))))))
)