Further refactoring of the tallying code.

compile/lambda.ml

@@ -26,7 +26,7 @@ type iface = (Types.descr * Types.descr) list
 
 type sigma = 
   | Identity (* this is basically as Types.Tallying.CS.sat *)
-  | List of Type_tallying.CS.sl
+  | List of Type_tallying.Constr.sl
   | Comp of (sigma * sigma)
   | Sel of (var_loc * iface * sigma) 
 
@@ -104,7 +104,7 @@ module Print = struct
       ) ppf
     in
     function
-      |List ll -> Type_tallying.CS.pp_sl ppf ll
+      |List ll -> Type_tallying.Constr.pp_sl ppf ll
       |Comp(s1,s2) -> Format.fprintf ppf "Comp(%a,%a)" pp_sigma s1 pp_sigma s2
       |Sel(x,iface,s) -> Format.fprintf ppf "Sel(%a,%a,%a)" pp_vloc x pp_aux iface pp_sigma s
       |Identity -> Format.fprintf ppf "Id"

compile/lambda.mli

@@ -26,7 +26,7 @@ type iface = (Types.t * Types.t) list
 
 type sigma = 
   | Identity
-  | List of Type_tallying.CS.sl
+  | List of Type_tallying.Constr.sl
   | Comp of (sigma * sigma)
   | Sel of (var_loc * iface * sigma) 
 

runtime/value.ml

@@ -3,7 +3,7 @@ open Encodings
 
 type iface = (Types.t * Types.t) list
 type sigma =
-  | List of Type_tallying.CS.sl
+  | List of Type_tallying.Constr.sl
   | Comp of (sigma * sigma)
   | Sel of (int * iface * sigma)
   | Identity
@@ -313,7 +313,7 @@ module Print = struct
       ) ppf
     in
     function
-    |List ll -> Type_tallying.CS.pp_sl ppf ll
+    |List ll -> Type_tallying.Constr.pp_sl ppf ll
     |Comp(s1,s2) -> Format.fprintf ppf "Comp(%a,%a)" pp_sigma s1 pp_sigma s2
     |Sel(x,iface,s) -> Format.fprintf ppf "Sel(%d,%a,%a)" x pp_aux iface pp_sigma s
     |Identity -> Format.fprintf ppf "Id"

runtime/value.mli

@@ -3,7 +3,7 @@ open Encodings
 
 type iface = (Types.t * Types.t) list
 type sigma =
-  | List of Type_tallying.CS.sl
+  | List of Type_tallying.Constr.sl
   | Comp of (sigma * sigma)
   | Sel of (int * iface * sigma)
   | Identity

types/sortedList.ml

@@ -32,6 +32,7 @@ sig
     type 'a map
     external get: 'a map -> (Elem.t * 'a) list = "%identity"
     val add: Elem.t -> 'a -> 'a map -> 'a map
+    val replace: Elem.t -> 'a -> 'a map -> 'a map
     val mem: Elem.t -> 'a map -> bool
     val length: 'a map -> int
     val domain: 'a map -> t
@@ -320,6 +321,14 @@ module Make(X : Custom.T) = struct
         | (l1,[]) -> l1
 
     let add x v = union_disj [(x,v)]
+    let rec replace x v m =
+      match m with
+	[] -> [ (x,v) ]
+      | ((y, w) as t) :: q ->
+	 let c = Elem.compare x y in
+	 if c == 0 then (x, v) :: q
+	 else if c > 0 then t :: (replace x v q)
+	 else (* c < 0 *) (x, v) :: m
 
     let rec mem x l =
       match l with

types/sortedList.mli

@@ -32,6 +32,7 @@ sig
     type 'a map
     external get: 'a map -> (Elem.t * 'a) list = "%identity"
     val add: Elem.t -> 'a -> 'a map -> 'a map
+    val replace: Elem.t -> 'a -> 'a map -> 'a map
     val mem: Elem.t -> 'a map -> bool
     val length: 'a map -> int
     val domain: 'a map -> t

types/type_tallying.mli

@@ -8,15 +8,14 @@ exception UnSatConstr of string
 exception Step1Fail
 exception Step2Fail
 
-module CS : sig
-  module M : sig
-    type key = Var.t
+module Constr : sig
+  module Line : sig
     type t
     val compare  : t -> t -> int
     val empty : t
-    val add : Var.Set.t -> key -> descr*descr -> t -> t
-    val singleton : key -> descr*descr -> t
-    val pp : Format.formatter -> t -> unit
+    val add : Var.Set.t -> Var.t -> descr*descr -> t -> t
+    val singleton : Var.t -> descr*descr -> t
+    val print : Format.formatter -> t -> unit
     val inter : Var.Set.t -> t -> t -> t
   end
   module E : sig
@@ -28,18 +27,18 @@ module CS : sig
     val pp : Format.formatter -> t -> unit
   end
   module S : sig
-    type t = M.t list
+    type t = Line.t list
     val empty : t
-    val add : M.t -> t -> t
-    val singleton : M.t -> t
+    val add : Line.t -> t -> t
+    val singleton : Line.t -> t
     val union : t -> t -> t
-    val elements : t -> M.t list
-    val fold : (M.t -> 'b -> 'b) -> M.t list -> 'b -> 'b
+    val elements : t -> Line.t list
+    val fold : (Line.t -> 'b -> 'b) -> Line.t list -> 'b -> 'b
     val pp : Format.formatter -> t -> unit
   end
 
   type s = S.t
-  type m =  M.t
+  type m =  Line.t
   type es = ES.t
   type sigma = t E.t
   type sl = sigma list
@@ -57,21 +56,21 @@ module CS : sig
   val prod : Var.Set.t -> s -> s -> s
 end
 
-val norm : Var.Set.t -> t -> CS.s
-val merge : Var.Set.t -> CS.m -> CS.s
-val solve : Var.Set.t -> CS.s -> CS.es
-val unify : CS.sigma -> CS.sigma
+val norm : Var.Set.t -> t -> Constr.s
+val merge : Var.Set.t -> Constr.m -> Constr.s
+val solve : Var.Set.t -> Constr.s -> Constr.es
+val unify : Constr.sigma -> Constr.sigma
 
   (* [s1 ... sn] . si is a solution for tallying problem
      if si # delta and for all (s,t) in C si @ s < si @ t *)
-val tallying : Var.Set.t -> (t * t) list -> CS.sl
+val tallying : Var.Set.t -> (t * t) list -> Constr.sl
 
-val (>>) : t -> CS.sigma -> t
+val (>>) : t -> Constr.sigma -> t
 
   (** Symbolic Substitution Set *)
 type symsubst =
   |I (** Identity *)
-  |S of CS.sigma (** Substitution *)
+  |S of Constr.sigma (** Substitution *)
   |A of (symsubst * symsubst) (** Composition si (sj t) *)
 
   (** Cartesian Product of two symbolic substitution sets *)
@@ -80,16 +79,16 @@ val ( ++ ) : symsubst list -> symsubst list -> symsubst list
   (** Evaluation of a substitution *)
 val (@@) : t -> symsubst -> t
 
-val domain : CS.sl -> Var.Set.t
-val codomain : CS.sl -> Var.Set.t
-val is_identity : CS.sl -> bool
-val identity : CS.sl
-val filter : (Var.t -> bool) -> CS.sl -> CS.sl
+val domain : Constr.sl -> Var.Set.t
+val codomain : Constr.sl -> Var.Set.t
+val is_identity : Constr.sl -> bool
+val identity : Constr.sl
+val filter : (Var.t -> bool) -> Constr.sl -> Constr.sl
 
 (** Square Subtype relation. [squaresubtype delta s t] .
     True if there exists a substitution such that s < t only
     considering variables that are not in delta *)
-val squaresubtype : Var.Set.t -> t -> t -> CS.sl
+val squaresubtype : Var.Set.t -> t -> t -> Constr.sl
 val is_squaresubtype : Var.Set.t -> t -> t -> bool
 
 (** apply_raw s t returns the 4-tuple (subst,ss, tt, res) where
@@ -98,6 +97,6 @@ val is_squaresubtype : Var.Set.t -> t -> t -> bool
    and res is the type of the result of the application *)
 val apply_full : Var.Set.t -> t -> t -> t
 
-val apply_raw : Var.Set.t -> t -> t -> CS.sl * t * t * t
+val apply_raw : Var.Set.t -> t -> t -> Constr.sl * t * t * t
 
-val squareapply : Var.Set.t -> t -> t -> (CS.sl * t)
+val squareapply : Var.Set.t -> t -> t -> (Constr.sl * t)

typing/typed.ml

@@ -15,7 +15,7 @@ open Ident
 type tpat = Patterns.node
 type ttyp = Types.Node.t
 
-type sigma = Type_tallying.CS.sl
+type sigma = Type_tallying.Constr.sl
 
 type texpr  = 
     { exp_loc : loc; 
@@ -108,7 +108,7 @@ module Print = struct
 
   and pp_aux ppf e =
     match e.exp_descr with
-      | Subst(e,sl) -> Format.fprintf ppf "%a @@ %a" pp e Type_tallying.CS.pp_sl sl
+      | Subst(e,sl) -> Format.fprintf ppf "%a @@ %a" pp e Type_tallying.Constr.pp_sl sl
       | Forget(e, _) -> Format.fprintf ppf "Forget(%a)" pp e
       | Check(_, e, _) -> Format.fprintf ppf "Check(%a)" pp e
       | TVar(id, name) ->