monads.clj: new cont monad, new macros m-when and m-when-not

2 files changed, 90 insertions, 1 deletions

diff --git a/src/clojure/contrib/monads.clj b/src/clojure/contrib/monads.clj
index 68c8b534..2f89cb76 100644
--- a/src/clojure/contrib/monads.clj
+++ b/src/clojure/contrib/monads.clj
@@ -1,7 +1,7 @@
 ;; Monads in Clojure
 
 ;; by Konrad Hinsen
-;; last updated January 24, 2009
+;; last updated January 29, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -180,6 +180,18 @@
 	  m-result
 	  steps))
 
+(defmacro m-when
+  "If test if 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))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; Commonly used monads
@@ -260,6 +272,35 @@
 (defn censor [f mv]
   (let [[v a] mv] [v (f a)]))
 
+; Continuation monad
+
+(defmonad cont
+  "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 [v]
+		(fn [c] (c v)))
+   m-bind     (fn [mv f]
+		(fn [c]
+		  (mv (fn [a] ((f a) 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))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
diff --git a/src/clojure/contrib/monads/examples.clj b/src/clojure/contrib/monads/examples.clj
index 89b9bb68..98ffaecd 100644
--- a/src/clojure/contrib/monads/examples.clj
+++ b/src/clojure/contrib/monads/examples.clj
@@ -346,4 +346,52 @@
 ; The outcome of any function applied to arguments of which at least one
 ; is nil is supposed to be nil as well, and the function is never called.
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Continuation-passing style in the cont monad
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; A simple computation performed in continuation-passing style.
+; (m-result 1) returns a function that, when called with a single
+; argument f, calls (f 1). The result of the domonad-computation is
+; a function that behaves in the same way, passing 3 to its function
+; argument. run-cont executes a continuation by calling it on identity.
+(run-cont
+  (domonad cont
+    [x (m-result 1)
+     y (m-result 2)]
+    (+ x y)))
+
+; Let's capture a continuation using call-cc. We store it in a global
+; variable so that we can do with it whatever we want. The computation
+; is the same one as in the first example, but it has the side effect
+; of storing the continuation at (m-result 2).
+(def continuation nil)
+
+(run-cont
+  (domonad cont
+    [x (m-result 1)
+     y (call-cc (fn [c] (def continuation c) (c 2)))]
+    (+ x y)))
+
+; Now we can call the continuation with whatever argument we want. The
+; supplied argument takes the place of 2 in the above computation:
+(run-cont (continuation 5))
+(run-cont (continuation 42))
+(run-cont (continuation -1))
+
+; Next, a function that illustrates how a captured continuation can be
+; used as an "emergency exit" out of a computation:
+(defn sqrt-as-str [x]
+  (call-cc
+   (fn [k]
+     (domonad cont
+       [_ (m-when (< x 0) (k (str "negative argument " x)))]
+       (str (. Math sqrt x))))))
+
+(run-cont (sqrt-as-str 2))
+(run-cont (sqrt-as-str -2))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;