gadt_and_first_class_module_matching.ml

let maybe_reduce
    (MonoidElement.Constructor ((module Monoid1) as monoid1, element1))
    (MonoidElement.Constructor ((module Monoid2) as monoid2, element2)) =
    let element1_is_unit = Monoid1.eq element1 Monoid1.unit in
    let element2_is_unit = Monoid2.eq element2 Monoid2.unit in
    let same_monoid = Type_equal.Id.same_witness Monoid1.t Monoid2.t in
    match element1_is_unit, element2_is_unit, same_monoid with
    | true, _, _ -> Reduced (MonoidElement.Constructor (monoid2, element2))
    | _, true, _ -> Reduced (MonoidElement.Constructor (monoid1, element1))
    | _, _, Some eq ->
      let element1_in_2 = Type_equal.conv eq element1 in
      let element = Monoid2.op element1_in_2 element2 in
      Reduced (MonoidElement.Constructor (monoid2, element))
    | false, false, None -> Irreducible