module V = struct type t = { id : string; repr : string } let dump ppf t = let r = if t.repr = t.id then "" else Format.sprintf ";repr=%s" t.repr in Format.fprintf ppf "{id=%s;%s}" t.id r let compare x y = Pervasives.compare x.id y.id let equal x y = Pervasives.compare x.id y.id = 0 let hash x = Hashtbl.hash x.id let check _ = () let make_id ?repr id = match repr with |None -> { id = id ; repr = id } |Some r -> { id = id ; repr = r } end type var = [ `Var of V.t ] module VAR = struct type t = var let dump ppf (`Var x) = Format.fprintf ppf "%a" V.dump x let compare (`Var x) (`Var y) = V.compare x y let equal v1 v2 = (compare v1 v2) = 0 let hash (`Var x) = V.hash x let check _ = () end include VAR let id (`Var x) = x.V.id let pp ppf (`Var x) = Format.fprintf ppf "'%s" x.V.repr let mk ?repr id = `Var (V.make_id ?repr id) let fresh : ?pre: string -> unit -> [> var ] = let counter = ref 0 in fun ?(pre="_fresh_") -> fun _ -> let id = (Printf.sprintf "%s%d" pre !counter) in let v = mk id in incr counter; v ;; module Set = struct include SortedList.Make(VAR) let dump ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") VAR.dump ppf (get s) let pp ppf s = Utils.pp_list ~sep:";" ~delim:("{","}") pp ppf (get s) let printf = pp Format.std_formatter let union = cup let inter = cap let cardinal = length let mem t v = mem v t let fold = fold end type 'a pairvar = [ `Atm of 'a | var ] module type MAKE = functor (X : Custom.T) -> Custom.T with type t = X.t pairvar module Make (X : Custom.T) = struct type t = X.t pairvar let hash = function `Atm t -> X.hash t | `Var x -> V.hash x let check = function `Atm t -> X.check t | `Var _ -> () let compare t1 t2 = match t1,t2 with |`Var x, `Var y -> compare (`Var x) (`Var y) |`Atm x, `Atm y -> X.compare x y |`Var _, `Atm _ -> -1 |`Atm _, `Var _ -> 1 let equal t1 t2 = (compare t1 t2) = 0 let dump ppf = function |`Atm x -> X.dump ppf x |`Var x -> dump ppf (`Var x) end