clojure 1.0.0

data/lib/clojure/main.clj

@@ -0,0 +1,337 @@
+;; 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.
+
+;; Originally contributed by Stephen C. Gilardi
+
+(ns clojure.main
+  (:import (clojure.lang Compiler Compiler$CompilerException
+                         LineNumberingPushbackReader RT)))
+
+(declare main)
+
+(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*
+  *print-length* *print-level* *compile-path* *command-line-args* *1
+  *2 *3 *e"
+  [& body]
+  `(binding [*ns* *ns*
+             *warn-on-reflection* *warn-on-reflection*
+             *print-meta* *print-meta*
+             *print-length* *print-length*
+             *print-level* *print-level*
+             *compile-path* (System/getProperty "clojure.compile.path" "classes")
+             *command-line-args* *command-line-args*
+             *1 nil
+             *2 nil
+             *3 nil
+             *e nil]
+     ~@body))
+
+(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
+  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-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"
+  [throwable]
+  (if (instance? Compiler$CompilerException throwable)
+    throwable
+    (root-cause throwable)))
+
+(defn repl-caught
+  "Default :caught hook for repl"
+  [e]
+  (.println *err* (repl-exception e)))
+
+(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
+       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: repl-prompt
+
+     - :flush, function of no arguments, flushes output
+       default: flush
+
+     - :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
+       default: eval
+
+     - :print, function of one argument, prints its argument to the output
+       default: prn
+
+     - :caught, function of one argument, a throwable, called when
+       read, eval, or print throws an exception or error
+       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      repl-prompt
+              flush       flush
+              read        repl-read
+              eval        eval
+              print       prn
+              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 []
+       (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
+  beginning with @ or @/ are considered relative to classpath."
+  [path]
+  (if (.startsWith path "@")
+    (RT/loadResourceScript
+     (.substring path (if (.startsWith path "@/") 2 1)))
+    (Compiler/loadFile path)))
+
+(defn- init-opt
+  "Load a script"
+  [path]
+  (load-script path))
+
+(defn- eval-opt
+  "Evals expressions in str, prints each non-nil result using prn"
+  [str]
+  (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"
+  [opt]
+  ({"-i"     init-opt
+    "--init" init-opt
+    "-e"     eval-opt
+    "--eval" eval-opt} opt))
+
+(defn- initialize
+  "Common initialize routine for repl, script, and null opts"
+  [args inits]
+  (in-ns 'user)
+  (set! *command-line-args* args)
+  (doseq [[opt arg] inits]
+    ((init-dispatch opt) arg)))
+
+(defn- repl-opt
+  "Start a repl with args and inits. Print greeting if no eval options were
+  present"
+  [[_ & args] inits]
+  (when-not (some #(= eval-opt (init-dispatch (first %))) inits)
+    (println "Clojure" (clojure-version)))
+  (repl :init #(initialize args inits))
+  (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))))
+
+(defn- null-opt
+  "No repl or script opt present, just bind args and run inits"
+  [args inits]
+  (with-bindings
+    (initialize args inits)))
+
+(defn- help-opt
+  "Print help text for main"
+  [_ _]
+  (println (:doc (meta (var main)))))
+
+(defn- main-dispatch
+  "Returns the handler associated with a main option"
+  [opt]
+  (or
+   ({"-r"     repl-opt
+     "--repl" repl-opt
+     nil      null-opt
+     "-h"     help-opt
+     "--help" help-opt
+     "-?"     help-opt} opt)
+   script-opt))
+
+(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 ~(clojure-version)\".
+
+  Paths may be absolute or relative in the filesystem or relative to
+  classpath. Classpath-relative paths have prefix of @ or @/"
+  [& args]
+  (try
+   (if args
+     (loop [[opt arg & more :as args] args inits []]
+       (if (init-dispatch opt)
+         (recur more (conj inits [opt arg]))
+         ((main-dispatch opt) args inits)))
+     (repl-opt nil nil))
+   (finally 
+     (flush))))
+

data/lib/clojure/parallel.clj

@@ -0,0 +1,248 @@
+;   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.
+
+(ns clojure.parallel)
+(alias 'parallel 'clojure.parallel)
+
+(comment "
+The parallel library wraps the ForkJoin library scheduled for inclusion in JDK 7:
+
+http://gee.cs.oswego.edu/dl/concurrency-interest/index.html
+
+You'll need jsr166y.jar in your classpath in order to use this
+library.  The basic idea is that Clojure collections, and most
+efficiently vectors, can be turned into parallel arrays for use by
+this library with the function par, although most of the functions
+take collections and will call par if needed, so normally you will
+only need to call par explicitly in order to attach bound/filter/map
+ops. Parallel arrays support the attachment of bounds, filters and
+mapping functions prior to realization/calculation, which happens as
+the result of any of several operations on the
+array (pvec/psort/pfilter-nils/pfilter-dupes). Rather than perform
+composite operations in steps, as would normally be done with
+sequences, maps and filters are instead attached and thus composed by
+providing ops to par. Note that there is an order sensitivity to the
+attachments - bounds precede filters precede mappings.  All operations
+then happen in parallel, using multiple threads and a sophisticated
+work-stealing system supported by fork-join, either when the array is
+realized, or to perform aggregate operations like preduce/pmin/pmax
+etc. A parallel array can be realized into a Clojure vector using
+pvec.
+")
+
+(import '(jsr166y.forkjoin ParallelArray ParallelArrayWithBounds ParallelArrayWithFilter 
+                           ParallelArrayWithMapping 
+                           Ops$Op Ops$BinaryOp Ops$Reducer Ops$Predicate Ops$BinaryPredicate 
+                           Ops$IntAndObjectPredicate Ops$IntAndObjectToObject))
+
+(defn- op [f]
+  (proxy [Ops$Op] []
+    (op [x] (f x))))
+
+(defn- binary-op [f]
+  (proxy [Ops$BinaryOp] []
+    (op [x y] (f x y))))
+
+(defn- int-and-object-to-object [f]
+  (proxy [Ops$IntAndObjectToObject] []
+    (op [i x] (f x i))))
+
+(defn- reducer [f]
+  (proxy [Ops$Reducer] []
+    (op [x y] (f x y))))
+
+(defn- predicate [f]
+  (proxy [Ops$Predicate] []
+    (op [x] (boolean (f x)))))
+
+(defn- binary-predicate [f]
+  (proxy [Ops$BinaryPredicate] []
+    (op [x y] (boolean (f x y)))))
+
+(defn- int-and-object-predicate [f]
+  (proxy [Ops$IntAndObjectPredicate] []
+    (op [i x] (boolean (f x i)))))
+
+(defn par
+  "Creates a parallel array from coll. ops, if supplied, perform
+  on-the-fly filtering or transformations during parallel realization
+  or calculation. ops form a chain, and bounds must precede filters,
+  must precede maps. ops must be a set of keyword value pairs of the
+  following forms:
+
+     :bound [start end] 
+
+  Only elements from start (inclusive) to end (exclusive) will be
+  processed when the array is realized.
+
+     :filter pred 
+
+  Filter preds remove elements from processing when the array is realized. pred
+  must be a function of one argument whose return will be processed
+  via boolean.
+
+     :filter-index pred2 
+
+  pred2 must be a function of two arguments, which will be an element
+  of the collection and the corresponding index, whose return will be
+  processed via boolean.
+
+     :filter-with [pred2 coll2] 
+
+  pred2 must be a function of two arguments, which will be
+  corresponding elements of the 2 collections.
+
+     :map f 
+
+  Map fns will be used to transform elements when the array is
+  realized. f must be a function of one argument.
+
+     :map-index f2 
+
+  f2 must be a function of two arguments, which will be an element of
+  the collection and the corresponding index.
+
+     :map-with [f2 coll2]
+
+  f2 must be a function of two arguments, which will be corresponding
+  elements of the 2 collections."
+
+  ([coll] 
+     (if (instance? ParallelArrayWithMapping coll)
+       coll
+       (. ParallelArray createUsingHandoff  
+        (to-array coll) 
+        (. ParallelArray defaultExecutor))))
+  ([coll & ops]
+     (reduce (fn [pa [op args]] 
+                 (cond
+                  (= op :bound) (. pa withBounds (args 0) (args 1))
+                  (= op :filter) (. pa withFilter (predicate args))
+                  (= op :filter-with) (. pa withFilter (binary-predicate (args 0)) (par (args 1)))
+                  (= op :filter-index) (. pa withIndexedFilter (int-and-object-predicate args))
+                  (= op :map) (. pa withMapping (parallel/op args))
+                  (= op :map-with) (. pa withMapping (binary-op (args 0)) (par (args 1)))
+                  (= op :map-index) (. pa withIndexedMapping (int-and-object-to-object args))
+                  :else (throw (Exception. (str "Unsupported par op: " op)))))
+             (par coll) 
+             (partition 2 ops))))
+
+;;;;;;;;;;;;;;;;;;;;; aggregate operations ;;;;;;;;;;;;;;;;;;;;;;
+(defn pany
+  "Returns some (random) element of the coll if it satisfies the bound/filter/map"
+  [coll] 
+  (. (par coll) any))
+
+(defn pmax
+  "Returns the maximum element, presuming Comparable elements, unless
+  a Comparator comp is supplied"
+  ([coll] (. (par coll) max))
+  ([coll comp] (. (par coll) max comp)))
+
+(defn pmin
+  "Returns the minimum element, presuming Comparable elements, unless
+  a Comparator comp is supplied"
+  ([coll] (. (par coll) min))
+  ([coll comp] (. (par coll) min comp)))
+
+(defn- summary-map [s]
+  {:min (.min s) :max (.max s) :size (.size s) :min-index (.indexOfMin s) :max-index (.indexOfMax s)})
+
+(defn psummary 
+  "Returns a map of summary statistics (min. max, size, min-index, max-index, 
+  presuming Comparable elements, unless a Comparator comp is supplied"
+  ([coll] (summary-map (. (par coll) summary)))
+  ([coll comp] (summary-map (. (par coll) summary comp))))
+
+(defn preduce 
+  "Returns the reduction of the realized elements of coll
+  using function f. Note f will not necessarily be called
+  consecutively, and so must be commutative. Also note that 
+  (f base an-element) might be performed many times, i.e. base is not
+  an initial value as with sequential reduce."
+  [f base coll]
+  (. (par coll) (reduce (reducer f) base)))
+
+;;;;;;;;;;;;;;;;;;;;; collection-producing operations ;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- pa-to-vec [pa]
+  (vec (. pa getArray)))
+
+(defn- pall
+  "Realizes a copy of the coll as a parallel array, with any bounds/filters/maps applied"
+  [coll]
+  (if (instance? ParallelArrayWithMapping coll)
+    (. coll all)
+    (par coll)))
+
+(defn pvec 
+  "Returns the realized contents of the parallel array pa as a Clojure vector"
+  [pa] (pa-to-vec (pall pa)))
+
+(defn pdistinct
+  "Returns a parallel array of the distinct elements of coll"
+  [coll]
+  (pa-to-vec (. (pall coll) allUniqueElements)))
+
+;this doesn't work, passes null to reducer?
+(defn- pcumulate [coll f init]
+  (.. (pall coll) (precumulate (reducer f) init)))
+
+(defn psort 
+  "Returns a new vector consisting of the realized items in coll, sorted, 
+  presuming Comparable elements, unless a Comparator comp is supplied"
+  ([coll] (pa-to-vec (. (pall coll) sort)))
+  ([coll comp] (pa-to-vec (. (pall coll) sort comp))))
+
+(defn pfilter-nils
+  "Returns a vector containing the non-nil (realized) elements of coll"
+  [coll]
+  (pa-to-vec (. (pall coll) removeNulls)))
+
+(defn pfilter-dupes 
+  "Returns a vector containing the (realized) elements of coll, 
+  without any consecutive duplicates"
+  [coll]
+  (pa-to-vec (. (pall coll) removeConsecutiveDuplicates)))
+
+
+(comment
+(load-file "src/parallel.clj")
+(refer 'parallel)
+(pdistinct [1 2 3 2 1])
+;(pcumulate [1 2 3 2 1] + 0) ;broken, not exposed
+(def a (make-array Object 1000000))
+(dotimes i (count a)
+  (aset a i (rand-int i)))
+(time (reduce + 0 a))
+(time (preduce + 0 a))
+(time (count (distinct a)))
+(time (count (pdistinct a)))
+
+(preduce + 0 [1 2 3 2 1])
+(preduce + 0 (psort a))
+(pvec (par [11 2 3 2] :filter-index (fn [x i] (> i x))))
+(pvec (par [11 2 3 2] :filter-with [(fn [x y] (> y x)) [110 2 33 2]]))
+
+(psummary ;or pvec/pmax etc
+ (par [11 2 3 2] 
+      :filter-with [(fn [x y] (> y x)) 
+                    [110 2 33 2]]
+      :map #(* % 2)))
+
+(preduce + 0
+  (par [11 2 3 2] 
+       :filter-with [< [110 2 33 2]]))
+
+(time (reduce + 0 (map #(* % %) (range 1000000))))
+(time (preduce + 0 (par (range 1000000) :map-index *)))
+(def v (range 1000000))
+(time (preduce + 0 (par v :map-index *)))
+(time (preduce + 0 (par v :map  #(* % %))))
+(time (reduce + 0 (map #(* % %) v)))
+)