aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/clojure/contrib/duck_streams/duck_streams.clj120
-rw-r--r--src/clojure/contrib/enum/enum.clj47
-rw-r--r--src/clojure/contrib/except/except.clj44
-rw-r--r--src/clojure/contrib/fcase/fcase.clj93
-rw-r--r--src/clojure/contrib/gen_interface/gen_interface.clj179
-rw-r--r--src/clojure/contrib/javalog/javalog.clj98
-rw-r--r--src/clojure/contrib/lazy_seqs/lazy_seqs.clj90
-rw-r--r--src/clojure/contrib/lib/lib.clj483
-rw-r--r--src/clojure/contrib/memoize/memoize.clj32
-rw-r--r--src/clojure/contrib/ns_utils/ns_utils.clj88
-rw-r--r--src/clojure/contrib/pred/pred.clj108
-rw-r--r--src/clojure/contrib/seq_utils/seq_utils.clj79
-rw-r--r--src/clojure/contrib/sql/sql.clj126
-rw-r--r--src/clojure/contrib/str_utils/str_utils.clj44
-rw-r--r--src/clojure/contrib/string/string.clj29
-rw-r--r--src/clojure/contrib/test_is/test_is.clj211
-rw-r--r--src/clojure/contrib/trace/trace.clj55
-rw-r--r--src/clojure/contrib/zip_filter/xml/xml.clj177
-rw-r--r--src/clojure/contrib/zip_filter/zip_filter.clj91
19 files changed, 2194 insertions, 0 deletions
diff --git a/src/clojure/contrib/duck_streams/duck_streams.clj b/src/clojure/contrib/duck_streams/duck_streams.clj
new file mode 100644
index 00000000..855e8db5
--- /dev/null
+++ b/src/clojure/contrib/duck_streams/duck_streams.clj
@@ -0,0 +1,120 @@
+;;; duck_streams.clj -- duck-typed I/O streams for Clojure
+
+;; by Stuart Sierra <mail@stuartsierra.com>
+;; April 8, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+;; This file defines "duck-typed" I/O utility functions for Clojure.
+;; The 'reader' and 'writer' functions will open and return an
+;; instance of java.io.BufferedReader and java.io.PrintWriter,
+;; respectively, for a variety of argument types -- filenames as
+;; strings, URLs, java.io.File's, etc. These functions are not very
+;; efficient, because they have to perform a number of 'instance?'
+;; checks, but they are convenient when you just want to open a file
+;; and don't want to deal with all the Java I/O classes.
+;;
+;; This file also defines two convenience functions, 'spit' (opposite
+;; of 'slurp') and 'write-lines' (opposite of 'line-seq').
+
+
+(clojure/in-ns 'clojure.contrib.duck-streams)
+(clojure/refer 'clojure)
+
+(import '(java.io Reader InputStream InputStreamReader FileReader
+ BufferedReader File PrintWriter OutputStream
+ OutputStreamWriter BufferedWriter Writer FileWriter)
+ '(java.net URI URL MalformedURLException))
+
+(defmacro bufr
+ {:private true}
+ [reader]
+ `(new java.io.BufferedReader ~reader))
+
+(defn reader
+ "Attempts to coerce its argument into an open
+ java.io.BufferedReader. Argument may be an instance of Reader,
+ BufferedReader, InputStream, File, URI, URL, or String.
+
+ If argument is a String, it tries to resolve it first as a URI, then
+ as a local file name. URIs with a 'file' protocol are converted to
+ local file names.
+
+ Should be used inside with-open to ensure the Reader is properly
+ closed."
+ [x]
+ (cond
+ (instance? BufferedReader x) x
+ (instance? Reader x) (bufr x)
+ (instance? InputStream x) (bufr (new InputStreamReader x))
+ (instance? File x) (bufr (new FileReader #^File x))
+ (instance? URL x) (if (= (. #^URL x (getProtocol)) "file")
+ (bufr (new FileReader (. #^URL x (getPath))))
+ (bufr (new InputStreamReader (. #^URL x (openStream)))))
+ (instance? URI x) (reader (. #^URI x (toURL)))
+ (instance? String x) (try (let [url (new URL x)]
+ (reader url))
+ (catch MalformedURLException err
+ (bufr (new FileReader #^String x))))
+ :else (throw (new Exception (str "Cannot coerce " (class x)
+ " into a Reader.")))))
+
+(defmacro bufw
+ {:private true}
+ [writer]
+ `(new java.io.PrintWriter (new java.io.BufferedWriter ~writer)))
+
+(defn writer
+ "Attempts to coerce its argument into an open java.io.PrintWriter
+ wrapped around a java.io.BufferedWriter. Argument may be an
+ instance of Writer, PrintWriter, BufferedWriter, OutputStream, File,
+ URI, URL, or String.
+
+ If argument is a String, it tries to resolve it first as a URI, then
+ as a local file name. URIs with a 'file' protocol are converted to
+ local file names.
+
+ Should be used inside with-open to ensure the Writer is properly
+ closed."
+ [x]
+ (cond
+ (instance? PrintWriter x) x
+ (instance? BufferedWriter x) (new PrintWriter #^BufferedWriter x)
+ (instance? Writer x) (bufw x) ; includes FileWriter
+ (instance? OutputStream x) (bufw (new OutputStreamWriter x))
+ (instance? File x) (bufw (new FileWriter #^File x))
+ (instance? URL x) (if (= (. #^URL x (getProtocol)) "file")
+ (bufw (new FileWriter (. #^URL x (getPath))))
+ (throw (new Exception (str "Cannot write to non-file URL <" x ">."))))
+ (instance? URI x) (writer (. #^URI x (toURL)))
+ (instance? String x) (try (let [url (new URL x)]
+ (writer url))
+ (catch MalformedURLException err
+ (bufw (new FileWriter #^String x))))
+ :else (throw (new Exception (str "Cannot coerce " (class x)
+ " into a Writer.")))))
+
+(defn write-lines
+ "Opposite of 'line-seq'. Writes lines (a seq) to writer (an open
+ java.io.PrintWriter), separated by newlines."
+ [#^PrintWriter writer lines]
+ (let [line (first lines)]
+ (when line
+ (. writer (write (str line)))
+ (. writer (println))
+ (recur writer (rest lines)))))
+
+(defn spit
+ "Opposite of 'slurp'. Writes 'contents' to the file named by
+ 'filename'."
+ [filename contents]
+ (with-open w (#^PrintWriter writer filename)
+ (. w (print contents))))
+
diff --git a/src/clojure/contrib/enum/enum.clj b/src/clojure/contrib/enum/enum.clj
new file mode 100644
index 00000000..b417028d
--- /dev/null
+++ b/src/clojure/contrib/enum/enum.clj
@@ -0,0 +1,47 @@
+;;; enum.clj -- Java enum classes in Clojure
+
+;; by Stuart Sierra, http://www.stuartsierra.com/
+;; May 29, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+;; This file helps define Java Enums, introduced in Java 1.5. Use it
+;; when you need to define an enum to pass to a Java method.
+;;
+;; This file depends on genclass.clj in the Clojure distribution.
+
+
+(clojure/in-ns 'clojure.contrib.enum)
+(clojure/refer 'clojure)
+
+(defmacro defenum
+ "Generates and loads a subclass of java.lang.Enum, then
+ defs symbols as enumerated instances of that class.
+
+ Example: (defenum my.package.MyEnum FOO BAR)
+ ;; FOO and BAR are now instances of MyEnum
+
+ Java equivalent: enum MyEnum { FOO, BAR };
+
+ Caveats:
+ 1. The generated class has no values() method.
+ 2. The generated class returns false for Class.isEnum().
+ 3. Enum.valueOf(Class, String) will not work.
+ 4. Redefining an enum is allowed, but enumeration resets
+ to zero."
+ [class & symbols]
+ ;; Can't load a class twice, so check first:
+ (try (. Class (forName (str class)))
+ (catch java.lang.ClassNotFoundException e
+ (gen-and-load-class (str class) :extends java.lang.Enum)))
+ (cons 'do
+ (map (fn [sym val]
+ `(def ~sym (new ~class ~(str sym) ~val)))
+ symbols (iterate inc 0))))
diff --git a/src/clojure/contrib/except/except.clj b/src/clojure/contrib/except/except.clj
new file mode 100644
index 00000000..a2fc8521
--- /dev/null
+++ b/src/clojure/contrib/except/except.clj
@@ -0,0 +1,44 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common Public
+;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found
+;; in the file CPL.TXT 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.
+;;
+;; except.clj
+;;
+;; scgilardi (gmail)
+;; Created 07 July 2008
+
+(clojure/in-ns 'clojure.contrib.except)
+(clojure/refer 'clojure)
+
+(clojure.contrib.lib/use '(clojure.contrib string))
+
+(defn throw-if
+ "Throws an exception with a message if pred is true. Arguments are:
+
+ pred class? format format-args*
+
+ class is optional and defaults to Exception. If present, it must be a
+ Class in the tree under Throwable with a constructor that takes a single
+ String.
+
+ format is a string as documented for java.util.Formatter.
+
+ format-args are zero or more objects that correspond to the format
+ specifiers in format."
+ [pred & args]
+ (if pred
+ (let [class-present (instance? Class (first args))
+ args (if class-present args (cons Exception args))
+ [class fmt & fmt-args] args
+ ctor (.getConstructor (identity class) (into-array [String]))
+ message (apply format fmt fmt-args)
+ exception (.newInstance ctor (into-array [message]))
+ raw-trace (.getStackTrace exception)
+ boring? #(not= (.getMethodName %) "doInvoke")
+ trace (into-array (drop 2 (drop-while boring? raw-trace)))]
+ (.setStackTrace exception trace)
+ (throw exception))))
diff --git a/src/clojure/contrib/fcase/fcase.clj b/src/clojure/contrib/fcase/fcase.clj
new file mode 100644
index 00000000..8e316f56
--- /dev/null
+++ b/src/clojure/contrib/fcase/fcase.clj
@@ -0,0 +1,93 @@
+;;; fcase.clj -- simple variants of "case" for Clojure
+
+;; by Stuart Sierra <mail@stuartsierra.com>
+;; April 7, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+;; This file defines a generic "case" macro called "fcase" which takes
+;; the equality-testing function as an argument. It also defines a
+;; traditional "case" macro that tests using "=" and variants that
+;; test for regular expressions and class membership.
+
+
+(clojure/in-ns 'clojure.contrib.fcase)
+(clojure/refer 'clojure)
+
+
+(defmacro fcase
+ "Generic switch/case macro. 'fcase' is short for 'function case'.
+
+ The 'compare-fn' is a fn of two arguments.
+
+ The 'test-expr-clauses' are value-expression pairs without
+ surrounding parentheses, like in Clojure's 'cond'.
+
+ The 'case-value' is evaluated once and cached. Then, 'compare-fn'
+ is called once for each clause, with the clause's test value as its
+ first argument and 'case-value' as its second argument. If
+ 'compare-fn' returns logical true, the clause's expression is
+ evaluated and returned. If 'compare-fn' returns false/nil, we go to
+ the next test value.
+
+ If 'test-expr-clauses' contains an odd number of items, the last
+ item is the default expression evaluated if no case-value matches.
+ If there is no default expression and no case-value matches, fcase
+ returns nil.
+
+ See specific forms of this macro in 'case' and 're-case'.
+
+ The test expressions in 'fcase' are always evaluated linearly, in
+ order. For a large number of case expressions it may be more
+ efficient to use a hash lookup."
+ [compare-fn case-value &
+ test-expr-clauses]
+ (let [test-val-sym (gensym "test_val")
+ test-fn-sym (gensym "test_fn")
+ cond-loop (fn this [clauses]
+ (cond
+ (>= (count clauses) 2)
+ (list 'if (list test-fn-sym (first clauses) test-val-sym)
+ (second clauses)
+ (this (rest (rest clauses))))
+ (= (count clauses) 1) (first clauses)))]
+ (list 'let [test-val-sym case-value, test-fn-sym compare-fn]
+ (cond-loop test-expr-clauses))))
+
+(defmacro case
+ "Like cond, but test-value is compared against the value of each
+ test expression with =. If they are equal, executes the \"body\"
+ expression. Optional last expression is executed if none of the
+ test expressions match."
+ [test-value & clauses]
+ `(fcase = ~test-value ~@clauses))
+
+(defmacro re-case
+ "Like case, but the test expressions are regular expressions, tested
+ with re-find."
+ [test-value & clauses]
+ `(fcase re-find ~test-value ~@clauses))
+
+(defmacro instance-case
+ "Like case, but the test expressions are Java class names, tested with
+ 'instance?'."
+ [test-value & clauses]
+ `(fcase instance? ~test-value ~@clauses))
+
+(defn- in-case-test [test-seq case-value]
+ (some (fn [item] (= item case-value))
+ test-seq))
+
+(defmacro in-case
+ "Like case, but test expressions are sequences. The test expression
+ is true if any item in the sequence is equal (tested with '=') to
+ the test value."
+ [test-value & clauses]
+ `(fcase in-case-test ~test-value ~@clauses))
diff --git a/src/clojure/contrib/gen_interface/gen_interface.clj b/src/clojure/contrib/gen_interface/gen_interface.clj
new file mode 100644
index 00000000..2ab9a601
--- /dev/null
+++ b/src/clojure/contrib/gen_interface/gen_interface.clj
@@ -0,0 +1,179 @@
+; Copyright (c) Chris Houser, July 2008. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+; which can be found in the file CPL.TXT 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.
+
+; Functions for generating interface classes, which can then be loaded
+; or saved to a .class file.
+
+(clojure/in-ns 'clojure.contrib.gen-interface)
+(clojure/refer 'clojure)
+
+(import '(clojure.asm ClassWriter Opcodes Type)
+ '(java.io File FileOutputStream IOException))
+
+(defn- asm-type
+ "Returns an asm Type object for c, which may be a primitive class
+ (such as Integer/TYPE), any other class (such as Double), or a
+ fully-qualified class name given as a string or symbol
+ (such as 'java.lang.String)"
+ [c]
+ (if (instance? Class c)
+ (Type/getType c)
+ (Type/getObjectType (.replace (str c) "." "/"))))
+
+(defn- iname
+ "Returns the internal name of given class or class name. Cannot be
+ used for primitive types."
+ [c] (.getInternalName (asm-type c)))
+
+(defstruct #^{:private true} spec-map :cname :iname :extends :methods)
+
+(defn- make-spec
+ "Returns an interface spec object based on the given description.
+ cname is the fully-qualified classname (string or symbol) of the
+ interface to be created.
+ extends is a collection of classes this interface will extend (each
+ may be a string, symbol, or a class). These are followed by the
+ method descriptions, each of which is a vector: [methodName,
+ arg types, return type]"
+ [cname extends & methods]
+ (struct spec-map
+ (str cname)
+ (iname cname)
+ (set (map iname extends))
+ (set (map (fn [[mname pclasses rclass]]
+ [(str mname)
+ (map asm-type pclasses)
+ (asm-type rclass)])
+ methods))))
+
+(defn- spec-from-class
+ "Returns an interface spec object based on the given class."
+ [c]
+ (struct spec-map
+ (.getName c)
+ (iname c)
+ (set (map iname (.getInterfaces c)))
+ (set (map (fn [m]
+ [(.getName m)
+ (map asm-type (.getParameterTypes m))
+ (asm-type (.getReturnType m))])
+ (.getDeclaredMethods c)))))
+
+(def #^{:private true} object-iname (iname Object))
+
+(defn- spec-bytecode
+ "Uses the given interface spec object (such as created by make-spec)
+ to generate a Java interface. Returns a byte array containing the
+ Java bytecode for the interface. You'll almost always want to use
+ gen-interface instead."
+ [{:keys [iname extends methods]}]
+ (let [cv (ClassWriter. ClassWriter/COMPUTE_MAXS)]
+ (. cv visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT
+ Opcodes/ACC_INTERFACE)
+ iname nil object-iname
+ (when (seq extends)
+ (into-array extends)))
+ (doseq [mname pclasses rclass] methods
+ (. cv visitMethod (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT)
+ mname
+ (Type/getMethodDescriptor rclass (if pclasses
+ (into-array pclasses)
+ (make-array Type 0)))
+ nil nil))
+ (. cv visitEnd)
+ (. cv toByteArray)))
+
+
+(defn- load-interface-bytecode
+ [{:keys [cname] :as spec} bytecode]
+ (let [old-class (try (Class/forName cname) (catch Throwable t nil))]
+ (if old-class
+ (when-not (= spec (spec-from-class old-class))
+ (throw (Exception. (str "A different class named "
+ cname " already loaded"))))
+ (.. clojure.lang.RT
+ ROOT_CLASSLOADER (defineClass cname bytecode)))))
+
+(defn- save-interface-bytecode
+ [path {:keys [cname]} bytecode]
+ (let [file (File. path (str (.replace cname \. File/separatorChar)
+ ".class"))]
+ (try
+ (.createNewFile file)
+ (catch IOException e
+ (throw (Exception. (str "Failed to create " file) e))))
+ (with-open f (FileOutputStream. file)
+ (.write f bytecode))))
+
+(defn gen-and-load-interface
+ "Uses the given interface description to generate a Java interface
+ and immediately load it. make-spec-args is the interface
+ description as documented in make-spec. This function is not
+ generally useful since you'll usually want a .class file in order
+ to write Java code that uses the generated interface -- see
+ gen-interface instead."
+ [& make-spec-args]
+ (let [spec (apply make-spec make-spec-args)]
+ (load-interface-bytecode spec (spec-bytecode spec))))
+
+(defn gen-and-save-interface
+ "Uses the given interface description to generate a Java interface
+ and save it to a .class file. make-spec-args is the interface
+ description as documented in make-spec. The .class file will be
+ written into a sub-directory of the given base path (note that the
+ appropriate sub-directories under path must already exist or this
+ will throw an exception). If you intend to use this interface
+ immediately (for example to refer to it in a later gen-interface or
+ gen-class call), you'll want to use gen-interface instead."
+ [path & make-spec-args]
+ (let [spec (apply make-spec make-spec-args)]
+ (save-interface-bytecode path spec (spec-bytecode spec))))
+
+(defn gen-interface
+ "Uses the given interface description to generate a Java interface,
+ save it to a .class file, and immediately load it so it's ready
+ for use by subsequent gen-interface or gen-class calls. The .class
+ file will be written into a sub-directory of the given base path.
+ make-spec-args is the interface description as documented in
+ make-spec."
+ [path & make-spec-args]
+ (let [spec (apply make-spec make-spec-args)
+ bytecode (spec-bytecode spec)]
+ (load-interface-bytecode spec bytecode)
+ (save-interface-bytecode path spec bytecode)))
+
+(comment
+
+(gen-interface "/tmp" 'net.n01se.Foo [Appendable]
+ ['foo [] Integer]
+ ['bar [Integer/TYPE String] Double])
+
+; re-genning an identical interface doesn't try to load anything
+(gen-interface "/tmp" 'net.n01se.Foo [Appendable]
+ ['foo [] Integer]
+ ['bar [Integer/TYPE String] Double])
+
+; re-genning a different interface throws an exception
+;(gen-interface "/tmp" 'net.n01se.Foo [Appendable]
+; ['foo [] Integer])
+
+; gen-and-save-interface is used directly in this example because I
+; want to refer to a class that's not yet defined in this runtime
+; (Other). This is possible because I specify the class as a quoted
+; symbol, and then don't load it -- but this isn't really recommended.
+; Instead, why not make sure Other is defined -- then you can use
+; gen-interface.
+(gen-and-save-interface "/tmp" 'net.n01se.Bar ['net.n01se.Other Iterable]
+ ['baz [] net.n01se.Foo])
+
+(prn :isInterface (.isInterface (identity net.n01se.Foo)))
+(prn :interfaces (seq (.getGenericInterfaces (identity net.n01se.Foo))))
+(doseq m (seq (.getMethods (identity net.n01se.Foo)))
+ (prn m))
+
+)
diff --git a/src/clojure/contrib/javalog/javalog.clj b/src/clojure/contrib/javalog/javalog.clj
new file mode 100644
index 00000000..2cb12c48
--- /dev/null
+++ b/src/clojure/contrib/javalog/javalog.clj
@@ -0,0 +1,98 @@
+;;; javalog.clj -- convenient access to java.util.logging in Clojure
+
+;; by Stuart Sierra <mail@stuartsierra.com>
+;; April 8, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+;; This file defines some convenience functions for using the Java
+;; logging framework from Clojure. It is oriented towards simple
+;; development and debugging rather than complex production
+;; environments.
+
+
+
+(clojure/in-ns 'clojure.contrib.javalog)
+(clojure/refer 'clojure)
+
+(import '(java.util.logging Logger Level ConsoleHandler
+ FileHandler SimpleFormatter))
+
+(def
+ #^{:tag Logger
+ :doc "The current java.util.logging.Logger. By default, the
+ global logger, modified by 'with-logger'."}
+ *logger*
+ (. Logger
+ (getLogger
+ (. Logger GLOBAL_LOGGER_NAME))))
+
+(defmacro log-level
+ "Translates 'level' (a lower-case keyword) into a static field of
+ java.util.logging.Level, by name.
+
+ Example: (log-level :severe) => java.util.logging.Level.SEVERE
+
+ If 'level' is not a keyword, it is assumed to be a user-defined
+ instance of java.util.logging.Level and is returned unchanged."
+ [level]
+ (if (keyword? level)
+ `(. java.util.logging.Level
+ ~(symbol (. (name level) (toUpperCase))))
+ level))
+
+(defn root-logger
+ "Returns the root Logger instance."
+ ([] (root-logger *logger*))
+ ([logger] (let [parent (. logger (getParent))]
+ (if parent
+ (recur parent)
+ logger))))
+
+(defn set-console-log-level
+ "Attempts to set the level of the current logger and the root
+ ConsoleHandler to 'level' (a java.util.logging.Level). Useful for
+ debugging at the REPL."
+ [level]
+ (let [console-handler
+ (some (fn [h] (if (instance? ConsoleHandler h) h))
+ (. (root-logger) (getHandlers)))]
+ (if console-handler
+ (do (. *logger* (setLevel level))
+ (. console-handler (setLevel level)))
+ (throw (new Exception "No ConsoleHandler on root logger.")))))
+
+(defn add-log-file
+ "Attaches a log file, using SimpleFormatter, with the given level,
+ to the named logger. 'level' defaults to ALL. Note: multiple
+ invocations will create multiple log files, with numbers appended to
+ the names."
+ ([logger-name filename]
+ (add-log-file logger-name filename (. Level ALL)))
+ ([logger-name filename level]
+ (let [logger (. Logger (getLogger logger-name))
+ handler (new FileHandler filename)]
+ (. handler (setFormatter (new SimpleFormatter)))
+ (. handler (setLevel level))
+ (. logger (addHandler handler)))))
+
+(defmacro with-logger
+ "Executes 'body' with *logger* bound to a logger with the given name
+ and level. 'level' is expanded with 'log-level'."
+ [logger-name level & body]
+ `(binding [*logger* (. Logger (getLogger ~logger-name))]
+ (. *logger* (setLevel (log-level ~level)))
+ ~@body))
+
+(defmacro log
+ "Logs a message to *logger*. 'level' is expanded with 'log-level'.
+ Example: (log :severe \"Bad argument: \" object)"
+ [level & strings]
+ `(. *logger* (log (log-level ~level) (str ~@strings))))
diff --git a/src/clojure/contrib/lazy_seqs/lazy_seqs.clj b/src/clojure/contrib/lazy_seqs/lazy_seqs.clj
new file mode 100644
index 00000000..9ffd72f4
--- /dev/null
+++ b/src/clojure/contrib/lazy_seqs/lazy_seqs.clj
@@ -0,0 +1,90 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common Public
+;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found
+;; in the file CPL.TXT 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.
+;;
+;; lazy-seqs
+;;
+;; == Lazy sequences ==
+;;
+;; primes - based on the "naive" implemention described in [1] plus a
+;; small "wheel" which eliminates multiples of 2, 3, 5, and
+;; 7 from consideration by incrementing past them. Also inspired
+;; by code from Christophe Grand in [2].
+;;
+;; fibs - based on code from Rich Hickey at the Clojure wiki [3]
+;;
+;; powers-of-2 - all the powers of 2
+;;
+;; == Lazy sequence functions ==
+;;
+;; rotations - returns a lazy seq of all the rotations of a seq
+;;
+;; permutations - returns a lazy seq of all the permutations of a seq
+;;
+;; [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
+;; [2] http://clj-me.blogspot.com/2008/06/primes.html
+;; [3] http://en.wikibooks.org/wiki/Clojure_Programming#Examples
+;;
+;; scgilardi (gmail)
+;; Created 07 June 2008
+
+(clojure/in-ns 'clojure.contrib.lazy-seqs)
+(clojure/refer 'clojure)
+
+(clojure.contrib.lib/use '(clojure.contrib def))
+
+(defvar primes
+ (lazy-cat [2 3 5 7]
+ (let [primes-from
+ (fn primes-from [n [f & r]]
+ (if (some #(zero? (rem n %))
+ (take-while #(<= (* % %) n) primes))
+ (recur (+ n f) r)
+ (lazy-cons n (primes-from (+ n f) r))))
+ wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2
+ 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6
+ 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])]
+ (primes-from 11 wheel)))
+ "A lazy sequence of all the prime numbers.")
+
+(defvar fibs
+ (lazy-cat [0 1]
+ (let [rest-fn
+ (fn rest-fn [a b]
+ (let [next (+ a b)]
+ (lazy-cons next (rest-fn b next))))]
+ (rest-fn 0 1)))
+ "A lazy sequence of all the fibonacci numbers.")
+
+(defvar powers-of-2
+ (lazy-cons 1
+ (let [rest-fn
+ (fn rest-fn [n]
+ (let [next (bit-shift-left n 1)]
+ (lazy-cons next (rest-fn next))))]
+ (rest-fn 1)))
+ "A lazy sequence of all the powers of 2")
+
+(defn rotations
+ "Returns a lazy seq of all rotations of a seq"
+ [x]
+ (if (seq x)
+ (map
+ (fn [n _]
+ (lazy-cat (drop n x) (take n x)))
+ (iterate inc 0) x)
+ (list nil)))
+
+(defn permutations
+ "Returns a lazy seq of all permutations of a seq"
+ [x]
+ (if (seq x)
+ (mapcat
+ (fn [[f & r]]
+ (map #(cons f %) (permutations r)))
+ (rotations x))
+ (list nil)))
diff --git a/src/clojure/contrib/lib/lib.clj b/src/clojure/contrib/lib/lib.clj
new file mode 100644
index 00000000..c5324b07
--- /dev/null
+++ b/src/clojure/contrib/lib/lib.clj
@@ -0,0 +1,483 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common Public
+;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found
+;; in the file CPL.TXT 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.
+;;
+;; clojure.contrib.lib (Lib)
+;;
+;; Lib provides functions for loading and managing Clojure source code
+;; contained in Java resources.
+;;
+;; A 'lib' is a unit of Clojure source code contained in a Java resource
+;; and named by a symbol. The lib's name is used to identify the lib and
+;; to locate the resource that contains it.
+;;
+;; Lib provides functions to:
+;;
+;; - find a resource given a classpath-relative path
+;; - load code from a resource given an absolute path
+;; - load libs from resources given lib names
+;; - load namespace definitions given namespace specs
+;; - ensure namespace definitions have been loaded while avoiding
+;; duplicate loads, and
+;; - create a namespace and refer 'clojure into it succinctly
+;;
+;; Symbols, Namespaces, Packages
+;;
+;; Symbols in Clojure are two-part identifiers - with an optional
+;; namespace and a name, both strings. Namespaces are used to distinguish
+;; two symbols that have the same name. Vars are named by symbols that
+;; must have a namespace part, and thus can be considered to be in
+;; namespaces. [From Clojure documentation]
+;;
+;; Packages in Java play a role similar to Clojure namespaces - they
+;; partition the global namespace to allow large programs to avoid name
+;; conflicts. Java defines a mapping from package names to directories
+;; within classpath: components of a package name separated by periods
+;; correspond to components of a classpath-relative path separated by
+;; slashes. Lib uses this same mapping to locate libs and namespaces in
+;; classpath.
+;;
+;; Loading Libs
+;;
+;; A lib's name provides the location of the resource that contains it in
+;; classpath. The resource name is the last component of the lib's path
+;; followed by ".clj". For example, a lib named 'a.b.c is contained in the
+;; resource "<classpath>/a/b/c.clj".
+;;
+;; Loading Namespaces
+;;
+;; To load a namespace definition, Lib loads the 'root lib' for the
+;; namespace. The root lib's name is derived from the namespace name by
+;; repeating its last component. For example, the root lib for the
+;; namespace 'x.y.z is the lib 'x.y.z.z contained in the resource
+;; "<classpath>/x/y/z/z.clj". The namespace definition may be entirely
+;; within the root lib or it may span multiple libs in the hierarchy of
+;; directories at and under the namespace's directory. In the latter case
+;; the root lib must include commands to (directly or indirectly) load the
+;; remaining libs.
+;;
+;; Nsspecs
+;;
+;; An nsspec specifies a namespace to load. It is either a namespace name
+;; or a list containing the namespace name and zero or more options
+;; expressed as squential keywords and values. Nsspec examples:
+;; - 'clojure.contrib.sql
+;; - '(clojure.contrib.sql)
+;; - '(clojure.contrib.sql :exclude (get-connection)).
+;; - '(clojure.contrib.sql :as sql)
+;;
+;; Prefix Lists
+;;
+;; It is common for Clojure code to depend on several libs or namespaces
+;; whose names have one or more initial components in common. When
+;; specifying lib or namespace names for Lib to use, prefix lists can be
+;; used to reduce repetition in the call. A prefix list is a list
+;; containing the shared prefix followed by lib or namespace names and/or
+;; prefix lists with the shared prefix elided. For example, the following
+;; are all equivalent:
+;; (load-libs 'a.b.c 'a.b.d 'a.c.e 'a.c.f) ; all names fully qualified
+;; (load-libs '(a.b c d) '(a.c e f)) ; 'a.b and 'a.c extracted
+;; (load-libs '(a (b c d) (c e f))) ; all common prefixes extracted
+;; Symbols containing explicit periods and the equivalent prefix lists may
+;; be mixed freely.
+;;
+;; Lib Functions
+;;
+;; Resources
+;;
+;; Function: find-resource
+;; Searches available class loaders for a resource, returns URL or nil
+;;
+;; Function: load-resource
+;; Loads Clojure source from an absolute path: URI, URL or String
+;;
+;; Libs
+;;
+;; Function: load-libs
+;; Loads libs by name from arbitrary locations within classpath
+;;
+;; Namespaces
+;;
+;; Function: load-namespaces
+;; Loads namespace definitions by loading namespace root libs
+;;
+;; Function: namespaces
+;; Returns a sorted set symbols naming namespaces that have been loaded
+;; with the :require option - used to track and avoid duplicate loads.
+;;
+;; Function: require
+;; Loads namespace definitions that have not yet been loaded
+;;
+;; Function: use
+;; Requires namespaces and refers to them using clojure/refer
+;;
+;; Function: init-ns
+;; Creates and enters a namespace and refers to 'clojure and
+;; 'clojure.contrib.lib (use in namespace root libs)
+;;
+;; Examples
+;;
+;; (load-namespaces :require '(clojure.contrib sql sql.tests))
+;; (require '(clojure.contrib sql sql.tests))
+;;
+;; (load-namespaces :require :use '(clojure.contrib sql ns-utils) :verbose)
+;; (use '(clojure.contrib sql ns-utils) :verbose)
+;;
+;; (use :reload-all :verbose
+;; '(clojure.contrib
+;; (sql :exclude (get-connection)
+;; :rename {execute-commands do-commands})
+;; ns-utils))
+;;
+;; scgilardi (gmail)
+;; Created 7 April 2008
+;;
+;; Thanks to Stuart Sierra for providing many useful ideas, discussions
+;; and code contributions for lib.clj.
+
+(clojure/in-ns 'clojure.contrib.lib)
+(clojure/refer 'clojure)
+
+(alias 'set 'clojure.set)
+
+(import '(clojure.lang RT))
+(import '(java.io BufferedReader InputStreamReader))
+(import '(java.net URI URL))
+
+;; Private
+
+(defmacro init-once
+ "Initializes a var exactly once. The var must already exist."
+ {:private true}
+ [var init]
+ `(let [v# (resolve '~var)]
+ (when-not (.isBound v#)
+ (.bindRoot v# ~init))))
+
+(def
+ #^{:private true :doc
+ "A ref to a sorted set of symbols representing loaded namespaces"}
+ *namespaces*)
+(init-once *namespaces* (ref (sorted-set)))
+
+(def
+ #^{:private true :doc
+ "True while a verbose load is pending"}
+ *verbose*)
+(init-once *verbose* false)
+
+(def
+ #^{:private true :doc
+ "A list of keywords that clojure/refer recognizes as filters"}
+ *filter-keys*)
+(init-once *filter-keys* '(:exclude :only :rename))
+
+(def
+ #^{:private true :doc
+ "A vector of the available class loaders ordered by the degree to which
+ they are controlled by Clojure. The root loader's classpath can be
+ extended with clojure/add-classpath"}
+ *class-loaders*
+ (let [root (.ROOT_CLASSLOADER RT)
+ runtime (.getClassLoader (identity RT))
+ system (.getSystemClassLoader ClassLoader)]
+ (if (= system runtime)
+ [root system]
+ [root runtime system])))
+
+(defn- format
+ "Formats a string using String/format"
+ [fmt & args]
+ (String/format fmt (to-array args)))
+
+(defn- printf
+ "Prints formatted output"
+ [fmt & args]
+ (print (apply format fmt args)))
+
+(defn- throw-if
+ "Throws an exception with a message if pred is true. See
+ java.util.Formatter for format string syntax."
+ [pred fmt & args]
+ (when pred
+ (let [message (apply format fmt args)
+ exception (Exception. message)
+ raw-trace (.getStackTrace exception)
+ boring? #(not= (.getMethodName %) "doInvoke")
+ trace (into-array (drop 2 (drop-while boring? raw-trace)))]
+ (.setStackTrace exception trace)
+ (throw exception))))
+
+(defn- nsspec?
+ "Returns true if x is an nsspec"
+ [x]
+ (or (symbol? x)
+ (nil? (second x))
+ (keyword? (second x))))
+
+(defn- prepend
+ "Prepends a symbol or collection to coll"
+ [x coll]
+ (if (symbol? x)
+ (cons x coll)
+ (concat x coll)))
+
+(def find-resource) ; forward declaration
+(def load-resource) ; forward declaration
+
+(defn- load-one
+ "Loads one lib from a resource at url. If need-ns is 'true' ensures that
+ the namespace named by sym exists after loading. If require is 'true'
+ also records the namespace named by sym as loaded so any duplicate loads
+ can be skipped."
+ [url need-ns sym require]
+ (load-resource url)
+ (throw-if (and need-ns (not (find-ns sym)))
+ "namespace '%s' not found after loading '%s'" sym url)
+ (when require
+ (dosync
+ (commute *namespaces* conj sym))))
+
+(defn- load-all
+ "Loads a lib from a resource at url and forces a load of any namespaces
+ it directly or indirectly loads via require/use/load-namespaces"
+ [url need-ns sym require]
+ (dosync
+ (commute *namespaces* set/union
+ (binding [*namespaces* (ref (sorted-set))]
+ (load-one url need-ns sym require)
+ @*namespaces*))))
+
+(defn- name-path
+ "Returns a classpath-relative path given a symbol name"
+ [name]
+ (.. name
+ (replace \- \_)
+ (replace \. \/)))
+
+(defn- lib-path
+ "Returns the resource path for a lib"
+ [lib-sym]
+ (str (name-path (name lib-sym)) ".clj"))
+
+(defn- root-lib-path
+ "Returns the resource path for a namespace root lib"
+ [ns-sym]
+ (let [n (name-path (name ns-sym))
+ i (inc (.lastIndexOf n (int \/)))
+ leaf (.substring n i)]
+ (str n \/ leaf ".clj")))
+
+(defn- load-lib
+ "Loads a lib with options: sequential keywords and arguments."
+ [prefix sym & options]
+ (let [sym (symbol (str prefix (when prefix \.) sym))
+ opts (apply hash-map options)
+ as (:as opts)
+ reload (:reload opts)
+ reload-all (:reload-all opts)
+ require (:require opts)
+ root (:root opts)
+ use (:use opts)
+ verbose (:verbose opts)
+ loaded (contains? @*namespaces* sym)
+ load (cond reload-all
+ load-all
+ (or reload (not require) (not loaded))
+ load-one)
+ need-ns (or as use)
+ path ((if root root-lib-path lib-path) sym)
+ url (find-resource path)
+ filter-opts (select-keys opts *filter-keys*)]
+ (binding [*verbose* (or *verbose* verbose)]
+ (when load
+ (throw-if (not url) "'%s' not found in classpath" path)
+ (when *verbose*
+ (printf "(clojure.contrib.lib/load-resource \"%s\")\n" url)
+ (flush))
+ (load url need-ns sym require))
+ (throw-if (and need-ns (not (find-ns sym)))
+ "namespace '%s' not found" sym)
+ (when (and need-ns *verbose*)
+ (printf "(clojure/in-ns '%s)\n" (ns-name *ns*)))
+ (when as
+ (when *verbose*
+ (printf "(clojure/alias '%s '%s)\n" as sym))
+ (alias as sym))
+ (when use
+ (when *verbose*
+ (printf "(clojure/refer '%s" sym)
+ (doseq opt filter-opts
+ (printf " %s '%s" (key opt) (print-str (val opt))))
+ (printf ")\n"))
+ (apply refer sym (mapcat seq filter-opts))))))
+
+(defn- load-prefix-list
+ "Loads libs and handles (nested) prefix lists"
+ [load? prefix opts & args]
+ (doseq arg args
+ (if (load? arg)
+ (apply load-lib prefix (prepend arg opts))
+ (let [[nested-prefix & nested-args] arg]
+ (throw-if (nil? nested-prefix) "prefix cannot be nil")
+ (apply load-prefix-list
+ load?
+ (symbol (str prefix (when prefix \.) nested-prefix))
+ opts
+ nested-args)))))
+
+;; Resources
+
+(defn find-resource
+ "Searches for a resource given a classpath-relative path using available
+ ClassLoaders. If the resource is found, returns its URL, otherwise nil."
+ [rel-path]
+ (some #(.findResource % rel-path) *class-loaders*))
+
+(defn load-resource
+ "Loads Clojure source from a resource specified by an absolute path. The
+ path may be a URI, URL, or String. Accepts any URI scheme supported by
+ URLConnection (http and jar), plus file paths."
+ [abs-path]
+ (let [url (cond (instance? URL abs-path)
+ abs-path
+ (instance? URI abs-path)
+ (.toURL abs-path)
+ (string? abs-path)
+ (URL. abs-path))]
+ (throw-if (not url) "Cannot coerce %s to %s" (class abs-path) URL)
+ (with-open reader
+ (BufferedReader.
+ (InputStreamReader.
+ (.openStream url)))
+ (.load Compiler reader (.getPath url) (.getFile url)))))
+
+;; Libs
+
+(defn load-libs
+ "Loads libs - Clojure source contained in resources in classpath. Each
+ argument is a either a symbol that identifies a lib, a prefix list that
+ identifies multiple libs with names that share common prefixes, or a flag
+ that modifies how all the identified libs are loaded. Symbol names map to
+ paths within classpath: components of the symbol name separated by
+ periods correspond to components in classpath-relative paths separated by
+ slashes. The full resource path is the mapped path with '.clj'
+ appended. For example, the resource containing the lib 'a.b.c is
+ '<classpath>/a/b/c.clj'.
+
+
+ Multiple libs whose names share the same period-delimited prefix can be
+ identified succinctly using a prefix list: a list containing the shared
+ prefix followed by symbols and/or prefix lists with the shared prefix
+ elided. For example, the following are all equivalent:
+ (load-libs 'a.b.c 'a.b.d 'a.c.e 'a.c.f) ; all names fully qualified
+ (load-libs '(a.b c d) '(a.c e f)) ; 'a.b and 'a.c extracted
+ (load-libs '(a (b c d) (c e f))) ; all common prefixes extracted
+ Symbols containing explicit periods and the equivalent prefix lists may
+ be mixed freely.
+
+ Recognized flags: :reload-all, :verbose
+
+ :reload-all forces loading of all namespaces that the identified libs
+ directly or indirectly load via load-namespaces/require/use
+ :verbose triggers printing information about each load and refer"
+ [& args]
+ (let [flags (filter keyword? args)
+ opts (interleave flags (repeat true))
+ args (filter (complement keyword?) args)]
+ (apply load-prefix-list symbol? nil opts args)))
+
+;; Namespaces
+
+(defn load-namespaces
+ "Loads namespace definitions contained in resources in classpath.
+ Each argument is a either an nsspec that identifies a namespace, a prefix
+ list that identifies multiple namespaces with names that share common
+ prefixes, or a flag that modifies how all the identified namespaces are
+ loaded. Namespace names map to paths within classpath: components of the
+ namespace name separated by periods correspond to components in
+ classpath-relative paths separated by slashes. To load the namespace
+ definition, load-namespaces loads the namespace's 'root lib'. The root
+ lib's name is derived from the namespace name by repeating its last
+ component. The root lib for namespace 'a.b.c is the lib 'a.b.c.c
+ contained in the resource '<classpath>/a/b/c/c.clj'. The namespace
+ definition need not be completely contained in its root lib. If it's not
+ the root lib must contain code to (directly or indirectly) load the
+ additional libs using load-libs.
+
+ An nsspec is a symbol or a list containing a symbol and options. Some
+ options may have meaning only when specific flags are set.
+
+ An option is a keyword followed by an argument.
+ Recognized options: :as :exclude, :only, :rename
+
+ The argument for :as is a symbol to use as an alias for the specified
+ namespace.
+ The arguments and semantics for :exclude, :only, and :rename are those
+ documented for clojure/refer. They are only effective when the :use flag
+ is present.
+
+ Multiple namespaces whose names share the same period-delimited prefix
+ can be identified succinctly using a prefix list: a list containing the
+ shared prefix followed by nsspecs and/or prefix lists with the shared
+ prefix elided. For example, the following are all equivalent:
+ (load-namespaces 'a.b.c 'a.b.d 'a.c.e 'a.c.f) ; fully qualified names
+ (load-namespaces '(a.b c d) '(a.c e f)) ; 'a.b and 'a.c extracted
+ (load-namespaces '(a (b c d) (c e f))) ; all common prefixes extracted
+ Symbols containing explicit periods and the equivalent prefix lists may be
+ mixed freely.
+
+ A flag is a keyword.
+ Recognized flags: :require, :use, :reload, :reload-all, :verbose
+
+ :require indicates that any identified namespace definitions that are
+ already loaded need not be reloaded
+ :use triggers referring to each namespace with optional filters specified
+ in its options
+ :reload forces loading of all the identified namespace definitions even
+ if they are already loaded. :reload supersedes :require
+ :reload-all implies :reload and also forces loading of all namespace
+ definitions that the identified namespace definitions directly or
+ indirectly load via load-namespaces/require/use
+ :verbose triggers printing information about each load, alias and refer"
+ [& args]
+ (let [flags (cons :root (filter keyword? args))
+ opts (interleave flags (repeat true))
+ args (filter (complement keyword?) args)]
+ (apply load-prefix-list nsspec? nil opts args)))
+
+(defn namespaces
+ "Returns a sorted set of symbols naming loaded namespaces"
+ []
+ @*namespaces*)
+
+(defn require
+ "Ensures that namespaces are loaded while avoiding duplicate
+ loads. Arguments are described in the docs for 'load-namespaces. The
+ :require flag is automatically set."
+ [& args]
+ (apply load-namespaces :require args))
+
+(defn use
+ "Ensures that namespaces are loaded while avoiding duplicate loads and
+ refers to them in the current namespace. Arguments are described in the
+ docs for 'load-namespaces. The :require and :use flags are automatically
+ set."
+ [& args]
+ (apply load-namespaces :require :use args))
+
+(defn init-ns
+ "Creates ns (if necessary), makes it current, and uses clojure/refer to
+ make the 'clojure namespace available to it. Optional clojure-filters can
+ be passed along to clojure/refer to modify how much of and how 'clojure
+ is pulled in. init-ns also refers to (all of) 'clojure.contrib.lib.
+ Namespace root libs will typically begin with a call to init-ns; any
+ subordinate libs can begin with a call to in-ns."
+ [ns & clojure-filters]
+ (in-ns ns)
+ (apply refer 'clojure clojure-filters)
+ (refer 'clojure.contrib.lib))
diff --git a/src/clojure/contrib/memoize/memoize.clj b/src/clojure/contrib/memoize/memoize.clj
new file mode 100644
index 00000000..db782082
--- /dev/null
+++ b/src/clojure/contrib/memoize/memoize.clj
@@ -0,0 +1,32 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+;; which can be found in the file CPL.TXT 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.
+;;
+;; File: memoize.clj
+;;
+;; scgilardi (gmail)
+;; 02 June 2008
+;;
+;; Based on Common Lisp code from:
+;; http://asymmetrical-view.com/talks/lisp-presentation/lisp-presentation.pdf
+
+(clojure/in-ns 'clojure.contrib.memoize)
+(clojure/refer 'clojure)
+
+(defn memoize
+ "Returns a memoized version of a referentially transparent function. The
+ memoized version of the function keeps a cache of the mapping from arguments
+ to results and, when calls with the same arguments are repeated often, has
+ higher performance at the expense of higher memory use."
+ [function]
+ (let [cache (ref {})]
+ (fn [& args]
+ (or (@cache args)
+ (let [result (apply function args)]
+ (dosync
+ (commute cache assoc args result))
+ result)))))
diff --git a/src/clojure/contrib/ns_utils/ns_utils.clj b/src/clojure/contrib/ns_utils/ns_utils.clj
new file mode 100644
index 00000000..a165b1f8
--- /dev/null
+++ b/src/clojure/contrib/ns_utils/ns_utils.clj
@@ -0,0 +1,88 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+;; which can be found in the file CPL.TXT 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-utils
+;;
+;; Namespace Utilities
+;;
+;; 'ns' returns the namespace named by a symbol or throws
+;; if the namespace does not exist
+;;
+;; 'ns-vars' returns a sorted seq of symbols naming public vars
+;; in a namespace
+;;
+;; 'print-dir' prints a sorted directory of public vars in a
+;; namespace
+;;
+;; 'print-docs' prints documentation for the public vars in a
+;; namespace
+;;
+;; Convenience
+;;
+;; 'vars' returns a sorted seq of symbols naming public vars
+;; in a namespace (macro)
+;;
+;; 'dir' prints a sorted directory of public vars in a
+;; namespace (macro)
+;;
+;; 'docs' prints documentation for the public vars in a
+;; namespace (macro)
+;;
+;; scgilardi (gmail)
+;; 23 April 2008
+
+(clojure/in-ns 'clojure.contrib.ns-utils)
+(clojure/refer 'clojure)
+
+;; Namespace Utilities
+
+(defn ns
+ "Returns the namespace named by ns-sym or throws if the
+ namespace does not exist"
+ [ns-sym]
+ (let [ns (find-ns ns-sym)]
+ (when-not ns
+ (throw (new Exception (str "Unable to find namespace: "
+ ns-sym))))
+ ns))
+
+(defn ns-vars
+ "Returns a sorted seq of symbols naming public vars in
+ a namespace"
+ [ns]
+ (sort (map first (ns-publics ns))))
+
+(defn print-dir
+ "Prints a sorted directory of public vars in a namespace"
+ [ns]
+ (doseq item (ns-vars ns)
+ (println item)))
+
+(defn print-docs
+ "Prints documentation for the public vars in a namespace"
+ [ns]
+ (doseq item (ns-vars ns)
+ (print-doc (ns-resolve ns item))))
+
+;; Convenience
+
+(defmacro vars
+ "Returns a sorted seq of symbols naming public vars in
+ a namespace"
+ [nsname]
+ `(ns-vars (ns '~nsname)))
+
+(defmacro dir
+ "Prints a sorted directory of public vars in a namespace"
+ [nsname]
+ `(print-dir (ns '~nsname)))
+
+(defmacro docs
+ "Prints documentation for the public vars in a namespace"
+ [nsname]
+ `(print-docs (ns '~nsname)))
diff --git a/src/clojure/contrib/pred/pred.clj b/src/clojure/contrib/pred/pred.clj
new file mode 100644
index 00000000..b654a5e8
--- /dev/null
+++ b/src/clojure/contrib/pred/pred.clj
@@ -0,0 +1,108 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+;; which can be found in the file CPL.TXT 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.
+;;
+;; pred.clj
+;;
+;; Some clojure predicates
+;;
+;; scgilardi (gmail)
+;; 28 June 2008
+
+(clojure/in-ns 'clojure.contrib.pred)
+(clojure/refer 'clojure)
+
+(defn coll?
+ "Returns true if x implements IPersistentCollection"
+ [x]
+ (instance? clojure.lang.IPersistentCollection x))
+
+(defn list?
+ "Returns true if x implements IPersistentList"
+ [x]
+ (instance? clojure.lang.IPersistentList x))
+
+;; map
+
+(defn set?
+ "Returns true if x implements IPersistentSet"
+ [x]
+ (instance? clojure.lang.IPersistentSet x))
+
+(defn stack?
+ "Returns true if x implements IPersistentStack"
+ [x]
+ (instance? clojure.lang.IPersistentStack x))
+
+;; vector
+
+(defn ref?
+ "Returns true if x implements IRef"
+ [x]
+ (instance? clojure.lang.IRef x))
+
+;; seq
+;; var
+
+(defn map-entry?
+ "Returns true if x is a MapEntry"
+ [x]
+ (instance? clojure.lang.MapEntry x))
+
+(defn atom?
+ "Returns true if x is not a collection"
+ [x]
+ (not (coll? x)))
+
+(defn number?
+ "Returns true if x is a Number"
+ [x]
+ (instance? Number x))
+
+(defn ratio?
+ "Returns true if x is a Ratio"
+ [x]
+ (instance? clojure.lang.Ratio x))
+
+(defn range?
+ "Returns true if x is a Range"
+ [x]
+ (instance? clojure.lang.Range x))
+
+(defn function?
+ "Returns true if x implements IFn"
+ [x]
+ (instance? clojure.lang.IFn x))
+
+(defmacro macro?
+ "Returns true if x is a function and the symbol of the
+ same name can be resolved and has its :macro metadata
+ set"
+ [x]
+ `(and (function? ~x) (boolean (:macro ^#'~x))))
+
+(defn integer?
+ "Returns true if x is an integer"
+ [x]
+ (or (instance? Integer x)
+ (instance? Long x)
+ (instance? BigInteger x)))
+
+(defn even?
+ "Returns true if x is even, throws an exception if x is not an integer"
+ [x]
+ (zero? (bit-and x 1)))
+
+(defn odd?
+ "Returns true if x is odd, throws an exception if x is not an integer"
+ [x]
+ (not (even? x)))
+
+(defn empty?
+ "Returns true if coll is empty"
+ [coll]
+ (not (seq coll)))
diff --git a/src/clojure/contrib/seq_utils/seq_utils.clj b/src/clojure/contrib/seq_utils/seq_utils.clj
new file mode 100644
index 00000000..33f67420
--- /dev/null
+++ b/src/clojure/contrib/seq_utils/seq_utils.clj
@@ -0,0 +1,79 @@
+;;; seq_utils.clj -- Sequence utilities for Clojure
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; last updated August 12, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+(clojure/in-ns 'clojure.contrib.seq-utils)
+(clojure/refer 'clojure)
+
+
+;; 'flatten' written by Rich Hickey,
+;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b
+(defn flatten
+ "Takes any nested combination of sequential things (lists, vectors,
+ etc.) and returns their contents as a single, flat sequence."
+ [x]
+ (let [s? #(instance? clojure.lang.Sequential %)]
+ (filter (complement s?) (tree-seq s? seq x))))
+
+(defn batch
+ "Returns a sequence of sequences, each containing 'size' elements
+ from s. DEPRECATED in favor of clojure/partition, added to boot.clj
+ in r865."
+ [size s]
+ (when s
+ (lazy-cons (take size s) (batch size (drop size s)))))
+
+(defn separate
+ "Returns a vector:
+ [ (filter f s), (filter (complement f) s) ]"
+ [f s]
+ [(filter f s) (filter (complement f) s)])
+
+(defn includes?
+ "Returns true if s contains something equal (with =) to x."
+ [x s]
+ (if (some (fn [y] (= y x)) s)
+ true false))
+
+(defn indexed
+ "Returns a lazy sequence of [index, item] pairs, where items come
+ from 's' and indexes count up from zero.
+
+ (indexed '(a b c d)) => ([0 a] [1 b] [2 c] [3 d])"
+ [s]
+ (map vector (iterate inc 0) s))
+
+;; group-by written by Rich Hickey;
+;; see http://paste.lisp.org/display/64190
+(defn group-by [f coll]
+ "Returns a sorted map of the elements of coll keyed by the result of
+ f on each element. The value at each key will be a vector of the
+ corresponding elements, in the order they appeared in coll."
+ (reduce
+ (fn [ret x]
+ (let [k (f x)]
+ (assoc ret k (conj (get ret k []) x))))
+ (sorted-map) coll))
+
+;; partition-by written by Rich Hickey;
+;; see http://paste.lisp.org/display/64190
+(defn partition-by [f coll]
+ "Applies f to each value in coll, splitting it each time f returns
+ a new value. Returns a lazy seq of lazy seqs."
+ (when-let s (seq coll)
+ (let [fv (f (first s))
+ ends (drop-while #(= fv (f %)) (rest s))
+ tw (fn this [s]
+ (when-not (identical? s ends)
+ (lazy-cons (first s) (this (rest s)))))]
+ (lazy-cons (tw s) (partition-by f ends)))))
diff --git a/src/clojure/contrib/sql/sql.clj b/src/clojure/contrib/sql/sql.clj
new file mode 100644
index 00000000..1f81b9b8
--- /dev/null
+++ b/src/clojure/contrib/sql/sql.clj
@@ -0,0 +1,126 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+;; which can be found in the file CPL.TXT 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.
+;;
+;; sql.clj
+;;
+;; A Clojure interface to sql databases via jdbc
+;;
+;; scgilardi (gmail)
+;; 23 April 2008
+
+(clojure/in-ns 'clojure.contrib.sql)
+(clojure/refer 'clojure)
+
+(import '(java.sql DriverManager Connection PreparedStatement ResultSet))
+
+(defn get-connection
+ "Attempts to get a connection to a database via a jdbc URL"
+ [subprotocol db-name]
+ (let [url (str "jdbc:" subprotocol ":" db-name)]
+ (.getConnection DriverManager url)))
+
+(defmacro with-connection
+ "Evaluates body in the context of a connection to a database. Any updates
+ are committed as one transaction after evaluating body or rolled back on
+ any uncaught exception."
+ [con init & body]
+ `(with-open ~con ~init
+ (try
+ (.setAutoCommit ~con false))
+ ~@body
+ (.commit ~con)
+ (catch Exception e#
+ (.rollback ~con)
+ (throw (Exception. "transaction rolled back" e#)))))
+
+(defn execute-commands
+ "Executes a sequence of SQL commands that do not return results"
+ [con commands]
+ (with-open stmt (.createStatement con)
+ (doseq cmd commands
+ (.addBatch stmt cmd))
+ (.executeBatch stmt)))
+
+(defn execute-prepared-statement
+ "Executes a prepared statement with a sequence of parameter sets"
+ [con sql sets]
+ (with-open stmt (.prepareStatement con sql)
+ (doseq set sets
+ (doseq [index value] (map vector (iterate inc 1) set)
+ (.setObject stmt index value))
+ (.addBatch stmt ))
+ (.executeBatch stmt)))
+
+(defmacro with-query-results
+ "Executes a query and then evaluates body repeatedly with rec bound to
+ each of the generated results in turn"
+ [rec con sql & body]
+ `(with-open stmt# (.prepareStatement ~con ~sql)
+ (with-open rset# (.executeQuery stmt#)
+ (doseq ~rec (resultset-seq rset#)
+ ~@body))))
+
+(comment
+
+ ;; Examples
+
+ ;; Simple tests of sql.clj using derby as a JDBC provider.
+ ;;
+ ;; Substituting a different database should only affect the definition
+ ;; of 'db' below (and perhaps suggest the need for more variations of
+ ;; get-connection).
+
+(clojure/in-ns 'sql-test)
+(clojure/refer 'clojure)
+
+(lib/use sql)
+
+(.forName Class "org.apache.derby.jdbc.EmbeddedDriver")
+
+(defn db []
+ (get-connection "derby" "/tmp/test-derby.db;create=true"))
+
+(defn db-drop []
+ (with-connection con (db)
+ (try
+ (execute-commands con
+ ["drop table fruit"])
+ (catch Exception e))))
+
+(defn db-write []
+ (db-drop)
+ (with-connection con (db)
+ (execute-commands con
+ ["create table fruit (name varchar(32), appearance varchar(32), cost int, grade real)"])
+ (execute-prepared-statement con
+ "insert into fruit values (?, ?, ?, ?)"
+ [["Apple" "red" 59 87]
+ ["Banana" "yellow" 29 92.2]
+ ["Peach" "fuzzy" 139 90.0]
+ ["Orange" "juicy" 89 88.6]])))
+
+(defn db-read []
+ (with-connection con (db)
+ (with-query-results rec con
+ "select * from fruit"
+ (println rec))))
+
+(defn db-grade-a []
+ (with-connection con (db)
+ (with-query-results rec con
+ "select name, cost from fruit where grade >= 90"
+ (println rec))))
+
+(defn db-exception []
+ (with-connection con (db)
+ (execute-prepared-statement con
+ "insert into fruit (name, appearance) values (?, ?)"
+ [["Grape" "yummy"]
+ ["Pear" "bruised"]])
+ (throw (Exception. "an exception"))))
+)
diff --git a/src/clojure/contrib/str_utils/str_utils.clj b/src/clojure/contrib/str_utils/str_utils.clj
new file mode 100644
index 00000000..cb344024
--- /dev/null
+++ b/src/clojure/contrib/str_utils/str_utils.clj
@@ -0,0 +1,44 @@
+;;; str_utils.clj -- string utilities for Clojure
+
+;; by Stuart Sierra <mail@stuartsierra.com>
+;; April 8, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+(clojure/in-ns 'clojure.contrib.str-utils)
+(clojure/refer 'clojure)
+
+(import '(java.util.regex Pattern))
+
+
+(defn re-split
+ "Splits the string on instances of 'pattern'. Returns a sequence of
+ strings. Optional 'limit' argument is the maximum number of
+ splits. Like Perl's 'split'."
+ ([#^Pattern pattern string] (seq (. pattern (split string))))
+ ([#^Pattern pattern string limit] (seq (. pattern (split string limit)))))
+
+(defn re-gsub
+ "Replaces all instances of 'pattern' in 'string' with
+ 'replacement'. Like Ruby's 'String#gsub'."
+ [#^Pattern regex replacement #^String string]
+ (.. regex (matcher string) (replaceAll replacement)))
+
+(defn re-sub
+ "Replaces the first instance of 'pattern' in 'string' with
+ 'replacement'. Like Ruby's 'String#sub'."
+ [#^Pattern regex replacement #^String string]
+ (.. regex (matcher string) (replaceFirst replacement)))
+
+(defn str-join
+ "Returns a string of all elements in 'sequence', separated by
+ 'separator'. Like Perl's 'join'."
+ [separator sequence]
+ (apply str (interpose separator sequence)))
diff --git a/src/clojure/contrib/string/string.clj b/src/clojure/contrib/string/string.clj
new file mode 100644
index 00000000..f9445422
--- /dev/null
+++ b/src/clojure/contrib/string/string.clj
@@ -0,0 +1,29 @@
+;; Copyright (c) Stephen C. Gilardi. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+;; which can be found in the file CPL.TXT 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.
+;;
+;; string.clj
+;;
+;; String functions
+;;
+;; scgilardi (gmail)
+;; Created: 6 July 2008
+
+(clojure/in-ns 'clojure.contrib.string)
+(clojure/refer 'clojure)
+
+;; until Clojure supports "..." arguments, calling String/format directly
+;; is just ugly enough, and could be commonly used enough to warrant a
+;; Clojure wrapper.
+;;
+;; (let [name "world"] (format "Hello, %s!" name)) ==> "Hello, world!"
+
+(defn format
+ "Returns a string using the specified format and arguments. See
+ java.util.Formatter for format string syntax."
+ [fmt & args]
+ (String/format fmt (to-array args)))
diff --git a/src/clojure/contrib/test_is/test_is.clj b/src/clojure/contrib/test_is/test_is.clj
new file mode 100644
index 00000000..68463393
--- /dev/null
+++ b/src/clojure/contrib/test_is/test_is.clj
@@ -0,0 +1,211 @@
+;;; test_is.clj: test framework for Clojure
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; June 5, 2008
+
+;; Thanks to Chas Emerick for contributions.
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+
+;; Inspired by many Common Lisp test frameworks and clojure/test, this
+;; file is a Clojure test framework.
+;;
+;; Define tests as :test metadata on your fns. Use the "is" macro
+;; for assertions. Examples:
+;;
+;; (defn add2
+;; ([x] (+ x 2))
+;; {:test (fn [] (is (= (add2 3) 5))
+;; (is (= (add2 -4) -2)
+;; (is (> (add2 50) 50)))})
+;;
+;; You can also define tests in isolation with the "deftest" macro:
+;;
+;; (deftest test-new-fn
+;; (is (= (new-fn) "Awesome")))
+;;
+;; Run tests with (run-tests). As in any language with macros, you may
+;; need to recompile functions after changing a macro definition.
+
+
+
+(clojure/in-ns 'clojure.contrib.test-is)
+(clojure/refer 'clojure)
+
+(def
+ #^{:doc "PrintWriter to which test results are printed; defaults to
+ System.err."}
+ *test-out* (. System err))
+
+
+;;; PRIVATE
+
+(defmacro #^{:private true} defcounter [ref-name fn-name]
+ `(do (def ~(with-meta ref-name {:private true}) nil)
+ (defn ~fn-name []
+ (when ~ref-name (sync nil (commute ~ref-name inc))))))
+
+(defcounter *tests* count-test)
+(defcounter *assertions* count-assertion)
+(defcounter *failures* count-failure)
+(defcounter *exceptions* count-exception)
+
+(defmacro failure [reason message]
+ `(throw (new java.lang.AssertionError
+ (str ~reason (when ~message (str "; " ~message))))))
+
+(defn- assert-true [form message]
+ `(do (count-assertion)
+ (let [value# ~form]
+ (when-not value#
+ (failure (str ~(pr-str form) " was false/nil")
+ ~message)))))
+
+;; Multimethod for testing expressions, dispatches on the first symbol
+;; in the expression.
+(defmulti assert-expr (fn [form message] (first form)))
+
+;; Test for (= actual expected) expressions.
+(defmethod assert-expr '= [form message]
+ (let [expr1 (second form)
+ expr2 (nth form 2)]
+ `(do (count-assertion)
+ (let [value1# ~expr1
+ value2# ~expr2]
+ (when-not (= value1# value2#)
+ (failure (str ~(pr-str expr1) " is " (pr-str value1#)
+ " but should be " (pr-str value2#))
+ ~message))))))
+
+;; Test for (instance? class object) expressions.
+(defmethod assert-expr 'instance? [form message]
+ (let [clazz (second form)
+ object (nth form 2)]
+ `(do (count-assertion)
+ (let [value1# ~clazz
+ value2# ~object]
+ (when-not (instance? value1# value2#)
+ (failure (str ~(pr-str object) " has " (class value2#)
+ " but should have " (pr-str value1#))
+ ~message))))))
+
+;; Generic expression test, just check if expression evaluates to
+;; logical true.
+(defmethod assert-expr :default [form message]
+ (assert-true form message))
+
+(defn- always-fail-assert [message]
+ `(do (count-assertion)
+ (failure ~message nil)))
+
+(defmacro #^{:private true} with-test-counters
+ "Creates dynamic bindings for counting the number of tests,
+ assertions, failures, and exceptions. Returns the results in a
+ map."
+ [& body]
+ `(binding [*tests* (ref 0)
+ *assertions* (ref 0)
+ *failures* (ref 0)
+ *exceptions* (ref 0)]
+ ~@body
+ {:tests @*tests*
+ :assertions @*assertions*
+ :failures @*failures*
+ :exceptions @*exceptions*}))
+
+(defn- run-test-fn
+ "Calls the function; reports errors/exceptions."
+ [f name]
+ (try
+ (count-test)
+ (f)
+ (catch java.lang.AssertionError e
+ (count-failure)
+ (. *test-out* (println (str "FAIL in " name ": "
+ (.getMessage e)))))
+ (catch java.lang.Exception e
+ (count-exception)
+ (. *test-out* (println (str "EXCEPTION in " name ":")))
+ (.printStackTrace e *test-out*))))
+
+(defn- test-var
+ "Finds and calls the fn in a var's :test metadata."
+ [v]
+ (when-let f (:test (meta v))
+ (run-test-fn f (str v))))
+
+(defn- test-interns
+ "Tests all interned symbols in the namespace."
+ [ns]
+ (let [ns (if (symbol? ns) (find-ns ns) ns)]
+ (. *test-out* (println (str "Testing " ns)))
+ (dorun (map test-var (vals (ns-interns ns))))))
+
+
+;;; PUBLIC
+
+(defmacro is
+ "Generic assertion macro. Throws AssertionError if form evaluates
+ logical false. Optional message will be added to the error.
+
+ form may be one of:
+ * an equality test like (= expression expected-value)
+ * an instance? test like (instance? class expression)
+ * nil, which always fails
+ * an arbitrary expression, fails if it returns false/nil"
+ ([form] `(is ~form nil))
+ ([form message]
+ (cond
+ (nil? form) (always-fail-assert message)
+ (seq? form) (assert-expr form message)
+ :else (assert-true form message))))
+
+(defn print-results
+ "Prints a summary of the results from test-ns to *test-out*."
+ [r]
+ (. *test-out*
+ (println (str "\nRan " (:tests r) " tests "
+ (:assertions r) " assertions.\n"
+ (:failures r) " failures, "
+ (:exceptions r) " exceptions."))) )
+
+(defn test-ns
+ "Runs tests on all interned symbols in the namespaces
+ (symbols or namespace objects).
+
+ Returns a map with the following keys:
+ :tests => number of tests run
+ :assertions => number of assertions checked
+ :failures => number of failed assertions
+ :exceptions => number of exceptions raised
+
+ If no namespace is given, uses *ns*."
+ ([] (test-ns *ns*))
+ ([& namespaces]
+ (with-test-counters (dorun (map test-interns namespaces)))))
+
+(defn run-tests
+ "Runs tests in the given namespaces and prints a summary of
+ results.
+
+ If no namespace is given, uses *ns*."
+ [& namespaces]
+ (print-results (apply test-ns namespaces)))
+
+(defn run-all-tests
+ "Runs tests in all namespaces and prints a summary of results."
+ []
+ (apply run-tests (all-ns)))
+
+(defmacro deftest
+ "Defs an unbound Var with body in its :test fn."
+ [name & body]
+ `(def ~(with-meta name {:test `(fn [] ~@body)})))
diff --git a/src/clojure/contrib/trace/trace.clj b/src/clojure/contrib/trace/trace.clj
new file mode 100644
index 00000000..9f91d585
--- /dev/null
+++ b/src/clojure/contrib/trace/trace.clj
@@ -0,0 +1,55 @@
+;;; trace.clj -- simple call-tracing macros for Clojure
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; June 9, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+;; This file defines simple "tracing" macros to help you see what your
+;; code is doing.
+
+
+(clojure/in-ns 'clojure.contrib.trace)
+(clojure/refer 'clojure)
+
+(def
+ #^{:doc "PrintStream for trace output. Defaults to System.err."}
+ *trace-out* (. System err))
+
+(defmacro trace
+ "Prints value of expr to standard error and returns it. Can be
+ inserted anywhere without affecting surrounding code. Optional
+ 'name' argument can be used to identify what is being traced."
+ ([expr]
+ `(let [value# ~expr]
+ (. *trace-out* (println
+ (str "TRACE: " (pr-str value#))))
+ value#))
+ ([name expr]
+ `(let [value# ~expr]
+ (. *trace-out* (println
+ (str "TRACE " ~name ": " (pr-str value#))))
+ value#)))
+
+(defmacro deftrace
+ "Use in place of defn; traces each call/return of this fn, including
+ arguments."
+ [name & definition]
+ `(let [f# (fn ~@definition)]
+ (defn ~name [& args#]
+ (let [id# (gensym "t")] ; identifier for this invocation
+ (. *trace-out*
+ (println (str "TRACE " id# ": " ~(str name)
+ " called with " (pr-str args#))))
+ (let [value# (apply f# args#)] ; call original fn
+ (. *trace-out*
+ (println (str "TRACE " id# ": " ~(str name)
+ " returned " (pr-str value#))))
+ value#)))))
diff --git a/src/clojure/contrib/zip_filter/xml/xml.clj b/src/clojure/contrib/zip_filter/xml/xml.clj
new file mode 100644
index 00000000..16f67e8e
--- /dev/null
+++ b/src/clojure/contrib/zip_filter/xml/xml.clj
@@ -0,0 +1,177 @@
+; Copyright (c) Chris Houser, April 2008. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+; which can be found in the file CPL.TXT 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.
+
+; Specialization of zip-filter for xml trees.
+
+(clojure/in-ns 'clojure.contrib.zip-filter.xml)
+(clojure/refer 'clojure)
+
+; load zip-filter if it isn't already -- when will lib.clj be guaranteed?
+(when-not (find-ns 'clojure.contrib.zip-filter)
+ (clojure.lang.RT/loadResourceScript
+ "clojure/contrib/zip_filter/zip_filter.clj"))
+
+(alias 'zf 'clojure.contrib.zip-filter)
+(alias 'zip 'clojure.zip)
+(alias 'xml 'clojure.xml)
+
+(def xml->)
+
+(defn attr
+ "Returns the xml attribute named attrname, of the xml node at location loc."
+ ([attrname] (fn [loc] (attr loc attrname)))
+ ([loc attrname] (when (zip/branch? loc) (-> loc zip/node :attrs attrname))))
+
+(defn attr=
+ "Returns a query predicate that matches a node when it has an
+ attribute named attrname whose value is attrval."
+ [attrname attrval] (fn [loc] (= attrval (attr loc attrname))))
+
+(defn tag=
+ "Returns a query predicate that matches a node when its is a tag
+ named tagname."
+ [tagname]
+ (fn [loc]
+ (filter #(and (zip/branch? %) (= tagname ((zip/node %) :tag)))
+ (if (zf/auto? loc)
+ (zf/children-auto loc)
+ (list (zf/auto true loc))))))
+
+(defn text
+ "Returns the textual contents of the given location, similar to
+ xpaths's value-of"
+ [loc]
+ (.replaceAll
+ #^String (apply str (xml-> loc zf/descendants zip/node string?))
+ (str "[\\s" (char 160) "]+") " "))
+
+(defn text=
+ "Returns a query predicate that matches a node when its textual
+ content equals s."
+ [s] (fn [loc] (= (text loc) s)))
+
+(defn seq-test
+ "Returns a query predicate that matches a node when its xml content
+ matches the query expresions given."
+ #^{:private true}
+ [preds] (fn [loc] (and (apply xml-> loc preds) (list loc))))
+
+(defn xml->
+ "The loc is passed to the first predicate. If the predicate returns
+ a collection, each value of the collection is passed to the next
+ predicate. If it returns a location, the location is passed to the
+ next predicate. If it returns true, the input location is passed to
+ the next predicate. If it returns false or nil, the next predicate
+ is not called.
+
+ This process is repeated, passing the processed results of each
+ predicate to the next predicate. xml-> returns the final sequence.
+ The entire chain is evaluated lazily.
+
+ There are also special predicates: keywords are converted to tag=,
+ strings to text=, and vectors to sub-queries that return true if
+ they match.
+
+ See the footer of zip-query.clj for examples."
+ [loc & preds]
+ (zf/mapcat-chain loc preds
+ #(cond (keyword? %) (tag= %)
+ (string? %) (text= %)
+ (vector? %) (seq-test %))))
+
+(defn xml1->
+ "Returns the first item from loc based on the query predicates
+ given. See xml->"
+ [loc & preds] (first (apply xml-> loc preds)))
+
+
+; === examples ===
+
+(comment
+
+(defn parse-str [s]
+ (zip/xml-zip (xml/parse (new org.xml.sax.InputSource
+ (new java.io.StringReader s)))))
+
+(def atom1 (parse-str "<?xml version='1.0' encoding='UTF-8'?>
+<feed xmlns='http://www.w3.org/2005/Atom'>
+ <id>tag:blogger.com,1999:blog-28403206</id>
+ <updated>2008-02-14T08:00:58.567-08:00</updated>
+ <title type='text'>n01senet</title>
+ <link rel='alternate' type='text/html' href='http://n01senet.blogspot.com/'/>
+ <entry>
+ <id>1</id>
+ <published>2008-02-13</published>
+ <title type='text'>clojure is the best lisp yet</title>
+ <author><name>Chouser</name></author>
+ </entry>
+ <entry>
+ <id>2</id>
+ <published>2008-02-07</published>
+ <title type='text'>experimenting with vnc</title>
+ <author><name>agriffis</name></author>
+ </entry>
+</feed>
+"))
+
+; simple single-function filter
+(assert (= (xml-> atom1 #((zip/node %) :tag))
+ '(:feed)))
+
+; two-stage filter using helpful query prediates
+(assert (= (xml-> atom1 (tag= :title) text)
+ '("n01senet")))
+
+; same filter as above, this time using keyword shortcut
+(assert (= (xml-> atom1 :title text)
+ '("n01senet")))
+
+; multi-stage filter
+(assert (= (xml-> atom1 :entry :author :name text)
+ '("Chouser" "agriffis")))
+
+; test xml1->
+(assert (= (xml1-> atom1 :entry :author :name text)
+ "Chouser"))
+
+; multi-stage filter with subquery specified using a vector
+(assert (= (xml-> atom1 :entry [:author :name (text= "agriffis")]
+ :id text)
+ '("2")))
+
+; same filter as above, this time using a string shortcut
+(assert (= (xml-> atom1 :entry [:author :name "agriffis"] :id text)
+ '("2")))
+
+; attribute access
+(assert (= (xml-> atom1 :title (attr :type))
+ '("text")))
+
+; attribute filtering
+(assert (= (xml-> atom1 :link [(attr= :rel "alternate")] (attr :type))
+ '("text/html")))
+
+; ancestors
+(assert (= (xml-> atom1 zf/descendants :id "2" zf/ancestors zip/node #(:tag %))
+ '(:id :entry :feed)))
+
+; ancestors with non-auto tag= (:entry), followed by auto tag= (:id)
+(assert (= (xml-> atom1 zf/descendants :name "Chouser" zf/ancestors
+ :entry :id text)
+ '("1")))
+
+; left-locs and detection of returning a single loc (zip/up)
+(assert (= (xml-> atom1 zf/descendants :name "Chouser" zip/up
+ zf/left-locs :id text)
+ '("1")))
+
+; right-locs
+(assert (= (xml-> atom1 zf/descendants :id zf/right-locs :author text)
+ '("Chouser" "agriffis")))
+
+)
diff --git a/src/clojure/contrib/zip_filter/zip_filter.clj b/src/clojure/contrib/zip_filter/zip_filter.clj
new file mode 100644
index 00000000..76388c10
--- /dev/null
+++ b/src/clojure/contrib/zip_filter/zip_filter.clj
@@ -0,0 +1,91 @@
+; Copyright (c) Chris Houser, April 2008. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+; which can be found in the file CPL.TXT 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.
+
+; System for filtering trees and nodes generated by zip.clj in
+; general, and xml trees in particular.
+
+(clojure/in-ns 'clojure.contrib.zip-filter)
+(clojure/refer 'clojure :exclude '(descendants ancestors))
+(alias 'zip 'clojure.zip)
+
+(defn sequential?
+ "Returns true if x implements Sequential."
+ [x] (instance? clojure.lang.Sequential x))
+
+; This uses the negative form (no-auto) so that the result from any
+; naive function, including user functions, defaults to "auto".
+(defn auto
+ [v x] (with-meta x ((if v dissoc assoc) ^x :zip-filter/no-auto? true)))
+
+(defn auto?
+ [x] (not (:zip-filter/no-auto? ^x)))
+
+(defn right-locs
+ "Returns a lazy sequence of locations to the right of loc, starting with loc."
+ [loc] (when loc (lazy-cons (auto false loc) (right-locs (zip/right loc)))))
+
+(defn left-locs
+ "Returns a lazy sequence of locations to the left of loc, starting with loc."
+ [loc] (when loc (lazy-cons (auto false loc) (left-locs (zip/left loc)))))
+
+(defn leftmost?
+ "Returns true if there are no more nodes to the left of location loc."
+ [loc] (nil? (zip/left loc)))
+
+(defn rightmost?
+ "Returns true if there are no more nodes to the right of location loc."
+ [loc] (nil? (zip/right loc)))
+
+(defn children
+ "Returns a lazy sequence of all immediate children of location loc,
+ left-to-right."
+ [loc]
+ (when (zip/branch? loc)
+ (map #(auto false %) (right-locs (zip/down loc)))))
+
+(defn children-auto
+ "Returns a lazy sequence of all immediate children of location loc,
+ left-to-right, marked so that a following tag= predicate will auto-descend."
+ #^{:private true}
+ [loc]
+ (when (zip/branch? loc)
+ (map #(auto true %) (right-locs (zip/down loc)))))
+
+(defn descendants
+ "Returns a lazy sequence of all descendants of location loc, in
+ depth-first order, left-to-right, starting with loc."
+ [loc] (lazy-cons (auto false loc) (mapcat descendants (children loc))))
+
+(defn ancestors
+ "Returns a lazy sequence of all ancestors of location loc, starting
+ with loc and proceeding to loc's parent node and on through to the
+ root of the tree."
+ [loc] (when loc (lazy-cons (auto false loc) (ancestors (zip/up loc)))))
+
+(defn- fixup-apply
+ "Calls (pred loc), and then converts the result to the 'appropriate'
+ sequence."
+ #^{:private true}
+ [pred loc]
+ (let [rtn (pred loc)]
+ (cond (and (map? ^rtn) (:zip-filter/is-node? ^rtn)) (list rtn)
+ (= rtn true) (list loc)
+ (= rtn false) nil
+ (nil? rtn) nil
+ (sequential? rtn) rtn
+ :else (list rtn))))
+
+(defn mapcat-chain
+ #^{:private true}
+ [loc preds mkpred]
+ (reduce (fn [prevseq expr]
+ (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq))
+ (list (with-meta loc (assoc ^loc :zip-filter/is-node? true)))
+ preds))
+
+; see clojure.contrib.zip-filter.xml for examples
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-09-08 20:42:37 +0000