Convert Descr.Abstrat to a BooVar Bdd

Tallying and printing still broken.

ocamliface/mlstub.ml

@@ -75,7 +75,7 @@ and typ_descr = function
   | Abstract "int" -> Builtin_defs.caml_int
   | Abstract "char" -> Builtin_defs.char_latin1
   | Abstract "string" -> Builtin_defs.string_latin1
-  | Abstract s -> Types.abstract (Types.Abstract.atom s)
+  | Abstract s -> Types.abstract (Types.Abstracts.atom s)
   | Builtin ("list", [t])
   | Builtin ("array", [t]) -> Types.descr (Sequence.star_node (typ t))
   | Builtin ("Pervasives.ref", [t]) -> Builtin_defs.ref_type (typ t)

parser/parser.ml

@@ -614,7 +614,7 @@ EXTEND Gram
       | "("; a = IDENT; ":="; c = expr; ")" ->
 	  mk _loc (Constant (ident a,c))
       | "!"; a = IDENT ->
-	  mk _loc (Internal (Types.abstract (Types.Abstract.atom a)))
+	  mk _loc (Internal (Types.abstract (Types.Abstracts.atom a)))
       | ids = LIST1 ident_or_keyword SEP "." ->
 	  let ids = List.map (fun x -> ident x) ids in
 	  mk _loc (PatVar ids)

runtime/run_dispatch.ml

@@ -250,7 +250,7 @@ and run_disp_kind env actions v =
   | Abstraction (Some iface,_,sigma) ->
       run_disp_basic v (fun t -> inzero env v t) actions.basic
   | Abstract (abs,_) -> 
-      run_disp_basic v (fun t -> Types.Abstract.contains abs (Types.get_abstract t))
+      run_disp_basic v (fun t -> Types.Abstract.has_abstract t abs (* Types.Abstracts.contains abs (Types.Abstract.get t) *))
 	  actions.basic
   | Absent ->
       run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic

runtime/value.ml

@@ -18,7 +18,7 @@ and t =
   | Integer of Intervals.V.t
   | Char of Chars.V.t
   | Abstraction of (Types.descr * Types.descr) list option * (t -> t) * sigma
-  | Abstract of Types.Abstract.V.t
+  | Abstract of Types.Abstracts.V.t
   | String_latin1 of int * int * string * t
   | String_utf8 of Utf8.uindex * Utf8.uindex * Utf8.t * t
   | Concat of t * t
@@ -531,7 +531,7 @@ let rec compare x y =
       | _, Abstraction (_,_,_) ->
 	  raise (CDuceExn (string_latin1 "comparing functional values"))
       | Abstract (s1,v1), Abstract (s2,v2) ->
-	  let c = Types.Abstract.T.compare s1 s2 in if c <> 0 then c 
+	  let c = Types.Abstracts.T.compare s1 s2 in if c <> 0 then c 
 	  else begin
               match s1 with
               |"float" -> Pervasives.compare (Obj.magic v1 : float) (Obj.magic v2 : float)

runtime/value.mli

@@ -19,7 +19,7 @@ and t =
   | Integer of Intervals.V.t
   | Char of Chars.V.t
   | Abstraction of (Types.descr * Types.descr) list option * (t -> t) * sigma
-  | Abstract of Types.Abstract.V.t
+  | Abstract of Types.Abstracts.V.t
   | String_latin1 of int * int * string * t
   | String_utf8 of Utf8.uindex * Utf8.uindex * Utf8.t * t
   | Concat of t * t
@@ -73,7 +73,7 @@ val get_field_ascii : t -> string -> t
 
 val get_variant : t -> string * t option
 
-val abstract : Types.Abstract.abs -> 'a -> t
+val abstract : Types.Abstracts.abs -> 'a -> t
 val get_abstract : t -> 'a
 
 val mk_ref : Types.t -> t -> t

tests/libtest/tallyingTest.ml

@@ -12,10 +12,9 @@ let parse_typ s =
 module ESet = OUnitDiff.SetMake (struct
   type t = (Var.var * Types.t)
   let compare (v1,t1) (v2,t2) =
-    let a = Types.abstract Abstract.any in
     if (v1,t1) == (v2,t2) then 0
     else let c = Var.compare v1 v2 in if c <> 0 then c
-    else Types.compare (diff t1 a) (diff t2 a)
+    else Types.compare t1 t2
   let pp_printer ppf (v,t) = Format.fprintf ppf "(%a = %a)" Var.pp v Types.Print.pp_type t
   let pp_print_sep = OUnitDiff.pp_comma_separator
 end)

types/builtin_defs.ml

@@ -156,7 +156,7 @@ let float_abs =
   "float"
 
 let float =
-  Types.abstract (Types.Abstract.atom float_abs)
+  Types.abstract (Types.Abstracts.atom float_abs)
 
 let any_attr_node = Types.cons (Types.record_fields (true,LabelMap.empty)) 
 let any_xml,any_xml_seq,any_xml_content = 

types/builtin_defs.mli

@@ -40,7 +40,7 @@ val mk_ref: get:'a -> set:'a -> 'a Ident.label_map
 val ref_type: Types.Node.t -> Types.t
 
 val float: Types.t
-val float_abs: Types.Abstract.abs
+val float_abs: Types.Abstracts.abs
 
 val any_xml : Types.t
 

types/types.mli

 open Ident
 
-module BoolAtoms : BoolVar.S with
-  type s = Atoms.t and
-  type elem = Atoms.t Var.pairvar
-module BoolIntervals : BoolVar.S with
-  type s = Intervals.t and
-  type elem = Intervals.t Var.pairvar
-module BoolChars : BoolVar.S with
-  type s = Chars.t and
-  type elem = Chars.t Var.pairvar
-
 type const =
   | Integer of Intervals.V.t
   | Atom of Atoms.V.t
@@ -64,7 +54,7 @@ module CompUnit : sig
 end
 *)
 
-module Abstract : sig
+module Abstracts : sig
   module T : Custom.T with type t = string
   type abs = T.t
   type t
@@ -72,15 +62,26 @@ module Abstract : sig
   val atom: abs -> t
   val compare: t -> t -> int
 
-  module V : sig
-    type t = abs * Obj.t
-  end
+  module V : sig type t = abs * Obj.t end
 
   val contains: abs -> t -> bool
 end
 
 (** Algebra **)
 
+module BoolAtoms : BoolVar.S with
+  type s = Atoms.t and
+  type elem = Atoms.t Var.pairvar
+module BoolIntervals : BoolVar.S with
+  type s = Intervals.t and
+  type elem = Intervals.t Var.pairvar
+module BoolChars : BoolVar.S with
+  type s = Chars.t and
+  type elem = Chars.t Var.pairvar
+module BoolAbstracts: BoolVar.S with
+  type s = Abstracts.t and
+  type elem = Abstracts.t Var.pairvar
+
 include Custom.T
 module Node : Custom.T
 
@@ -140,7 +141,7 @@ val record   : label -> Node.t -> t
 val record_fields : bool * Node.t label_map -> t
 val char     : Chars.t -> t
 val constant : const -> t
-val abstract : Abstract.t -> t
+val abstract : Abstracts.t -> t
 
 (** Helpers *)
 
@@ -154,8 +155,7 @@ val empty_open_record: t
 
 (** Positive systems and least solutions **)
 
-module Positive :
-sig
+module Positive : sig
   type v
   val forward: unit -> v
   val define: v -> v -> unit
@@ -303,7 +303,14 @@ module Char : sig
   val any : t
 end
 
-val get_abstract: t -> Abstract.t
+module Abstract : sig
+  val has_abstract : t -> Abstracts.T.t -> bool
+  val get: t -> BoolAbstracts.t
+  val any : t
+end
+(*
+val get_abstract: t -> Abstracts.t
+*)
 
 val normalize : t -> t