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
type 'a t = 'a list
let pure x = [ x ]
module Foldable = Preface_make.Foldable.Via_fold_right (struct
type nonrec 'a t = 'a t
let fold_right f x acc = Stdlib.List.fold_right f x acc
end)
module Functor = Preface_make.Functor.Via_map (struct
type nonrec 'a t = 'a t
let map = Stdlib.List.map
end)
module Alternative = Preface_make.Alternative.Via_apply (struct
type nonrec 'a t = 'a t
let pure = pure
let apply fs xs =
Stdlib.List.(concat @@ map (fun f -> map (fun x -> f x) xs) fs)
;;
let neutral = []
let combine l r = l @ r
end)
module Applicative_traversable (A : Preface_specs.APPLICATIVE) =
Preface_make.Traversable.Over_applicative
(A)
(struct
type 'a t = 'a A.t
type 'a iter = 'a list
let traverse =
let open A.Infix in
let rec traverse f = function
| [] -> A.pure []
| x :: xs -> Stdlib.List.cons <$> f x <*> traverse f xs
in
traverse
;;
end)
module Applicative =
Preface_make.Traversable.Join_with_applicative
(Alternative)
(Applicative_traversable)
module Monad_plus = Preface_make.Monad_plus.Via_bind (struct
type nonrec 'a t = 'a t
let return = pure
let bind f =
let rec aux_bind acc = function
| [] -> Stdlib.List.rev acc
| x :: tail ->
let xs = f x in
aux_bind (Stdlib.List.rev_append xs acc) tail
in
aux_bind []
;;
let neutral = []
let combine l r = l @ r
end)
module Monad_traversable (M : Preface_specs.MONAD) =
Preface_make.Traversable.Over_monad
(M)
(struct
type 'a t = 'a M.t
type 'a iter = 'a list
let traverse =
let open M.Syntax in
let rec traverse f = function
| [] -> M.return []
| x :: xs ->
let* h = f x in
let* t = traverse f xs in
M.return (Stdlib.List.cons h t)
in
traverse
;;
end)
module Monad =
Preface_make.Traversable.Join_with_monad (Monad_plus) (Monad_traversable)
module Selective =
Preface_make.Selective.Over_applicative_via_select
(Applicative)
(Preface_make.Selective.Select_from_monad (Monad))
module Monoid (T : Preface_specs.Types.T0) =
Preface_make.Monoid.Via_combine_and_neutral (struct
type nonrec t = T.t t
let combine l r = l @ r
let neutral = []
end)
let equal f a b =
let rec eq = function
| ([], []) -> true
| (x :: xs, y :: ys) -> f x y && eq (xs, ys)
| _ -> false
in
eq (a, b)
;;
let pp pp' formater list =
let pp_sep ppf () = Format.fprintf ppf ";@ " in
Format.(fprintf formater "@[[%a]@]" (pp_print_list ~pp_sep pp') list)
;;