Minor refactoring and API Change Var.print -> Var.pp

types/types.ml

@@ -153,8 +153,8 @@ module TLV = struct
       end)
     let print sep ppf s =
       let aux1 ppf = function
-        |(v,true) -> Format.fprintf ppf "%a" Var.print v
-        |(v,false) -> Format.fprintf ppf "~ %a" Var.print v
+        |(v,true) -> Format.fprintf ppf "%a" Var.pp v
+        |(v,false) -> Format.fprintf ppf "~ %a" Var.pp v
       in
       let rec aux ppf = function
         |[] -> ()
@@ -198,7 +198,7 @@ module TLV = struct
   let print ppf x = Set.print ";" ppf x.tlv
   let dump ppf x =
     Format.fprintf ppf "<fv = {%a} ; tlv = {%a}>"
-      Var.Set.print x.fv (Set.print ";") x.tlv
+      Var.Set.pp x.fv (Set.print ";") x.tlv
   let mem v x = Set.mem v x.tlv
 
 end
@@ -1803,7 +1803,7 @@ struct
             let (_,l1) =
               List.fold_left (fun (has_tlv,acc) -> function
                 |(`Var v) as x when (TLV.mem (x,true) tlv) -> (true,acc)
-                |(`Var v) as x -> (has_tlv,(Atomic (fun ppf -> Var.print ppf x))::acc)
+                |(`Var v) as x -> (has_tlv,(Atomic (fun ppf -> Var.pp ppf x))::acc)
                 |`Atm bdd ->
                     begin match has_tlv,acc with
                     |true,[] -> if is_full bdd then (has_tlv,[]) else (has_tlv,print bdd)
@@ -1815,7 +1815,7 @@ struct
             let l2 =
               List.fold_left (fun acc -> function
                 |(`Var v) as x when (TLV.mem (x,false) tlv) -> acc
-                |(`Var v) as x -> (Atomic (fun ppf -> Format.fprintf ppf "~ %a" Var.print x))::acc
+                |(`Var v) as x -> (Atomic (fun ppf -> Format.fprintf ppf "~ %a" Var.pp x))::acc
                 |`Atm bdd -> assert false
               ) [] n
             in
@@ -1833,8 +1833,8 @@ struct
         let l =
           TLV.Set.fold (fun ((`Var v) as x,p) acc ->
             let s =
-              if p then (Atomic (fun ppf -> Var.print ppf x))
-              else (Atomic (fun ppf -> Format.fprintf ppf "~ %a" Var.print x))
+              if p then (Atomic (fun ppf -> Var.pp ppf x))
+              else (Atomic (fun ppf -> Format.fprintf ppf "~ %a" Var.pp x))
             in s::acc
           ) (all_tlv not_seq) []
         in
@@ -2566,7 +2566,7 @@ struct
         MemoHash.add memo v node_name;
         match v.def with
         |`Type d -> Format.fprintf ppf "`Type(%a)" Print.pp_type d
-        |`Variable d -> Format.fprintf ppf "`Var(%a)" Var.print d
+        |`Variable d -> Format.fprintf ppf "`Var(%a)" Var.pp d
         |`Cup vl -> Format.fprintf ppf "`Cup(%a)" (Utils.pp_list aux) vl
         |`Cap vl -> Format.fprintf ppf "`Cap(%a)" (Utils.pp_list aux) vl
         |`Times (v1,v2) -> Format.fprintf ppf "`Times(%a,%a)" aux v1 aux v2
@@ -2626,7 +2626,7 @@ struct
 
   let rec pretty_name i acc =
     let ni,nm = i/26, i mod 26 in
-    let acc = acc ^ (String.make 1 (OldChar.chr (OldChar.code 'A' + nm))) in
+    let acc = acc ^ (String.make 1 (OldChar.chr (OldChar.code 'a' + nm))) in
     if ni == 0 then acc else pretty_name ni acc
 
   let collect_variables v =
@@ -2763,7 +2763,7 @@ module Tallying = struct
 
       let pp ppf map =
         Utils.pp_list ~delim:("{","}") (fun ppf (v, (i,s)) ->
-          Format.fprintf ppf "%a <= %a <= %a" Print.pp_type i Var.print v Print.pp_type s
+          Format.fprintf ppf "%a <= %a <= %a" Print.pp_type i Var.pp v Print.pp_type s
         ) ppf (VarMap.bindings map)
 
       let compare map1 map2 =
@@ -2788,7 +2788,7 @@ module Tallying = struct
 
       let pp ppf e =
           Utils.pp_list ~delim:("{","}") (fun ppf -> fun (v,t) ->
-            Format.fprintf ppf "%a = %a@," Var.print v Print.pp_type t
+            Format.fprintf ppf "%a = %a@," Var.pp v Print.pp_type t
           ) ppf (bindings e)
 
     end
@@ -3190,14 +3190,14 @@ module Tallying = struct
       if CS.E.is_empty e then sol
       else begin
         let (alpha,t) = CS.E.min_binding e in
-        (* Format.printf "Unify -> %a = %a\n" Var.print alpha Print.print t; *)
+        (* Format.printf "Unify -> %a = %a\n" Var.pp alpha Print.print t; *)
         let e1 = CS.E.remove alpha e in
         (* Format.printf "e1 = %a\n" CS.print_e e1; *)
         (* remove from E \ { (alpha,t) } every occurrences of alpha
          * by mu X . (t{X/alpha}) with X fresh . X is a recursion variale *)
         (* substituterec remove also all previously introduced fresh variables *)
         let x = Positive.substituterec t alpha in
-        (* Format.printf "X = %a %a %a\n" Var.print alpha Print.print x dump t; *)
+        (* Format.printf "X = %a %a %a\n" Var.pp alpha Print.print x dump t; *)
         let es = CS.E.fold (fun beta s acc -> CS.E.add beta (Positive.substitute s (alpha,x)) acc) e1 CS.E.empty in
         (* Format.printf "es = %a\n" CS.print_e es; *)
         aux ((CS.E.add alpha x sol)) es

types/var.ml

 
 module V = struct
   type t = { fresh : bool; id : string; }
-  let make_id ?(fresh=false) id = { id = id ; fresh = fresh }
   let dump ppf t = Format.fprintf ppf "{id=%s;fresh=%b}" t.id t.fresh
   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 ?(fresh=false) id = { id = id ; fresh = fresh }
 end
 
 type var = [ `Var of V.t ]
-type 'a pairvar = [ `Atm of 'a | var ]
-
+type t = var
 let dump ppf (`Var x) = Format.fprintf ppf "%a" V.dump x
-let print ppf (`Var x) = Format.fprintf ppf "'%s" x.V.id
+let pp ppf (`Var x) = Format.fprintf ppf "'%s" x.V.id
 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 _ = ()
 
-let mk ?fresh id = 
-  `Var (V.make_id ?fresh id)
-
+let mk ?fresh id = `Var (V.make_id ?fresh id)
 let fresh : ?pre: string -> unit -> [> var ] =
   let counter = ref 0 in
   fun ?(pre="_fresh_") -> fun _ ->
@@ -29,8 +29,8 @@ let fresh : ?pre: string -> unit -> [> var ] =
     v
 ;;
 
-let id (`Var t) = t.V.id
-let is_fresh (`Var t) = t.V.fresh
+let id (`Var x) = x.V.id
+let is_fresh (`Var x) = x.V.fresh
 
 module Set = struct
   include Set.Make(struct type t = var let compare = compare end) 
@@ -43,11 +43,12 @@ module Set = struct
     aux ppf (elements s)
 
   let dump ppf s = aux_print ";" dump ppf s
-  let print ppf s = aux_print ";" print ppf s
+  let pp ppf s = aux_print ";" pp ppf s
   let is_empty s = equal s empty
   let from_list l = List.fold_left (fun acc x -> add x acc) empty l
 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

types/var.mli

 module V : sig
-  type t
+  include Custom.T
   val make_id : ?fresh:bool -> string -> t
-  val dump : Format.formatter -> t -> unit
-  val compare : t -> t -> int
-  val equal : t -> t -> bool
-  val hash : t -> int
 end
 
 type var = [ `Var of V.t ]
 
-val dump : Format.formatter -> var -> unit
-val print : Format.formatter -> var -> unit
-val compare : var -> var -> int
-val equal : var -> var -> bool
-val hash : var -> int
+include Custom.T with type t = var
 
+val pp : Format.formatter -> var -> unit
 val mk : ?fresh:bool -> string -> var
 val fresh : ?pre:string -> unit -> var
 val id : var -> string
@@ -23,7 +16,7 @@ val is_fresh : var -> bool
 module Set : sig
   include Set.S with type elt = var
   val dump : Format.formatter -> t -> unit
-  val print : Format.formatter -> t -> unit
+  val pp : Format.formatter -> t -> unit
   val is_empty : t -> bool
   val from_list : elt list -> t
 end

typing/typed.ml

@@ -188,7 +188,7 @@ module Print = struct
   and pp_fv ppf fv = Utils.pp_list pp_v ppf fv
 
   and pp_vars_poly ppf m =
-    let pp_aux ppf (x,s) = Format.fprintf ppf "%a : %a" Ident.print x  Var.Set.print s in
+    let pp_aux ppf (x,s) = Format.fprintf ppf "%a : %a" Ident.print x  Var.Set.pp s in
     Utils.pp_list ~sep:";" pp_aux ppf (Ident.IdMap.get m)
 
   let string_of_typed = Utils.string_of_formatter pp_typed