rlm@10
|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
3 ;;
|
rlm@10
|
4 ;; Monad application examples
|
rlm@10
|
5 ;;
|
rlm@10
|
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
8
|
rlm@10
|
9 (ns
|
rlm@10
|
10 #^{:author "Konrad Hinsen"
|
rlm@10
|
11 :skip-wiki true
|
rlm@10
|
12 :doc "Examples for using monads"}
|
rlm@10
|
13 clojure.contrib.monads.examples
|
rlm@10
|
14 (:use [clojure.contrib.monads
|
rlm@10
|
15 :only (domonad with-monad m-lift m-seq m-reduce m-when
|
rlm@10
|
16 sequence-m
|
rlm@10
|
17 maybe-m
|
rlm@10
|
18 state-m fetch-state set-state
|
rlm@10
|
19 writer-m write
|
rlm@10
|
20 cont-m run-cont call-cc
|
rlm@10
|
21 maybe-t)])
|
rlm@10
|
22 (:require (clojure.contrib [accumulators :as accu])))
|
rlm@10
|
23
|
rlm@10
|
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
25 ;;
|
rlm@10
|
26 ;; Sequence manipulations with the sequence monad
|
rlm@10
|
27 ;;
|
rlm@10
|
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
29
|
rlm@10
|
30 ; Note: in the Haskell world, this monad is called the list monad.
|
rlm@10
|
31 ; The Clojure equivalent to Haskell's lists are (possibly lazy)
|
rlm@10
|
32 ; sequences. This is why I call this monad "sequence". All sequences
|
rlm@10
|
33 ; created by sequence monad operations are lazy.
|
rlm@10
|
34
|
rlm@10
|
35 ; Monad comprehensions in the sequence monad work exactly the same
|
rlm@10
|
36 ; as Clojure's 'for' construct, except that :while clauses are not
|
rlm@10
|
37 ; available.
|
rlm@10
|
38 (domonad sequence-m
|
rlm@10
|
39 [x (range 5)
|
rlm@10
|
40 y (range 3)]
|
rlm@10
|
41 (+ x y))
|
rlm@10
|
42
|
rlm@10
|
43 ; Inside a with-monad block, domonad is used without the monad name.
|
rlm@10
|
44 (with-monad sequence-m
|
rlm@10
|
45 (domonad
|
rlm@10
|
46 [x (range 5)
|
rlm@10
|
47 y (range 3)]
|
rlm@10
|
48 (+ x y)))
|
rlm@10
|
49
|
rlm@10
|
50 ; Conditions are written with :when, as in Clojure's for form:
|
rlm@10
|
51 (domonad sequence-m
|
rlm@10
|
52 [x (range 5)
|
rlm@10
|
53 y (range (+ 1 x))
|
rlm@10
|
54 :when (= (+ x y) 2)]
|
rlm@10
|
55 (list x y))
|
rlm@10
|
56
|
rlm@10
|
57 ; :let is also supported like in for:
|
rlm@10
|
58 (domonad sequence-m
|
rlm@10
|
59 [x (range 5)
|
rlm@10
|
60 y (range (+ 1 x))
|
rlm@10
|
61 :let [sum (+ x y)
|
rlm@10
|
62 diff (- x y)]
|
rlm@10
|
63 :when (= sum 2)]
|
rlm@10
|
64 (list diff))
|
rlm@10
|
65
|
rlm@10
|
66 ; An example of a sequence function defined in terms of a lift operation.
|
rlm@10
|
67 (with-monad sequence-m
|
rlm@10
|
68 (defn pairs [xs]
|
rlm@10
|
69 ((m-lift 2 #(list %1 %2)) xs xs)))
|
rlm@10
|
70
|
rlm@10
|
71 (pairs (range 5))
|
rlm@10
|
72
|
rlm@10
|
73 ; Another way to define pairs is through the m-seq operation. It takes
|
rlm@10
|
74 ; a sequence of monadic values and returns a monadic value containing
|
rlm@10
|
75 ; the sequence of the underlying values, obtained from chaining together
|
rlm@10
|
76 ; from left to right the monadic values in the sequence.
|
rlm@10
|
77 (with-monad sequence-m
|
rlm@10
|
78 (defn pairs [xs]
|
rlm@10
|
79 (m-seq (list xs xs))))
|
rlm@10
|
80
|
rlm@10
|
81 (pairs (range 5))
|
rlm@10
|
82
|
rlm@10
|
83 ; This definition suggests a generalization:
|
rlm@10
|
84 (with-monad sequence-m
|
rlm@10
|
85 (defn ntuples [n xs]
|
rlm@10
|
86 (m-seq (replicate n xs))))
|
rlm@10
|
87
|
rlm@10
|
88 (ntuples 2 (range 5))
|
rlm@10
|
89 (ntuples 3 (range 5))
|
rlm@10
|
90
|
rlm@10
|
91 ; Lift operations can also be used inside a monad comprehension:
|
rlm@10
|
92 (domonad sequence-m
|
rlm@10
|
93 [x ((m-lift 1 (partial * 2)) (range 5))
|
rlm@10
|
94 y (range 2)]
|
rlm@10
|
95 [x y])
|
rlm@10
|
96
|
rlm@10
|
97 ; The m-plus operation does concatenation in the sequence monad.
|
rlm@10
|
98 (domonad sequence-m
|
rlm@10
|
99 [x ((m-lift 2 +) (range 5) (range 3))
|
rlm@10
|
100 y (m-plus (range 2) '(10 11))]
|
rlm@10
|
101 [x y])
|
rlm@10
|
102
|
rlm@10
|
103
|
rlm@10
|
104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
105 ;;
|
rlm@10
|
106 ;; Handling failures with the maybe monad
|
rlm@10
|
107 ;;
|
rlm@10
|
108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
109
|
rlm@10
|
110 ; Maybe monad versions of basic arithmetic
|
rlm@10
|
111 (with-monad maybe-m
|
rlm@10
|
112 (def m+ (m-lift 2 +))
|
rlm@10
|
113 (def m- (m-lift 2 -))
|
rlm@10
|
114 (def m* (m-lift 2 *)))
|
rlm@10
|
115
|
rlm@10
|
116 ; Division is special for two reasons: we can't call it m/ because that's
|
rlm@10
|
117 ; not a legal Clojure symbol, and we want it to fail if a division by zero
|
rlm@10
|
118 ; is attempted. It is best defined by a monad comprehension with a
|
rlm@10
|
119 ; :when clause:
|
rlm@10
|
120 (defn safe-div [x y]
|
rlm@10
|
121 (domonad maybe-m
|
rlm@10
|
122 [a x
|
rlm@10
|
123 b y
|
rlm@10
|
124 :when (not (zero? b))]
|
rlm@10
|
125 (/ a b)))
|
rlm@10
|
126
|
rlm@10
|
127 ; Now do some non-trivial computation with division
|
rlm@10
|
128 ; It fails for (1) x = 0, (2) y = 0 or (3) y = -x.
|
rlm@10
|
129 (with-monad maybe-m
|
rlm@10
|
130 (defn some-function [x y]
|
rlm@10
|
131 (let [one (m-result 1)]
|
rlm@10
|
132 (safe-div one (m+ (safe-div one (m-result x))
|
rlm@10
|
133 (safe-div one (m-result y)))))))
|
rlm@10
|
134
|
rlm@10
|
135 ; An example that doesn't fail:
|
rlm@10
|
136 (some-function 2 3)
|
rlm@10
|
137 ; And two that do fail, at different places:
|
rlm@10
|
138 (some-function 2 0)
|
rlm@10
|
139 (some-function 2 -2)
|
rlm@10
|
140
|
rlm@10
|
141 ; In the maybe monad, m-plus selects the first monadic value that
|
rlm@10
|
142 ; holds a valid value.
|
rlm@10
|
143 (with-monad maybe-m
|
rlm@10
|
144 (m-plus (some-function 2 0) (some-function 2 -2) (some-function 2 3)))
|
rlm@10
|
145
|
rlm@10
|
146 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
147 ;;
|
rlm@10
|
148 ;; Random numbers with the state monad
|
rlm@10
|
149 ;;
|
rlm@10
|
150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
151
|
rlm@10
|
152 ; A state monad item represents a computation that changes a state and
|
rlm@10
|
153 ; returns a value. Its structure is a function that takes a state argument
|
rlm@10
|
154 ; and returns a two-item list containing the value and the updated state.
|
rlm@10
|
155 ; It is important to realize that everything you put into a state monad
|
rlm@10
|
156 ; expression is a state monad item (thus a function), and everything you
|
rlm@10
|
157 ; get out as well. A state monad does not perform a calculation, it
|
rlm@10
|
158 ; constructs a function that does the computation when called.
|
rlm@10
|
159
|
rlm@10
|
160 ; First, we define a simple random number generator with explicit state.
|
rlm@10
|
161 ; rng is a function of its state (an integer) that returns the
|
rlm@10
|
162 ; pseudo-random value derived from this state and the updated state
|
rlm@10
|
163 ; for the next iteration. This is exactly the structure of a state
|
rlm@10
|
164 ; monad item.
|
rlm@10
|
165 (defn rng [seed]
|
rlm@10
|
166 (let [m 259200
|
rlm@10
|
167 value (/ (float seed) (float m))
|
rlm@10
|
168 next (rem (+ 54773 (* 7141 seed)) m)]
|
rlm@10
|
169 [value next]))
|
rlm@10
|
170
|
rlm@10
|
171 ; We define a convenience function that creates an infinite lazy seq
|
rlm@10
|
172 ; of values obtained from iteratively applying a state monad value.
|
rlm@10
|
173 (defn value-seq [f seed]
|
rlm@10
|
174 (lazy-seq
|
rlm@10
|
175 (let [[value next] (f seed)]
|
rlm@10
|
176 (cons value (value-seq f next)))))
|
rlm@10
|
177
|
rlm@10
|
178 ; Next, we define basic statistics functions to check our random numbers
|
rlm@10
|
179 (defn sum [xs] (apply + xs))
|
rlm@10
|
180 (defn mean [xs] (/ (sum xs) (count xs)))
|
rlm@10
|
181 (defn variance [xs]
|
rlm@10
|
182 (let [m (mean xs)
|
rlm@10
|
183 sq #(* % %)]
|
rlm@10
|
184 (mean (for [x xs] (sq (- x m))))))
|
rlm@10
|
185
|
rlm@10
|
186 ; rng implements a uniform distribution in the interval [0., 1.), so
|
rlm@10
|
187 ; ideally, the mean would be 1/2 (0.5) and the variance 1/12 (0.8333).
|
rlm@10
|
188 (mean (take 1000 (value-seq rng 1)))
|
rlm@10
|
189 (variance (take 1000 (value-seq rng 1)))
|
rlm@10
|
190
|
rlm@10
|
191 ; We make use of the state monad to implement a simple (but often sufficient)
|
rlm@10
|
192 ; approximation to a Gaussian distribution: the sum of 12 random numbers
|
rlm@10
|
193 ; from rng's distribution, shifted by -6, has a distribution that is
|
rlm@10
|
194 ; approximately Gaussian with 0 mean and variance 1, by virtue of the central
|
rlm@10
|
195 ; limit theorem.
|
rlm@10
|
196 ; In the first version, we call rng 12 times explicitly and calculate the
|
rlm@10
|
197 ; shifted sum in a monad comprehension:
|
rlm@10
|
198 (def gaussian1
|
rlm@10
|
199 (domonad state-m
|
rlm@10
|
200 [x1 rng
|
rlm@10
|
201 x2 rng
|
rlm@10
|
202 x3 rng
|
rlm@10
|
203 x4 rng
|
rlm@10
|
204 x5 rng
|
rlm@10
|
205 x6 rng
|
rlm@10
|
206 x7 rng
|
rlm@10
|
207 x8 rng
|
rlm@10
|
208 x9 rng
|
rlm@10
|
209 x10 rng
|
rlm@10
|
210 x11 rng
|
rlm@10
|
211 x12 rng]
|
rlm@10
|
212 (- (+ x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12) 6.)))
|
rlm@10
|
213
|
rlm@10
|
214 ; Let's test it:
|
rlm@10
|
215 (mean (take 1000 (value-seq gaussian1 1)))
|
rlm@10
|
216 (variance (take 1000 (value-seq gaussian1 1)))
|
rlm@10
|
217
|
rlm@10
|
218 ; Of course, we'd rather have a loop construct for creating the 12
|
rlm@10
|
219 ; random numbers. This would be easy if we could define a summation
|
rlm@10
|
220 ; operation on random-number generators, which would then be used in
|
rlm@10
|
221 ; combination with reduce. The lift operation gives us exactly that.
|
rlm@10
|
222 ; More precisely, we need (m-lift 2 +), because we want both arguments
|
rlm@10
|
223 ; of + to be lifted to the state monad:
|
rlm@10
|
224 (def gaussian2
|
rlm@10
|
225 (domonad state-m
|
rlm@10
|
226 [sum12 (reduce (m-lift 2 +) (replicate 12 rng))]
|
rlm@10
|
227 (- sum12 6.)))
|
rlm@10
|
228
|
rlm@10
|
229 ; Such a reduction is often quite useful, so there's m-reduce predefined
|
rlm@10
|
230 ; to simplify it:
|
rlm@10
|
231 (def gaussian2
|
rlm@10
|
232 (domonad state-m
|
rlm@10
|
233 [sum12 (m-reduce + (replicate 12 rng))]
|
rlm@10
|
234 (- sum12 6.)))
|
rlm@10
|
235
|
rlm@10
|
236 ; The statistics should be strictly the same as above, as long as
|
rlm@10
|
237 ; we use the same seed:
|
rlm@10
|
238 (mean (take 1000 (value-seq gaussian2 1)))
|
rlm@10
|
239 (variance (take 1000 (value-seq gaussian2 1)))
|
rlm@10
|
240
|
rlm@10
|
241 ; We can also do the subtraction of 6 in a lifted function, and get rid
|
rlm@10
|
242 ; of the monad comprehension altogether:
|
rlm@10
|
243 (with-monad state-m
|
rlm@10
|
244 (def gaussian3
|
rlm@10
|
245 ((m-lift 1 #(- % 6.))
|
rlm@10
|
246 (m-reduce + (replicate 12 rng)))))
|
rlm@10
|
247
|
rlm@10
|
248 ; Again, the statistics are the same:
|
rlm@10
|
249 (mean (take 1000 (value-seq gaussian3 1)))
|
rlm@10
|
250 (variance (take 1000 (value-seq gaussian3 1)))
|
rlm@10
|
251
|
rlm@10
|
252 ; For a random point in two dimensions, we'd like a random number generator
|
rlm@10
|
253 ; that yields a list of two random numbers. The m-seq operation can easily
|
rlm@10
|
254 ; provide it:
|
rlm@10
|
255 (with-monad state-m
|
rlm@10
|
256 (def rng2 (m-seq (list rng rng))))
|
rlm@10
|
257
|
rlm@10
|
258 ; Let's test it:
|
rlm@10
|
259 (rng2 1)
|
rlm@10
|
260
|
rlm@10
|
261 ; fetch-state and get-state can be used to save the seed of the random
|
rlm@10
|
262 ; number generator and go back to that saved seed later on:
|
rlm@10
|
263 (def identical-random-seqs
|
rlm@10
|
264 (domonad state-m
|
rlm@10
|
265 [seed (fetch-state)
|
rlm@10
|
266 x1 rng
|
rlm@10
|
267 x2 rng
|
rlm@10
|
268 _ (set-state seed)
|
rlm@10
|
269 y1 rng
|
rlm@10
|
270 y2 rng]
|
rlm@10
|
271 (list [x1 x2] [y1 y2])))
|
rlm@10
|
272
|
rlm@10
|
273 (identical-random-seqs 1)
|
rlm@10
|
274
|
rlm@10
|
275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
276 ;;
|
rlm@10
|
277 ;; Logging with the writer monad
|
rlm@10
|
278 ;;
|
rlm@10
|
279 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
280
|
rlm@10
|
281 ; A basic logging example
|
rlm@10
|
282 (domonad (writer-m accu/empty-string)
|
rlm@10
|
283 [x (m-result 1)
|
rlm@10
|
284 _ (write "first step\n")
|
rlm@10
|
285 y (m-result 2)
|
rlm@10
|
286 _ (write "second step\n")]
|
rlm@10
|
287 (+ x y))
|
rlm@10
|
288
|
rlm@10
|
289 ; For a more elaborate application, let's trace the recursive calls of
|
rlm@10
|
290 ; a naive implementation of a Fibonacci function. The starting point is:
|
rlm@10
|
291 (defn fib [n]
|
rlm@10
|
292 (if (< n 2)
|
rlm@10
|
293 n
|
rlm@10
|
294 (let [n1 (dec n)
|
rlm@10
|
295 n2 (dec n1)]
|
rlm@10
|
296 (+ (fib n1) (fib n2)))))
|
rlm@10
|
297
|
rlm@10
|
298 ; First we rewrite it to make every computational step explicit
|
rlm@10
|
299 ; in a let expression:
|
rlm@10
|
300 (defn fib [n]
|
rlm@10
|
301 (if (< n 2)
|
rlm@10
|
302 n
|
rlm@10
|
303 (let [n1 (dec n)
|
rlm@10
|
304 n2 (dec n1)
|
rlm@10
|
305 f1 (fib n1)
|
rlm@10
|
306 f2 (fib n2)]
|
rlm@10
|
307 (+ f1 f2))))
|
rlm@10
|
308
|
rlm@10
|
309 ; Next, we replace the let by a domonad in a writer monad that uses a
|
rlm@10
|
310 ; vector accumulator. We can then place calls to write in between the
|
rlm@10
|
311 ; steps, and obtain as a result both the return value of the function
|
rlm@10
|
312 ; and the accumulated trace values.
|
rlm@10
|
313 (with-monad (writer-m accu/empty-vector)
|
rlm@10
|
314
|
rlm@10
|
315 (defn fib-trace [n]
|
rlm@10
|
316 (if (< n 2)
|
rlm@10
|
317 (m-result n)
|
rlm@10
|
318 (domonad
|
rlm@10
|
319 [n1 (m-result (dec n))
|
rlm@10
|
320 n2 (m-result (dec n1))
|
rlm@10
|
321 f1 (fib-trace n1)
|
rlm@10
|
322 _ (write [n1 f1])
|
rlm@10
|
323 f2 (fib-trace n2)
|
rlm@10
|
324 _ (write [n2 f2])
|
rlm@10
|
325 ]
|
rlm@10
|
326 (+ f1 f2))))
|
rlm@10
|
327
|
rlm@10
|
328 )
|
rlm@10
|
329
|
rlm@10
|
330 (fib-trace 5)
|
rlm@10
|
331
|
rlm@10
|
332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
333 ;;
|
rlm@10
|
334 ;; Sequences with undefined value: the maybe-t monad transformer
|
rlm@10
|
335 ;;
|
rlm@10
|
336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
337
|
rlm@10
|
338 ; A monad transformer is a function that takes a monad argument and
|
rlm@10
|
339 ; returns a monad as its result. The resulting monad adds some
|
rlm@10
|
340 ; specific behaviour aspect to the input monad.
|
rlm@10
|
341
|
rlm@10
|
342 ; The simplest monad transformer is maybe-t. It adds the functionality
|
rlm@10
|
343 ; of the maybe monad (handling failures or undefined values) to any other
|
rlm@10
|
344 ; monad. We illustrate this by applying maybe-t to the sequence monad.
|
rlm@10
|
345 ; The result is an enhanced sequence monad in which undefined values
|
rlm@10
|
346 ; (represented by nil) are not subjected to any transformation, but
|
rlm@10
|
347 ; lead immediately to a nil result in the output.
|
rlm@10
|
348
|
rlm@10
|
349 ; First we define the combined monad:
|
rlm@10
|
350 (def seq-maybe-m (maybe-t sequence-m))
|
rlm@10
|
351
|
rlm@10
|
352 ; As a first illustration, we create a range of integers and replace
|
rlm@10
|
353 ; all even values by nil, using a simple when expression. We use this
|
rlm@10
|
354 ; sequence in a monad comprehension that yields (inc x). The result
|
rlm@10
|
355 ; is a sequence in which inc has been applied to all non-nil values,
|
rlm@10
|
356 ; whereas the nil values appear unmodified in the output:
|
rlm@10
|
357 (domonad seq-maybe-m
|
rlm@10
|
358 [x (for [n (range 10)] (when (odd? n) n))]
|
rlm@10
|
359 (inc x))
|
rlm@10
|
360
|
rlm@10
|
361 ; Next we repeat the definition of the function pairs (see above), but
|
rlm@10
|
362 ; using the seq-maybe monad:
|
rlm@10
|
363 (with-monad seq-maybe-m
|
rlm@10
|
364 (defn pairs-maybe [xs]
|
rlm@10
|
365 (m-seq (list xs xs))))
|
rlm@10
|
366
|
rlm@10
|
367 ; Applying this to a sequence containing nils yields the pairs of all
|
rlm@10
|
368 ; non-nil values interspersed with nils that result from any combination
|
rlm@10
|
369 ; in which one or both of the values is nil:
|
rlm@10
|
370 (pairs-maybe (for [n (range 5)] (when (odd? n) n)))
|
rlm@10
|
371
|
rlm@10
|
372 ; It is important to realize that undefined values (nil) are not eliminated
|
rlm@10
|
373 ; from the iterations. They are simply not passed on to any operations.
|
rlm@10
|
374 ; The outcome of any function applied to arguments of which at least one
|
rlm@10
|
375 ; is nil is supposed to be nil as well, and the function is never called.
|
rlm@10
|
376
|
rlm@10
|
377
|
rlm@10
|
378 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
379 ;;
|
rlm@10
|
380 ;; Continuation-passing style in the cont monad
|
rlm@10
|
381 ;;
|
rlm@10
|
382 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@10
|
383
|
rlm@10
|
384 ; A simple computation performed in continuation-passing style.
|
rlm@10
|
385 ; (m-result 1) returns a function that, when called with a single
|
rlm@10
|
386 ; argument f, calls (f 1). The result of the domonad-computation is
|
rlm@10
|
387 ; a function that behaves in the same way, passing 3 to its function
|
rlm@10
|
388 ; argument. run-cont executes a continuation by calling it on identity.
|
rlm@10
|
389 (run-cont
|
rlm@10
|
390 (domonad cont-m
|
rlm@10
|
391 [x (m-result 1)
|
rlm@10
|
392 y (m-result 2)]
|
rlm@10
|
393 (+ x y)))
|
rlm@10
|
394
|
rlm@10
|
395 ; Let's capture a continuation using call-cc. We store it in a global
|
rlm@10
|
396 ; variable so that we can do with it whatever we want. The computation
|
rlm@10
|
397 ; is the same one as in the first example, but it has the side effect
|
rlm@10
|
398 ; of storing the continuation at (m-result 2).
|
rlm@10
|
399 (def continuation nil)
|
rlm@10
|
400
|
rlm@10
|
401 (run-cont
|
rlm@10
|
402 (domonad cont-m
|
rlm@10
|
403 [x (m-result 1)
|
rlm@10
|
404 y (call-cc (fn [c] (def continuation c) (c 2)))]
|
rlm@10
|
405 (+ x y)))
|
rlm@10
|
406
|
rlm@10
|
407 ; Now we can call the continuation with whatever argument we want. The
|
rlm@10
|
408 ; supplied argument takes the place of 2 in the above computation:
|
rlm@10
|
409 (run-cont (continuation 5))
|
rlm@10
|
410 (run-cont (continuation 42))
|
rlm@10
|
411 (run-cont (continuation -1))
|
rlm@10
|
412
|
rlm@10
|
413 ; Next, a function that illustrates how a captured continuation can be
|
rlm@10
|
414 ; used as an "emergency exit" out of a computation:
|
rlm@10
|
415 (defn sqrt-as-str [x]
|
rlm@10
|
416 (call-cc
|
rlm@10
|
417 (fn [k]
|
rlm@10
|
418 (domonad cont-m
|
rlm@10
|
419 [_ (m-when (< x 0) (k (str "negative argument " x)))]
|
rlm@10
|
420 (str (. Math sqrt x))))))
|
rlm@10
|
421
|
rlm@10
|
422 (run-cont (sqrt-as-str 2))
|
rlm@10
|
423 (run-cont (sqrt-as-str -2))
|
rlm@10
|
424
|
rlm@10
|
425 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|