some simplifications

svn: r4686

collects/tests/mzscheme/benchmarks/shootout/heapsort.ss

@@ -6,7 +6,8 @@
 ;; Updated by Brent Fulgham to provide proper output formatting
 
 (module heapsort mzscheme
-  (require (only (lib "13.ss" "srfi") string-index string-pad-right))
+  (require (only (lib "13.ss" "srfi") string-index string-pad-right)
+           (only (lib "string.ss") real->decimal-string))
 
   (define IM   139968)
   (define IA     3877)
@@ -50,15 +51,6 @@
 		   (set! j (+ ir 1)))))
 	  (vector-set! ra i rra)))))
 
-  (define (roundto digits num)
-    (let* ([e (expt 10 digits)]
-	   [num (round (* e (inexact->exact num)))])
-      (format "~a.~a"
-	      (quotient num e)
-	      (substring (string-append (number->string (remainder num e))
-					(make-string digits #\0))
-			 0 digits))))
-
   (define (main args)
     (let* ((n (or (and (= (vector-length args) 1) (string->number (vector-ref args 0)))
 		  1))
@@ -69,6 +61,6 @@
 	(vector-set! ary i (gen_random 1.0)))
       (heapsort n ary)
       (printf "~a~n"
-	      (roundto 10 (vector-ref ary n)))))
+	      (real->decimal-string (vector-ref ary n) 10))))
 
   (main (current-command-line-arguments)))

collects/tests/mzscheme/benchmarks/shootout/moments.ss

@@ -1,17 +1,10 @@
 ; Moments.scm
 
 (module moments mzscheme
-  (require (only (lib "list.ss") sort))
+  (require (only (lib "list.ss") sort)
+           (only (lib "string.ss") real->decimal-string))
 
-  (define (roundto digits n)
+  (define (to-str n) (real->decimal-string n 6))
-    (let* ([e (expt 10 digits)]
-	   [num (round (abs (* e (inexact->exact n))))])
-      (format "~a~a.~a"
-	      (if (negative? n) "-" "")
-	      (quotient num e)
-	      (substring (string-append (number->string (remainder num e))
-					(make-string digits #\0))
-			 0 digits))))
 
   (let* ((sum 0.0)
 	 (numlist (let loop ((line (read-line)) (numlist '()))
@@ -63,10 +56,10 @@
 
 	(for-each display
 		  `("n:                  " ,n                   "\n"
-		    "median:             " ,(roundto 6 median)  "\n"
+		    "median:             " ,(to-str median)  "\n"
-		    "mean:               " ,(roundto 6 mean)    "\n"
+		    "mean:               " ,(to-str mean)    "\n"
-		    "average_deviation:  " ,(roundto 6 average_deviation ) "\n"
+		    "average_deviation:  " ,(to-str average_deviation ) "\n"
-		    "standard_deviation: " ,(roundto 6 standard_deviation) "\n"
+		    "standard_deviation: " ,(to-str standard_deviation) "\n"
-		    "variance:           " ,(roundto 6 variance)"\n"
+		    "variance:           " ,(to-str variance)"\n"
-		    "skew:               " ,(roundto 6 skew)    "\n"
+		    "skew:               " ,(to-str skew)    "\n"
-		    "kurtosis:           " ,(roundto 6 kurtosis)"\n" ))))))
+		    "kurtosis:           " ,(to-str kurtosis)"\n" ))))))

collects/tests/mzscheme/benchmarks/shootout/nbody.ss

@@ -16,18 +16,7 @@ Correct output N = 1000 is
 -0.169087605
 |#
 (module nbody mzscheme
-  (provide main)
+  (require (only (lib "string.ss") real->decimal-string))
-
-  ;;; Stupid boiler-plate for formatting floating point value
-  (define (roundto digits n)
-    (let* ([e (expt 10 digits)]
-	   [num (round (abs (* e (inexact->exact n))))])
-      (format "~a~a.~a" 
-	      (if (negative? n) "-" "")
-	      (quotient num e) 
-	      (substring (string-append (number->string (remainder num e))
-					(make-string digits #\0))
-			 0 digits))))
 
   ;; ------------------------------
   ;; define planetary masses, initial positions & velocity
@@ -147,20 +136,16 @@ Correct output N = 1000 is
 	  (loop-o (cdr o))))))
 
   ;; -------------------------------
-  (define (main args)
+  
-    (let ((n (if (null? args)
+  (let ((n (string->number (vector-ref (current-command-line-arguments) 0)))
-		 1
+        (system (list *sun* *jupiter* *saturn* *uranus* *neptune*)))
-		 (string->number (car args))))
+    
-	  (system (list *sun* *jupiter* *saturn* *uranus* *neptune*)))
+    (offset-momentum system)
+    
+    (printf "~a~%" (real->decimal-string (energy system) 9))
+    
+    (do ((i 1 (+ i 1)))
+        ((< n i))
+      (advance system 0.01))
 
-      (offset-momentum system)
+      (printf "~a~%" (real->decimal-string (energy system) 9))))
-
-      (printf "~a~%" (roundto 9 (energy system)))
-
-      (do ((i 1 (+ i 1)))
-	  ((< n i))
-	(advance system 0.01))
-
-      (printf "~a~%" (roundto 9 (energy system)))))
-
-  (main (vector->list (current-command-line-arguments))))

collects/tests/mzscheme/benchmarks/shootout/partialsums.ss

@@ -12,17 +12,8 @@
 ;;  its time GCing; it runs 1.5 times as fast in mzscheme3m.
 
 (module partialsums mzscheme
+  (require (only (lib "string.ss") real->decimal-string))
 
-  (define (roundto digits n)
-    (let* ([e (expt 10 digits)]
-	   [num (round (abs (* e (inexact->exact n))))])
-      (format "~a~a.~a" 
-	      (if (negative? n) "-" "")
-	      (quotient num e) 
-	      (substring (string-append (number->string (remainder num e))
-					(make-string digits #\0))
-			 0 digits))))
-  
   (let ((n (exact->inexact
 	    (string->number
 	     (vector-ref (current-command-line-arguments) 0))))
@@ -36,7 +27,7 @@
       (if (= d n #;(+ n 1))
 	  (let ([format-result
 		 (lambda (str n)
-		   (printf str (roundto 9 n)))])
+		   (printf str (real->decimal-string n 9)))])
 	    
 	    (format-result "~a\t(2/3)^k\n" s0)
 	    (format-result "~a\tk^-0.5\n" s1)

collects/tests/mzscheme/benchmarks/shootout/random.ss

@@ -4,7 +4,7 @@
 ;;; Modified for proper string output by Brent Fulgham
 
 (module random mzscheme
-  (provide main)
+  (require (only (lib "string.ss") real->decimal-string))
 
   (define IM 139968)
   (define IA   3877)
@@ -25,16 +25,13 @@
 					(make-string digits #\0))
 			 0 digits))))
 
-  (define (main args)
+  (let ((n (string->number 
-    (let ((n (if (= (vector-length args) 0)
+            (vector-ref (current-command-line-arguments)
-		 1
+                        0))))
-		 (string->number (vector-ref args 0)))))
+    (let loop ((iter n))
-      (let loop ((iter n))
+      (if (> iter 1)
-	(if (> iter 1)
+          (begin
-	    (begin
+            (gen_random 100.0)
-	      (gen_random 100.0)
+            (loop (- iter 1)))))
-	      (loop (- iter 1)))))
+    (printf "~a~%"
-      (printf "~a~%"
+            (real->decimal-string (gen_random 100.0) 9))))
-	      (roundto 9 (gen_random 100.0)))))
-
-  (main (current-command-line-arguments)))

collects/tests/mzscheme/benchmarks/shootout/recursive.ss

@@ -9,6 +9,7 @@
 ;; ---------------------------------------------------------------------
 
 (module recursive mzscheme
+  (require (only (lib "string.ss") real->decimal-string))
 
   ;; -------------------------------
 
@@ -39,26 +40,19 @@
 
   ;; -------------------------------
 
-  (define (roundto digits n)
-    (let* ([e (expt 10 digits)]
-	   [num (round (* e (inexact->exact n)))])
-      (format "~a.~a" 
-	      (quotient num e) 
-	      (substring (string-append (number->string (remainder num e))
-					(make-string digits #\0))
-			 0 digits))))
-
   (define (main args)
     (let ((n (string->number (vector-ref args 0))))
 
       (printf "Ack(3,~A): ~A~%" n (ack 3 n))
-      (printf "Fib(~a): ~a~%" (roundto 1 (+ 27.0 n)) (roundto 1 (fibflt (+ 27.0 n))))
+      (printf "Fib(~a): ~a~%" 
+              (real->decimal-string (+ 27.0 n) 1)
+              (real->decimal-string (fibflt (+ 27.0 n)) 1))
 
       (set! n (- n 1))
       (printf "Tak(~A,~A,~A): ~A~%" (* n 3) (* n 2) n (tak (* n 3) (* n 2) n))
 
       (printf "Fib(3): ~A~%" (fib 3))
-      (printf "Tak(3.0,2.0,1.0): ~a~%" (roundto 1 (takflt 3.0 2.0 1.0)))))
+      (printf "Tak(3.0,2.0,1.0): ~a~%" (real->decimal-string (takflt 3.0 2.0 1.0) 1))))
 
   ;; -------------------------------
 

collects/tests/mzscheme/benchmarks/shootout/regexpdna.ss

@@ -31,23 +31,7 @@
   ;; -------------------------------
 
   (define (ci-byte-regexp s)
-    (byte-regexp (ci-pattern s)))
+    (byte-regexp (bytes-append #"(?i:" s #")")))
-  (define (ci-pattern s)
-    (let ([m (regexp-match #rx#"^(.*)\\[([^]]*)\\](.*)$" s)])
-      (if m
-	  (bytes-append (ci-pattern (cadr m))
-			#"["
-			(regexp-replace* #rx#"[a-zA-Z]" (caddr m) both-cases)
-			#"]"
-			(ci-pattern (cadddr m)))
-	  (regexp-replace* #rx#"[a-zA-Z]" s (lambda (s)
-					      (string->bytes/latin-1
-					       (format "[~a]" (both-cases s))))))))  
-  (define (both-cases s)
-    (string->bytes/latin-1
-     (format "~a~a" 
-	     (string-downcase (bytes->string/latin-1 s))
-	     (string-upcase (bytes->string/latin-1 s)))))
 
   ;; -------------------------------
   

collects/tests/mzscheme/benchmarks/shootout/run.ss

@@ -17,7 +17,7 @@
       ("lists.ss" . "18")
       ("mandelbrot.ss")
       ("matrix.ss" . "600")
-      ("moments.ss" . "200")
+      ("moments.ss") 200 somethings...
       ("nbody.ss")
       ("nestedloop.ss" . "18")
       ("nsieve.ss")