custom.ml 2.98 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
module type T = sig
  type t

  (* Debugging *)
  val dump: Format.formatter -> t -> unit
  val check: t -> unit (* Check internal invariants *)

  (* Data structures *)
  val equal: t -> t -> bool
  val hash: t -> int
  val compare:t -> t -> int
  
  (* Serialization *)
  val serialize: t Serialize.Put.f
  val deserialize: t Serialize.Get.f
end

module Dummy = struct
  let dump ppf _ = assert false
  let check _ = assert false
  let equal t1 t2 = assert false
  let hash t = assert false
  let compare t1 t2 = assert false
  let serialize t = assert false
  let deserialize t = assert false
end

let dump_list ?(sep="; ") f ppf l =
  Format.pp_print_string ppf "[ ";
  (match l with 
     | [] -> ()
     | [hd] -> f ppf hd
     | hd::tl -> 
	 f ppf hd; 
	 List.iter (fun x -> Format.pp_print_string ppf sep; f ppf x) tl
  );
  Format.pp_print_string ppf " ]"

module String : T with type t = string = struct
  type t = string
  let dump = Format.pp_print_string
  let check s = ()
  let equal : t -> t -> bool = (=)
  let compare : t -> t -> int = Pervasives.compare
  let hash = Hashtbl.hash
  let serialize = Serialize.Put.string
  let deserialize = Serialize.Get.string
end

module Int : T with type t = int = struct
  type t = int
  let dump = Format.pp_print_int
  let check s = ()
  let equal : t -> t -> bool = (=)
  let compare : t -> t -> int = Pervasives.compare
  let hash x = x
  let serialize = Serialize.Put.int
  let deserialize = Serialize.Get.int
end

module Bool : T with type t = bool = struct
  type t = bool
  let dump = Format.pp_print_bool
  let check s = ()
  let equal : t -> t -> bool = (=)
  let compare : t -> t -> int = Pervasives.compare
  let hash x = if x then 1 else 0
  let serialize = Serialize.Put.bool
  let deserialize = Serialize.Get.bool
end

module List(X : T) = struct
  module Elem = X
  type t = X.t list
  let dump = dump_list X.dump
  let check l = List.iter X.check l

  let rec equal l1 l2 =
    (l1 == l2) ||
    match (l1,l2) with
      | x1::l1, x2::l2 -> (X.equal x1 x2) && (equal l1 l2)
      | _ -> false

  let rec hash accu = function
    | [] -> 1 + accu
    | x::l -> hash (17 * accu + X.hash x) l

  let hash l = hash 1 l

  let rec compare l1 l2 =
    if l1 == l2 then 0 
    else match (l1,l2) with
      | x1::l1, x2::l2 -> 
	  let c = X.compare x1 x2 in if c <> 0 then c 
	  else compare l1 l2
      | [],_ -> -1
      | _ -> 1

  let serialize = Serialize.Put.list X.serialize
  let deserialize = Serialize.Get.list X.deserialize
end


module Pair(X : T)(Y : T) = struct
  module Fst = X
  module Snd = Y

  type t = X.t * Y.t
  let dump ppf (x,y) = Format.fprintf ppf "(%a,%a)" X.dump x Y.dump y
  let check (x,y) = X.check x; Y.check y
  let compare (x1,y1) (x2,y2) =
    let c = X.compare x1 x2 in if c <> 0 then c
    else Y.compare y1 y2
  let equal (x1,y1) (x2,y2) = (X.equal x1 x2) && (Y.equal y1 y2)
  let hash (x,y) = X.hash x + 17 * Y.hash y

  let serialize = Serialize.Put.pair X.serialize Y.serialize
  let deserialize = Serialize.Get.pair X.deserialize Y.deserialize
end