unified clojure.main, patch from Stephen C. Gilardi

5 files changed, 247 insertions, 257 deletions

diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj
index 527beb7e..fa869e64 100644
--- a/src/clj/clojure/main.clj
+++ b/src/clj/clojure/main.clj
@@ -1,5 +1,5 @@
 ;; Copyright (c) Rich Hickey All rights reserved. The use and
-;; distribution terms for this software are covered by the Common Public
+;; distribution terms for this software are covered by the Eclipse Public
 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found
 ;; in the file epl-v10.html at the root of this distribution. By using this
 ;; software in any fashion, you are agreeing to be bound by the terms of
@@ -9,12 +9,19 @@
 ;; Originally contributed by Stephen C. Gilardi
 
 (ns clojure.main
-  (:gen-class)
-  (:import (clojure.lang Compiler Compiler$CompilerException RT)))
+  (:import (clojure.lang Compiler Compiler$CompilerException
+                         LineNumberingPushbackReader RT)))
+
+(declare main)
+
+(def #^{:private true}
+     eof (Object.))
 
 (defmacro with-bindings
   "Executes body in the context of thread-local bindings for several vars
-  that often need to be set!"
+  that often need to be set!: *ns* *warn-on-reflection* *print-meta*
+  *print-length* *print-level* *compile-path* *command-line-args* *1
+  *2 *3 *e"
   [& body]
   `(binding [*ns* *ns*
              *warn-on-reflection* *warn-on-reflection*
@@ -38,6 +45,38 @@
       (recur cause)
       cause)))
 
+(defn skip-if-eol
+  "If the next character on stream s is a newline, skips it, otherwise
+  leaves the stream untouched. Returns :line-start, :stream-end, or :body
+  to indicate the relative location of the next character on s. The stream
+  must either be an instance of LineNumberingPushbackReader or duplicate
+  its behavior of both supporting .unread and collapsing all of CR, LF, and
+  CRLF to a single \\newline."
+  [s]
+  (let [c (.read s)]
+    (cond
+     (= c (int \newline)) :line-start
+     (= c -1) :stream-end
+     :else (do (.unread s c) :body))))
+
+(defn skip-whitespace
+  "Skips whitespace characters on stream s. Returns :line-start, :stream-end,
+  or :body to indicate the relative location of the next character on s.
+  Interprets comma as whitespace and semicolon as comment to end of line.
+  Does not interpret #! as comment to end of line because only one
+  character of lookahead is available. The stream must either be an
+  instance of LineNumberingPushbackReader or duplicate its behavior of both
+  supporting .unread and collapsing all of CR, LF, and CRLF to a single
+  \\newline."
+  [s]
+  (loop [c (.read s)]
+    (cond
+     (= c (int \newline)) :line-start
+     (= c -1) :stream-end
+     (= c (int \;)) (do (.readLine s) :line-start)
+     (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s))
+     :else (do (.unread s c) :body))))
+
 (defn repl-exception
   "Returns CompilerExceptions in tact, but only the root cause of other
   throwables"
@@ -47,21 +86,31 @@
     (root-cause throwable)))
 
 (defn repl
-  "Generic, reusable, read-eval-print loop. Options are sequential
-  keyword-value pairs. Available options and their defaults:
+  "Generic, reusable, read-eval-print loop. Reads from *in* and writes to
+  *out*. *in* must either be an instance of LineNumberingPushbackReader or
+  duplicate its behavior of both supporting .unread and collapsing CR, LF,
+  and CRLF into a single \\newline. Options are sequential keyword-value
+  pairs. Available options and their defaults:
 
      - :init, function of no arguments, initialization hook
        default: #()
 
-     - :prompt, function of no arguments, prompts for more input
+     - :need-prompt, function of no arguments, called before each
+       read-eval-print except the first, the user will be prompted if it
+       returns true.
+       default: (if (instance? LineNumberingPushbackReader *in*)
+                  #(.atLineStart *in*)
+                  #(identity true))
+
+     - :prompt, function of no arguments, prompts for more input.
        default: #(printf \"%s=> \" (ns-name *ns*))
 
      - :flush, function of no arguments, flushes output
        default: flush
 
-     - :read, function of one argument, returns the next object read from
-       the input, or its argument iff the input is exhausted
-       default: #(read *in* false %)
+     - :read, function of no arguments, returns the next object read from
+       the input
+       default: read
 
      - :eval, funtion of one argument, returns the evaluation of its
        argument
@@ -74,36 +123,40 @@
        read, eval, or print throws an exception or error
        default: #(.println *err* (repl-exception %))"
   [& options]
-  (let [{:keys [init prompt flush read eval print caught]
-         :or {init    #()
-              prompt  #(printf "%s=> " (ns-name *ns*))
-              flush   flush
-              read    #(read *in* false %)
-              eval    eval
-              print   prn
-              caught  #(.println *err* (repl-exception %))}}
-        (apply hash-map options)
-        eof (Object.)]
+  (let [{:keys [init need-prompt prompt flush read eval print caught]
+         :or {init        #()
+              need-prompt (if (instance? LineNumberingPushbackReader *in*)
+                            #(.atLineStart *in*)
+                            #(identity true))
+              prompt      #(printf "%s=> " (ns-name *ns*))
+              flush       flush
+              read        read
+              eval        eval
+              print       prn
+              caught      #(.println *err* (repl-exception %))}}
+        (apply hash-map options)]
     (with-bindings
-     (init)
-     (loop []
-       (prompt)
-       (flush)
-       (when-not
-        (= eof
-           (try
-            (let [input (read eof)]
-              (if (= input eof)
-                eof
-                (let [value (eval input)]
-                  (print value)
-                  (set! *3 *2)
-                  (set! *2 *1)
-                  (set! *1 value))))
-            (catch Throwable e
-              (caught e)
-              (set! *e e))))
-        (recur))))))
+      (init)
+      (prompt)
+      (flush)
+      (loop [where (skip-whitespace *in*)]
+        (when-not (= where :stream-end)
+          (when (= where :body)
+            (try
+             (let [input (read)]
+               (skip-if-eol *in*)
+               (let [value (eval input)]
+                 (print value)
+                 (set! *3 *2)
+                 (set! *2 *1)
+                 (set! *1 value)))
+             (catch Throwable e
+               (caught e)
+               (set! *e e))))
+          (when (need-prompt)
+            (prompt)
+            (flush))
+          (recur (skip-whitespace *in*)))))))
 
 (defn load-script
   "Loads Clojure source from a file or resource given its path. Paths
@@ -120,11 +173,15 @@
   (load-script path))
 
 (defn- eval-opt
-  "Eval expr, print the result if it's not nil"
-  [expr]
-  (let [value (with-in-str expr (eval (read)))]
-    (when-not (nil? value)
-      (println value))))
+  "Evals expressions in str, prints each non-nil result using prn"
+  [str]
+  (with-in-str str
+    (loop [input (read *in* false eof)]
+      (when-not (= input eof)
+        (let [value (eval input)]
+          (when-not (nil? value)
+            (prn value))
+          (recur (read *in* false eof)))))))
 
 (defn- init-dispatch
   "Returns the handler associated with an init opt"
@@ -149,58 +206,28 @@
   (when-not (some #(= eval-opt (init-dispatch (first %))) inits)
     (println "Clojure"))
   (repl :init #(initialize args inits))
-  (prn))
+  (prn)
+  (System/exit 0))
 
 (defn- script-opt
   "Run a script from a file, resource, or standard in with args and inits"
   [[path & args] inits]
   (with-bindings
-   (initialize args inits)
-   (if (= path "-")
-     (load-reader *in*)
-     (load-script path))))
+    (initialize args inits)
+    (if (= path "-")
+      (load-reader *in*)
+      (load-script path))))
 
 (defn- null-opt
-  "No repl or script opt present, just bind nil and run inits"
+  "No repl or script opt present, just bind args and run inits"
   [args inits]
   (with-bindings
-   (initialize args inits)))
+    (initialize args inits)))
 
 (defn- help-opt
   "Print help text for main"
   [_ _]
-  (println
-"Usage: java -jar clojure.jar [option*] [arg*]
-
-  With no options or args, runs an interactive Read-Eval-Print Loop
-
-init options:
-
-  -i, --init path  Load a file or resource
-  -e, --eval expr  Evaluate an expression and print its value if non-nil
-
-main options:
-
-  -r, --repl       Run a repl
-  path             Run a script from from a file or resource
-  -                Run a script from standard input
-  -h, -?, --help   Print this help message and exit
-
-operation:
-
-  - Establishes thread-local bindings for commonly set!-able vars
-  - Enters the user namespace
-  - Binds *command-line-args* to a seq of strings containing command line
-    args that appear after any main option
-  - Runs all init options in order
-  - Runs a repl or script if requested
-
-  The init options may be repeated and mixed freely, but must appear before
-  any main option. The appearance of any eval option before running a repl
-  suppresses the usual repl greeting message: \"Clojure\".
-
-  Paths may be absolute or relative in the filesystem or relative to
-  classpath. Classpath-relative paths have prefix of @ or @/"))
+  (println (:doc (meta (var main)))))
 
 (defn- main-dispatch
   "Returns the handler associated with a main option"
@@ -214,8 +241,50 @@ operation:
      "-?"     help-opt} opt)
    script-opt))
 
-(defn- -main
-  "Flexible main for Clojure"
+(defn- legacy-repl
+  "Called by the clojure.lang.Repl.main stub to run a repl with args
+  specified the old way"
+  [args]
+  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
+    (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits))))
+
+(defn- legacy-script
+  "Called by the clojure.lang.Script.main stub to run a script with args
+  specified the old way"
+  [args]
+  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
+    (null-opt args (map vector (repeat "-i") inits))))
+
+(defn main
+  "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*]
+
+  With no options or args, runs an interactive Read-Eval-Print Loop
+
+  init options:
+    -i, --init path   Load a file or resource
+    -e, --eval string Evaluate expressions in string; print non-nil values
+
+  main options:
+    -r, --repl        Run a repl
+    path              Run a script from from a file or resource
+    -                 Run a script from standard input
+    -h, -?, --help    Print this help message and exit
+
+  operation:
+
+    - Establishes thread-local bindings for commonly set!-able vars
+    - Enters the user namespace
+    - Binds *command-line-args* to a seq of strings containing command line
+      args that appear after any main option
+    - Runs all init options in order
+    - Runs a repl or script if requested
+
+  The init options may be repeated and mixed freely, but must appear before
+  any main option. The appearance of any eval option before running a repl
+  suppresses the usual repl greeting message: \"Clojure\".
+
+  Paths may be absolute or relative in the filesystem or relative to
+  classpath. Classpath-relative paths have prefix of @ or @/"
   [& args]
   (try
    (if args
@@ -225,6 +294,5 @@ operation:
          ((main-dispatch opt) args inits)))
      (repl-opt nil nil))
    (catch Exception e
-     (.printStackTrace e *err*))
-   (finally
-    (flush))))
+     (.printStackTrace e *err*)))
+  (flush))
diff --git a/src/jvm/clojure/lang/LineNumberingPushbackReader.java b/src/jvm/clojure/lang/LineNumberingPushbackReader.java
index f722e867..ad81ce9a 100644
--- a/src/jvm/clojure/lang/LineNumberingPushbackReader.java
+++ b/src/jvm/clojure/lang/LineNumberingPushbackReader.java
@@ -18,6 +18,16 @@ import java.io.IOException;
 

 public class LineNumberingPushbackReader extends PushbackReader{

 

+// This class is a PushbackReader that wraps a LineNumberReader. The code

+// here to handle line terminators only mentions '\n' because

+// LineNumberReader collapses all occurrences of CR, LF, and CRLF into a

+// single '\n'.

+

+private static final int newline = (int) '\n';

+

+private boolean _atLineStart = true;

+private boolean _prev;

+

 public LineNumberingPushbackReader(Reader r){

 	super(new LineNumberReader(r));

 }

@@ -26,7 +36,40 @@ public int getLineNumber(){
 	return ((LineNumberReader) in).getLineNumber() + 1;

 }

 

+public int read() throws IOException{

+    int c = super.read();

+    _prev = _atLineStart;

+    _atLineStart = (c == newline) || (c == -1);

+    return c;

+}

+

+public void unread(int c) throws IOException{

+    super.unread(c);

+    _atLineStart = _prev;

+}

+

 public String readLine() throws IOException{

-	return ((LineNumberReader)in).readLine();

+    int c = read();

+    String line;

+    switch (c) {

+    case -1:

+        line = null;

+        break;

+    case newline:

+        line = "";

+        break;

+    default:

+        String first = String.valueOf((char) c);

+        String rest = ((LineNumberReader)in).readLine();

+        line = (rest == null) ? first : first + rest;

+        _prev = false;

+        _atLineStart = true;

+        break;

+    }

+    return line;

+}

+

+public boolean atLineStart(){

+    return _atLineStart;

 }

 }

diff --git a/src/jvm/clojure/lang/Repl.java b/src/jvm/clojure/lang/Repl.java
index 4a9153b2..9abe82aa 100644
--- a/src/jvm/clojure/lang/Repl.java
+++ b/src/jvm/clojure/lang/Repl.java
@@ -12,111 +12,11 @@
 
 package clojure.lang;
 
-import java.io.InputStreamReader;
-import java.io.OutputStreamWriter;
-import java.io.PrintWriter;
+import clojure.main;
 
-public class Repl{
-static final Symbol USER = Symbol.create("user");
-static final Symbol CLOJURE = Symbol.create("clojure.core");
-
-static final Var in_ns = RT.var("clojure.core", "in-ns");
-static final Var refer = RT.var("clojure.core", "refer");
-static final Var ns = RT.var("clojure.core", "*ns*");
-static final Var compile_path = RT.var("clojure.core", "*compile-path*");
-static final Var warn_on_reflection = RT.var("clojure.core", "*warn-on-reflection*");
-static final Var print_meta = RT.var("clojure.core", "*print-meta*");
-static final Var print_length = RT.var("clojure.core", "*print-length*");
-static final Var print_level = RT.var("clojure.core", "*print-level*");
-static final Var star1 = RT.var("clojure.core", "*1");
-static final Var star2 = RT.var("clojure.core", "*2");
-static final Var star3 = RT.var("clojure.core", "*3");
-static final Var stare = RT.var("clojure.core", "*e");
+class Repl {
 
 public static void main(String[] args) throws Exception{
-
-//	RT.init();
-
-	try
-		{
-		//*ns* must be thread-bound for in-ns to work
-		//thread-bind *warn-on-reflection* so it can be set!
-		//thread-bind *1,*2,*3,*e so each repl has its own history
-		//must have corresponding popThreadBindings in finally clause
-		Var.pushThreadBindings(
-				RT.map(ns, ns.get(),
-				       warn_on_reflection, warn_on_reflection.get(),
-				       print_meta, print_meta.get(),
-				       print_length, print_length.get(),
-				       print_level, print_level.get(),
-				       compile_path, "classes",
-				       star1, null,
-				       star2, null,
-				       star3, null,
-				       stare, null));
-
-		//create and move into the user namespace
-		in_ns.invoke(USER);
-		refer.invoke(CLOJURE);
-
-		//load any supplied files
-		for(String file : RT.processCommandLine(args))
-			try
-				{
-				Compiler.loadFile(file);
-				}
-			catch(Exception e)
-				{
-				e.printStackTrace((PrintWriter) RT.ERR.get());
-				}
-
-		//repl IO support
-		LineNumberingPushbackReader rdr = new LineNumberingPushbackReader(new InputStreamReader(System.in, RT.UTF8));
-		OutputStreamWriter w = (OutputStreamWriter) RT.OUT.get();//new OutputStreamWriter(System.out);
-		Object EOF = new Object();
-
-		//start the loop
-		w.write("Clojure\n");
-		for(; ;)
-			{
-			try
-				{
-				w.write(Compiler.currentNS().name + "=> ");
-				w.flush();
-				Object r = LispReader.read(rdr, false, EOF, false);
-				if(r == EOF)
-					{
-					w.write("\n");
-					w.flush();
-					break;
-					}
-				Object ret = Compiler.eval(r);
-				RT.print(ret, w);
-				w.write('\n');
-				//w.flush();
-				star3.set(star2.get());
-				star2.set(star1.get());
-				star1.set(ret);
-				}
-			catch(Throwable e)
-				{
-				Throwable c = e;
-				while(c.getCause() != null)
-					c = c.getCause();
-				((PrintWriter) RT.ERR.get()).println(e instanceof Compiler.CompilerException ? e : c);
-				stare.set(e);
-				}
-			}
-		}
-	catch(Exception e)
-		{
-		e.printStackTrace((PrintWriter) RT.ERR.get());
-		}
-	finally
-		{
-		Var.popThreadBindings();
-		}
-	System.exit(0);
+    main.legacy_repl(args);
 }
-
 }
diff --git a/src/jvm/clojure/lang/Script.java b/src/jvm/clojure/lang/Script.java
index e67f85e9..84abbe59 100644
--- a/src/jvm/clojure/lang/Script.java
+++ b/src/jvm/clojure/lang/Script.java
@@ -12,73 +12,11 @@
 
 package clojure.lang;
 
-import java.io.OutputStreamWriter;
-import java.io.PrintWriter;
-import java.io.IOException;
-import java.util.List;
-import java.util.Arrays;
+import clojure.main;
 
-/**
- * <code>Script</code> provides a way to run one or more Clojure files
- * from a command line.  Example usage:
- * <p>
- * <pre>java -cp clojure.jar script1.clj @/dir/script2.clj -- [arguments]</pre>
- * </p>
- * <p>
- * The example above will:
- * <ol>
- * <li>bind *command-line-args* to a seq containing the (optional) arguments provided
- *     after the two dashes (--); this provides a way to provide command-line arguments
- *     to your scripts</li>
- * <li>load the Clojure file <i>at the filesystem path</i> <code>script1.clj</code></li>
- * <li>load the Clojure file with the name <code>dir/script2.clj</code> <i>from the
- *     current Java classpath</i>.  Files to be loaded from the classpath must be prefixed
- *     with a '@' character, and must be an "absolute path" to the classpath resource.
- *     Note that the "path" will be treated as absolute within the classpath, whether it is
- *     prefixed with a slash or not.</li>
- * </ol>
- * </p>
- * <p>
- * Any number of Clojure files can be provided as path arguments; these
- * files are loaded in order, as if via <code>load-file</code>.  Filesystem and classpath
- * paths may be provided in any order, and be intermixed as necessary.
- * </p>
- * <p>
- * Once the final script path has been loaded, the java process exits.
- * </p>
- */
-public class Script{
+class Script {
 
 public static void main(String[] args) throws Exception{
-    try
-		{
-		for(String file : RT.processCommandLine(args))
-            {
-            if (file.startsWith("@"))
-                {
-                // trim leading slash if it's there -- loadResourceScript prepends its
-                // own slash to every name it's given
-                RT.loadResourceScript(file.substring(file.startsWith("@/") ? 2 : 1));
-                }
-            else
-                {
-                Compiler.loadFile(file);
-                }
-            }
-		}
-	finally
-		{
-		OutputStreamWriter w = (OutputStreamWriter) RT.OUT.get();
-		try
-			{
-			w.flush();
-			w.close();
-			}
-		catch(IOException e)
-			{
-			e.printStackTrace((PrintWriter)RT.ERR.get());
-			}
-		}
+    main.legacy_script(args);
 }
 }
-
diff --git a/src/jvm/clojure/main.java b/src/jvm/clojure/main.java
new file mode 100644
index 00000000..50bc3434
--- /dev/null
+++ b/src/jvm/clojure/main.java
@@ -0,0 +1,41 @@
+/**
+ *   Copyright (c) Rich Hickey. All rights reserved.
+ *   The use and distribution terms for this software are covered by the
+ *   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+ *   which can be found in the file epl-v10.html at the root of this distribution.
+ *   By using this software in any fashion, you are agreeing to be bound by
+ * 	 the terms of this license.
+ *   You must not remove this notice, or any other, from this software.
+ **/
+
+package clojure;
+
+import clojure.lang.Symbol;
+import clojure.lang.Namespace;
+import clojure.lang.Var;
+import clojure.lang.RT;
+
+public class main{
+
+final static private Symbol CLOJURE_MAIN = Symbol.create("clojure.main");
+final static private Namespace CLOJURE_MAIN_NS = Namespace.findOrCreate(CLOJURE_MAIN);
+final static private Var REQUIRE = Var.intern(RT.CLOJURE_NS, Symbol.create("require"));
+final static private Var LEGACY_REPL = Var.intern(CLOJURE_MAIN_NS, Symbol.create("legacy-repl"));
+final static private Var LEGACY_SCRIPT = Var.intern(CLOJURE_MAIN_NS, Symbol.create("legacy-script"));
+final static private Var MAIN = Var.intern(CLOJURE_MAIN_NS, Symbol.create("main"));
+
+public static void legacy_repl(String[] args) throws Exception{
+    REQUIRE.invoke(CLOJURE_MAIN);
+    LEGACY_REPL.invoke(RT.seq(args));
+}
+
+public static void legacy_script(String[] args) throws Exception{
+    REQUIRE.invoke(CLOJURE_MAIN);
+    LEGACY_SCRIPT.invoke(RT.seq(args));
+}
+
+public static void main(String[] args) throws Exception{
+    REQUIRE.invoke(CLOJURE_MAIN);
+    MAIN.applyTo(RT.seq(args));
+}
+}