From bc794b443cff7f3a01cf4ce42be8133cfa0c463e Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Mon, 21 Jun 2010 16:57:47 -0400 Subject: [PATCH] Propagated Eli's changes to the mandelbrot benchmark to the generic and typed versions. --- .../shootout/mandelbrot-generic.rkt | 107 +++++++---------- .../shootout/typed/mandelbrot-generic.rktl | 110 +++++++----------- .../benchmarks/shootout/typed/mandelbrot.rktl | 106 ++++++++--------- 3 files changed, 124 insertions(+), 199 deletions(-) diff --git a/collects/tests/racket/benchmarks/shootout/mandelbrot-generic.rkt b/collects/tests/racket/benchmarks/shootout/mandelbrot-generic.rkt index 3343a13023..dfe3bb1565 100644 --- a/collects/tests/racket/benchmarks/shootout/mandelbrot-generic.rkt +++ b/collects/tests/racket/benchmarks/shootout/mandelbrot-generic.rkt @@ -2,78 +2,49 @@ ;; The Computer Language Benchmarks Game ;; http://shootout.alioth.debian.org/ -;; -;; Derived from the Chicken variant, which was -;; Contributed by Anthony Borla -;; The version that uses complex number is a little -;; more elegant, but much slower: -;; (define (mandelbrot iterations x y n ci) -;; (let ((c (+ (- (/ (* 2.0 x) n) 1.5) -;; (* ci 0.0+1.0i)))) -;; (let loop ((i 0) (z 0.0+0.0i)) -;; (cond -;; [(> i iterations) 1] -;; [(> (magnitude z) 2.0) 0] -;; [else (loop (add1 i) (+ (* z z) c))])))) - +(require (for-syntax racket/base)) (require racket/cmdline) -(define +limit-sqr+ 4.0) +(define O (current-output-port)) -(define +iterations+ 50) +(define LIMIT-SQR 4.0) +(define ITERATIONS 50) +(define N (command-line #:args (n) (string->number n))) +(define N.0 (exact->inexact N)) +(define 2/N (/ 2.0 N.0)) +(define Crs + (let ([v (make-vector N)]) + (for ([x (in-range N)]) + (vector-set! v x (- (/ (* 2 x) N.0) 1.5))) + v)) -;; ------------------------------- +(define-syntax (let-n stx) + (syntax-case stx () + [(_ N bindings E) + (let loop ([N (syntax-e #'N)] [E #'E]) + (if (zero? N) E (loop (sub1 N) #`(let bindings #,E))))])) -(define (mandelbrot iterations x y n ci) - (let ((cr (- (/ (* 2.0 x) n) 1.5))) - (let loop ((i 0) (zr 0.0) (zi 0.0)) - (if (> i iterations) - 1 - (let ((zrq (* zr zr)) - (ziq (* zi zi))) - (cond - ((> (+ zrq ziq) +limit-sqr+) 0) - (else (loop (add1 i) - (+ (- zrq ziq) cr) - (+ (* 2.0 zr zi) ci))))))))) +(define-syntax-rule (mandelbrot Cr Ci) + (let loop ([i 0] [Zr 0.0] [Zi 0.0]) + (cond [(> (+ (* Zr Zr) (* Zi Zi)) LIMIT-SQR) 0] + [(= i ITERATIONS) 1] + [else (let-n 5 ([Zr (+ (- (* Zr Zr) (* Zi Zi)) Cr)] + [Zi (+ (* 2.0 (* Zr Zi)) Ci)]) + (loop (+ i 5) Zr Zi))]))) -;; ------------------------------- - -(define (main n) - (let ((out (current-output-port))) - - (fprintf out "P4\n~a ~a\n" n n) - - (let loop-y ((y 0)) - - (when (< y n) - - (let ([ci (- (/ (* 2.0 y) n) 1.0)]) - - (let loop-x ((x 0) (bitnum 0) (byteacc 0)) - - (if (< x n) - (let ([bitnum (add1 bitnum)] - [byteacc (+ (arithmetic-shift byteacc 1) - (mandelbrot +iterations+ x y n ci))]) - - (cond - ((= bitnum 8) - (write-byte byteacc out) - (loop-x (add1 x) 0 0)) - - [else (loop-x (add1 x) bitnum byteacc)])) - - (begin - (when (positive? bitnum) - (write-byte (arithmetic-shift byteacc - (- 8 (bitwise-and n #x7))) - out)) - - (loop-y (add1 y)))))))))) - -;; ------------------------------- - -(command-line #:args (n) - (main (string->number n))) +(fprintf O "P4\n~a ~a\n" N N) +(let loop-y ([y N]) + (let ([Ci (- (* 2/N y) 1.0)]) + (let loop-x ([x 0] [bitnum 0] [byteacc 0]) + (if (< x N) + (let* ([Cr (vector-ref Crs x)] + [bitnum (+ bitnum 1)] + [byteacc (+ (arithmetic-shift byteacc 1) (mandelbrot Cr Ci))]) + (cond [(= bitnum 8) + (write-byte byteacc O) + (loop-x (+ x 1) 0 0)] + [else (loop-x (+ x 1) bitnum byteacc)])) + (begin (when (> bitnum 0) + (write-byte (arithmetic-shift byteacc (- 8 (bitwise-and N #x7))) O)) + (when (> y 1) (loop-y (- y 1)))))))) diff --git a/collects/tests/racket/benchmarks/shootout/typed/mandelbrot-generic.rktl b/collects/tests/racket/benchmarks/shootout/typed/mandelbrot-generic.rktl index e85da37d2a..351cbae2e9 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/mandelbrot-generic.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/mandelbrot-generic.rktl @@ -1,80 +1,48 @@ ;; The Computer Language Benchmarks Game ;; http://shootout.alioth.debian.org/ -;; -;; Derived from the Chicken variant, which was -;; Contributed by Anthony Borla -;; The version that uses complex number is a little -;; more elegant, but much slower: -;; (define (mandelbrot iterations x y n ci) -;; (let ((c (+ (- (/ (* 2.0 x) n) 1.5) -;; (* ci 0.0+1.0i)))) -;; (let loop ((i 0) (z 0.0+0.0i)) -;; (cond -;; [(> i iterations) 1] -;; [(> (magnitude z) 2.0) 0] -;; [else (loop (add1 i) (+ (* z z) c))])))) - +(require (for-syntax racket/base)) (require racket/cmdline) -(define +limit-sqr+ 4.0) +(define O (current-output-port)) -(define +iterations+ 50) +(define LIMIT-SQR 4.0) +(define ITERATIONS 50) +(define N (command-line #:args (n) (assert (string->number (assert n string?)) exact-integer?))) +(define N.0 (exact->inexact N)) +(define 2/N (/ 2.0 N.0)) +(define Crs + (let ([v (make-vector N 0.0)]) + (for ([x (in-range N)]) + (vector-set! v x (- (/ (* 2 x) N.0) 1.5))) + v)) -;; ------------------------------- +(define-syntax (let-n stx) + (syntax-case stx () + [(_ N bindings E) + (let loop ([N (syntax-e #'N)] [E #'E]) + (if (zero? N) E (loop (sub1 N) #`(let bindings #,E))))])) -(: mandelbrot (Integer Integer Integer Integer Float -> (U 0 1))) -(define (mandelbrot iterations x y n ci) - (let ((cr (- (/ (* 2.0 x) n) 1.5))) - (let loop ((i 0) (zr 0.0) (zi 0.0)) - (if (> i iterations) - 1 - (let ((zrq (* zr zr)) - (ziq (* zi zi))) - (cond - ((> (+ zrq ziq) +limit-sqr+) 0) - (else (loop (add1 i) - (+ (- zrq ziq) cr) - (+ (* 2.0 zr zi) ci))))))))) +(define-syntax-rule (mandelbrot Cr Ci) + (let: loop : Integer ([i : Integer 0] [Zr : Float 0.0] [Zi : Float 0.0]) + (cond [(> (+ (* Zr Zr) (* Zi Zi)) LIMIT-SQR) 0] + [(= i ITERATIONS) 1] + [else (let-n 5 ([Zr (+ (- (* Zr Zr) (* Zi Zi)) Cr)] + [Zi (+ (* 2.0 (* Zr Zi)) Ci)]) + (loop (+ i 5) Zr Zi))]))) -;; ------------------------------- - -(: main (Integer -> Void)) -(define (main n) - (let ((out (current-output-port))) - - (fprintf out "P4\n~a ~a\n" n n) - - (let loop-y ((y 0)) - - (when (< y n) - - (let ([ci (- (/ (* 2.0 y) n) 1.0)]) - - (let: loop-x : Void - ((x : Integer 0) (bitnum : Integer 0) (byteacc : Integer 0)) - - (if (< x n) - (let ([bitnum (add1 bitnum)] - [byteacc (+ (arithmetic-shift byteacc 1) - (mandelbrot +iterations+ x y n ci))]) - - (cond - ((= bitnum 8) - (write-byte byteacc out) - (loop-x (add1 x) 0 0)) - - [else (loop-x (add1 x) bitnum byteacc)])) - - (begin - (when (positive? bitnum) - (write-byte (arithmetic-shift byteacc - (- 8 (bitwise-and n #x7))) - out)) - - (loop-y (add1 y)))))))))) - -;; ------------------------------- - -(command-line #:args (n) - (main (assert (string->number (assert n string?)) exact-integer?))) +(fprintf O "P4\n~a ~a\n" N N) +(let: loop-y : Void ([y : Integer N]) + (let ([Ci (- (* 2/N y) 1.0)]) + (let: loop-x : Void ([x : Integer 0] [bitnum : Integer 0] [byteacc : Integer 0]) + (if (< x N) + (let* ([Cr (vector-ref Crs x)] + [bitnum (+ bitnum 1)] + [byteacc (+ (arithmetic-shift byteacc 1) (mandelbrot Cr Ci))]) + (cond [(= bitnum 8) + (write-byte byteacc O) + (loop-x (+ x 1) 0 0)] + [else (loop-x (+ x 1) bitnum byteacc)])) + (begin (when (> bitnum 0) + (write-byte (arithmetic-shift byteacc (- 8 (bitwise-and N #x7))) O)) + (when (> y 1) (loop-y (- y 1)))))))) diff --git a/collects/tests/racket/benchmarks/shootout/typed/mandelbrot.rktl b/collects/tests/racket/benchmarks/shootout/typed/mandelbrot.rktl index f933062902..72cb8bdae2 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/mandelbrot.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/mandelbrot.rktl @@ -1,68 +1,54 @@ ;; The Computer Language Benchmarks Game ;; http://shootout.alioth.debian.org/ -;; -;; Derived from the Chicken variant, which was -;; Contributed by Anthony Borla - -(require racket/cmdline - racket/flonum) -(define +limit-sqr+ 4.0) +(require racket/require racket/require-syntax (for-syntax racket/base)) +(define-require-syntax overriding-in + (syntax-rules () [(_ R1 R2) (combine-in R2 (subtract-in R1 R2))])) +(require (overriding-in + racket/flonum + (filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name "")) + racket/unsafe/ops)) + racket/cmdline) -(define +iterations+ 50) +(define O (current-output-port)) -;; ------------------------------- +(define LIMIT-SQR 4.0) +(define ITERATIONS 50) +(define N (command-line #:args (n) (assert (string->number (assert n string?)) exact-integer?))) +(define N.0 (fx->fl N)) +(define 2/N (fl/ 2.0 N.0)) +(define Crs + (let ([v (make-flvector N)]) + (for ([x (in-range N)]) + (flvector-set! v x (fl- (fl/ (fx->fl (fx* 2 x)) N.0) 1.5))) + v)) -(: mandelbrot (Integer Integer Integer Float -> (U 1 0))) -(define (mandelbrot x y n ci) - (let ((cr (fl- (fl/ (fl* 2.0 (->fl x)) (->fl n)) 1.5))) - (let loop ((i 0) (zr 0.0) (zi 0.0)) - (if (> i +iterations+) - 1 - (cond - ((fl> (fl+ (fl* zr zr) (fl* zi zi)) +limit-sqr+) 0) - (else (loop (+ 1 i) - (fl+ (fl- (fl* zr zr) (fl* zi zi)) cr) - (fl+ (fl* 2.0 (fl* zr zi)) ci)))))))) +(define-syntax (let-n stx) + (syntax-case stx () + [(_ N bindings E) + (let loop ([N (syntax-e #'N)] [E #'E]) + (if (zero? N) E (loop (sub1 N) #`(let bindings #,E))))])) -;; ------------------------------- +(define-syntax-rule (mandelbrot Cr Ci) + (let: loop : Integer ([i : Integer 0] [Zr : Float 0.0] [Zi : Float 0.0]) + (cond [(fl> (fl+ (fl* Zr Zr) (fl* Zi Zi)) LIMIT-SQR) 0] + [(fx= i ITERATIONS) 1] + [else (let-n 5 ([Zr (fl+ (fl- (fl* Zr Zr) (fl* Zi Zi)) Cr)] + [Zi (fl+ (fl* 2.0 (fl* Zr Zi)) Ci)]) + (loop (fx+ i 5) Zr Zi))]))) -(: main (Integer -> Void)) -(define (main n) - (let ((out (current-output-port))) - - (fprintf out "P4\n~a ~a\n" n n) - - (let loop-y ((y 0)) - - (when (< y n) - - (let ([ci (fl- (fl/ (fl* 2.0 (->fl y)) (->fl n)) 1.0)]) - - (let: loop-x : Void - ((x : Natural 0) (bitnum : Natural 0) (byteacc : Natural 0)) - - (if (< x n) - (let: ([bitnum : Natural (+ 1 bitnum)] - [byteacc : Natural (+ (arithmetic-shift byteacc 1) - (mandelbrot x y n ci))]) - - (cond - ((= bitnum 8) - (write-byte byteacc out) - (loop-x (+ 1 x) 0 0)) - - [else (loop-x (+ 1 x) bitnum byteacc)])) - - (begin - (when (positive? bitnum) - (write-byte (arithmetic-shift byteacc - (- 8 (bitwise-and n #x7))) - out)) - - (loop-y (add1 y)))))))))) - -;; ------------------------------- - -(command-line #:args (n) - (main (assert (string->number (assert n string?)) exact-integer?))) +(fprintf O "P4\n~a ~a\n" N N) +(let: loop-y : Void ([y : Integer N]) + (let ([Ci (fl- (fl* 2/N (fx->fl y)) 1.0)]) + (let: loop-x : Void ([x : Integer 0] [bitnum : Integer 0] [byteacc : Integer 0]) + (if (fx< x N) + (let* ([Cr (flvector-ref Crs x)] + [bitnum (fx+ bitnum 1)] + [byteacc (fx+ (fxlshift byteacc 1) (mandelbrot Cr Ci))]) + (cond [(fx= bitnum 8) + (write-byte byteacc O) + (loop-x (fx+ x 1) 0 0)] + [else (loop-x (fx+ x 1) bitnum byteacc)])) + (begin (when (fx> bitnum 0) + (write-byte (fxlshift byteacc (fx- 8 (fxand N #x7))) O)) + (when (fx> y 1) (loop-y (fx- y 1))))))))