blob: 7636b1630ca0c049914080afa18c97b6a994b88f (
plain)
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
|
(***********************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
(* \VV/ *************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(***********************************************************************)
(** Combinators on monadic computations. *)
(** A minimal definition necessary for the definition to go through. *)
module type Def = sig
type +'a t
val return : 'a -> 'a t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** The monadic laws must hold:
- [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)]
- [return a >>= f] = [f a]
- [x>>=return] = [x] *)
end
module type S = sig
include Def
(** List combinators *)
module List : sig
(** [List.map f l] maps [f] on the elements of [l] in left to right
order. *)
val map : ('a -> 'b t) -> 'a list -> 'b list t
(** [List.map f l] maps [f] on the elements of [l] in right to left
order. *)
val map_right : ('a -> 'b t) -> 'a list -> 'b list t
(** Like the regular [List.fold_right]. The monadic effects are
threaded right to left.
Note: many monads behave poorly with right-to-left order. For
instance a failure monad would still have to traverse the
whole list in order to fail and failure needs to be propagated
through the rest of the list in binds which are now
spurious. It is also the worst case for substitution monads
(aka free monads), exposing the quadratic behaviour.*)
val fold_right : ('a -> 'b -> 'b t) -> 'a list -> 'b -> 'b t
(** Like the regular [List.fold_left]. The monadic effects are
threaded left to right. It is tail-recursive if the [(>>=)]
operator calls its second argument in a tail position. *)
val fold_left : ('a -> 'b -> 'a t) -> 'a -> 'b list -> 'a t
end
end
module Make (M:Def) : S with type +'a t = 'a M.t = struct
include M
module List = struct
let rec map f = function
| [] -> return []
| a::l ->
f a >>= fun a' ->
map f l >>= fun l' ->
return (a'::l')
let rec map_right f = function
| [] -> return []
| a::l ->
map f l >>= fun l' ->
f a >>= fun a' ->
return (a'::l')
let rec fold_right f l x =
match l with
| [] -> return x
| a::l ->
fold_right f l x >>= fun acc ->
f a acc
let rec fold_left f x = function
| [] -> return x
| a::l ->
f x a >>= fun x' ->
fold_left f x' l
end
end
|
