From a76e86013a3c977c0cb1ec0e75fb1cdcc5141b4e Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Sun, 2 May 2010 18:52:47 -0500
Subject: [PATCH] Fix loading from relative paths, and output of empty lists.

Also add some basic command-line processing to the front-end.
---
 compiler.scm           | 34 ++++++++++++++++++++++++++++++----
 libcompiler/reader.scm | 31 +++++++++++++++----------------
 libcompiler/writer.scm |  2 ++
 3 files changed, 47 insertions(+), 20 deletions(-)

diff --git a/compiler.scm b/compiler.scm
index 611248e..7aeb173 100755
--- a/compiler.scm
+++ b/compiler.scm
@@ -1,16 +1,42 @@
 #! /usr/bin/mzscheme
 #lang scheme/base
 
+(require scheme/path)
 (require scheme/pretty)
+(require scheme/cmdline)
 
 (require (file "libcompiler/reader.scm"))
 (require (file "libcompiler/compiler.scm"))
 (require (file "libcompiler/writer.scm"))
 
-(optimize? #t)
+(define map-bytecode? (make-parameter #t))
 
-;(pretty-print (reduce-function (read-module)))
-(write-rla-value (compile-function (read-module)))
-(write-char #\Newline)
+(define source-file
+  (command-line
+    #:once-each
+    [("-O") ol "Set the optimization level"
+               (optimize? (>= (string->number ol) 1))]
+    [("-R" "--reduce-only") "Stop before mapping forms to VM bytecode"
+                            (map-bytecode? #f)]
+    #:args source-file
+    (if (null? source-file)
+        "-"
+        (car source-file))))
+
+(define source-module
+  (if (string=? source-file "-")
+      (read-module)
+      (let* ([complete-path (path->complete-path source-file)]
+             [directory     (path-only complete-path)])
+        (with-input-from-file complete-path
+          (lambda ()
+            (parameterize ([current-directory directory])
+              (read-module)))))))
+
+(if (map-bytecode?)
+    (begin
+      (write-rla-value (compile-function source-module))
+      (write-char #\Newline))
+    (pretty-print (reduce-function source-module)))
 
 ; vim:set sw=2 expandtab:
diff --git a/libcompiler/reader.scm b/libcompiler/reader.scm
index bb4aeb4..6eff65a 100644
--- a/libcompiler/reader.scm
+++ b/libcompiler/reader.scm
@@ -3,6 +3,7 @@
 (require scheme/list)
 (require scheme/match)
 (require scheme/path)
+(require scheme/pretty)
 
 (provide read-module)
 
@@ -23,17 +24,6 @@
             (error "Unrecognized define-form:" (first forms))]
            [`((begin . ,body) . ,rst)
             (iter (append body rst) bindings)]
-           [`((load ,(? string? pathname)) . ,rst)
-            (let* ([complete-path (path->complete-path pathname)]
-                   [directory (path-only complete-path)])
-              (iter (append (with-input-from-file complete-path
-                              (lambda ()
-                                (parameterize ([current-directory directory])
-                                  (read-forms))))
-                            rst)
-                    bindings))]
-           [`((load . ,_) . ,rst)
-            (error "Unrecognized load-form:" (first forms))]
            [`(,form . ,rst)
             (if (null? bindings)
                 (cons form (iter rst '()))
@@ -41,10 +31,19 @@
                     ,@(cons form (iter rst '())))))]))))
 
 (define (read-forms [port (current-input-port)])
-  (reverse (let iter ([form (read port)]
-                      [forms '()])
-             (if (eof-object? form)
-                 forms
-                 (iter (read port) (cons form forms))))))
+  (let iter ([form (read port)]
+             [forms '()])
+    (match form
+      [(? eof-object?)
+       (reverse forms)]
+      [`(load ,(? string? pathname))
+       (let ([loaded-forms (with-input-from-file pathname
+                             (lambda ()
+                               (parameterize ([current-directory (or (path-only pathname) ".")])
+                                 (read-forms))))])
+         (iter (read port) (cons `(begin ,@loaded-forms) forms)))]
+      [`(load . ,_)
+       (error "Unrecognized load-form:" (first forms))]
+      [_ (iter (read port) (cons form forms))])))
 
 ; vim:set sw=2 expandtab:
diff --git a/libcompiler/writer.scm b/libcompiler/writer.scm
index 127f58f..26742d5 100644
--- a/libcompiler/writer.scm
+++ b/libcompiler/writer.scm
@@ -135,6 +135,8 @@
            (write-rla-value (vector-ref value i) port)
            (write-char #\Space port))
          (write-string ")" port)]
+      [(null? value)
+         (write-string "()" port)]
       [(pair? value)
          (write-string "(" port)
          (let iter ([lst value])