separating the command line from its functions

info.rkt

@@ -13,4 +13,5 @@
 (define scribblings '(("scribblings/manual.scrbl")))
 (define compile-omit-paths '("tests"
                              "examples"
-                             "experiments"))
+                             "experiments"
+                             "simulator"))

js-assembler/assemble.rkt

@@ -516,9 +516,9 @@ EOF
 (define-predicate natural? Natural)
 
 (: ensure-natural (Any -> Natural))
-(define (ensure-natural x)
+(define (ensure-natural n)
-  (if (natural? x)
+  (if (natural? n)
-      x
+      n
       (error 'ensure-natural)))
 
 

whalesong-helpers.rkt

@@ -0,0 +1,88 @@
+#lang racket/base
+
+(require racket/match
+         racket/file
+         racket/path
+         racket/port
+         "make/make-structs.rkt"
+         "js-assembler/package.rkt"
+         "resource/structs.rkt"
+         "logger.rkt")
+
+(provide (all-defined-out))
+
+
+(define current-verbose? (make-parameter #f))
+(define current-output-dir (make-parameter (build-path (current-directory))))
+(define current-write-resources? (make-parameter #t))
+
+(define (same-file? p1 p2)
+  (or (equal? (normalize-path p1) (normalize-path p2))
+      (bytes=? (call-with-input-file p1 port->bytes)
+               (call-with-input-file p2 port->bytes))))
+
+
+(define (turn-on-logger!)
+  (void (thread (lambda ()
+                  (let ([receiver
+                         (make-log-receiver whalesong-logger
+                                            (if (current-verbose?)
+                                                'debug
+                                                'info))])
+                    (let loop ()
+                      (let ([msg (sync receiver)])
+                        (match msg
+                          [(vector level msg data)
+                           (fprintf (current-error-port)"~a: ~a\n" level msg)
+                           (flush-output (current-error-port))]))
+                      (loop)))))))
+
+(define (build f)
+  (turn-on-logger!)
+  (let-values ([(base filename dir?)
+                (split-path f)])
+    (let ([output-filename
+           (build-path
+            (regexp-replace #rx"[.](rkt|ss)$"
+                            (path->string filename)
+                            ".xhtml"))])
+      (unless (directory-exists? (current-output-dir))
+        (make-directory* (current-output-dir)))
+      (parameterize ([current-on-resource
+                      (lambda (r)
+                        (log-info (format "Writing resource ~s" (resource-path r)))
+                        (cond
+                          [(file-exists? (build-path (current-output-dir)
+                                                     (resource-key r)))
+                           (cond [(same-file? (build-path (current-output-dir)
+                                                          (resource-key r))
+                                              (resource-path r))
+                                  (void)]
+                                 [else
+                                  (error 'whalesong "Unable to write resource ~s; this will overwrite a file"
+                                         (build-path (current-output-dir)
+                                                     (resource-key r)))])]
+                          [else
+                           (copy-file (resource-path r) 
+                                      (build-path (current-output-dir)
+                                                  (resource-key r)))]))])
+        (call-with-output-file* (build-path (current-output-dir) output-filename)
+                                (lambda (op)
+                                  (package-standalone-xhtml
+                                   (make-ModuleSource (build-path f))
+                                   op))
+                                #:exists 'replace)))))
+
+
+
+(define (print-the-runtime)
+  (turn-on-logger!)
+  (display (get-runtime) (current-output-port)))
+
+
+
+(define (get-javascript-code filename)
+  (turn-on-logger!)
+  (display (get-standalone-code
+            (make-ModuleSource (build-path filename)))
+           (current-output-port)))

whalesong.rkt

@@ -1,19 +1,16 @@
 #!/usr/bin/env racket
 #lang racket/base
 
-(require racket/list
+(require "private/command.rkt"
-         racket/string
-         racket/match
-         racket/file
-         racket/path
-         racket/port
-         "make/make-structs.rkt"
-         "js-assembler/package.rkt"
-         "resource/structs.rkt"
-         "private/command.rkt"
-         "logger.rkt"
          "parameters.rkt"
-         raco/command-name)
+         "whalesong-helpers.rkt")
+
+;; Command line for running Whalesong.
+
+
+;; TODO: we may want to adopt this as a raco command, as described in:
+;;
+;;     http://docs.racket-lang.org/raco/command.html
 
 
 ;; Usage:
@@ -34,14 +31,10 @@
 
 
 
-(define current-verbose? (make-parameter #f))
-(define current-resource-dir (make-parameter (build-path (current-directory))))
-(define current-write-resources? (make-parameter #t))
-
 
 (define (at-toplevel)
   (svn-style-command-line
-   #:program "whalesong"  ; (short-program+command-name)
+   #:program "whalesong"
    #:argv (current-command-line-arguments)
    "The Whalesong command-line tool for compiling Racket to JavaScript"
    ["build" "build a standalone xhtml package" 
@@ -53,9 +46,12 @@
             [("--compress-javascript")
              ("Compress JavaScript with Google Closure (requires Java)")
              (current-compress-javascript? #t)]
-            
+            [("--dest-dir")
+             dest-dir
+             ("Set destination directory (default: current-directory)")
+             (current-output-dir dest-dir)]
             #:args (path)
-            (do-the-build path)]
+            (build path)]
    ["get-runtime" "print the runtime library to standard output"
                   "Prints the runtime JavaScript library that's used by Whalesong programs."
                   #:once-each
@@ -84,86 +80,4 @@
                      (get-javascript-code file)]))
 
 
-
-
-(define (turn-on-logger!)
-  (void (thread (lambda ()
-                  (let ([receiver
-                         (make-log-receiver whalesong-logger
-                                            (if (current-verbose?)
-                                                'debug
-                                                'info))])
-                    (let loop ()
-                      (let ([msg (sync receiver)])
-                        (match msg
-                          [(vector level msg data)
-                           (fprintf (current-error-port)"~a: ~a\n" level msg)
-                           (flush-output (current-error-port))]))
-                      (loop)))))))
-                    
-
-
-
-   
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (same-file? p1 p2)
-  (or (equal? (normalize-path p1) (normalize-path p2))
-      (bytes=? (call-with-input-file p1 port->bytes)
-               (call-with-input-file p2 port->bytes))))
-
-
-(define (do-the-build f)
-  (turn-on-logger!)
-  (let-values ([(base filename dir?)
-                (split-path f)])
-    (let ([output-filename
-           (build-path
-            (regexp-replace #rx"[.](rkt|ss)$"
-                            (path->string filename)
-                            ".xhtml"))])
-      (parameterize ([current-on-resource
-                      (lambda (r)
-                        (make-directory* (current-resource-dir))
-                        (log-info (format "Writing resource ~s" (resource-path r)))
-                        (cond
-                         [(file-exists? (build-path (current-resource-dir)
-                                                    (resource-key r)))
-                          (cond [(same-file? (build-path (current-resource-dir)
-                                                         (resource-key r))
-                                             (resource-path r))
-                                 (void)]
-                                [else
-                                 (error 'whalesong "Unable to write resource ~s; this will overwrite a file"
-                                        (build-path (current-resource-dir)
-                                                         (resource-key r)))])]
-                         [else
-                          (copy-file (resource-path r) 
-                                     (build-path (current-resource-dir)
-                                                 (resource-key r)))]))])
-        (call-with-output-file* output-filename
-                                (lambda (op)
-                                  (package-standalone-xhtml
-                                   (make-ModuleSource (build-path f))
-                                   op))
-                                #:exists 'replace)))))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (print-the-runtime)
-  (turn-on-logger!)
-  (display (get-runtime) (current-output-port)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (get-javascript-code filename)
-  (turn-on-logger!)
-  (display (get-standalone-code
-            (make-ModuleSource (build-path filename)))
-           (current-output-port)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (at-toplevel)

world/kernel.js

@@ -134,7 +134,7 @@ var adaptWorldFunction = function(worldFunction) {
                  // FIXME: do error trapping
                  console.log(err);
              }].concat([].slice.call(arguments, 0, arguments.length - 1)));
-    }
+    };
 };