47 regels
1.3 KiB
OCaml
47 regels
1.3 KiB
OCaml
|
|
type 'a monoid = 'a * ('a -> 'a -> 'a)
|
|
|
|
let lift_monoid (zero, plus) =
|
|
(Lwd.return zero, Lwd.map2 plus)
|
|
|
|
let map_reduce inj (zero, plus) items =
|
|
let rec cons_monoid c xs v =
|
|
match xs with
|
|
| (c', v') :: xs when c = c' ->
|
|
cons_monoid (c + 1) xs (plus v' v)
|
|
| xs -> (c, v) :: xs
|
|
in
|
|
let cons_monoid xs v = cons_monoid 0 xs (inj v) in
|
|
match List.fold_left cons_monoid [] items with
|
|
| [] -> zero
|
|
| (_,x) :: xs ->
|
|
List.fold_left (fun acc (_, v) -> plus v acc) x xs
|
|
|
|
let reduce monoid items = map_reduce (fun x -> x) monoid items
|
|
|
|
let rec cons_lwd_monoid plus c xs v =
|
|
match xs with
|
|
| (c', v') :: xs when c = c' ->
|
|
cons_lwd_monoid plus (c + 1) xs (Lwd.map2 plus v' v)
|
|
| xs -> (c, v) :: xs
|
|
|
|
let pack (zero, plus) items =
|
|
match List.fold_left (cons_lwd_monoid plus 0) [] items with
|
|
| [] -> Lwd.return zero
|
|
| (_,x) :: xs ->
|
|
List.fold_left (fun acc (_, v) -> Lwd.map2 plus v acc) x xs
|
|
|
|
let pack_seq (zero, plus) items =
|
|
match Seq.fold_left (cons_lwd_monoid plus 0) [] items with
|
|
| [] -> Lwd.return zero
|
|
| (_,x) :: xs ->
|
|
List.fold_left (fun acc (_, v) -> Lwd.map2 plus v acc) x xs
|
|
|
|
let rec map_l (f:'a -> 'b Lwd.t) (l:'a list) : 'b list Lwd.t =
|
|
match l with
|
|
| [] -> Lwd.return []
|
|
| x :: tl -> Lwd.map2 List.cons (f x) (map_l f tl)
|
|
|
|
let flatten_l (l:'a Lwd.t list) : 'a list Lwd.t =
|
|
map_l (fun x->x) l
|