Created
February 23, 2010 12:41
-
-
Save oranenj/312137 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns net.gensoukyou.monad-protocol) | |
(declare *current-monad*) | |
(defprotocol Monad | |
(pure-impl [M v] "Lift a value into the same monad as M") | |
(bind [mv f])) | |
(defprotocol MonadPlus | |
(++ [mv1 mv1]) | |
(zero-impl [mv])) | |
(defn mzero [] (zero-impl *current-monad*)) | |
(defn pure [v] | |
(pure-impl *current-monad* v)) | |
(defn lift | |
"I can't believe this works" | |
([f] | |
(fn this | |
([v v2 & rest] | |
(bind (this v v2) (fn [x] (apply this (pure x) rest)))) | |
([v v2] | |
(bind v (fn [x] (bind v2 (partial (comp pure f) x))))) | |
([v] | |
(bind v (comp pure f)))))) | |
(defmacro with-monad [monad & body] | |
`(binding [*current-monad* ~monad] | |
~@body)) | |
(deftype MaybeM [val] :as this | |
Monad | |
(pure-impl [v] (MaybeM. v)) | |
(bind [mf] (if-let [v (:val this)] | |
(mf v) | |
this)) | |
MonadPlus | |
(++ [mv2] (if (:val this) | |
this | |
mv2)) | |
(zero-impl [] (MaybeM. nil))) | |
(def Maybe (MaybeM nil)) ;; for use in with-monad | |
(extend-type clojure.lang.ISeq | |
Monad | |
(pure-impl [M v] (list v)) | |
(bind [mv mf] | |
(mapcat mf mv))) | |
(with-monad Maybe | |
(bind (pure 4) (comp pure inc))) | |
(with-monad () | |
(bind (seq [1 2 3]) | |
(fn [x] | |
(bind (seq [1 2 3]) | |
(fn [y] (pure (+ x y))))))) | |
(with-monad Maybe | |
((lift +) (MaybeM 5) (MaybeM 3) (MaybeM 3) (MaybeM 4) (MaybeM 22))) | |
(with-monad () | |
((lift +) '(1 2) '(3 4 5))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment