1 files changed, 0 insertions, 580 deletions
diff --git a/src/clojure/contrib/monads.clj b/src/clojure/contrib/monads.clj
deleted file mode 100644
index 8d287105..00000000
--- a/src/clojure/contrib/monads.clj
+++ /dev/null
@@ -1,580 +0,0 @@
-;; 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))))))
-          ]))