A lightweight reactive document library.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

47 lines
1.3 KiB

  1. type 'a monoid = 'a * ('a -> 'a -> 'a)
  2. let lift_monoid (zero, plus) =
  3. (Lwd.return zero, Lwd.map2 plus)
  4. let map_reduce inj (zero, plus) items =
  5. let rec cons_monoid c xs v =
  6. match xs with
  7. | (c', v') :: xs when c = c' ->
  8. cons_monoid (c + 1) xs (plus v' v)
  9. | xs -> (c, v) :: xs
  10. in
  11. let cons_monoid xs v = cons_monoid 0 xs (inj v) in
  12. match List.fold_left cons_monoid [] items with
  13. | [] -> zero
  14. | (_,x) :: xs ->
  15. List.fold_left (fun acc (_, v) -> plus v acc) x xs
  16. let reduce monoid items = map_reduce (fun x -> x) monoid items
  17. let rec cons_lwd_monoid plus c xs v =
  18. match xs with
  19. | (c', v') :: xs when c = c' ->
  20. cons_lwd_monoid plus (c + 1) xs (Lwd.map2 plus v' v)
  21. | xs -> (c, v) :: xs
  22. let pack (zero, plus) items =
  23. match List.fold_left (cons_lwd_monoid plus 0) [] items with
  24. | [] -> Lwd.return zero
  25. | (_,x) :: xs ->
  26. List.fold_left (fun acc (_, v) -> Lwd.map2 plus v acc) x xs
  27. let pack_seq (zero, plus) items =
  28. match Seq.fold_left (cons_lwd_monoid plus 0) [] items with
  29. | [] -> Lwd.return zero
  30. | (_,x) :: xs ->
  31. List.fold_left (fun acc (_, v) -> Lwd.map2 plus v acc) x xs
  32. let rec map_l (f:'a -> 'b Lwd.t) (l:'a list) : 'b list Lwd.t =
  33. match l with
  34. | [] -> Lwd.return []
  35. | x :: tl -> Lwd.map2 List.cons (f x) (map_l f tl)
  36. let flatten_l (l:'a Lwd.t list) : 'a list Lwd.t =
  37. map_l (fun x->x) l