


@ 311,13 +311,78 @@ end (* Env *)










module IdTable = Hashtbl










module EqEnv : sig





module type EQUALITY_ENV = sig










type scope = int










val eq: variable S.structure > variable S.structure > scope option










end = struct





end










module EqUFEnv : EQUALITY_ENV = struct





type scope =





int










(* For each scope where an equality was introduced, we store a unionfind





of type equality. There is no easy way to store the scope information





in the unionfind. Indeed, we need to add (resp. remove) equality in the





unionfind every time we enter (resp. exit) the scoping site of an





equality, and this may affect the scopes stored in the unionfind. *)










(* When we check an equality, we find the lowest scope in which this equality





holds. To do this we traverse the array of unionfind indexed by scope. *)










(* Our unionfind data structure need a relatively efficient support for





copy, since we will copy it every time we enter a new equality scope. *)





module UF =





UnionFind.Make(UnionFind.StoreMap)










(* The nodes of our unionfind are structures with rigid (but not flexible !)





variables as leaves. *)





type uf_store =





variable S.structure UF.store










(* Array of unionfind data structures indexed by scope. *)





type t =





uf_store option Array.t










let empty () : t =





Array.make 8 None










(* When entering a new scope, we extend the array of unionfind with a new





empty store. *)





let rec enter (s : scope) (env : t) : t =





let len = Array.length env in





if s < len then begin





env.(s) < Some (UF.new_store ());





env





end





else





(* If the scope is out of bound, we double the size of the array and





try again. *)





let env' = Array.make (len * 2) None in





Array.blit env 0 env' 0 len;





enter s env'










(* Exiting a scope is just erasing the associated unionfind. *)





let exit (s : scope) (env : t) : t =





assert (s < Array.length env);





env.(s) < None;





env










(* We do not add redundant equalities. *)





let add_equality store s1 s2 =





(* Create new vertices for both [s1] and [s2]. *)





let v1 = UF.make store s1 in





let v2 = UF.make store s2 in





UF.union store v1 v2










let eq _ _ =





failwith "todo"










end (* EqUFEnv *)










module EqEnv : EQUALITY_ENV = struct










type scope =





int




