Skip to content

Commit

Permalink
Support for :if/:then/:else statements and :cond
Browse files Browse the repository at this point in the history
  • Loading branch information
Roman Gonzalez & Tatsuhiro Ujihisa committed Jul 24, 2013
1 parent 1672820 commit 4d0c512
Show file tree
Hide file tree
Showing 5 changed files with 102 additions and 33 deletions.
20 changes: 10 additions & 10 deletions project.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,28 +10,28 @@

:cljsbuild
{:builds
[{:source-paths ["src/cljs" "test/cljs"],
[{:id "browser-test",
:source-paths ["src/cljs" "test/cljs"],
:compiler
{:pretty-print true,
:target :browser,
:output-to "resources/js/protocol_monads_browser_test.js",
:externs ["externs/buster.js"],
:optimizations :whitespace},
:id "browser-test"}
{:source-paths ["src/cljs" "test/cljs"],
:optimizations :whitespace}}
{:id "browser-test-optimized",
:source-paths ["src/cljs" "test/cljs"],
:compiler
{:target :browser,
:output-to "resources/js/protocol_monads_browser_optimized_test.js",
:externs ["externs/buster.js"],
:optimizations :advanced},
:id "browser-test-optimized"}
{:source-paths ["src/cljs" "test/cljs"],
:optimizations :advanced}}
{:id "node-test",
:source-paths ["src/cljs" "test/cljs"],
:compiler
{:pretty-print true,
:target :node,
:target :node
:output-to "resources/js/protocol_monads_node_test.js",
:externs ["externs/buster.js"],
:optimizations :whitespace},
:id "node-test"}]}
:optimizations :simple}}]}

)
14 changes: 7 additions & 7 deletions src/clj/monads/macros.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,13 +68,13 @@
(cond
(identical? bform :when) `(if ~expr ~mexpr (monads.core/zero (~result nil)))
(identical? bform :let) `(let ~expr ~mexpr)
;; (identical? bform :cond) (cond-statement expr mexpr add-monad-step)
;; (identical? bform :then) mexpr
;; ; ^ ignore :then step (processed on the :else step)
;; (identical? bform :if) mexpr
;; ; ^ ignore :if step (processed on the :else step)
;; (identical? bform :else)
;; (if-then-else-statement steps mexpr add-monad-step)
(identical? bform :cond) (cond-statement expr mexpr (partial add-monad-step result))
(identical? bform :then) mexpr
; ^ ignore :then step (processed on the :else step)
(identical? bform :if) mexpr
; ^ ignore :if step (processed on the :else step)
(identical? bform :else)
(if-then-else-statement steps mexpr (partial add-monad-step result))
:else
(list 'monads.core/bind expr (list 'fn [bform] mexpr)))))

Expand Down
22 changes: 11 additions & 11 deletions src/cljs/monads/core.cljs
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
;; This file was generated with lein-dalap from
;;
;; src/clj/monads/core.clj @ Sat Jan 26 20:48:05 PST 2013
;; src/clj/monads/core.clj @ Tue Jul 23 19:45:42 PDT 2013
;;
(ns monads.core (:refer-clojure :exclude [do seq map]) (:require [clojure.set :as set]))
(defprotocol Monad (do-result [_ v]) (bind [mv f]))
Expand All @@ -18,25 +18,25 @@
(extend-type EmptyList Monad (do-result [_ v] (list v)) (bind [mv f] (mapcat f mv)) MonadZero (zero [_] (list)) (plus-step [mv mvs] (apply concat mv mvs)) MonadWriter (writer-m-empty [_] (list)) (writer-m-add [c v] (conj c v)) (writer-m-combine [c1 c2] (concat c1 c2)))
(extend-type PersistentVector Monad (do-result [_ v] [v]) (bind [mv f] (vec (mapcat f mv))) MonadZero (zero [_] []) (plus-step [mv mvs] (vec (apply concat mv mvs))) MonadWriter (writer-m-empty [_] []) (writer-m-add [c v] (conj c v)) (writer-m-combine [c1 c2] (vec (concat c1 c2))))
(defn- lazy-concat ([l] l) ([l ls] (lazy-seq (cond (clojure.core/seq l) (cons (first l) (lazy-concat (rest l) ls)) (clojure.core/seq ls) (lazy-concat (first l) (rest ls)) :else (list)))))
(do (extend-type Range Monad (do-result [_ v] (list v)) (bind [mv f] (mapcat f mv)) MonadZero (zero [_] []) (plus-step [mv mvs] (lazy-concat mv mvs)) MonadWriter (writer-m-empty [_] (list)) (writer-m-add [c v] (conj c v)) (writer-m-combine [c1 c2] (concat c1 c2))))
(extend-type Range Monad (do-result [_ v] (list v)) (bind [mv f] (mapcat f mv)) MonadZero (zero [_] []) (plus-step [mv mvs] (lazy-concat mv mvs)) MonadWriter (writer-m-empty [_] (list)) (writer-m-add [c v] (conj c v)) (writer-m-combine [c1 c2] (concat c1 c2)))
(extend-type LazySeq Monad (do-result [_ v] (list v)) (bind [mv f] (mapcat f mv)) MonadZero (zero [_] []) (plus-step [mv mvs] (lazy-concat mv mvs)) MonadWriter (writer-m-empty [_] (list)) (writer-m-add [c v] (conj c v)) (writer-m-combine [c1 c2] (concat c1 c2)))
(extend-type PersistentHashSet Monad (do-result [_ v] (hash-set v)) (bind [mv f] (apply set/union (clojure.core/map f mv))) MonadZero (zero [_] #{}) (plus-step [mv mvs] (apply set/union mv mvs)) MonadWriter (writer-m-empty [_] #{}) (writer-m-add [c v] (conj c v)) (writer-m-combine [c1 c2] (clojure.set/union c1 c2)))
(declare maybe-zero-val)
(deftype maybe-monad [v] IDeref (-deref [_] v) Monad (do-result [_ v] (maybe-monad. v)) (bind [mv f] (if (= mv maybe-zero-val) maybe-zero-val (f (clojure.core/deref mv)))) MonadZero (zero [_] maybe-zero-val) (plus-step [mv mvs] (let [mv (->> (cons mv mvs) (drop-while (fn* [p1__1326#] (= maybe-zero-val p1__1326#))) first)] (if (nil? mv) maybe-zero-val mv))))
(deftype maybe-monad [v] IDeref (-deref [_] v) Monad (do-result [_ v] (maybe-monad. v)) (bind [mv f] (if (= mv maybe-zero-val) maybe-zero-val (f (clojure.core/deref mv)))) MonadZero (zero [_] maybe-zero-val) (plus-step [mv mvs] (let [mv (->> (cons mv mvs) (drop-while (fn* [p1__1287#] (= maybe-zero-val p1__1287#))) first)] (if (nil? mv) maybe-zero-val mv))))
(def maybe-zero-val (maybe-monad. :user/nothing))
(defn maybe "Monad describing computations with possible failures. Failure is\n represented by nil, any other value is considered valid. As soon as\n a step returns nil, the whole computation will yield nil as well." [v] (maybe-monad. v))
(deftype state-monad [v mv f] IFn (-invoke [_ s] (if f (let [[v ss] (mv s)] ((f v) ss)) [v s])) Monad (do-result [_ v] (state-monad. v nil nil)) (bind [mv f] (state-monad. nil mv f)))
(defn state "Monad describing stateful computations. The monadic values have the\n structure (fn [old-state] [result new-state])." [v] (state-monad. v nil nil))
(deftype RomanFn [f] IFn (-invoke [_ s] [s (f s)]) Monad (do-result [_ v] (state-monad. v nil nil)) (bind [mv f1] (state-monad. nil mv f1)))
(defn update-state "Return a state-monad value that replaces the current state by the\n result of f applied to the current state and that returns the old state." [f] (RomanFn. f))
(deftype StateMonadFn [f] IFn (-invoke [_ s] [s (f s)]) Monad (do-result [_ v] (state-monad. v nil nil)) (bind [mv f1] (state-monad. nil mv f1)))
(defn update-state "Return a state-monad value that replaces the current state by the\n result of f applied to the current state and that returns the old state." [f] (StateMonadFn. f))
(defn set-state "Return a state-monad value that replaces the current state by s and\n returns the previous state." [s] (update-state (constantly s)))
(defn get-state "Return a state-monad value that returns the current state and does not\n modify it." [] (update-state identity))
(defn get-val "Return a state-monad value that assumes the state to be a map and\n returns the value corresponding to the given key. The state is not modified." [key] (bind (get-state) (fn* [p1__1327#] (state (get p1__1327# key)))))
(defn update-val "Return a state-monad value that assumes the state to be a map and\n replaces the value associated with the given key by the return value\n of f applied to the old value and args. The old value is returned." [key f & args] (bind (update-state (fn* [p1__1328#] (apply update-in p1__1328# [key] f args))) (fn* [p1__1329#] (state (get p1__1329# key)))))
(defn get-val "Return a state-monad value that assumes the state to be a map and\n returns the value corresponding to the given key. The state is not modified." [key] (bind (get-state) (fn* [p1__1288#] (state (get p1__1288# key)))))
(defn update-val "Return a state-monad value that assumes the state to be a map and\n replaces the value associated with the given key by the return value\n of f applied to the old value and args. The old value is returned." [key f & args] (bind (update-state (fn* [p1__1289#] (apply update-in p1__1289# [key] f args))) (fn* [p1__1290#] (state (get p1__1290# key)))))
(defn set-val "Return a state-monad value that assumes the state to be a map and\n replaces the value associated with key by val. The old value is returned." [key val] (update-val key (constantly val)))
(defn get-in-val [path & [default]] (bind (get-state) (fn* [p1__1330#] (state (get-in p1__1330# path default)))))
(defn assoc-in-val [path val] (bind (update-state (fn* [p1__1331#] (assoc-in p1__1331# path val))) (fn* [p1__1332#] (state (get-in p1__1332# path)))))
(defn update-in-val [path f & args] (bind (update-state (fn* [p1__1333#] (apply update-in p1__1333# path f args))) (fn* [p1__1334#] (state (get-in p1__1334# path)))))
(defn get-in-val [path & [default]] (bind (get-state) (fn* [p1__1291#] (state (get-in p1__1291# path default)))))
(defn assoc-in-val [path val] (bind (update-state (fn* [p1__1292#] (assoc-in p1__1292# path val))) (fn* [p1__1293#] (state (get-in p1__1293# path)))))
(defn update-in-val [path f & args] (bind (update-state (fn* [p1__1294#] (apply update-in p1__1294# path f args))) (fn* [p1__1295#] (state (get-in p1__1295# path)))))
(deftype cont-monad [v mv f] IDeref (-deref [mv] (mv identity)) IFn (-invoke [_ c] (if f (mv (fn [v] ((f v) c))) (c v))) Monad (do-result [_ v] (cont-monad. v nil nil)) (bind [mv f] (cont-monad. nil mv f)))
(defn cont "Monad describing computations in continuation-passing style. The monadic\n values are functions that are called with a single argument representing\n the continuation of the computation, to which they pass their result." [v] (cont-monad. v nil nil))
(defn call-cc "A computation in the cont monad that calls function f with a single\n argument representing the current continuation. The function f should\n return a continuation (which becomes the return value of call-cc),\n or call the passed-in current continuation to terminate." [f])
Expand All @@ -46,7 +46,7 @@
(defn write [m-result val-to-write] (let [[_ a] (-deref (m-result nil))] (writer-monad. nil (writer-m-add a val-to-write))))
(defn listen [mv] (let [[v a :as va] (-deref mv)] (writer-monad. va a)))
(defn censor [f mv] (let [[v a] (-deref mv)] (writer-monad. v (f a))))
(deftype state-transformer [m v mv f alts] IFn (-invoke [_ s] (cond alts (plus (clojure.core/map (fn* [p1__1335#] (p1__1335# s)) alts)) f (bind (mv s) (fn [[v ss]] ((f v) ss))) :else (if (= v (zero (m nil))) v (m [v s])))) Monad (do-result [_ v] (state-transformer. m v nil nil nil)) (bind [mv f] (state-transformer. m nil mv f nil)) MonadZero (zero [_] (state-transformer. m nil (fn [s] (zero (m nil))) (fn [v] (state-transformer. m v nil nil nil)) nil)) (plus-step [mv mvs] (state-transformer. m nil nil nil (cons mv mvs))))
(deftype state-transformer [m v mv f alts] IFn (-invoke [_ s] (cond alts (plus (clojure.core/map (fn* [p1__1296#] (p1__1296# s)) alts)) f (bind (mv s) (fn [[v ss]] ((f v) ss))) :else (if (= v (zero (m nil))) v (m [v s])))) Monad (do-result [_ v] (state-transformer. m v nil nil nil)) (bind [mv f] (state-transformer. m nil mv f nil)) MonadZero (zero [_] (state-transformer. m nil (fn [s] (zero (m nil))) (fn [v] (state-transformer. m v nil nil nil)) nil)) (plus-step [mv mvs] (state-transformer. m nil nil nil (cons mv mvs))))
(defn state-t "Monad transformer that transforms a monad m into a monad of stateful\n computations that have the base monad type as their result." [m] (fn [v] (state-transformer. m v nil nil nil)))
(deftype maybe-transformer [m v] IDeref (-deref [_] v) Monad (do-result [_ v] (maybe-transformer. m (m (maybe v)))) (bind [mv f] (let [v (-deref mv)] (maybe-transformer. m (bind v (fn [x] (if (= x maybe-zero-val) (m maybe-zero-val) (-deref (f (-deref x))))))))) MonadZero (zero [_] (maybe-transformer. m (m maybe-zero-val))) (plus-step [mv mvs] (maybe-transformer. m (bind (-deref mv) (fn [x] (cond (and (= x maybe-zero-val) (empty? mvs)) (m maybe-zero-val) (= x maybe-zero-val) (-deref (plus mvs)) :else (m x)))))))
(defn maybe-t "Monad transformer that transforms a monad m into a monad in which\n the base values can be invalid (represented by :nothing)." [m] (fn [v] (maybe-transformer. m (m (maybe v)))))
Expand Down
65 changes: 65 additions & 0 deletions test/clj/monads/test/core_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -778,3 +778,68 @@
(write-msg :msg1)])
(censor-msgs #(conj % :msg3)))
:state))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(deftest domonad-if-then
(it ""
(let [monad-value (monadic/do m/maybe
[ a (m/maybe 5)
:let [c 7 ]
:if (and (= a 5) (= c 7))
:then [
b (m/maybe 6)]
:else [
b m/maybe-zero-val]]
[a b])]
(is (= @monad-value [5 6])))))

(deftest domonad-nested-if-then
(it ""
(let [monad-value (monadic/do m/maybe
[ a (m/maybe 5)
:if (= a 5)
:then [
b (m/maybe 6)
:if (= b 6)
:then [
c (m/maybe 7)]
:else [
c m/maybe-zero-val]]
:else [
b m/maybe-zero-val
c m/maybe-zero-val]]
[a b c])]
(is (= @monad-value [5 6 7])))))

(deftest domonad-if-then-with-when
(it ""
(let [monad-value (monadic/do m/maybe
[ a (m/maybe 5)
:when (= a 5)
:if (= a 1)
:then [
b (m/maybe 6)]
:else [
b m/maybe-zero-val]]
[a b])]
(is (= monad-value m/maybe-zero-val)))))

(deftest domonad-cond
(it ""
(let [monad-value (monadic/do m/maybe
[ a (m/maybe 5)
:when (= a 5)
:cond
[(< a 1)
[result (m/maybe "less than one")]
(< a 3)
[result (m/maybe "less than three")]
(< a 6)
[result (m/maybe "less than six")]
:else
[result (m/maybe "arbitrary number")]]
b (m/maybe 7)
:let [some-val 12345]]
[result b some-val])]
(is (= @monad-value ["less than six" 7 12345])))))
Loading

0 comments on commit 4d0c512

Please sign in to comment.