rackety shootout benchmarks

collects/tests/racket/benchmarks/shootout/binarytrees.rkt

@@ -1,22 +1,26 @@
+#lang racket/base
+
 ;;; The Great Computer Language Shootout
 ;;; http://shootout.alioth.debian.org/
 ;;; Derived from the Chicken variant by Sven Hartrumpf
-#lang scheme/base
-(require scheme/cmdline)
 
-(define-struct node (left val right))
+(require racket/cmdline)
+
+(struct node (left val right))
 
 ;; Instead of (define-struct leaf (val)):
-(define (make-leaf val) (make-node #f val #f))
+(define (leaf val) (node #f val #f))
 (define (leaf? l) (not (node-left l)))
 (define (leaf-val l) (node-val l))
 
 (define (make item d)
   (if (= d 0)
-      (make-leaf item)
+      (leaf item)
       (let ((item2 (* item 2))
             (d2 (- d 1)))
-        (make-node (make (- item2 1) d2) item (make item2 d2)))))
+        (node (make (- item2 1) d2) 
+              item 
+              (make item2 d2)))))
 
 (define (check t)
   (if (leaf? t)

collects/tests/racket/benchmarks/shootout/chameneos.rkt

@@ -1,11 +1,12 @@
+#lang racket/base
+
 ;;; The Great Computer Language Shootout
 ;;; http://shootout.alioth.debian.org/
 ;;;
-;;; Uses PLT Scheme threads
+;;; Uses Racket threads
 
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline
+         racket/match)
-         scheme/match)
 
 (define (change c1 c2)
   (case c1
@@ -96,5 +97,3 @@
   (go n '(blue red yellow))
   (go n '(blue red yellow red yellow blue red yellow red blue))
   (newline))
-
-  

collects/tests/racket/benchmarks/shootout/fannkuch.rkt

@@ -1,11 +1,12 @@
+#lang racket/base
+
 ;; fannkuch benchmark for The Computer Language Shootout
 ;; Written by Dima Dorfman, 2004
 ;; Slightly improved by Sven Hartrumpf, 2005-2006
 ;; Ever-so-slightly tweaked for MzScheme by Brent Fulgham
 ;; PLT-ized for v4.0 by Matthew
 
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline)
 
 (define (fannkuch n)
   (let ([pi (list->vector 

collects/tests/racket/benchmarks/shootout/fasta.rkt

@@ -1,3 +1,5 @@
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -6,8 +8,7 @@
 ;; Derived from the Chicken variant, which was
 ;; Contributed by Anthony Borla
 
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline)
 
 (define +alu+
   (bytes-append
@@ -40,7 +41,7 @@
   (let* ((ia 3877) (ic 29573) (im 139968) (last seed))
     (lambda (max)
       (set! last (modulo (+ ic (* last ia)) im))
-      (/ (* max last) im) )))
+      (/ (* max last) im))))
 
 ;; -------------------------------
 

collects/tests/racket/benchmarks/shootout/k-nucleotide.rkt

@@ -1,8 +1,8 @@
+#lang racket/base
+
 ;;   The Computer Language Shootout
 ;;   http://shootout.alioth.debian.org/
 
-#lang scheme/base
-
 (define (all-counts len dna)
   (let ([table (make-hasheq)]
         [seq (make-string len)])
@@ -16,12 +16,10 @@
 (define (write-freqs table)
   (let* ([content (hash-map table cons)]
          [total (exact->inexact (apply + (map cdr content)))])
-    (for-each
+    (for ([a (sort content > #:key cdr)])
-     (lambda (a)
       (printf "~a ~a\n" 
               (car a) 
-               (real->decimal-string (* 100 (/ (cdr a) total)) 3)))
+              (real->decimal-string (* 100 (/ (cdr a) total)) 3)))))
-     (sort content (lambda (a b) (> (cdr a) (cdr b)))))))
 
 (define (write-one-freq table key)
   (let ([cnt (hash-ref table key 0)])
@@ -33,9 +31,8 @@
     (regexp-match #rx#"(?m:^>THREE.*$)" in)
     (let ([s (open-output-string)])
       ;; Copy everything but newlines to s:
-      (let loop ()
+      (for ([l (in-bytes-lines in)])
-        (when (regexp-match #rx#"\n" in 0 #f s)
+        (write-bytes l s))
-          (loop)))
       ;; Extract the string from s:
       (string-upcase (get-output-string s)))))
 
@@ -48,8 +45,6 @@
 (newline)
 
 ;; Specific sequences:
-(for-each (lambda (seq)
+(for ([seq '("GGT" "GGTA" "GGTATT" "GGTATTTTAATT" "GGTATTTTAATTTATAGT")]) 
   (write-one-freq (all-counts (string-length seq) dna)
                   (string->symbol seq)))
-          '("GGT" "GGTA" "GGTATT" "GGTATTTTAATT" "GGTATTTTAATTTATAGT"))
-

collects/tests/racket/benchmarks/shootout/mandelbrot-generic.rkt

@@ -1,4 +1,5 @@
-;; ---------------------------------------------------------------------
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -16,8 +17,7 @@
 ;;	 [(> (magnitude z) 2.0) 0]
 ;;	 [else (loop (add1 i) (+ (* z z) c))]))))
  
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline)
 
 (define +limit-sqr+ 4.0)
 

collects/tests/racket/benchmarks/shootout/mandelbrot-unsafe.rkt

@@ -1,4 +1,5 @@
-;; ---------------------------------------------------------------------
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -7,12 +8,11 @@
 ;;
 ;; This version uses unsafe operations
 
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline
+	 racket/require (for-syntax racket/base)
-	 scheme/require (for-syntax scheme/base)
 	 (filtered-in
 	  (lambda (name) (regexp-replace #rx"unsafe-" name ""))
-	  scheme/unsafe/ops))
+	  racket/unsafe/ops))
 
 (define +limit-sqr+ 4.0)
 

collects/tests/racket/benchmarks/shootout/mandelbrot.rkt

@@ -1,13 +1,13 @@
-;; ---------------------------------------------------------------------
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 ;;
 ;; Derived from the Chicken variant, which was
 ;; Contributed by Anthony Borla
  
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline
+         racket/flonum)
-         scheme/flonum)
 
 (define +limit-sqr+ 4.0)
 

collects/tests/racket/benchmarks/shootout/meteor.rkt

@@ -1,3 +1,5 @@
+#lang racket/base
+
 ;; The Computer Language Benchmarks Game
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -7,8 +9,7 @@
 ;;   contributed by Matthew Flatt
 ;;   optimized by Eli Barzilay
 
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline scheme/list)
 
 (define width 5)
 (define height 10)

collects/tests/racket/benchmarks/shootout/nbody-generic.rkt

@@ -1,4 +1,5 @@
-#!/usr/bin/mzscheme -qu
+#lang racket/base
+
 ;; The Computer Language Benchmarks Game
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -6,7 +7,7 @@
 ;; Patrick Frankenberger and Juho Snellman, but using only native Scheme
 ;; idioms like 'named let' and 'do' special form.
 ;;
-;; Contributed by Anthony Borla, then converted for mzscheme
+;; Contributed by Anthony Borla, then converted for Racket
 ;; by Matthew Flatt and Brent Fulgham
 
 #|
@@ -16,8 +17,7 @@ Correct output N = 1000 is
 -0.169087605
 |#
 
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline)
 
 ;; ------------------------------
 ;; define planetary masses, initial positions & velocity

collects/tests/racket/benchmarks/shootout/nbody-vec-generic.rkt

@@ -1,4 +1,5 @@
-#!/usr/bin/mzscheme -qu
+#lang racket/base
+
 ;; The Computer Language Benchmarks Game
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -6,7 +7,7 @@
 ;; Patrick Frankenberger and Juho Snellman, but using only native Scheme
 ;; idioms like 'named let' and 'do' special form.
 ;;
-;; Contributed by Anthony Borla, then converted for mzscheme
+;; Contributed by Anthony Borla, then converted for Racket
 ;; by Matthew Flatt and Brent Fulgham
 
 #|
@@ -16,8 +17,7 @@ Correct output N = 1000 is
 -0.169087605
 |#
 
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline)
 
 ;; ------------------------------
 ;; define planetary masses, initial positions & velocity

collects/tests/racket/benchmarks/shootout/nbody-vec-unsafe.rkt

@@ -1,4 +1,5 @@
-#!/usr/bin/mzscheme -qu
+#lang racket/base
+
 ;; The Computer Language Benchmarks Game
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -6,7 +7,7 @@
 ;; Patrick Frankenberger and Juho Snellman, but using only native Scheme
 ;; idioms like 'named let' and 'do' special form.
 ;;
-;; Contributed by Anthony Borla, then converted for mzscheme
+;; Contributed by Anthony Borla, then converted for Racket
 ;; by Matthew Flatt and Brent Fulgham
 ;; Made unsafe and optimized by Sam TH
 #|
@@ -16,15 +17,14 @@ Correct output N = 1000 is
 -0.169087605
 |#
 
-#lang scheme/base
+(require racket/cmdline racket/require 
-(require scheme/cmdline scheme/require 
+         (only-in racket/flonum flvector)
-         (only-in scheme/flonum flvector)
+	 (for-syntax racket/base)
-	 (for-syntax scheme/base)
 	 (filtered-in
 	  (lambda (name)
 	    (regexp-replace
 	     #rx"unsafe-fl" name "fl"))
-	  scheme/unsafe/ops))
+	  racket/unsafe/ops))
 
 ;; ------------------------------
 ;; define planetary masses, initial positions & velocity

collects/tests/racket/benchmarks/shootout/nbody-vec.rkt

@@ -1,4 +1,5 @@
-#!/usr/bin/mzscheme -qu
+#lang racket/base
+
 ;; The Computer Language Benchmarks Game
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -6,7 +7,7 @@
 ;; Patrick Frankenberger and Juho Snellman, but using only native Scheme
 ;; idioms like 'named let' and 'do' special form.
 ;;
-;; Contributed by Anthony Borla, then converted for mzscheme
+;; Contributed by Anthony Borla, then converted for Racket
 ;; by Matthew Flatt and Brent Fulgham
 
 #|
@@ -16,9 +17,8 @@ Correct output N = 1000 is
 -0.169087605
 |#
 
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline
+         racket/flonum)
-         scheme/flonum)
 
 ;; ------------------------------
 ;; define planetary masses, initial positions & velocity

collects/tests/racket/benchmarks/shootout/nbody.rkt

@@ -1,4 +1,5 @@
-#!/usr/bin/mzscheme -qu
+#lang racket/base
+
 ;; The Computer Language Benchmarks Game
 ;; http://shootout.alioth.debian.org/
 ;;
@@ -6,7 +7,7 @@
 ;; Patrick Frankenberger and Juho Snellman, but using only native Scheme
 ;; idioms like 'named let' and 'do' special form.
 ;;
-;; Contributed by Anthony Borla, then converted for mzscheme
+;; Contributed by Anthony Borla, then converted for Racket
 ;; by Matthew Flatt and Brent Fulgham
 
 #|
@@ -16,9 +17,8 @@ Correct output N = 1000 is
 -0.169087605
 |#
 
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline
+         racket/flonum)
-         scheme/flonum)
 
 ;; ------------------------------
 ;; define planetary masses, initial positions & velocity

collects/tests/racket/benchmarks/shootout/pidigits-gmp.rkt

@@ -1,12 +1,13 @@
+#lang racket/base
+
 ;; The Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 ;; Based on the Perl version of the benchmark
 ;; adapted with a GMP interface by Eli Barzilay
 
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline)
+         (for-syntax racket/base)
-(require (for-syntax scheme/base))
+         ffi/unsafe)
-(require scheme/foreign) (unsafe!)
 
 ;; quick libgmp interface, limited to what we need below
 (define libgmp (ffi-lib "libgmp"))

collects/tests/racket/benchmarks/shootout/pidigits.rkt

@@ -1,10 +1,11 @@
+#lang racket/base
+
 ;; The Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 ;; Based on the MLton version of the benchmark
 ;; contributed by Scott Cruzen
 
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline)
 
 (define (floor_ev q r s t x)
   (quotient (+ (* q x) r) (+ (* s x) t)))

collects/tests/racket/benchmarks/shootout/pidigits1.rkt

@@ -1,4 +1,5 @@
-#!/usr/bin/mzscheme -r
+#lang racket/base
+
 ; The Computer Language Shootout
 ; http://shootout.alioth.debian.org/
 ; Sven Hartrumpf 2005-04-12
@@ -6,9 +7,7 @@
 ; This program is based on an implementation for SCM by Aubrey Jaffer and
 ; Jerry D. Hedden.
 
-(module pidigits1 mzscheme
+(define (pi n d)
-  
-  (define (pi n d)
   (let* ((r (inexact->exact (floor (exp (* d (log 10)))))) ; 10^d
          (p (+ (quotient n d) 1))
          (m (quotient (* p d 3322) 1000))
@@ -36,7 +35,7 @@
                       (vector-set! a k rr)
                       (loop (sub1 k) (* k qt)))))))))))
 
-  (define (print-digits out s start end digits n)
+(define (print-digits out s start end digits n)
   (let* ([len (- end start)]
          [cnt (min len (- n digits) (- 10 (modulo digits 10)) len)])
     (if (zero? cnt)
@@ -48,10 +47,10 @@
               (fprintf out "\t:~a\n" digits))
             (print-digits out s (+ start cnt) end digits n))))))
 
-  (define (main args)
+(define (main args)
   (let ((n (if (= (vector-length args) 0)
                1
                (string->number (vector-ref args 0)))))
     (pi n 10)))
 
-  (main (current-command-line-arguments)))
+(main (current-command-line-arguments))

collects/tests/racket/benchmarks/shootout/regexpdna.rkt

@@ -1,17 +1,11 @@
-;; ---------------------------------------------------------------------
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 ;;
-;; Tested with PCRE [compiler must be built with PCRE already installed
+;; Based on a version by by Anthony Borla
-;; else other regex routines (with different behaviours) will be used].
-;; Regex performance appears reasonable, but file loading [of 'large'
-;; files] performance requires tweaking to effect a significant improvement.
-;;
-;; Contributed by Anthony Borla
-;; ---------------------------------------------------------------------
 
-#lang scheme/base
+(require racket/port)
-(require scheme/port)
 
 ;; -------------------------------
 
@@ -40,49 +34,22 @@
         (match-count str rx (cdar m) (add1 cnt))
         cnt)))
 
-;; --------------
-
-(define (replace-all rx str new)
-  (let ([out (open-output-bytes)])
-    (let loop ([pos 0])
-      (let ([m (regexp-match-positions rx str pos)])
-        (if m
-            (begin
-              (write-bytes str out pos (caar m))
-              (write-bytes new out)
-              (loop (cdar m)))
-            (write-bytes str out pos))))
-    (get-output-bytes out)))
-
-;; -------------------------------
-
-(define (input->bytes)
-  (let ([b (open-output-bytes)])
-    (copy-port (current-input-port) b)
-    (get-output-bytes b)))
-
 ;; -------------------------------
 
 ;; Load sequence and record its length
-(let* ([orig (input->bytes)]
+(let* ([orig (port->bytes)]
-       [filtered (replace-all #rx#"(>.*?\n)|\n" orig #"")])
+       [filtered (regexp-replace* #rx#"(?:>.*?\n)|\n" orig #"")])
 
   ;; Perform regexp counts
-  (for-each
+  (for ([i (in-list VARIANTS)])
-   (lambda (i)
     (printf "~a ~a\n" i (match-count filtered (ci-byte-regexp i) 0 0)))
-   VARIANTS)
 
   ;; Perform regexp replacements, and record sequence length
   (let ([replaced
-         (let loop ([sequence filtered]
+         (for/fold ([sequence filtered]) ([IUB IUBS])
-                    [IUBS IUBS])
+           (regexp-replace* (byte-regexp (car IUB)) sequence (cadr IUB)))])
-           (if (null? IUBS)
-               sequence
-               (loop (replace-all (byte-regexp (caar IUBS)) sequence (cadar IUBS))
-                     (cdr IUBS))))])
     ;; Print statistics
-    (printf "~%~A~%~A~%~A~%" 
+    (printf "\n~a\n~a\n~a\n" 
             (bytes-length orig)
             (bytes-length filtered)
             (bytes-length replaced))))

collects/tests/racket/benchmarks/shootout/reversecomplement.rkt

@@ -1,17 +1,13 @@
+#lang racket/base
+
+;; The Computer Language Benchmarks Game
+;; http://shootout.alioth.debian.org/
 
-#lang scheme/base
 (require scheme/cmdline)
 
 (define translation (make-vector 128))
 
-(for-each (lambda (from-to)
+(for ([from-to '([a t]
-            (let ([char (lambda (sym)
-                          (string-ref (symbol->string sym) 0))])
-              (let ([from (char (car from-to))]
-                    [to (char->integer (char-upcase (char (cadr from-to))))])
-                (vector-set! translation (char->integer from) to)
-                (vector-set! translation (char->integer (char-upcase from)) to))))
-          '([a t]
                  [c g]
                  [g c]
                  [t a]
@@ -26,7 +22,13 @@
                  [h d]
                  [d h]
                  [b v]
-            [n n]))
+                 [n n])])
+  (let ([char (lambda (sym)
+                (string-ref (symbol->string sym) 0))])
+    (let ([from (char (car from-to))]
+          [to (char->integer (char-upcase (char (cadr from-to))))])
+      (vector-set! translation (char->integer from) to)
+      (vector-set! translation (char->integer (char-upcase from)) to))))
 
 (define (output lines)
   (let* ([str (apply bytes-append lines)]

collects/tests/racket/benchmarks/shootout/spectralnorm-generic.rkt

@@ -1,11 +1,12 @@
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 
 ;; Translated directly from the C# version, which was:
 ;;   contributed by Isaac Gouy
 
-#lang scheme/base
+(require racket/cmdline)
-(require scheme/cmdline)
 
 (define (Approximate n)
   (let ([u (make-vector n 1.0)]

collects/tests/racket/benchmarks/shootout/spectralnorm-unsafe.rkt

@@ -1,18 +1,19 @@
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 
 ;; Translated directly from the C# version, which was:
 ;;   contributed by Isaac Gouy
 
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline
+	 racket/require (for-syntax racket/base)
-	 scheme/require (for-syntax scheme/base)
 	 (rename-in
           (filtered-in
            (lambda (name) (regexp-replace #rx"unsafe-" name ""))
-           scheme/unsafe/ops)
+           racket/unsafe/ops)
           [fx->fl ->fl])
-         (only-in scheme/flonum make-flvector))
+         (only-in racket/flonum make-flvector))
 
 
 (define (Approximate n)

collects/tests/racket/benchmarks/shootout/spectralnorm.rkt

@@ -1,12 +1,13 @@
+#lang racket/base
+
 ;; The Great Computer Language Shootout
 ;; http://shootout.alioth.debian.org/
 
 ;; Translated directly from the C# version, which was:
 ;;   contributed by Isaac Gouy
 
-#lang scheme/base
+(require racket/cmdline
-(require scheme/cmdline
+         racket/flonum)
-         scheme/flonum)
 
 (define (Approximate n)
   (let ([u (make-flvector n 1.0)]

collects/tests/racket/benchmarks/shootout/thread-ring.rkt

@@ -1,7 +1,11 @@
-;; Uses PLT Scheme threads
+#lang racket/base
 
-#lang scheme/base
+;; The Great Computer Language Shootout
-(require scheme/cmdline)
+;; http://shootout.alioth.debian.org/
+;;
+;; Uses Racket threads
+
+(require racket/cmdline)
 
 ;; Each thread runs this loop:
 (define (run id next)