Source file monoid.ml

module type Basic = Monoid_intf.Basic
module type S = Monoid_intf.S

module Make (M : Basic) = struct
  include M

  module O = struct
    let ( @ ) = combine
  end

  let reduce = List.fold_left ~init:empty ~f:combine
  let map_reduce ~f = List.fold_left ~init:empty ~f:(fun acc a -> combine acc (f a))
end

module Exists = Make (struct
    type t = bool

    let empty = false
    let combine = ( || )
  end)

module Forall = Make (struct
    type t = bool

    let empty = true
    let combine = ( && )
  end)

module String = Make (struct
    type t = string

    let empty = ""
    let combine = ( ^ )
  end)

module List (M : sig
    type t
  end) =
Make (struct
    type t = M.t list

    let empty = []
    let combine = ( @ )
  end)

module Appendable_list (M : sig
    type t
  end) =
Make (struct
    type t = M.t Appendable_list.t

    let empty = Appendable_list.empty
    let combine = Appendable_list.( @ )
  end)

module Unit = Make (struct
    include Unit

    let empty = ()
    let combine () () = ()
  end)

module type Add = sig
  type t

  val zero : t
  val ( + ) : t -> t -> t
end

module Add (M : Add) = Make (struct
    include M

    let empty = zero
    let combine = ( + )
  end)

module type Mul = sig
  type t

  val one : t
  val ( * ) : t -> t -> t
end

module Mul (M : Mul) = Make (struct
    include M

    let empty = one
    let combine = ( * )
  end)

module type Union = sig
  type t

  val empty : t
  val union : t -> t -> t
end

module Union (M : Union) = Make (struct
    include M

    let combine = union
  end)

module Product (A : Basic) (B : Basic) = Make (struct
    type t = A.t * B.t

    let empty = A.empty, B.empty
    let combine (a1, b1) (a2, b2) = A.combine a1 a2, B.combine b1 b2
  end)

module Product3 (A : Basic) (B : Basic) (C : Basic) = Make (struct
    type t = A.t * B.t * C.t

    let empty = A.empty, B.empty, C.empty

    let combine (a1, b1, c1) (a2, b2, c2) =
      A.combine a1 a2, B.combine b1 b2, C.combine c1 c2
    ;;
  end)

module Function
    (A : sig
       type t
     end)
    (M : Basic) =
Make (struct
    type t = A.t -> M.t

    let empty _ = M.empty
    let combine f g x = M.combine (f x) (g x)
  end)

module Endofunction = struct
  module Left (A : sig
      type t
    end) =
  Make (struct
      type t = A.t -> A.t

      let empty x = x
      let combine f g x = g (f x)
    end)

  module Right (A : sig
      type t
    end) =
  Make (struct
      type t = A.t -> A.t

      let empty x = x
      let combine f g x = f (g x)
    end)
end

module Commutative = struct
  (* Inject the "proof" of commutativity into a give monoid. *)
  module Make_commutative (M : S) = struct
    include M

    type combine_is_commutative = unit
  end

  module type Basic = Monoid_intf.Commutative.Basic
  module type S = Monoid_intf.Commutative.S

  module Make (M : Basic) = Make_commutative (Make (M))
  module Exists = Make_commutative (Exists)
  module Forall = Make_commutative (Forall)
  module Unit = Make_commutative (Unit)
  module Add (M : Add) = Make_commutative (Add (M))
  module Mul (M : Mul) = Make_commutative (Mul (M))
  module Union (M : Union) = Make_commutative (Union (M))
  module Product (A : Basic) (B : Basic) = Make_commutative (Product (A) (B))

  module Product3 (A : Basic) (B : Basic) (C : Basic) =
    Make_commutative (Product3 (A) (B) (C))

  module Function
      (A : sig
         type t
       end)
      (M : Basic) =
    Make_commutative (Function (A) (M))
end