repl read refactoring, patch from scgilardi

1 files changed, 94 insertions, 59 deletions

diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj
index 744ac0da..63644e12 100644
--- a/src/clj/clojure/main.clj
+++ b/src/clj/clojure/main.clj
@@ -14,9 +14,6 @@
 
 (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!: *ns* *warn-on-reflection* *print-meta*
@@ -36,14 +33,10 @@
              *e nil]
      ~@body))
 
-(defn- root-cause
-  "Returns the initial cause of an exception or error by peeling off all of
-  its wrappers"
-  [throwable]
-  (loop [cause throwable]
-    (if-let [cause (.getCause cause)]
-      (recur cause)
-      cause)))
+(defn repl-prompt
+  "Default :prompt hook for repl"
+  []
+  (printf "%s=> " (ns-name *ns*)))
 
 (defn skip-if-eol
   "If the next character on stream s is a newline, skips it, otherwise
@@ -77,6 +70,33 @@
      (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s))
      :else (do (.unread s c) :body))))
 
+(defn repl-read
+  "Default :read hook for repl. Reads from *in* which must either be an
+  instance of LineNumberingPushbackReader or duplicate its behavior of both
+  supporting .unread and collapsing all of CR, LF, and CRLF into a single
+  \\newline. repl-read:
+    - skips whitespace, then
+      - returns request-prompt on start of line, or
+      - returns request-exit on end of stream, or
+      - reads an object from the input stream, then
+        - skips the next input character if it's end of line, then
+        - returns the object."
+  [request-prompt request-exit]
+  (or ({:line-start request-prompt :stream-end request-exit}
+       (skip-whitespace *in*))
+      (let [input (read)]
+        (skip-if-eol *in*)
+        input)))
+
+(defn- root-cause
+  "Returns the initial cause of an exception or error by peeling off all of
+  its wrappers"
+  [throwable]
+  (loop [cause throwable]
+    (if-let [cause (.getCause cause)]
+      (recur cause)
+      cause)))
+
 (defn repl-exception
   "Returns CompilerExceptions in tact, but only the root cause of other
   throwables"
@@ -85,14 +105,21 @@
     throwable
     (root-cause throwable)))
 
-(defn repl
-  "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:
+(defn repl-caught
+  "Default :caught hook for repl"
+  [e]
+  (.println *err* (repl-exception e)))
 
-     - :init, function of no arguments, initialization hook
+(defn repl
+  "Generic, reusable, read-eval-print loop. By default, reads from *in*,
+  writes to *out*, and prints exception summaries to *err*. If you use the
+  default :read hook, *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 called with
+       bindings for set!-able vars in place.
        default: #()
 
      - :need-prompt, function of no arguments, called before each
@@ -103,14 +130,18 @@
                   #(identity true))
 
      - :prompt, function of no arguments, prompts for more input.
-       default: #(printf \"%s=> \" (ns-name *ns*))
+       default: repl-prompt
 
      - :flush, function of no arguments, flushes output
        default: flush
 
-     - :read, function of no arguments, returns the next object read from
-       the input
-       default: read
+     - :read, function of two arguments, reads from *in*:
+         - returns its first argument to request a fresh prompt
+           - depending on need-prompt, this may cause the repl to prompt
+             before reading again
+         - returns its second argument to request an exit from the repl
+         - else returns the next object read from the input stream
+       default: repl-read
 
      - :eval, funtion of one argument, returns the evaluation of its
        argument
@@ -121,46 +152,49 @@
 
      - :caught, function of one argument, a throwable, called when
        read, eval, or print throws an exception or error
-       default: #(.println *err* (repl-exception %))"
+       default: repl-caught"
   [& options]
   (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*))
+              prompt      repl-prompt
               flush       flush
-              read        read
+              read        repl-read
               eval        eval
               print       prn
-              caught      #(.println *err* (repl-exception %))}}
-        (apply hash-map options)]
+              caught      repl-caught}}
+        (apply hash-map options)
+        request-prompt (Object.)
+        request-exit (Object.)
+        read-eval-print
+        (fn []
+          (try
+           (let [input (read request-prompt request-exit)]
+             (or (#{request-prompt request-exit} input)
+                 (let [value (eval input)]
+                   (print value)
+                   (set! *3 *2)
+                   (set! *2 *1)
+                   (set! *1 value))))
+           (catch Throwable e
+             (caught e)
+             (set! *e e))))]
     (with-bindings
-      (try
-       (init)
-       (catch Throwable e
-	 (caught e)
-	 (set! *e e)))
-      (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*)))))))
+     (try
+      (init)
+      (catch Throwable e
+        (caught e)
+        (set! *e e)))
+     (prompt)
+     (flush)
+     (loop []
+       (when-not (= (read-eval-print) request-exit)
+         (when (need-prompt)
+           (prompt)
+           (flush))
+         (recur))))))
 
 (defn load-script
   "Loads Clojure source from a file or resource given its path. Paths
@@ -179,13 +213,14 @@
 (defn- eval-opt
   "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)))))))
+  (let [eof (Object.)]
+    (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"