1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
;; Monads in Clojure
;; by Konrad Hinsen
;; last updated January 8, 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 clojure.contrib.monads)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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]
(if (identical? bform :when)
(list 'm-bind `(if ~expr (~'m-result ::any) ~'m-zero)
(list 'fn ['_] mexpr))
(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")))
(reduce add-monad-step
(list 'm-result expr)
(reverse (partition 2 steps))))
(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."
[name & exprs]
`(let [~'m-bind (:m-bind ~name)
~'m-result (:m-result ~name)
~'m-zero (:m-zero ~name)
~'m-plus (:m-plus ~name)]
(do ~@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 :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."
([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."
([name doc-string args expr]
(let [doc-name (with-meta name {:doc doc-string})]
`(defmonadfn ~doc-name ~args ~expr)))
([name args expr]
(let [fn-name (symbol (format "m+%s+m" (str name)))]
`(do
(def ~fn-name nil)
(defmacro ~name ~args
(list (quote ~fn-name)
'~'m-bind '~'m-result '~'m-zero '~'m-plus
~@args))
(defn ~fn-name [~'m-bind ~'m-result ~'m-zero ~'m-plus ~@args] ~expr)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Commonly used monad functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 (lazy-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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Commonly used monads
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Maybe monad
(defmonad maybe
"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
"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]
(apply concat (map f mv)))
m-zero (list)
m-plus (fn m-plus-sequence [& mvs]
(apply concat mvs))
])
; State monad
(defmonad state
"Monad describing stateful computations. The monadic values have the
structure (fn [old-state] (list result new-state))."
[m-result (fn m-result-state [v]
(fn [s] (list v s)))
m-bind (fn m-bind-state [mv f]
(fn [s]
(let [[v ss] (mv s)]
((f v) ss))))
])
(defn update-state [f]
(fn [s] (list s (f s))))
(defn set-state [s]
(update-state (fn [_] s)))
(defn fetch-state []
(update-state identity))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Monad transformers
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn maybe-t
"Monad transformer that transforms a monad m into a monad in which
the base values can be invalid (represented by nil)."
[m]
(monad [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 (nil? x) (m-result nil) (f x))))))
m-zero (with-monad m m-zero)
m-plus (with-monad m m-plus)]))
|
