module type RANGE =
sig
  type t
  type e
  val singleton : e -> t
  val range : e -> e -> t
  val (+) : t -> e -> t
  val ( * ) : t -> e -> t
  val bridge : t -> t -> t
  val size : t -> int
  val contains : t -> e -> bool
  val (<) : t -> t -> bool option
end

module LoHiPairRange : RANGE with type e = int =
struct
  type e = int
  type t = e * e
  let singleton (i:e) : t = (i,i)
  let range (i:e) (j:e) : t = ((min i j), (max i j))
  let (+) (x:t) (i:e) : t = let (lo,hi) = x in (lo+i,hi+i)
  let ( * ) (x:t) (i:e) : t =
    let (lo, hi) = x in
    if i >= 0 then (lo*i,hi*i)
    else (hi*i,lo*i)
  let bridge (x:t) (y:t) : t =
    let (lx, hx) = x in
    let (ly, hy) = y in
    ((min lx ly), (max hx hy))
  let size (x:t) : int =
    let (lo,hi) = x in
    hi - lo - (-1) (* our + shadows int's + here ... *)
  let contains (x:t) (i:e) : bool =
    let (lo,hi) = x in
    (lo <= i) && (i <= hi)
  let (<) (x:t) (y:t) : bool option =
    let (lx, hx) = x in
    let (ly, hy) = y in
    if hx < ly then Some true
    else if hy < lx then Some false
    else None
end

module LoLenPairRange : RANGE with type e = int =
struct
  type e = int
  type t = e * e
  let singleton (i:e) : t = (i,1)
  let range (i:e) (j:e) : t = ((min i j), (max i j)-(min i j)+1)
  let ( * ) (x:t) (i:e) : t =
    let (lo,len) = x in
    let newlen : e = ((len-1)*(abs i))+1 in
    if i >= 0 then (lo*i,newlen)
    else
      let hi = lo+(len-1) in
      (hi*i,newlen)
  let bridge (x:t) (y:t) : t =
    let (lwx, lnx) = x in
    let (lwy, lny) = y in
    let hx = lwx + lnx - 1 in
    let hy = lwy + lny - 1 in
    let newbase = min lwx lwy in
    let newlen = (max hx hy) - newbase + 1 in
    (newbase, newlen)
  let size (x:t) : int =
    let (lo,len) = x in
    len
  let contains (x:t) (i:e) : bool =
    let (lo,len) = x in
    let hi = lo + len - 1 in
    (lo <= i) && (i <= hi)
  let (<) (x:t) (y:t) : bool option =
    let (lwx, lnx) = x in
    let (lwy, lny) = y in
    let hx = lwx + lnx - 1 in
    let hy = lwy + lny - 1 in
    if hx < lwy then Some true
    else if hy < lwx then Some false
    else None
  (* (+) defined after others because otherwise shadows int->int->int (+) *)
  let (+) (x:t) (i:e) : t = let (lo,len) = x in (lo+i,len)
                                                  
end


module ListRange : RANGE with type e = int =
struct
  type e = int
  type t = e list

  (* auxiliary functions *)
  let minmax (l:t) : (e*e) option =
      let rec max (t:t) (e:e) : e =
          match t with
          | [] -> e
          | h::r -> max r h
      in
      match l with
      | [] -> None
      | h::r -> Some (h, (max r h))
  let rec build (i:e) (j:e) : e list =
    if i = j then [j]
    else i :: build (i+1) j
  
  let singleton (i:e) : t = [i]
  let range (i:e) (j:e) : t = build (min i j) (max i j)
  let (+) (x:t) (i:e) : t = List.map (fun y->y+i) x
  let ( * ) (x:t) (i:e) : t =
    match (minmax x) with
    | None -> []
    | Some (xl,xh)  ->
      if i < 0 then build (xh*i) (xl*i)
      else  build (xl*i) (xh*i)
  let bridge (x:t) (y:t) : t =    
    match (minmax x), (minmax y) with
    | None, None -> []
    | None, Some _ -> y
    | Some _, None -> x
    | Some (xl,xh), Some (yl,yh) ->
      build (min xl yl) (max xh yh)
  let size (x:t) : int = List.length x
  let contains (x:t) (i:e) : bool = List.mem i x
  let (<) (x:t) (y:t) : bool option =
    match (minmax x), (minmax y) with
    | None, _ -> None
    | _ , None -> None
    | Some (lx,hx), Some(ly,hy) ->
      if hx < ly then Some true
      else if hy < lx then Some false
      else None
end