plur.ml

module Plur = struct
  type 'a t =
  | Zero
  | One of 'a
  | Two of 'a * 'a

  let return x = One x

  let (++) r1 r2 = match r1, r2 with
    | _, Zero -> r1
    | Zero, _ -> r2
    | (One x | Two (x, _)), (One y | Two (y, _)) -> Two (x, y)

  let (>>=) m f = match m with
    | Zero -> Zero
    | One x -> f x
    | Two (x, y) -> f x ++ f y

  let equal eq v1 v2 = match v1, v2 with
      | Zero, Zero -> true
      | Zero, _ | _, Zero -> false
      | One x, One y -> eq x y
      | One _, _ | _, One _ -> false
      | Two (x1, y1), Two (x2, y2) -> eq x1 x2 && eq y1 y2

  let compare cmp v1 v2 = match v1, v2 with
      | Zero, Zero -> 0
      | Zero, _ -> -1
      | _, Zero -> +1

      | One x, One y -> cmp x y
      | One _, _ -> -1
      | _, One _ -> +1

      | Two (x1, y1), Two (x2, y2) ->
         let d = cmp x1 x2 in
         if d <> 0 then d else cmp y1 y2

  let list = function
    | Zero -> []
    | One x -> [x]
    | Two (x, y) -> [x; y]
end