From 99943314d2105e23936ced17ab487191831b1b1e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 19 Apr 2008 12:42:54 +0000
Subject: [PATCH] setup/unpack addition and docs

svn: r9370
---
 collects/scribble/search.ss                   |   7 +-
 .../scribblings/setup-plt/setup-plt.scrbl     | 183 ++++++++++---
 collects/setup/unpack.ss                      | 130 +++++++++-
 .../mzscheme/benchmarks/shootout/ackermann.ss |  21 +-
 .../benchmarks/shootout/binarytrees.ss        |  81 +++---
 .../mzscheme/benchmarks/shootout/chameneos.ss |  97 +++----
 .../benchmarks/shootout/cheapconcurrency.ss   |  43 ++--
 .../mzscheme/benchmarks/shootout/fannkuch.ss  | 131 +++++-----
 .../mzscheme/benchmarks/shootout/fasta.ss     | 201 +++++++--------
 .../mzscheme/benchmarks/shootout/nbody.ss     | 240 +++++++++---------
 .../mzscheme/benchmarks/shootout/pidigits.ss  |  68 +++--
 .../benchmarks/shootout/reversecomplement.ss  | 106 ++++----
 .../benchmarks/shootout/spectralnorm.ss       | 101 ++++----
 13 files changed, 808 insertions(+), 601 deletions(-)

diff --git a/collects/scribble/search.ss b/collects/scribble/search.ss
index 27f15767d0..7628b11e27 100644
--- a/collects/scribble/search.ss
+++ b/collects/scribble/search.ss
@@ -46,6 +46,11 @@
     ;; from (define-for-syntax x ...). This isn't a problem in practice,
     ;; because no one uses the same name for different-phase exported
     ;; bindings.
+    ;;
+    ;; However, we assume that bidings are defined as originating from some
+    ;; module at phase 0. Maybe it's defined at phase 1 and re-exported
+    ;; later for phase 0 (after a require-for-template), in which case the
+    ;; re-exporting module is the one we find.
     (let ([b (cond
               [(identifier? stx/binding)
                (identifier-binding stx/binding phase-level)]
@@ -90,7 +95,7 @@
                    [export-phase (list-ref (car queue) 4)]
                    [queue (cdr queue)])
                (let* ([rmp (module-path-index-resolve mod)]
-                      [eb (and (equal? defn-phase export-phase)
+                      [eb (and (equal? 0 export-phase) ;; look for the phase-0 export; good idea?
                                (list (let ([p (resolved-module-path-name rmp)])
                                        (if (path? p)
                                            (intern-taglet (path->main-collects-relative p))
diff --git a/collects/scribblings/setup-plt/setup-plt.scrbl b/collects/scribblings/setup-plt/setup-plt.scrbl
index 3526b283b7..6efe4add4b 100644
--- a/collects/scribblings/setup-plt/setup-plt.scrbl
+++ b/collects/scribblings/setup-plt/setup-plt.scrbl
@@ -15,6 +15,7 @@
                     setup/plt-installer-sig
                     setup/plt-installer-unit
                     setup/pack
+                    setup/unpack
                     compiler/compiler
                     launcher/launcher
                     compiler/sig
@@ -84,7 +85,7 @@ The @|setup-plt| executable performs two main services:
    should be a function like @scheme[compile]; see the
    @filepath{errortrace} collection for an example.}
 
- @item{@bold{Unpacking single @filepath{.plt} files:} A
+ @item{@bold{Unpacking @filepath{.plt} files:} A
    @filepath{.plt} file is a platform-independent distribution archive
    for software based on PLT Scheme. When one or more file names are
    provided as the command line arguments to @|setup-plt|, the files
@@ -325,37 +326,7 @@ Optional @filepath{info.ss} fields trigger additional actions by
 
 @section[#:tag "setup-plt-plt"]{Running @|setup-plt| from Scheme}
 
-@; ----------------------------------------
-
-@subsection{Installing a Single @filepath{.plt} File}
-
-@local-module[setup/plt-single-installer]{
-
-@defmodule[setup/plt-single-installer]{
-  The @schememodname{setup/plt-single-installer} module provides a function for
-  installing a single @filepath{.plt} file:}
-
-@defproc[(run-single-installer
-          (file path-string?)
-          (get-dir-proc (-> (or/c path-string? false/c)))) void?]{
-   Creates a separate thread and namespace, runs the installer in that
-   thread with the new namespace, and returns when the thread
-   completes or dies. It also creates a custodian
-   (see @secref[#:doc ref-src]{custodians}) to manage the
-   created thread, sets the exit handler for the thread to shut down
-   the custodian, and explicitly shuts down the custodian
-   when the created thread terminates or dies.
-
-   The @scheme[get-dir-proc] procedure is called if the installer needs a
-   target directory for installation, and a @scheme[#f] result means that
-   the user canceled the installation. Typically, @scheme[get-dir-proc] is
-   @scheme[current-directory].}}
-
-@; ----------------------------------------
-
-@subsection[#:tag "setup-plt-unit"]{General Case}
-
-The @scheme[setup/setup-unit] library provides @|setup-plt| in unit
+The @schememodname[setup/setup-unit] library provides @|setup-plt| in unit
 form. The associated @scheme[setup/option-sig] and
 @scheme[setup/option-unit] libraries provides the interface for
 setting options for the run of @|setup-plt|.
@@ -396,7 +367,7 @@ and exports nothing. Invoking @scheme[setup@] starts the setup process.}
 
 @; ----------------------------------------
 
-@subsubsection{Options Unit}
+@subsection{Options Unit}
 
 @defmodule[setup/option-unit]
 
@@ -406,7 +377,7 @@ Imports nothing and exports @scheme[setup-option^].}
 
 @; ----------------------------------------
 
-@subsubsection{Options Signature}
+@subsection{Options Signature}
 
 @defmodule[setup/option-sig]
 
@@ -677,9 +648,38 @@ for making @filepath{.plt} archives:}
    @scheme[file-mode] argument specifies the default mode for packing a file,
    either @scheme['file] or @scheme['file-replace].}
 
-@; ------------------------------------------------------------------------
+@; ----------------------------------------
 
-@subsection[#:tag "unpacking-.plt-archives"]{Unpacking @filepath{.plt} Archives}
+@subsection{Installing a Single @filepath{.plt} File}
+
+The @schememodname[setup/plt-single-installer] module provides a
+function for installing a single @filepath{.plt} file, and
+@schememodname[setup/plt-single-installer] wraps it with a GUI
+interface.
+
+@subsubsection{Non-GUI Installer}
+
+@local-module[setup/plt-single-installer]{
+
+@defmodule[setup/plt-single-installer]
+
+@defproc[(run-single-installer
+          (file path-string?)
+          (get-dir-proc (-> (or/c path-string? false/c)))) void?]{
+   Creates a separate thread and namespace, runs the installer in that
+   thread with the new namespace, and returns when the thread
+   completes or dies. It also creates a custodian
+   (see @secref[#:doc ref-src]{custodians}) to manage the
+   created thread, sets the exit handler for the thread to shut down
+   the custodian, and explicitly shuts down the custodian
+   when the created thread terminates or dies.
+
+   The @scheme[get-dir-proc] procedure is called if the installer needs a
+   target directory for installation, and a @scheme[#f] result means that
+   the user canceled the installation. Typically, @scheme[get-dir-proc] is
+   @scheme[current-directory].}}
+
+@subsubsection[#:tag "gui-unpacking"]{GUI Installer}
 
 @defmodule[setup/plt-installer]{ The
   @schememodname{setup/plt-installer} library in the setup collection
@@ -698,7 +698,8 @@ for making @filepath{.plt} archives:}
   A thunk that is run after a @filepath{.plt} file is installed.}
 
 @defproc[(with-installer-window
-          (do-install ((or/c (is-a?/c dialog%) (is-a?/c frame%)) . -> . void?))
+          (do-install ((or/c (is-a?/c dialog%) (is-a?/c frame%)) 
+                       . -> . void?))
           (cleanup-thunk (-> any)))
          void?]{
   Creates a frame, sets up the current error and output ports, and
@@ -715,14 +716,18 @@ for making @filepath{.plt} archives:}
          void?]{
   The same as the sole export of @schememodname[setup/plt-single-installer], but with a GUI.}
 
-@subsubsection{Unpacking Signature}
+@; ----------------------------------------
+
+@subsubsection{GUI Unpacking Signature}
       
 @defmodule[setup/plt-installer-sig]{
   @defsignature[setup:plt-installer^ ()]{
   Provides two names: @scheme[run-installer] and @scheme[on-installer-run].}
 }
 
-@subsubsection{Unpacking Unit}
+@; ----------------------------------------
+
+@subsubsection{GUI Unpacking Unit}
 
 @defmodule[setup/plt-installer-unit]{
 
@@ -730,6 +735,98 @@ Imports @scheme[mred^] and exports @scheme[setup:plt-installer^]. }
 
 @; ------------------------------------------------------------------------
 
+@subsection[#:tag "unpacking-.plt-archives"]{Unpacking @filepath{.plt} Archives}
+
+@defmodule[setup/unpack]{The @schememodname[setup/unpack]
+library provides raw support for unpacking a @filepath{.plt} file.}
+
+@defproc[(unpack [archive path-string?]
+                 [main-collects-parent-dir path-string? (current-directory)]
+                 [print-status (string? . -> . any) (lambda (x) (printf "~a\n" x))]
+                 [get-target-directory (-> path-string?) (lambda () (current-directory))]
+                 [force? any/c #f]
+                 [get-target-plt-directory
+                  (path-string? 
+                   path-string? 
+                   (listof path-string?) 
+                   . -> . path-string?)
+                  (lambda (_preferred-dir _main-dir _options)
+                    _preferred-dir)])
+          void?]{
+
+Unpacks @scheme[archive]. 
+
+The @scheme[main-collects-parent-dir] argument is passed along to
+@scheme[get-target-plt-directory].
+
+The @scheme[print-status] argument is used to report unpacking
+progress.
+
+The @scheme[get-target-directory] argument is used to get the
+destination directory for unpacking an archive whose content is
+relative to an arbitrary directory.
+
+If @scheme[force?] is true, then version and required-collection
+mismatches (comparing information in the archive to the current
+installation) are ignored.
+
+The @scheme[get-target-plt-directory] function is called to select a
+target for installation for an archive whose is relative to the
+installation. The function should normally return one if its first two
+arguments; the third argument merely contains the first two, but has
+only one element if the first two are the same. If the archive does
+not request installation for all uses, then the first two arguments
+will be different, and the former will be a user-specific location,
+while the second will refer to the main installation.}
+
+@defproc[(fold-plt-archive [archive path-string?]
+                           [on-config-fn (any/c any/c . -> . any/c)]
+                           [on-setup-unit (any/c input-port? any/c . -> . any/c)]
+                           [on-directory (path-string? any/c . -> . any/c)]
+                           [on-file (path-string? input-port? any/c . -> . any/c)]
+                           [initial-value any/c])
+          any/c]{
+
+Traverses the content of @scheme[archive], which must be a
+@filepath{.plt} archive that is created with the default unpacking
+unit and configuration expression. The configuration expression is not
+evaluated, the unpacking unit is not invoked, and not files are
+unpacked to the filesystem. Instead, the information in the archive is
+reported back through @scheme[on-config], @scheme[on-setup-unit],
+@scheme[on-directory], and @scheme[on-file], each of which can build on
+an accumulated value that starts with @scheme[initial-value] and whose
+final value is returned.
+
+The @scheme[on-config-fn] function is called once with an S-expression
+that represents a function to implement configuration information.
+The second argument to @scheme[on-config] is @scheme[initial-value],
+and the function's result is passes on as the last argument to @scheme[on-setup-unit].
+
+The @scheme[on-setup-unit] function is called with the S-expression
+representation of the installation unit, an input port that points to
+the rest of the file, and the accumulated value. This input port is
+the same port that will be used in the rest of processing, so if
+@scheme[on-setup-unit] consumes any data from the port, then that data
+will not be consumed by the remaining functions. (This means that
+on-setup-unit can leave processing in an inconsistent state, which is
+not checked by anything, and therefore could cause an error.)
+The result of @scheme[on-setup-unit] becomes the new accumulated value.
+
+For each directory that would be created by the archive when unpacking
+normally, @scheme[on-directory] is called with the directory path and the
+accumulated value up to that point, and its result is the new
+accumulated value.
+
+For each file that would be created by the archive when unpacking
+normally, @scheme[on-file] is called with the file path, an input port
+containing the contents of the file, and the accumulated value up to
+that point; its result is the new accumulated value. The input port
+can be used or ignored, and parsing of the rest of the file continues
+the same either way. After @scheme[on-file] returns control, however,
+the input port is drained of its content.}
+
+@; ------------------------------------------------------------------------
+
 @subsection[#:tag "format-of-.plt-archives"]{
   Format of @filepath{.plt} Archives}
 
@@ -1022,8 +1119,8 @@ An @deftech{unpackable} is one of the following:
    collections and installed @|PLaneT| packages) whose
    @filepath{info.ss} file defines one or more of the given
    symbols. The result is based on a cache that is computed by
-   @|setup-plt| and stored in the @filepath{info-domain} sub-directory
-   of each collection directory (as determined by the
+   @|setup-plt| and stored in the @indexed-file{info-domain}
+   sub-directory of each collection directory (as determined by the
    @envvar{PLT_COLLECTION_PATHS} environment variable, etc.) and the
    file @filepath{cache.ss} in the user add-on directory.
 
@@ -1101,3 +1198,7 @@ than specified in the contract above, it is returned as-is.}
 
 Like @scheme[load-xref], but automatically find all cross-reference files for
 manuals that have been installed with @exec{setup-plt}.}
+
+@; ----------------------------------------------------------------------
+
+@index-section[]
diff --git a/collects/setup/unpack.ss b/collects/setup/unpack.ss
index 4980f828ae..56390d64e8 100644
--- a/collects/setup/unpack.ss
+++ b/collects/setup/unpack.ss
@@ -5,10 +5,16 @@
 	   mzlib/inflate
 	   mzlib/file
            mzlib/list
+           mzlib/port
 	   net/base64
 	   (lib "getinfo.ss" "setup")
 	   "dirs.ss")
 
+  (provide unpack
+           fold-plt-archive)
+
+  ;; ----------------------------------------
+
   ;; Returns a port and a kill thunk
   (define (port64gz->port p64gz)
     ;; Inflate in a thread so the whole input isn't read at once
@@ -27,6 +33,126 @@
                          (lambda () (gunzip-through-ports base64-out guz-in))
                          (lambda () (close-output-port guz-in)))))])
 	(values guz-out (lambda () (kill-thread 64t) (kill-thread gzt))))))
+  
+  ;; ------------------------------------------------------------
+  
+  ;; fold-plt-archive : path[to .plt file] (sexpr A -> A) (sexpr input-port A -> A) (path A -> A) (path input-port A -> A) A -> A
+  (define (fold-plt-archive filename on-config-fn on-setup-unit on-directory on-file initial-value)
+    (let*-values ([(fip) (open-input-file filename)]
+                  [(ip kill) (port64gz->port fip)])
+      (dynamic-wind
+       void
+       (λ () (fold-plt-archive-port ip on-config-fn on-setup-unit on-directory on-file initial-value))
+       (λ ()
+         (close-input-port fip)
+         (kill)))))
+  
+  ;; fold-plt-archive-port : input-port (sexpr A -> A) (sexpr input-port A -> A) (path A -> A) (path input-port A -> A) A -> A
+  (define (fold-plt-archive-port p on-config-fn on-setup-unit on-directory on-file initial-value)
+    
+    ;; skip past the initial #"PLT" and two sexprs
+    (unless (and (eq? #\P (read-char p))
+                 (eq? #\L (read-char p))
+                 (eq? #\T (read-char p)))
+      (error "not an unpackable distribution archive"))
+    
+    (let* ([config-fn-sexpr (read p)]
+           [_  (when (eof-object? config-fn-sexpr) (error "malformed input"))]
+           [val (on-config-fn config-fn-sexpr initial-value)]
+           
+           [setup-unit (read p)]
+           [_ (when (eof-object? setup-unit) (error "malformed input"))]
+           [val (on-setup-unit setup-unit p val)])
+    
+      ;; read contents of file directly. [on-setup-unit may have consumed all input,
+      ;; but if so this loop will just do nothing.]
+      (let loop ([val val])
+        (let ([kind (read p)])
+          (cond
+            [(eof-object? kind) val]
+            [else
+             (case kind
+               [(dir) 
+                (let* ([v (read p)]
+                       [s (expr->path-descriptor v)])
+                  (unless (relative-path-descriptor? s)
+                    (error "expected a directory name relative path string, got" s))
+                  (let ([next-val (on-directory s val)])
+                    (loop next-val)))]
+               [(file file-replace)
+                (let* ([v (read p)]
+                       [s (expr->path-descriptor v)])
+                  (unless (relative-path-descriptor? s)
+                    (error "expected a file name relative path string, got" s))
+                  (let ([len (read p)])
+                    (unless (and (number? len) (integer? len))
+                      (error "expected a file name size, got" len))
+                    ;; Find starting *
+                    (let loop ()
+                      (let ([c (read-char p)])
+                        (cond [(char=? c #\*) (void)] ; found it
+                              [(char-whitespace? c) (loop)]
+                              [(eof-object? c) (void)] ; signal the error below
+                              [else (error 
+                                     (format "unexpected character setting up ~a, looking for *" s)
+                                     c)])))
+                    (let-values ([(control fp) (protected-limited-input-port p len)])
+                      (let ([next-val (on-file s fp val)])
+                        (exhaust-port control)
+                        (loop next-val)))))]
+               [else (error "unknown file tag" kind)])])))))
+  
+  ;; path-descriptor ::= 'same | (list location path)
+  ;; location        ::= symbol in '(same collects doc lib include)
+
+  ;; expr->path-descriptor : sexpr -> path-descriptor
+  ;; extracts a path-descriptor from an sexpr embedded in a .plt file
+  ;; raises an error if the given sexpr can't be converted to a path descriptor
+  (define (expr->path-descriptor v)
+    (cond
+      [(null? v) 'same]
+      [(and (pair? v) (symbol? (car v)) (symbol=? (car v) 'same))
+       'same]
+      [(and (pair? v) (string? (car v)))
+       (let ([location (string->loc (car v))])
+         (list location (apply build-path (cdr v))))]
+      [else (error "malformed path description: " v)]))
+
+  ;; string->loc : string -> location
+  ;; converts the string into a corresponding location, or raises an error
+  ;; if that is not possible
+  (define (string->loc str)
+    (let ([loc (string->symbol str)])
+      (cond
+        [(memq loc '(collects doc lib include same)) loc]
+        [else (error "unknown path root: " loc)])))
+  
+  ;; relative-path-descriptor? : path-descriptor -> boolean
+  ;; determines if the given path descriptor names a relative file rather
+  ;; than an absolute one
+  (define (relative-path-descriptor? s)
+    (or (eq? s 'same) (relative-path? (cadr s))))
+  
+  ;; protected-limited-output-port input-port n -> (values input-port input-port)
+  ;; returns two input ports. the first reads from the given input port, and the second
+  ;; reads from the first.
+  ;; why would you ever want to do this? So that you can hand out the second, and then
+  ;; regardless of whether the user closes it or not you still have a limited input port
+  ;; you can read to exhaustion.
+  (define (protected-limited-input-port ip limit)
+    (let* ([i2 (make-limited-input-port ip limit #f)]
+           [i3 (make-limited-input-port i2 limit #f)])
+      (values i2 i3)))
+  
+  ;; exhaust-port : input-port -> void
+  ;; consumes all input on the given port
+  (define exhaust-port
+    (let ([nowhere (open-output-nowhere)])
+      (λ (ip) (copy-port ip nowhere))))
+  
+  
+  ;; ------------------------------------------------------------
+  
 
   (define (pretty-name f)
     (with-handlers ([void (lambda (x) f)])
@@ -298,6 +424,4 @@
 
                   ;; Cancelled: no collections
                   null))))
-          (lambda () (kill) (close-input-port p64gz))))))
-
-  (provide unpack))
+          (lambda () (kill) (close-input-port p64gz)))))))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/ackermann.ss b/collects/tests/mzscheme/benchmarks/shootout/ackermann.ss
index 1fc792dc7c..63ccbba8db 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/ackermann.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/ackermann.ss
@@ -1,13 +1,12 @@
-(module ackermann mzscheme
-  (define (ack m n)
-    (cond ((zero? m) (+ n 1))
-	  ((zero? n) (ack (- m 1) 1))
-	  (else      (ack (- m 1) (ack m (- n 1))))))
+#lang scheme/base
+(require scheme/cmdline)
 
-  (define (main args)
-    (let ((n (if (= (vector-length args) 0)
-		 1
-		 (string->number (vector-ref args 0)))))
-      (printf "Ack(3,~a): ~a~n" n (ack 3 n))))
+(define (ack m n)
+  (cond ((zero? m) (+ n 1))
+        ((zero? n) (ack (- m 1) 1))
+        (else      (ack (- m 1) (ack m (- n 1))))))
 
-  (main (current-command-line-arguments)))
+(command-line #:args (n)
+              (printf "Ack(3,~a): ~a~n" 
+                      n
+                      (ack 3 (string->number n))))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/binarytrees.ss b/collects/tests/mzscheme/benchmarks/shootout/binarytrees.ss
index bd82bb38f5..33b4ed86b2 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/binarytrees.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/binarytrees.ss
@@ -1,49 +1,50 @@
 ;;; The Great Computer Language Shootout
 ;;; http://shootout.alioth.debian.org/
 ;;; Derived from the Chicken variant by Sven Hartrumpf
+#lang scheme/base
+(require scheme/cmdline)
 
-(module binarytrees mzscheme
+(define-struct node (left val right))
 
-  (define-struct node (left val right))
+;; Instead of (define-struct leaf (val)):
+(define (make-leaf val) (make-node #f val #f))
+(define (leaf? l) (not (node-left l)))
+(define (leaf-val l) (node-val l))
 
-  ;; Instead of (define-struct leaf (val)):
-  (define (make-leaf val) (make-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)
+      (let ((item2 (* item 2))
+            (d2 (- d 1)))
+        (make-node (make (- item2 1) d2) item (make item2 d2)))))
 
-  (define (make item d)
-    (if (= d 0)
-	(make-leaf item)
-	(let ((item2 (* item 2))
-	      (d2 (- d 1)))
-	  (make-node (make (- item2 1) d2) item (make item2 d2)))))
+(define (check t)
+  (if (leaf? t)
+      (leaf-val t)
+      (+ (node-val t) (- (check (node-left t)) (check (node-right t))))))
 
-  (define (check t)
-    (if (leaf? t)
-	(leaf-val t)
-	(+ (node-val t) (- (check (node-left t)) (check (node-right t))))))
+(define (main n)
+  (let* ((min-depth 4)
+         (max-depth (max (+ min-depth 2) n)))
+    (let ((stretch-depth (+ max-depth 1)))
+      (printf "stretch tree of depth ~a\t check: ~a\n"
+              stretch-depth
+              (check (make 0 stretch-depth))))
+    (let ((long-lived-tree (make 0 max-depth)))
+      (do ((d 4 (+ d 2))
+           (c 0 0))
+          ((> d max-depth))
+        (let ((iterations (arithmetic-shift 1 (+ (- max-depth d) min-depth))))
+          (do ((i 0 (+ i 1)))
+              ((>= i iterations))
+            (set! c (+ c (check (make i d)) (check (make (- i) d)))))
+          (printf "~a\t trees of depth ~a\t check: ~a\n"
+                  (* 2 iterations)
+                  d
+                  c)))
+      (printf "long lived tree of depth ~a\t check: ~a\n"
+              max-depth
+              (check long-lived-tree)))))
 
-  (define (main argv)
-    (let* ((min-depth 4)
-	   (max-depth (max (+ min-depth 2) (string->number (vector-ref argv 0)))))
-      (let ((stretch-depth (+ max-depth 1)))
-	(printf "stretch tree of depth ~a\t check: ~a\n"
-		stretch-depth
-		(check (make 0 stretch-depth))))
-      (let ((long-lived-tree (make 0 max-depth)))
-	(do ((d 4 (+ d 2))
-	     (c 0 0))
-	    ((> d max-depth))
-	  (let ((iterations (arithmetic-shift 1 (+ (- max-depth d) min-depth))))
-	    (do ((i 0 (+ i 1)))
-		((>= i iterations))
-	      (set! c (+ c (check (make i d)) (check (make (- i) d)))))
-	    (printf "~a\t trees of depth ~a\t check: ~a\n"
-		    (* 2 iterations)
-		    d
-		    c)))
-	(printf "long lived tree of depth ~a\t check: ~a\n"
-		max-depth
-		(check long-lived-tree)))))
-    
-  (main (current-command-line-arguments)))
+(command-line #:args (n) 
+              (main (string->number n)))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/chameneos.ss b/collects/tests/mzscheme/benchmarks/shootout/chameneos.ss
index b98a239c36..7a41a50289 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/chameneos.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/chameneos.ss
@@ -1,55 +1,56 @@
 ;;; The Great Computer Language Shootout
 ;;; http://shootout.alioth.debian.org/
 
-(module chameneos mzscheme 
+#lang scheme/base
+(require scheme/cmdline)
 
-  (define (change c1 c2)
-    (case c1
-      [(red)
-       (case c2	 [(blue) 'yellow] [(yellow) 'blue] [else c1])]
-      [(yellow)
-       (case c2 [(blue) 'red] [(red) 'blue] [else c1])]
-      [(blue)
-       (case c2 [(yellow) 'red] [(red) 'yellow] [else c1])]))
+(define (change c1 c2)
+  (case c1
+    [(red)
+     (case c2 [(blue) 'yellow] [(yellow) 'blue] [else c1])]
+    [(yellow)
+     (case c2 [(blue) 'red] [(red) 'blue] [else c1])]
+    [(blue)
+     (case c2 [(yellow) 'red] [(red) 'yellow] [else c1])]))
   
-  (define (place meeting-ch n)
-    (thread
-     (lambda ()
-       (let loop ([n n])
-	 (if (zero? n)
-	     ;; Fade all:
-	     (let loop ()
-	       (let ([c (channel-get meeting-ch)])
-		 (channel-put (car c) #f)
-		 (loop)))
-	     ;; Let two meet:
-	     (let ([c1 (channel-get meeting-ch)]
-		   [c2 (channel-get meeting-ch)])
-	       (channel-put (car c1) (cdr c2))
-	       (channel-put (car c2) (cdr c1))
-	       (loop (sub1 n))))))))
+(define (place meeting-ch n)
+  (thread
+   (lambda ()
+     (let loop ([n n])
+       (if (zero? n)
+           ;; Fade all:
+           (let loop ()
+             (let ([c (channel-get meeting-ch)])
+               (channel-put (car c) #f)
+               (loop)))
+           ;; Let two meet:
+           (let ([c1 (channel-get meeting-ch)]
+                 [c2 (channel-get meeting-ch)])
+             (channel-put (car c1) (cdr c2))
+             (channel-put (car c2) (cdr c1))
+             (loop (sub1 n))))))))
 
-  (define (creature color meeting-ch result-ch)
-    (thread 
-     (lambda ()
-       (let ([ch (make-channel)])
-	 (let loop ([color color][met 0])
-	   (channel-put meeting-ch (cons ch color))
-	   (let ([other-color (channel-get ch)])
-	     (if other-color
-		 ;; Meet:
-		 (loop (change color other-color) (add1 met))
-		 ;; Done:
-		 (channel-put result-ch met))))))))
+(define (creature color meeting-ch result-ch)
+  (thread 
+   (lambda ()
+     (let ([ch (make-channel)])
+       (let loop ([color color][met 0])
+         (channel-put meeting-ch (cons ch color))
+         (let ([other-color (channel-get ch)])
+           (if other-color
+               ;; Meet:
+               (loop (change color other-color) (add1 met))
+               ;; Done:
+               (channel-put result-ch met))))))))
 
-  (let ([result-ch (make-channel)]
-	[meeting-ch (make-channel)])
-    (place meeting-ch (string->number (vector-ref (current-command-line-arguments) 0)))
-    (creature 'blue meeting-ch result-ch)
-    (creature 'red meeting-ch result-ch)
-    (creature 'yellow meeting-ch result-ch)
-    (creature 'blue meeting-ch result-ch)
-    (printf "~a\n" (+ (channel-get result-ch)
-		      (channel-get result-ch)
-		      (channel-get result-ch)
-		      (channel-get result-ch)))))
+(let ([result-ch (make-channel)]
+      [meeting-ch (make-channel)])
+  (place meeting-ch (command-line #:args (n) (string->number n)))
+  (creature 'blue meeting-ch result-ch)
+  (creature 'red meeting-ch result-ch)
+  (creature 'yellow meeting-ch result-ch)
+  (creature 'blue meeting-ch result-ch)
+  (printf "~a\n" (+ (channel-get result-ch)
+                    (channel-get result-ch)
+                    (channel-get result-ch)
+                    (channel-get result-ch))))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss b/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss
index ea035a9298..21e6d39d4f 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/cheapconcurrency.ss
@@ -1,24 +1,23 @@
+#lang scheme/base
+(require scheme/cmdline)
 
-(module cheapconcurrency mzscheme 
+(define (generate receive-ch n)
+  (if (zero? n)
+      receive-ch
+      (let ([ch (make-channel)])
+        (thread (lambda ()
+                  (let loop ()
+                    (channel-put ch (add1 (channel-get receive-ch)))
+                    (loop))))
+        (generate ch (sub1 n)))))
 
-  (define (generate receive-ch n)
-    (if (zero? n)
-	receive-ch
-	(let ([ch (make-channel)])
-	  (thread (lambda ()
-		    (let loop ()
-		      (channel-put ch (add1 (channel-get receive-ch)))
-		      (loop))))
-	  (generate ch (sub1 n)))))
-
-  (let ([n (string->number 
-	    (vector-ref (current-command-line-arguments) 0))])
-    (let* ([start-ch (make-channel)]
-	   [end-ch (generate start-ch 500)])
-      (let loop ([n n][total 0])
-	(if (zero? n)
-	    (printf "~a\n" total)
-	    (begin
-	      (channel-put start-ch 0)
-	      (loop (sub1 n)
-		    (+ total (channel-get end-ch)))))))))
+(let ([n (command-line #:args (n) (string->number n))])
+  (let* ([start-ch (make-channel)]
+         [end-ch (generate start-ch 500)])
+    (let loop ([n n][total 0])
+      (if (zero? n)
+          (printf "~a\n" total)
+          (begin
+            (channel-put start-ch 0)
+            (loop (sub1 n)
+                  (+ total (channel-get end-ch))))))))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/fannkuch.ss b/collects/tests/mzscheme/benchmarks/shootout/fannkuch.ss
index f9a80228d0..987bb48914 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/fannkuch.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/fannkuch.ss
@@ -5,82 +5,77 @@
 ;;
 ;; Ever-so-slightly tweaked for MzScheme by Brent Fulgham
 
-(module fannkuch mzscheme
-  (define vector-for-each (lambda (pred v)
-    (do ((i 0 (add1 i))
-       (v-length (vector-length v)))
-      ((>= i v-length))
-    (pred (vector-ref v i)))))
+#lang scheme/base
+(require scheme/cmdline)
 
-  (define (vector-reverse-slice! v i j)
-    (do ((i i (add1 i))
+(define vector-for-each (lambda (pred v)
+                          (do ((i 0 (add1 i))
+                               (v-length (vector-length v)))
+                              ((>= i v-length))
+                            (pred (vector-ref v i)))))
+
+(define (vector-reverse-slice! v i j)
+  (do ((i i (add1 i))
        (j (sub1 j) (sub1 j))) ; exclude position j
       ((<= j i))
     (vector-swap! v i j)))
 
-  (define (vector-swap! v i j)
-    (let ((t (vector-ref v i)))
-      (vector-set! v i (vector-ref v j))
-      (vector-set! v j t)))
+(define (vector-swap! v i j)
+  (let ((t (vector-ref v i)))
+    (vector-set! v i (vector-ref v j))
+    (vector-set! v j t)))
 
-  (define (count-flips pi)
-    (do ((rho (vector-copy pi))
-         (i 0 (add1 i)))
-        ((= (vector-ref rho 0) 0) i)
-      (vector-reverse-slice! rho 0 (add1 (vector-ref rho 0)))))
+(define (count-flips pi)
+  (do ((rho (vector-copy pi))
+       (i 0 (add1 i)))
+      ((= (vector-ref rho 0) 0) i)
+    (vector-reverse-slice! rho 0 (add1 (vector-ref rho 0)))))
 
-  (define (vector-copy source)
-    (do ((vec (make-vector (vector-length source)))
-         (i 0 (add1 i)))
-        ((= i (vector-length source)) vec)
-      (vector-set! vec i (vector-ref source i))))
+(define (vector-copy source)
+  (let ([vec (make-vector (vector-length source))])
+    (vector-copy! vec 0 source)
+    vec))
 
-  (define (fannkuch n)
-    (let ((pi (do ((pi (make-vector n))
-                   (i 0 (add1 i)))
+(define (fannkuch n)
+  (let ((pi (do ((pi (make-vector n))
+                 (i 0 (add1 i)))
                 ((= i n) pi)
-                (vector-set! pi i i)))
-          (r n)
-          (count (make-vector n)))
-      (let loop ((flips 0)
-                 (perms 0))
-        (cond ((< perms 30)
-               (vector-for-each (lambda (x)
-                                  (display (add1 x)))
-                                pi)
-               (newline)))
-        (do ()
+              (vector-set! pi i i)))
+        (r n)
+        (count (make-vector n)))
+    (let loop ((flips 0)
+               (perms 0))
+      (cond ((< perms 30)
+             (vector-for-each (lambda (x)
+                                (display (add1 x)))
+                              pi)
+             (newline)))
+      (do ()
           ((= r 1))
-          (vector-set! count (sub1 r) r)
-          (set! r (sub1 r)))
-        (let ((flips2 (max (count-flips pi) flips)))
-          (let ((result
-                  (let loop2 ()
-                    (if (= r n)
-                      flips2
-                      (let ((perm0 (vector-ref pi 0)))
-                        (do ((i 0))
-                          ((>= i r))
-                          (let ((j (add1 i)))
-                            (vector-set! pi i (vector-ref pi j))
-                            (set! i j)))
-                        (vector-set! pi r perm0)
-                        (vector-set! count r (sub1 (vector-ref count r)))
-                        (cond ((<= (vector-ref count r) 0)
-                               (set! r (add1 r))
-                               (loop2))
-                              (else
-                                #f)))))))
-            (or result
-                (loop flips2 (add1 perms)))
-            )))))
+        (vector-set! count (sub1 r) r)
+        (set! r (sub1 r)))
+      (let ((flips2 (max (count-flips pi) flips)))
+        (let ((result
+               (let loop2 ()
+                 (if (= r n)
+                     flips2
+                     (let ((perm0 (vector-ref pi 0)))
+                       (do ((i 0))
+                           ((>= i r))
+                         (let ((j (add1 i)))
+                           (vector-set! pi i (vector-ref pi j))
+                           (set! i j)))
+                       (vector-set! pi r perm0)
+                       (vector-set! count r (sub1 (vector-ref count r)))
+                       (cond ((<= (vector-ref count r) 0)
+                              (set! r (add1 r))
+                              (loop2))
+                             (else
+                              #f)))))))
+          (or result
+              (loop flips2 (add1 perms))))))))
 
-  (define (main args)
-    (if (< (vector-length args) 1)
-      (begin (display "An argument is required") (newline) 2)
-      (let ((n (string->number (vector-ref args 0))))
-        (if (not (integer? n))
-          (begin (display "An integer is required") (newline) 2)
-          (printf "Pfannkuchen(~S) = ~S~%" n (fannkuch n))))))
-
-  (main (current-command-line-arguments)))
+(command-line #:args (n)
+              (printf "Pfannkuchen(~a) = ~a\n" 
+                      n 
+                      (fannkuch (string->number n))))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/fasta.ss b/collects/tests/mzscheme/benchmarks/shootout/fasta.ss
index f1a04322f1..1f60ba32a1 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/fasta.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/fasta.ss
@@ -6,114 +6,109 @@
 ;; Derived from the Chicken variant, which was
 ;; Contributed by Anthony Borla
 
-(module fasta mzscheme 
+#lang scheme/base
+(require scheme/cmdline)
 
-  (define +alu+
-    (bytes-append
-     #"GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG"
-     #"GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA"
-     #"CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT"
-     #"ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA"
-     #"GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG"
-     #"AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC"
-     #"AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"))
+(define +alu+
+  (bytes-append
+   #"GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG"
+   #"GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA"
+   #"CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT"
+   #"ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA"
+   #"GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG"
+   #"AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC"
+   #"AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"))
 
-  (define +iub+
-    (list
-     '(#\a . 0.27) '(#\c . 0.12) '(#\g . 0.12) '(#\t . 0.27) '(#\B . 0.02)
-     '(#\D . 0.02) '(#\H . 0.02) '(#\K . 0.02) '(#\M . 0.02) '(#\N . 0.02)
-     '(#\R . 0.02) '(#\S . 0.02) '(#\V . 0.02) '(#\W . 0.02) '(#\Y . 0.02)))
+(define +iub+
+  (list
+   '(#\a . 0.27) '(#\c . 0.12) '(#\g . 0.12) '(#\t . 0.27) '(#\B . 0.02)
+   '(#\D . 0.02) '(#\H . 0.02) '(#\K . 0.02) '(#\M . 0.02) '(#\N . 0.02)
+   '(#\R . 0.02) '(#\S . 0.02) '(#\V . 0.02) '(#\W . 0.02) '(#\Y . 0.02)))
 
-  (define +homosapien+
-    (list
-     '(#\a . 0.3029549426680) '(#\c . 0.1979883004921)
-     '(#\g . 0.1975473066391) '(#\t . 0.3015094502008)))
+(define +homosapien+
+  (list
+   '(#\a . 0.3029549426680) '(#\c . 0.1979883004921)
+   '(#\g . 0.1975473066391) '(#\t . 0.3015094502008)))
 
-  ;; -------------
+;; -------------
 
-  (define +line-size+ 60)
+(define +line-size+ 60)
+
+;; -------------------------------
+
+(define (make-random seed)
+  (let* ((ia 3877) (ic 29573) (im 139968) (last seed))
+    (lambda (max)
+      (set! last (modulo (+ ic (* last ia)) im))
+      (/ (* max last) im) )))
+
+;; -------------------------------
+
+(define (make-cumulative-table frequency-table)
+  (let ([cumulative 0.0])
+    (map
+     (lambda (x) 
+       (set! cumulative (+ cumulative (cdr x))) 
+       (cons (char->integer (car x)) cumulative))
+     frequency-table)))
+
+;; -------------
+
+(define random-next (make-random 42))
+(define +segmarker+ ">")
+
+;; -------------
+
+(define (select-random cumulative-table)
+  (let ((rvalue (random-next 1.0)))
+    (select-over-threshold rvalue cumulative-table)))
+
+(define (select-over-threshold rvalue table)
+  (if (<= rvalue (cdar table))
+      (caar table)
+      (select-over-threshold rvalue (cdr table))))
+
+;; -------------
+
+(define (repeat-fasta id desc n_ sequence line-length)
+  (let ((seqlen (bytes-length sequence))
+        (out (current-output-port)))
+    (display (string-append +segmarker+ id " " desc "\n") out)
+    (let loop-o ((n n_) (k 0))
+      (unless (<= n 0) 
+        (let ((m (min n line-length)))
+          (let loop-i ((i 0) (k k))
+            (if (>= i m) 
+                (begin
+                  (newline out)
+                  (loop-o (- n line-length) k))
+                (let ([k (if (= k seqlen) 0 k)])
+                  (write-byte (bytes-ref sequence k) out)
+                  (loop-i (add1 i) (add1 k))))))))))
+
+;; -------------
+
+(define (random-fasta id desc n_ cumulative-table line-length)
+  (let ((out (current-output-port)))
+    (display (string-append +segmarker+ id " " desc "\n") out)
+    (let loop-o ((n n_))
+      (unless (<= n 0)
+        (let ((m (min n line-length)))
+          (let loop-i ((i 0))
+            (unless (>= i m)
+              (write-byte (select-random cumulative-table) out)
+              (loop-i (add1 i))))
+          (newline out)
+          (loop-o (- n line-length)))))))
+
+;; -------------------------------
   
-  ;; -------------------------------
+(let ((n (command-line #:args (n) (string->number n))))
+    
+  (repeat-fasta "ONE" "Homo sapiens alu" (* n 2) +alu+ +line-size+)
   
-  (define (make-random seed)
-    (let* ((ia 3877) (ic 29573) (im 139968) (last seed))
-      (lambda (max)
-	(set! last (modulo (+ ic (* last ia)) im))
-	(/ (* max last) im) )))
-
-  ;; -------------------------------
-
-  (define (make-cumulative-table frequency-table)
-    (let ((cumulative 0.0))
-      (map
-       (lambda (x) 
-	 (set! cumulative (+ cumulative (cdr x))) 
-	 (cons (char->integer (car x)) cumulative))
-       frequency-table)))
-
-  ;; -------------
+  (random-fasta "TWO" "IUB ambiguity codes" (* n 3)
+                (make-cumulative-table +iub+) +line-size+)
   
-  (define random-next (make-random 42))
-  (define +segmarker+ ">")
-
-  ;; -------------
-
-  (define (select-random cumulative-table)
-    (let ((rvalue (random-next 1.0)))
-      (select-over-threshold rvalue cumulative-table)))
-  
-  (define (select-over-threshold rvalue table)
-    (if (<= rvalue (cdar table))
-	(caar table)
-	(select-over-threshold rvalue (cdr table))))
-
-  ;; -------------
-  
-  (define (repeat-fasta id desc n_ sequence line-length)
-    (let ((seqlen (bytes-length sequence))
-	  (out (current-output-port)))
-      (display (string-append +segmarker+ id " " desc "\n") out)
-      (let loop-o ((n n_) (k 0))
-	(unless (<= n 0) 
-	  (let ((m (min n line-length)))
-	    (let loop-i ((i 0) (k k))
-	      (if (>= i m) 
-		  (begin
-		    (newline out)
-		    (loop-o (- n line-length) k))
-		  (let ([k (if (= k seqlen) 0 k)])
-		    (write-byte (bytes-ref sequence k) out)
-		    (loop-i (add1 i) (add1 k))))))))))
-
-  ;; -------------
-
-  (define (random-fasta id desc n_ cumulative-table line-length)
-    (let ((out (current-output-port)))
-      (display (string-append +segmarker+ id " " desc "\n") out)
-      (let loop-o ((n n_))
-	(unless (<= n 0)
-	  (let ((m (min n line-length)))
-	    (let loop-i ((i 0))
-	      (unless (>= i m)
-		(write-byte (select-random cumulative-table) out)
-		(loop-i (add1 i))))
-	    (newline out)
-	    (loop-o (- n line-length)))))))
-  
-  ;; -------------------------------
-  
-  (define (main args)
-    (let ((n (string->number (vector-ref args 0))))
-      
-      (repeat-fasta "ONE" "Homo sapiens alu" (* n 2) +alu+ +line-size+)
-      
-      (random-fasta "TWO" "IUB ambiguity codes" (* n 3)
-		    (make-cumulative-table +iub+) +line-size+)
-      
-      (random-fasta "THREE" "Homo sapiens frequency" (* n 5)
-		    (make-cumulative-table +homosapien+) +line-size+) ))
-  
-  ;; -------------------------------
-
-  (main (current-command-line-arguments)))
-
+  (random-fasta "THREE" "Homo sapiens frequency" (* n 5)
+                (make-cumulative-table +homosapien+) +line-size+))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/nbody.ss b/collects/tests/mzscheme/benchmarks/shootout/nbody.ss
index 5666408f0f..94bc8b8cb9 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/nbody.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/nbody.ss
@@ -15,137 +15,139 @@ Correct output N = 1000 is
 -0.169075164
 -0.169087605
 |#
-(module nbody mzscheme
-  (require (only mzlib/string real->decimal-string))
 
-  ;; ------------------------------
-  ;; define planetary masses, initial positions & velocity
+#lang scheme/base
+(require scheme/cmdline)
 
-  (define +pi+ 3.141592653589793)
-  (define +days-per-year+ 365.24)
+;; ------------------------------
+;; define planetary masses, initial positions & velocity
 
-  (define +solar-mass+ (* 4 +pi+ +pi+))
+(define +pi+ 3.141592653589793)
+(define +days-per-year+ 365.24)
 
-  (define-struct body (x y z vx vy vz mass))
+(define +solar-mass+ (* 4 +pi+ +pi+))
 
-  (define *sun*
-    (make-body 0.0 0.0 0.0 0.0 0.0 0.0 +solar-mass+))
+(define-struct body (x y z vx vy vz mass)
+  #:mutable)
 
-  (define *jupiter*
-    (make-body 4.84143144246472090
-	       -1.16032004402742839
-	       -1.03622044471123109e-1
-	       (* 1.66007664274403694e-3 +days-per-year+)
-	       (* 7.69901118419740425e-3 +days-per-year+)
-	       (* -6.90460016972063023e-5 +days-per-year+)
-	       (* 9.54791938424326609e-4 +solar-mass+)))
+(define *sun*
+  (make-body 0.0 0.0 0.0 0.0 0.0 0.0 +solar-mass+))
 
-  (define *saturn*
-    (make-body 8.34336671824457987
-	       4.12479856412430479
-	       -4.03523417114321381e-1
-	       (* -2.76742510726862411e-3 +days-per-year+)
-	       (* 4.99852801234917238e-3 +days-per-year+)
-	       (* 2.30417297573763929e-5 +days-per-year+)
-	       (* 2.85885980666130812e-4 +solar-mass+)))
+(define *jupiter*
+  (make-body 4.84143144246472090
+             -1.16032004402742839
+             -1.03622044471123109e-1
+             (* 1.66007664274403694e-3 +days-per-year+)
+             (* 7.69901118419740425e-3 +days-per-year+)
+             (* -6.90460016972063023e-5 +days-per-year+)
+             (* 9.54791938424326609e-4 +solar-mass+)))
 
-  (define *uranus*
-    (make-body 1.28943695621391310e1
-	       -1.51111514016986312e1
-	       -2.23307578892655734e-1
-	       (* 2.96460137564761618e-03 +days-per-year+)
-	       (* 2.37847173959480950e-03 +days-per-year+)
-	       (* -2.96589568540237556e-05 +days-per-year+)
-	       (*  4.36624404335156298e-05 +solar-mass+)))
+(define *saturn*
+  (make-body 8.34336671824457987
+             4.12479856412430479
+             -4.03523417114321381e-1
+             (* -2.76742510726862411e-3 +days-per-year+)
+             (* 4.99852801234917238e-3 +days-per-year+)
+             (* 2.30417297573763929e-5 +days-per-year+)
+             (* 2.85885980666130812e-4 +solar-mass+)))
 
-  (define *neptune*
-    (make-body 1.53796971148509165e+01
-	       -2.59193146099879641e+01
-	       1.79258772950371181e-01
-	       (* 2.68067772490389322e-03 +days-per-year+)
-	       (* 1.62824170038242295e-03 +days-per-year+)
-	       (* -9.51592254519715870e-05 +days-per-year+)
-	       (* 5.15138902046611451e-05 +solar-mass+)))
+(define *uranus*
+  (make-body 1.28943695621391310e1
+             -1.51111514016986312e1
+             -2.23307578892655734e-1
+             (* 2.96460137564761618e-03 +days-per-year+)
+             (* 2.37847173959480950e-03 +days-per-year+)
+             (* -2.96589568540237556e-05 +days-per-year+)
+             (*  4.36624404335156298e-05 +solar-mass+)))
 
-  ;; -------------------------------
-  (define (offset-momentum system)
-    (let loop-i ((i system) (px 0.0) (py 0.0) (pz 0.0))
-      (if (null? i)
-	  (begin
-	    (set-body-vx! (car system) (/ (- px) +solar-mass+))
-	    (set-body-vy! (car system) (/ (- py) +solar-mass+))
-	    (set-body-vz! (car system) (/ (- pz) +solar-mass+)))
-	  (loop-i (cdr i)
-		  (+ px (* (body-vx (car i)) (body-mass (car i))))
-		  (+ py (* (body-vy (car i)) (body-mass (car i))))
-		  (+ pz (* (body-vz (car i)) (body-mass (car i))))))))
+(define *neptune*
+  (make-body 1.53796971148509165e+01
+             -2.59193146099879641e+01
+             1.79258772950371181e-01
+             (* 2.68067772490389322e-03 +days-per-year+)
+             (* 1.62824170038242295e-03 +days-per-year+)
+             (* -9.51592254519715870e-05 +days-per-year+)
+             (* 5.15138902046611451e-05 +solar-mass+)))
 
-  ;; -------------------------------
-  (define (energy system)
-    (let loop-o ((o system) (e 0.0))
-	(if (null? o)
-	    e
-	    (let ([e (+ e (* 0.5 (body-mass (car o))
-			     (+ (* (body-vx (car o)) (body-vx (car o)))
-				(* (body-vy (car o)) (body-vy (car o)))
-				(* (body-vz (car o)) (body-vz (car o))))))])
-		  
-	      (let loop-i ((i (cdr o)) (e e))
-		(if (null? i)
-		    (loop-o (cdr o) e)
-		    (let* ((dx (- (body-x (car o)) (body-x (car i))))
-			   (dy (- (body-y (car o)) (body-y (car i))))
-			   (dz (- (body-z (car o)) (body-z (car i))))
-			   (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))))
-		      (let ([e  (- e (/ (* (body-mass (car o)) (body-mass (car i))) distance))])
-			(loop-i (cdr i) e)))))))))
+;; -------------------------------
+(define (offset-momentum system)
+  (let loop-i ((i system) (px 0.0) (py 0.0) (pz 0.0))
+    (if (null? i)
+        (begin
+          (set-body-vx! (car system) (/ (- px) +solar-mass+))
+          (set-body-vy! (car system) (/ (- py) +solar-mass+))
+          (set-body-vz! (car system) (/ (- pz) +solar-mass+)))
+        (loop-i (cdr i)
+                (+ px (* (body-vx (car i)) (body-mass (car i))))
+                (+ py (* (body-vy (car i)) (body-mass (car i))))
+                (+ pz (* (body-vz (car i)) (body-mass (car i))))))))
 
-  ;; -------------------------------
-  (define (advance system dt)
-    (let loop-o ((o system))
-      (unless (null? o)
-	(let loop-i ((i (cdr o)))
-	  (unless (null? i)
-	    (let* ((o1 (car o))
-		   (i1 (car i))
-		   (dx (- (body-x o1) (body-x i1)))
-		   (dy (- (body-y o1) (body-y i1)))
-		   (dz (- (body-z o1) (body-z i1)))
-		   (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))
-		   (mag (/ dt (* distance distance distance)))
-		   (dxmag (* dx mag))
-		   (dymag (* dy mag))
-		   (dzmag (* dz mag))
-		   (om (body-mass o1))
-		   (im (body-mass i1)))
-	      (set-body-vx! o1 (- (body-vx o1) (* dxmag im)))
-	      (set-body-vy! o1 (- (body-vy o1) (* dymag im)))
-	      (set-body-vz! o1 (- (body-vz o1) (* dzmag im)))
-	      (set-body-vx! i1 (+ (body-vx i1) (* dxmag om)))
-	      (set-body-vy! i1 (+ (body-vy i1) (* dymag om)))
-	      (set-body-vz! i1 (+ (body-vz i1) (* dzmag om)))
-	      (loop-i (cdr i)))))
-	(loop-o (cdr o))))
-    
-    (let loop-o ((o system))
-      (unless (null? o)
-	(let ([o1 (car o)])
-	  (set-body-x! o1 (+ (body-x o1) (* dt (body-vx o1))))
-	  (set-body-y! o1 (+ (body-y o1) (* dt (body-vy o1))))
-	  (set-body-z! o1 (+ (body-z o1) (* dt (body-vz o1))))
-	  (loop-o (cdr o))))))
+;; -------------------------------
+(define (energy system)
+  (let loop-o ((o system) (e 0.0))
+    (if (null? o)
+        e
+        (let ([e (+ e (* 0.5 (body-mass (car o))
+                         (+ (* (body-vx (car o)) (body-vx (car o)))
+                            (* (body-vy (car o)) (body-vy (car o)))
+                            (* (body-vz (car o)) (body-vz (car o))))))])
+          
+          (let loop-i ((i (cdr o)) (e e))
+            (if (null? i)
+                (loop-o (cdr o) e)
+                (let* ((dx (- (body-x (car o)) (body-x (car i))))
+                       (dy (- (body-y (car o)) (body-y (car i))))
+                       (dz (- (body-z (car o)) (body-z (car i))))
+                       (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))))
+                  (let ([e  (- e (/ (* (body-mass (car o)) (body-mass (car i))) distance))])
+                    (loop-i (cdr i) e)))))))))
 
-  ;; -------------------------------
+;; -------------------------------
+(define (advance system dt)
+  (let loop-o ((o system))
+    (unless (null? o)
+      (let loop-i ((i (cdr o)))
+        (unless (null? i)
+          (let* ((o1 (car o))
+                 (i1 (car i))
+                 (dx (- (body-x o1) (body-x i1)))
+                 (dy (- (body-y o1) (body-y i1)))
+                 (dz (- (body-z o1) (body-z i1)))
+                 (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))
+                 (mag (/ dt (* distance distance distance)))
+                 (dxmag (* dx mag))
+                 (dymag (* dy mag))
+                 (dzmag (* dz mag))
+                 (om (body-mass o1))
+                 (im (body-mass i1)))
+            (set-body-vx! o1 (- (body-vx o1) (* dxmag im)))
+            (set-body-vy! o1 (- (body-vy o1) (* dymag im)))
+            (set-body-vz! o1 (- (body-vz o1) (* dzmag im)))
+            (set-body-vx! i1 (+ (body-vx i1) (* dxmag om)))
+            (set-body-vy! i1 (+ (body-vy i1) (* dymag om)))
+            (set-body-vz! i1 (+ (body-vz i1) (* dzmag om)))
+            (loop-i (cdr i)))))
+      (loop-o (cdr o))))
   
-  (let ((n (string->number (vector-ref (current-command-line-arguments) 0)))
-        (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))
+  (let loop-o ((o system))
+    (unless (null? o)
+      (let ([o1 (car o)])
+        (set-body-x! o1 (+ (body-x o1) (* dt (body-vx o1))))
+        (set-body-y! o1 (+ (body-y o1) (* dt (body-vy o1))))
+        (set-body-z! o1 (+ (body-z o1) (* dt (body-vz o1))))
+        (loop-o (cdr o))))))
 
-      (printf "~a~%" (real->decimal-string (energy system) 9))))
+;; -------------------------------
+
+(let ((n (command-line #:args (n) (string->number n)))
+      (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))
+  
+  (printf "~a~%" (real->decimal-string (energy system) 9)))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/pidigits.ss b/collects/tests/mzscheme/benchmarks/shootout/pidigits.ss
index 825212c7ce..925d4ae46a 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/pidigits.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/pidigits.ss
@@ -3,44 +3,42 @@
 ;; Based on the MLton version of the benchmark
 ;; contributed by Scott Cruzen
 
-;; Note: as of version 350, this benchmark spends most of
-;;  its time GCing; it runs 3 times as fast in mzscheme3m.
+#lang scheme/base
+(require scheme/cmdline)
 
-(module pidigits mzscheme
+(define (floor_ev q r s t x)
+  (quotient (+ (* q x) r) (+ (* s x) t)))
 
-  (define (floor_ev q r s t x)
-    (quotient (+ (* q x) r) (+ (* s x) t)))
-  
-  (define (comp q r s t  q2 r2 s2 t2)
-    (values (+ (* q q2) (* r s2))
-	    (+ (* q r2) (* r t2))
-	    (+ (* s q2) (* t s2))
-	    (+ (* s r2) (* t t2))))
+(define (comp q r s t  q2 r2 s2 t2)
+  (values (+ (* q q2) (* r s2))
+          (+ (* q r2) (* r t2))
+          (+ (* s q2) (* t s2))
+          (+ (* s r2) (* t t2))))
 
-  (define (next q r s t) (floor_ev q r s t 3))
-  (define (safe? q r s t n) (= n (floor_ev q r s t 4)))
-  (define (prod q r s t n) (comp 10 (* -10 n) 0 1  q r s t))
-  (define (mk q r s t k) (comp q r s t k (* 2 (add1 (* 2 k))) 0 (add1 (* 2 k))))
+(define (next q r s t) (floor_ev q r s t 3))
+(define (safe? q r s t n) (= n (floor_ev q r s t 4)))
+(define (prod q r s t n) (comp 10 (* -10 n) 0 1  q r s t))
+(define (mk q r s t k) (comp q r s t k (* 2 (add1 (* 2 k))) 0 (add1 (* 2 k))))
 
-  (define (digit k  q r s t  n row col)
-    (if (> n 0)
-	(let ([y (next q r s t)])
-	  (if (safe? q r s t y)
-	      (let-values ([(q r s t) (prod q r s t y)])
-		(if (= col 10)
-		    (let ([row (+ row 10)])
-		      (printf "\t:~a\n~a" row y)
-		      (digit k q r s t (sub1 n) row 1))
-		    (begin
-		      (printf "~a" y)
-		      (digit k q r s t(sub1 n) row (add1 col)))))
-	      (let-values ([(q r s t) (mk q r s t k)])
-		(digit (add1 k) q r s t n row col))))
-	(printf "~a\t:~a\n"
-		(make-string (- 10 col) #\space)
-		(+ row col))))
+(define (digit k  q r s t  n row col)
+  (if (> n 0)
+      (let ([y (next q r s t)])
+        (if (safe? q r s t y)
+            (let-values ([(q r s t) (prod q r s t y)])
+              (if (= col 10)
+                  (let ([row (+ row 10)])
+                    (printf "\t:~a\n~a" row y)
+                    (digit k q r s t (sub1 n) row 1))
+                  (begin
+                    (printf "~a" y)
+                    (digit k q r s t(sub1 n) row (add1 col)))))
+            (let-values ([(q r s t) (mk q r s t k)])
+              (digit (add1 k) q r s t n row col))))
+      (printf "~a\t:~a\n"
+              (make-string (- 10 col) #\space)
+              (+ row col))))
 
-  (define (digits n)
-    (digit 1  1 0 0 1  n 0 0))
+(define (digits n)
+  (digit 1  1 0 0 1  n 0 0))
 
-  (digits (string->number (vector-ref (current-command-line-arguments) 0))))
+(digits (command-line #:args (n) (string->number n)))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/reversecomplement.ss b/collects/tests/mzscheme/benchmarks/shootout/reversecomplement.ss
index cea3886c7e..332250c1f8 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/reversecomplement.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/reversecomplement.ss
@@ -1,60 +1,56 @@
 
-(module reversecomplement mzscheme 
+#lang scheme/base
+(require scheme/cmdline)
 
-  (define translation (make-vector 128))
+(define translation (make-vector 128))
 
-  (for-each (lambda (from-to)
-	      (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]
-	      [u a]
-	      [m k]
-	      [r y]
-	      [w w]
-	      [s s]
-	      [y R]
-	      [k M]
-	      [v b]
-	      [h d]
-	      [d h]
-	      [b v]
-	      [n n]))
+(for-each (lambda (from-to)
+            (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]
+            [u a]
+            [m k]
+            [r y]
+            [w w]
+            [s s]
+            [y R]
+            [k M]
+            [v b]
+            [h d]
+            [d h]
+            [b v]
+            [n n]))
 
-  (define (output lines)
-    (let* ([str (apply bytes-append lines)]
-	   [o (current-output-port)]
-	   [len (bytes-length str)])
-      (let loop ([offset 0])
-	(when (< offset len)
-	  (write-bytes str o offset (min len (+ offset 60)))
-	  (newline o)
-	  (loop (+ offset 60))))))
-  
-  (let ([in (current-input-port)])
-    (let loop ([accum null])
-      (let ([l (read-bytes-line in)])
-	(if (eof-object? l)
-	    (output accum)
-	    (cond
-	     [(regexp-match? #rx#"^>" l)
-	      (output accum)
-	      (printf "~a\n" l)
-	      (loop null)]
-	     [else
-	      (let* ([len (bytes-length l)]
-		     [dest (make-bytes len)])
-		(let loop ([i 0][j (- len 1)])
-		  (unless (= i len)
-		    (bytes-set! dest
-				j
-				(vector-ref translation (bytes-ref l i)))
-		    (loop (add1 i) (sub1 j))))
-		(loop (cons dest accum)))]))))))
+(define (output lines)
+  (let* ([str (apply bytes-append lines)]
+         [o (current-output-port)]
+         [len (bytes-length str)])
+    (for ([offset (in-range 0 len 60)])
+      (write-bytes str o offset (min len (+ offset 60)))
+      (newline o))))
 
+(let ([in (current-input-port)])
+  (let loop ([accum null])
+    (let ([l (read-bytes-line in)])
+      (if (eof-object? l)
+          (output accum)
+          (cond
+           [(regexp-match? #rx#"^>" l)
+            (output accum)
+            (printf "~a\n" l)
+            (loop null)]
+           [else
+            (let* ([len (bytes-length l)]
+                   [dest (make-bytes len)])
+              (for ([i (in-range len)])
+                (bytes-set! dest
+                            (- (- len i) 1)
+                            (vector-ref translation (bytes-ref l i))))
+              (loop (cons dest accum)))])))))
diff --git a/collects/tests/mzscheme/benchmarks/shootout/spectralnorm.ss b/collects/tests/mzscheme/benchmarks/shootout/spectralnorm.ss
index 78dadcbbd0..eaad19b68e 100644
--- a/collects/tests/mzscheme/benchmarks/shootout/spectralnorm.ss
+++ b/collects/tests/mzscheme/benchmarks/shootout/spectralnorm.ss
@@ -4,64 +4,55 @@
 ;; Translated directly from the C# version, which was:
 ;;   contributed by Isaac Gouy
 
-(module spectralnorm mzscheme
-  (require mzlib/string)
+#lang scheme/base
+(require scheme/cmdline)
 
-  (define (Approximate n)
-    (let ([u (make-vector n 1.0)]
-          [v (make-vector n 0.0)])
-      ;; 20 steps of the power method
-      (let loop ([i 0])
-        (unless (= i 10)
-          (MultiplyAtAv n u v)
-          (MultiplyAtAv n v u)
-          (loop (add1 i))))
-      
-      ;; B=AtA         A multiplied by A transposed
-      ;; v.Bv /(v.v)   eigenvalue of v
-      (let loop ([i 0][vBv 0][vv 0])
-        (if (= i n)
-            (sqrt (/ vBv vv))
-            (let ([vi (vector-ref v i)])
-              (loop (add1 i)
-                    (+ vBv (* (vector-ref u i) vi))
-                    (+ vv (* vi vi))))))))
+(define (Approximate n)
+  (let ([u (make-vector n 1.0)]
+        [v (make-vector n 0.0)])
+    ;; 20 steps of the power method
+    (for ([i (in-range 10)])
+      (MultiplyAtAv n u v)
+      (MultiplyAtAv n v u))
+    
+    ;; B=AtA         A multiplied by A transposed
+    ;; v.Bv /(v.v)   eigenvalue of v
+    (let loop ([i 0][vBv 0][vv 0])
+      (if (= i n)
+          (sqrt (/ vBv vv))
+          (let ([vi (vector-ref v i)])
+            (loop (add1 i)
+                  (+ vBv (* (vector-ref u i) vi))
+                  (+ vv (* vi vi))))))))
 
-  ;; return element i,j of infinite matrix A
-  (define (A i j)
-    (/ 1.0 (+ (* (+ i j) (/ (+ i j 1) 2)) i 1)))
+;; return element i,j of infinite matrix A
+(define (A i j)
+  (/ 1.0 (+ (* (+ i j) (/ (+ i j 1) 2)) i 1)))
 
-  ;; multiply vector v by matrix A
-  (define (MultiplyAv n v Av)
-    (let loop ([i 0])
-      (unless (= i n)
-        (let jloop ([j 0][r 0])
-          (if (= j n)
-              (vector-set! Av i r)
-              (jloop (add1 j)
-                     (+ r (* (A i j) (vector-ref v j))))))
-        (loop (add1 i)))))
+;; multiply vector v by matrix A
+(define (MultiplyAv n v Av)
+  (for ([i (in-range n)])
+    (vector-set! Av i 
+                 (for/fold ([r 0])
+                     ([j (in-range n)])
+                   (+ r (* (A i j) (vector-ref v j)))))))
 
-  ;; multiply vector v by matrix A transposed
-  (define (MultiplyAtv n v Atv)
-    (let loop ([i 0])
-      (unless (= i n)
-        (let jloop ([j 0][r 0])
-          (if (= j n)
-              (vector-set! Atv i r)
-              (jloop (add1 j)
-                     (+ r (* (A j i) (vector-ref v j))))))
-        (loop (add1 i)))))
+;; multiply vector v by matrix A transposed
+(define (MultiplyAtv n v Atv)
+  (for ([i (in-range n)])
+    (vector-set! Atv i
+                 (for/fold ([r 0])
+                     ([j (in-range n)])
+                   (+ r (* (A j i) (vector-ref v j)))))))
 
-  ;; multiply vector v by matrix A and then by matrix A transposed 
-  (define (MultiplyAtAv n v AtAv)
-    (let ([u (make-vector n 0.0)])
-      (MultiplyAv n v u)
-      (MultiplyAtv n u AtAv)))
+;; multiply vector v by matrix A and then by matrix A transposed 
+(define (MultiplyAtAv n v AtAv)
+  (let ([u (make-vector n 0.0)])
+    (MultiplyAv n v u)
+    (MultiplyAtv n u AtAv)))
+
+(printf "~a\n"
+        (real->decimal-string
+         (Approximate (command-line #:args (n) (string->number n)))
+         9))
 
-  (printf "~a\n"
-          (real->decimal-string
-           (Approximate (string->number (vector-ref
-                                         (current-command-line-arguments)
-                                         0)))
-           9)))