Further refactoring of type iterators.

types/bool.ml

@@ -350,7 +350,7 @@ sig
   (** returns the union of all leaves in the BDD *)
 
   val leafconj: t -> Atom.t
-
+  val get_kind : t -> (Var.t list * Var.t list * Atom.t option) list
   val is_empty : t -> bool
   val extract : t -> [ `Empty | `Full | `Split of (elem * t * t * t) ]
 
@@ -431,4 +431,24 @@ struct
     | True -> `Full
     | Split (_,x,p,i,n) -> `Split (x,p,i,n)
 
+  (* todo optimize *)
+  let get_kind t =
+    let rec split_vars l acc =
+      match l with
+	`Var v :: r -> split_vars r (v :: acc)
+      | [ `Atm a ] -> List.rev acc, Some a
+      | [] -> List.rev acc, None
+      | _ -> assert false
+    in
+    List.map (fun (pos, neg) ->
+      let pos, atm = split_vars pos [] in
+      let neg = List.map (function `Var v -> v | _ -> assert false) neg in
+      let oatm = match atm with
+	  Some a when T.equal a T.full -> None
+	| _ -> atm
+      in
+      (pos, neg, oatm)) (get t)
+
+
+
 end

types/bool.mli

@@ -39,8 +39,8 @@ sig
 
   (** returns the union of all leaves in the BDD *)
 
-  val leafconj: t -> Atom.t
-
+  val leafconj : t -> Atom.t
+  val get_kind : t -> (Var.t list * Var.t list * Atom.t option) list
   val is_empty : t -> bool
 
   val extract : t -> [ `Empty | `Full | `Split of (elem * t * t * t) ]

types/type_tallying.ml

@@ -314,8 +314,6 @@ let big_prod delta f acc l =
     Constr.prod delta acc (f pos neg)
   ) acc l
 
-  (* norm generates a constraint set for the costraint t <= 0 *)
-
 
 module NormMemoHash = Hashtbl.Make(Custom.Pair(Descr)(Var.Set))
 

types/types.mli

@@ -169,6 +169,24 @@ module Iter : sig
     val map : ?abs:(bool -> bool) -> (var_type -> t -> t) -> t -> t
     val iter : ?abs:(bool -> unit) ->(var_type -> t -> unit) -> t -> unit
     val fold : ?abs:(bool -> 'a -> 'a) -> (var_type -> t -> 'a -> 'a) -> t -> 'a -> 'a
+    module type Ops = sig
+	type t
+	val cup : t list -> t
+	val cap : t list -> t
+	val neg : t -> t
+	val var : Var.t list * Var.t list -> t
+	val atoms : Atoms.t -> t
+	val ints : Intervals.t -> t
+	val chars : Chars.t -> t
+	val times : Pair.t -> t
+	val xml : Pair.t -> t
+	val arrow : Pair.t -> t
+	val record : Rec.t -> t
+	val abstract : Abstracts.t -> t
+	val absent : bool -> t
+    end
+    val compute_ops : (module Ops with type t = 'a) -> t -> 'a
+
 end
 
 (** Positive systems and least solutions **)