From 46fdef3f3f287ea3b35b0438d08b0eb35fee4d2b Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 4 May 2010 18:53:15 -0400 Subject: [PATCH] Ported some of the common benchmarks to Typed Scheme. --- .../tests/racket/benchmarks/common/auto.rkt | 8 +++ .../benchmarks/common/cpstack-typed.rkt | 41 +++++++++++ .../racket/benchmarks/common/deriv-typed.rkt | 71 +++++++++++++++++++ .../racket/benchmarks/common/div-typed.rkt | 71 +++++++++++++++++++ 4 files changed, 191 insertions(+) create mode 100644 collects/tests/racket/benchmarks/common/cpstack-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/deriv-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/div-typed.rkt diff --git a/collects/tests/racket/benchmarks/common/auto.rkt b/collects/tests/racket/benchmarks/common/auto.rkt index ef3cc92274..b8dcadf784 100755 --- a/collects/tests/racket/benchmarks/common/auto.rkt +++ b/collects/tests/racket/benchmarks/common/auto.rkt @@ -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") diff --git a/collects/tests/racket/benchmarks/common/cpstack-typed.rkt b/collects/tests/racket/benchmarks/common/cpstack-typed.rkt new file mode 100644 index 0000000000..25e692a3e4 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/cpstack-typed.rkt @@ -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)) + + ) diff --git a/collects/tests/racket/benchmarks/common/deriv-typed.rkt b/collects/tests/racket/benchmarks/common/deriv-typed.rkt new file mode 100644 index 0000000000..674e8bb8d1 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/deriv-typed.rkt @@ -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)) + + ) diff --git a/collects/tests/racket/benchmarks/common/div-typed.rkt b/collects/tests/racket/benchmarks/common/div-typed.rkt new file mode 100644 index 0000000000..10443816a8 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/div-typed.rkt @@ -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* '())))))))) + + )