Split all namespaces into sub-modules.

* Examples and tests have not been copied over.
* Clojure test/compile phases are commented out in parent POM.
* May require installing parent POM before full build.

1 files changed, 580 insertions, 0 deletions

diff --git a/modules/monads/src/main/clojure/clojure/contrib/monads.clj b/modules/monads/src/main/clojure/clojure/contrib/monads.clj
new file mode 100644
index 00000000..3cb1bd16
--- /dev/null
+++ b/modules/monads/src/main/clojure/clojure/contrib/monads.clj
@@ -0,0 +1,580 @@
+;; Monads in Clojure
+
+;; by Konrad Hinsen
+;; last updated June 30, 2009
+
+;; Copyright (c) Konrad Hinsen, 2009. 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
+  ^{:author "Konrad Hinsen"
+     :see-also [["http://onclojure.com/2009/03/05/a-monad-tutorial-for-clojure-programmers-part-1/" "Monad tutorial part 1"]
+		["http://onclojure.com/2009/03/06/a-monad-tutorial-for-clojure-programmers-part-2/" "Monad tutorial part 2"]
+		["http://onclojure.com/2009/03/23/a-monad-tutorial-for-clojure-programmers-part-3/" "Monad tutorial part 3"]
+		["http://onclojure.com/2009/04/24/a-monad-tutorial-for-clojure-programmers-part-4/" "Monad tutorial part 4"]
+		["http://intensivesystems.net/tutorials/monads_101.html" "Monads in Clojure part 1"]
+		["http://intensivesystems.net/tutorials/monads_201.html" "Monads in Clojure part 2"]]
+     :doc "This library contains the most commonly used monads as well
+           as macros for defining and using monads and useful monadic
+           functions."}
+  clojure.contrib.monads
+  (:require [clojure.contrib.accumulators])
+  (:use [clojure.contrib.macro-utils :only (with-symbol-macros defsymbolmacro)])
+  (:use [clojure.contrib.def :only (name-with-attributes)]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Defining monads
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro monad
+   "Define a monad by defining the monad operations. The definitions
+    are written like bindings to the monad operations m-bind and
+    m-result (required) and m-zero and m-plus (optional)."
+   [operations]
+   `(let [~'m-bind   ::undefined
+	  ~'m-result ::undefined
+	  ~'m-zero   ::undefined
+	  ~'m-plus   ::undefined
+	  ~@operations]
+      {:m-result ~'m-result
+       :m-bind ~'m-bind 
+       :m-zero ~'m-zero
+       :m-plus ~'m-plus}))
+
+(defmacro defmonad
+   "Define a named monad by defining the monad operations. The definitions
+    are written like bindings to the monad operations m-bind and
+    m-result (required) and m-zero and m-plus (optional)."
+
+   ([name doc-string operations]
+    (let [doc-name (with-meta name {:doc doc-string})]
+      `(defmonad ~doc-name ~operations)))
+
+   ([name operations]
+    `(def ~name (monad ~operations))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Using monads
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- add-monad-step
+  "Add a monad comprehension step before the already transformed
+   monad comprehension expression mexpr."
+  [mexpr step]
+  (let [[bform expr] step]
+    (cond (identical? bform :when)  `(if ~expr ~mexpr ~'m-zero)
+	  (identical? bform :let)   `(let ~expr ~mexpr)
+	  :else (list 'm-bind expr (list 'fn [bform] mexpr)))))
+
+(defn- monad-expr
+   "Transforms a monad comprehension, consisting of a list of steps
+    and an expression defining the final value, into an expression
+    chaining together the steps using :bind and returning the final value
+    using :result. The steps are given as a vector of
+    binding-variable/monadic-expression pairs."
+   [steps expr]
+   (when (odd? (count steps))
+     (throw (Exception. "Odd number of elements in monad comprehension steps")))
+   (let [rsteps (reverse (partition 2 steps))
+	 [lr ls] (first rsteps)]
+     (if (= lr expr)
+       ; Optimization: if the result expression is equal to the result
+       ; of the last computation step, we can eliminate an m-bind to
+       ; m-result.
+       (reduce add-monad-step
+	       ls
+	       (rest rsteps))
+       ; The general case.
+       (reduce add-monad-step
+	       (list 'm-result expr)
+	       rsteps))))
+
+(defmacro with-monad
+   "Evaluates an expression after replacing the keywords defining the
+    monad operations by the functions associated with these keywords
+    in the monad definition given by name."
+   [monad & exprs]
+   `(let [name#      ~monad
+	  ~'m-bind   (:m-bind name#)
+	  ~'m-result (:m-result name#)
+	  ~'m-zero   (:m-zero name#)
+	  ~'m-plus   (:m-plus name#)]
+      (with-symbol-macros ~@exprs)))
+
+(defmacro domonad
+   "Monad comprehension. Takes the name of a monad, a vector of steps
+    given as binding-form/monadic-expression pairs, and a result value
+    specified by expr. The monadic-expression terms can use the binding
+    variables of the previous steps.
+    If the monad contains a definition of m-zero, the step list can also
+    contain conditions of the form :when p, where the predicate p can
+    contain the binding variables from all previous steps.
+    A clause of the form :let [binding-form expr ...], where the bindings
+    are given as a vector as for the use in let, establishes additional
+    bindings that can be used in the following steps."
+   ([steps expr]
+    (monad-expr steps expr))
+   ([name steps expr]
+    (let [mexpr (monad-expr steps expr)]
+      `(with-monad ~name ~mexpr))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Defining functions used with monads
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro defmonadfn
+  "Like defn, but for functions that use monad operations and are used inside
+   a with-monad block."
+  {:arglists '([name docstring? attr-map? args expr]
+	       [name docstring? attr-map? (args expr) ...])}
+  [name & options]
+  (let [[name options]  (name-with-attributes name options)
+	fn-name (symbol (str *ns*) (format "m+%s+m" (str name)))
+	make-fn-body    (fn [args expr]
+			  (list (vec (concat ['m-bind 'm-result
+					      'm-zero 'm-plus] args))
+				(list `with-symbol-macros expr)))]
+    (if (list? (first options))
+      ; multiple arities
+      (let [arglists        (map first options)
+	    exprs           (map second options)
+	    ]
+	`(do
+	   (defsymbolmacro ~name (partial ~fn-name ~'m-bind ~'m-result 
+                                                   ~'m-zero ~'m-plus))
+	   (defn ~fn-name ~@(map make-fn-body arglists exprs))))
+      ; single arity
+      (let [[args expr] options]
+	`(do
+	   (defsymbolmacro ~name (partial ~fn-name ~'m-bind ~'m-result 
+                                                   ~'m-zero ~'m-plus))
+	   (defn ~fn-name ~@(make-fn-body args expr)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Commonly used monad functions
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Define the four basic monad operations as symbol macros that
+; expand to their unqualified symbol equivalents. This makes it possible
+; to use them inside macro templates without having to quote them.
+(defsymbolmacro m-result m-result)
+(defsymbolmacro m-bind m-bind)
+(defsymbolmacro m-zero m-zero)
+(defsymbolmacro m-plus m-plus)
+
+(defmacro m-lift
+  "Converts a function f of n arguments into a function of n
+  monadic arguments returning a monadic value."
+  [n f]
+  (let [expr (take n (repeatedly #(gensym "x_")))
+	vars (vec (take n (repeatedly #(gensym "mv_"))))
+	steps (vec (interleave expr vars))]
+    (list `fn vars (monad-expr steps (cons f expr)))))
+
+(defmonadfn m-join
+  "Converts a monadic value containing a monadic value into a 'simple'
+   monadic value."
+  [m]
+  (m-bind m identity))
+
+(defmonadfn m-fmap
+  "Bind the monadic value m to the function returning (f x) for argument x"
+  [f m]
+  (m-bind m (fn [x] (m-result (f x)))))
+
+(defmonadfn m-seq
+  "'Executes' the monadic values in ms and returns a sequence of the
+   basic values contained in them."
+  [ms]
+  (reduce (fn [q p]
+	    (m-bind p (fn [x]
+			(m-bind q (fn [y]
+				    (m-result (cons x y)))) )))
+	  (m-result '())
+	  (reverse ms)))
+
+(defmonadfn m-map
+  "'Executes' the sequence of monadic values resulting from mapping
+   f onto the values xs. f must return a monadic value."
+  [f xs]
+  (m-seq (map f xs)))
+
+(defmonadfn m-chain
+  "Chains together monadic computation steps that are each functions
+   of one parameter. Each step is called with the result of the previous
+   step as its argument. (m-chain (step1 step2)) is equivalent to
+   (fn [x] (domonad [r1 (step1 x) r2 (step2 r1)] r2))."
+  [steps]
+  (reduce (fn m-chain-link [chain-expr step]
+	    (fn [v] (m-bind (chain-expr v) step)))
+	  m-result
+	  steps))
+
+(defmonadfn m-reduce
+  "Return the reduction of (m-lift 2 f) over the list of monadic values mvs
+   with initial value (m-result val)."
+  ([f mvs]
+   (if (empty? mvs)
+     (m-result (f))
+     (let [m-f (m-lift 2 f)]
+       (reduce m-f mvs))))
+  ([f val mvs]
+   (let [m-f    (m-lift 2 f)
+	 m-val  (m-result val)]
+     (reduce m-f m-val mvs))))
+
+(defmonadfn m-until
+  "While (p x) is false, replace x by the value returned by the
+   monadic computation (f x). Return (m-result x) for the first
+   x for which (p x) is true."
+  [p f x]
+  (if (p x)
+    (m-result x)
+    (domonad
+      [y (f x)
+       z (m-until p f y)]
+      z)))
+
+(defmacro m-when
+  "If test is logical true, return monadic value m-expr, else return
+   (m-result nil)."
+  [test m-expr]
+  `(if ~test ~m-expr (~'m-result nil)))
+
+(defmacro m-when-not
+  "If test if logical false, return monadic value m-expr, else return
+   (m-result nil)."
+  [test m-expr]
+  `(if ~test (~'m-result nil) ~m-expr))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Utility functions used in monad definitions
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- flatten*
+  "Like #(apply concat %), but fully lazy: it evaluates each sublist
+   only when it is needed."
+  [ss]
+  (lazy-seq
+   (when-let [s (seq ss)]
+     (concat (first s) (flatten* (rest s))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Commonly used monads
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Identity monad
+(defmonad identity-m
+   "Monad describing plain computations. This monad does in fact nothing
+    at all. It is useful for testing, for combination with monad
+    transformers, and for code that is parameterized with a monad."
+  [m-result identity
+   m-bind   (fn m-result-id [mv f]
+	      (f mv))
+  ])
+
+; Maybe monad
+(defmonad maybe-m
+   "Monad describing computations with possible failures. Failure is
+    represented by nil, any other value is considered valid. As soon as
+    a step returns nil, the whole computation will yield nil as well."
+   [m-zero   nil
+    m-result (fn m-result-maybe [v] v)
+    m-bind   (fn m-bind-maybe [mv f]
+               (if (nil? mv) nil (f mv)))
+    m-plus   (fn m-plus-maybe [& mvs]
+	       (first (drop-while nil? mvs)))
+    ])
+
+; Sequence monad (called "list monad" in Haskell)
+(defmonad sequence-m
+   "Monad describing multi-valued computations, i.e. computations
+    that can yield multiple values. Any object implementing the seq
+    protocol can be used as a monadic value."
+   [m-result (fn m-result-sequence [v]
+	       (list v))
+    m-bind   (fn m-bind-sequence [mv f]
+               (flatten* (map f mv)))
+    m-zero   (list)
+    m-plus   (fn m-plus-sequence [& mvs]
+               (flatten* mvs))
+    ])
+
+; Set monad
+(defmonad set-m
+   "Monad describing multi-valued computations, like sequence-m,
+    but returning sets of results instead of sequences of results."
+   [m-result (fn m-result-set [v]
+	       #{v})
+    m-bind   (fn m-bind-set [mv f]
+               (apply clojure.set/union (map f mv)))
+    m-zero   #{}
+    m-plus   (fn m-plus-set [& mvs]
+               (apply clojure.set/union mvs))
+    ])
+
+; State monad
+(defmonad state-m
+   "Monad describing stateful computations. The monadic values have the
+    structure (fn [old-state] [result new-state])."
+   [m-result  (fn m-result-state [v]
+	        (fn [s] [v s]))
+    m-bind    (fn m-bind-state [mv f]
+	        (fn [s]
+		  (let [[v ss] (mv s)]
+		    ((f v) ss))))
+   ])
+
+(defn update-state
+  "Return a state-monad function that replaces the current state by the
+   result of f applied to the current state and that returns the old state."
+  [f]
+  (fn [s] [s (f s)]))
+
+(defn set-state
+  "Return a state-monad function that replaces the current state by s and
+   returns the previous state."
+  [s]
+  (update-state (fn [_] s)))
+
+(defn fetch-state
+  "Return a state-monad function that returns the current state and does not
+   modify it."
+  []
+  (update-state identity))
+
+(defn fetch-val
+  "Return a state-monad function that assumes the state to be a map and
+   returns the value corresponding to the given key. The state is not modified."
+  [key]
+  (domonad state-m
+    [s (fetch-state)]
+    (key s)))
+
+(defn update-val
+  "Return a state-monad function that assumes the state to be a map and
+   replaces the value associated with the given key by the return value
+   of f applied to the old value. The old value is returned."
+  [key f]
+  (fn [s]
+    (let [old-val (get s key)
+	  new-s   (assoc s key (f old-val))]
+      [old-val new-s])))
+
+(defn set-val
+  "Return a state-monad function that assumes the state to be a map and
+   replaces the value associated with key by val. The old value is returned."
+  [key val]
+  (update-val key (fn [_] val)))
+
+(defn with-state-field
+  "Returns a state-monad function that expects a map as its state and
+   runs statement (another state-monad function) on the state defined by
+   the map entry corresponding to key. The map entry is updated with the
+   new state returned by statement."
+  [key statement]
+  (fn [s]
+    (let [substate (get s key nil)
+	  [result new-substate] (statement substate)
+	  new-state (assoc s key new-substate)]
+      [result new-state])))
+
+(defn state-m-until
+  "An optimized implementation of m-until for the state monad that
+   replaces recursion by a loop."
+  [p f x]
+  (letfn [(until [p f x s]
+	    (if (p x)
+	      [x s]
+	      (let [[x s] ((f x) s)]
+		(recur p f x s))))]
+    (fn [s] (until p f x s))))
+
+; Writer monad
+(defn writer-m
+  "Monad describing computations that accumulate data on the side, e.g. for
+   logging. The monadic values have the structure [value log]. Any of the
+   accumulators from clojure.contrib.accumulators can be used for storing the
+   log data. Its empty value is passed as a parameter."
+  [empty-accumulator]
+  (monad
+     [m-result  (fn m-result-writer [v]
+	          [v empty-accumulator])
+      m-bind    (fn m-bind-writer [mv f]
+	          (let [[v1 a1] mv
+			[v2 a2] (f v1)]
+		    [v2 (clojure.contrib.accumulators/combine a1 a2)]))
+     ]))
+
+(defmonadfn write [v]
+  (let [[_ a] (m-result nil)]
+    [nil (clojure.contrib.accumulators/add a v)]))
+
+(defn listen [mv]
+  (let [[v a] mv] [[v a] a]))
+
+(defn censor [f mv]
+  (let [[v a] mv] [v (f a)]))
+
+; Continuation monad
+
+(defmonad cont-m
+  "Monad describing computations in continuation-passing style. The monadic
+   values are functions that are called with a single argument representing
+   the continuation of the computation, to which they pass their result."
+  [m-result   (fn m-result-cont [v]
+		(fn [c] (c v)))
+   m-bind     (fn m-bind-cont [mv f]
+		(fn [c]
+		  (mv (fn [v] ((f v) c)))))
+   ])
+
+(defn run-cont
+  "Execute the computation c in the cont monad and return its result."
+  [c]
+  (c identity))
+
+(defn call-cc
+  "A computation in the cont monad that calls function f with a single
+   argument representing the current continuation. The function f should
+   return a continuation (which becomes the return value of call-cc),
+   or call the passed-in current continuation to terminate."
+  [f]
+  (fn [c]
+    (let [cc (fn cc [a] (fn [_] (c a)))
+	  rc (f cc)]
+      (rc c))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Monad transformers
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro monad-transformer
+   "Define a monad transforer in terms of the monad operations and the base
+    monad. The argument which-m-plus chooses if m-zero and m-plus are taken
+    from the base monad or from the transformer."
+  [base which-m-plus operations]
+  `(let [which-m-plus# (cond (= ~which-m-plus :m-plus-default)
+			       (if (= ::undefined (with-monad ~base ~'m-plus))
+			         :m-plus-from-transformer
+			         :m-plus-from-base)
+			     (or (= ~which-m-plus :m-plus-from-base)
+				 (= ~which-m-plus :m-plus-from-transformer))
+			       ~which-m-plus
+			     :else
+			       (throw (java.lang.IllegalArgumentException.
+				       "undefined m-plus choice")))
+	 combined-monad# (monad ~operations)]
+    (if (= which-m-plus# :m-plus-from-base)
+      (assoc combined-monad#
+	:m-zero (with-monad ~base ~'m-zero)
+	:m-plus (with-monad ~base ~'m-plus))
+      combined-monad#)))
+       
+(defn maybe-t
+  "Monad transformer that transforms a monad m into a monad in which
+   the base values can be invalid (represented by nothing, which defaults
+   to nil). The third argument chooses if m-zero and m-plus are inherited
+   from the base monad (use :m-plus-from-base) or adopt maybe-like
+   behaviour (use :m-plus-from-transformer). The default is :m-plus-from-base
+   if the base monad m has a definition for m-plus, and
+   :m-plus-from-transformer otherwise."
+  ([m] (maybe-t m nil :m-plus-default))
+  ([m nothing] (maybe-t m nothing :m-plus-default))
+  ([m nothing which-m-plus]
+   (monad-transformer m which-m-plus
+     [m-result (with-monad m m-result)
+      m-bind   (with-monad m
+		 (fn m-bind-maybe-t [mv f]
+		   (m-bind mv
+			   (fn [x]
+			     (if (identical? x nothing)
+			       (m-result nothing)
+			       (f x))))))
+      m-zero   (with-monad m (m-result nothing))
+      m-plus   (with-monad m
+	         (fn m-plus-maybe-t [& mvs]
+		   (if (empty? mvs)
+		     (m-result nothing)
+		     (m-bind (first mvs)
+			     (fn [v]
+			       (if (= v nothing)
+				 (apply m-plus-maybe-t (rest mvs))
+				 (m-result v)))))))
+      ])))
+
+(defn sequence-t
+  "Monad transformer that transforms a monad m into a monad in which
+   the base values are sequences. The argument which-m-plus chooses
+   if m-zero and m-plus are inherited from the base monad
+   (use :m-plus-from-base) or adopt sequence-like
+   behaviour (use :m-plus-from-transformer). The default is :m-plus-from-base
+   if the base monad m has a definition for m-plus, and
+   :m-plus-from-transformer otherwise."
+  ([m] (sequence-t m :m-plus-default))
+  ([m which-m-plus]
+   (monad-transformer m which-m-plus
+     [m-result (with-monad m
+	         (fn m-result-sequence-t [v]
+		   (m-result (list v))))
+      m-bind   (with-monad m
+		 (fn m-bind-sequence-t [mv f]
+		   (m-bind mv
+			   (fn [xs]
+			     (m-fmap flatten*
+				     (m-map f xs))))))
+      m-zero   (with-monad m (m-result (list)))
+      m-plus   (with-monad m
+                 (fn m-plus-sequence-t [& mvs]
+		   (m-reduce concat (list) mvs)))
+      ])))
+
+;; Contributed by Jim Duey
+(defn state-t
+  "Monad transformer that transforms a monad m into a monad of stateful
+  computations that have the base monad type as their result."
+  [m]
+  (monad [m-result (with-monad m
+		     (fn m-result-state-t [v]
+                       (fn [s]
+			 (m-result [v s]))))
+	  m-bind   (with-monad m
+                     (fn m-bind-state-t [stm f]
+                       (fn [s]
+                         (m-bind (stm s)
+                                 (fn [[v ss]]
+                                   ((f v) ss))))))
+          m-zero   (with-monad m
+                     (if (= ::undefined m-zero)
+		       ::undefined
+		       (fn [s]
+			 m-zero)))
+          m-plus   (with-monad m
+                     (if (= ::undefined m-plus)
+		       ::undefined
+		       (fn [& stms]
+			 (fn [s]
+			   (apply m-plus (map #(% s) stms))))))
+          ]))