Add interface for tpyes/var.ml and tight up boolVar interface

Makefile.distrib

@@ -239,7 +239,8 @@ ALL_OBJECTS = $(OBJECTS) \
  parser/cduce_netclient.cmo \
  runtime/cduce_expat.cmo runtime/cduce_pxp.cmo
 
-ALL_INTERFACES = schema/schema_types.mli 
+ALL_INTERFACES = schema/schema_types.mli
+#types/var.mli types/boolVar.mli
 
 DEPEND = $(ALL_OBJECTS:.cmo=.ml) $(ALL_OBJECTS:.cmo=.mli) $(ALL_INTERFACES)
 

Makefile.types

@@ -12,6 +12,8 @@ ML_SRC= \
  cduce/types/atoms.ml \
  cduce/misc/bool.ml \
  cduce/types/chars.ml \
+ cduce/types/var.ml \
+ cduce/types/boolVar.ml \
  cduce/types/ident.ml \
  cduce/types/intervals.ml \
  cduce/misc/inttbl.ml \
@@ -46,7 +48,6 @@ cduce_types.p.cmx: cduce_types.cmx
 
 CDUCE_INCLUDES = $(DIRS:%=-I %)
 
-
 .SUFFIXES: .ml .mli .cmo .cmi .cmx
 
 .ml.cmo:
@@ -65,8 +66,6 @@ compute_depend:
 
 include cduce/types_depend
 
-
-
 clean:
 	for i in $(DIRS); do \
 	(cd $$i; rm -f *.cmi *.cmo *.cma *.cmx *.o *.a *.cmxa *~); \

_tags

@@ -15,6 +15,3 @@ true: -traverse
 <schema/**>: package(pcre), package(netstring)
 <runtime/**>: package(pcre), package(netstring)
 <tests/libtest/*Test.*>: package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
-
-<tests/eval/src/main.*>:  pp(camlp4orf.opt), package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
-<kim*.native>: pp(camlp4orf.opt), package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)

misc/upool.ml

@@ -18,9 +18,12 @@ module type S = sig
   val from_int: int -> t
 end
 
-module HInt = Hashtbl.Make(struct type t = int
-				  let hash x = x
-				  let equal x y = x==y end)
+module HInt = 
+  Hashtbl.Make(struct
+    type t = int
+    let hash x = x
+    let equal x y = x==y 
+end)
 
 module Make(X : Custom.T) = struct
   type token

tests/lambda/src/compute.ml

@@ -7,7 +7,7 @@ module Locals = Map.Make(String)
 (* To throw in case of an unbound name *)
 exception Error
 
-let polyvar = Types.var (`Var (Var.make_id "A"))
+let polyvar = Types.var (Var.mk "A")
 
 let type_of_string s = match s with
   | "Int" -> Builtin_defs.int
@@ -115,7 +115,7 @@ and make_sigma s =
 and type_of_ptype =
   let open Types in function
     | Type(t) -> type_of_string t
-    | PType(t) -> var (`Var (Var.make_id t))
+    | PType(t) -> var (Var.mk t)
     | TPair(t1, t2) -> times (cons (type_of_ptype t1)) (cons (type_of_ptype t2))
     | TUnion(t1, t2) -> cup (type_of_ptype t1) (type_of_ptype t2)
     | TInter(t1, t2) -> cap (type_of_ptype t1) (type_of_ptype t2)

types/boolVar.ml

@@ -4,7 +4,7 @@ let (=) : int -> int -> bool = (=)
 
 (* this is the the of the Constructor container *)
 module type E = sig
-  type elem
+  type elem 
   include Custom.T
 
   val empty : t
@@ -19,20 +19,8 @@ end
 module type S = sig
 
   type s
-
-  module T : sig
-    include E
-    val is_empty : s -> bool
-    val is_full : s -> bool
-  end
-
   type elem = s Var.pairvar
-  type 'a bdd =
-    [ `True
-    | `False
-    | `Split of int * 'a * ('a bdd) * ('a bdd) * ('a bdd) ]
-
-  include Custom.T with type t = elem bdd
+  include Custom.T
 
   (* returns the union of all leaves in the BDD *)
   val leafconj: t -> s
@@ -48,14 +36,13 @@ module type S = sig
   val cap   : t -> t -> t
   val diff  : t -> t -> t
   val atom  : elem -> t
-  (* val neg_atom  : elem -> t *)
 
   val trivially_disjoint: t -> t -> bool
 
   (* vars a : return a bdd that is ( Any ^ Var a ) *)
   val vars  : Var.var -> t
 
-  val iter: (elem-> unit) -> t -> unit
+  val iter: (elem -> unit) -> t -> unit
 
   val compute: empty:'b -> full:'b -> cup:('b -> 'b -> 'b) 
     -> cap:('b -> 'b -> 'b) -> diff:('b -> 'b -> 'b) ->
@@ -72,9 +59,7 @@ module type S = sig
 *)
 end
 
-(*
-module type MAKE = functor (T : E) -> S with type elem = T.t Custom.pairvar 
-*)
+module type MAKE = functor (T : E) -> S with type s = T.t
 
 (* ternary BDD
  * where the nodes are Atm of X.t | Var of String.t
@@ -94,22 +79,16 @@ module type MAKE = functor (T : E) -> S with type elem = T.t Custom.pairvar
  *
  * *)
 
-module Make(T : E) : S with type s = T.t =
-struct
+module Make (T : E) : S with type s = T.t = struct
   (* ternary decision trees . cf section 11.3.3 Frish PhD *)
   (* plus variables *)
   (* `Atm are containers (Atoms, Chars, Intervals, Pairs ... )
    * `Var are String
    *)
-  module T = struct
-    include T
-    let is_empty t = (empty == t)
-    let is_full t = (full == t)
-  end
 
   type s = T.t
-  module X = Var.Make(T)
   type elem = s Var.pairvar
+  module X : Custom.T with type t = elem = Var.Make(T)
   type 'a bdd =
     [ `True
     | `False
@@ -167,6 +146,9 @@ struct
     `Split (h, x,`True,`False,`False)
 
   let vars v =
+    let compute_hash x p i n = 
+        (Var.hash x) + 17 * (hash p) + 257 * (hash i) + 16637 * (hash n)
+    in
     let a = atom (`Atm T.full) in 
     let h = compute_hash v a `False `False in 
     ( `Split (h,v,a,`False,`False) :> t )

types/types.ml

@@ -138,7 +138,6 @@ module BoolIntervals : BoolVar.S with
 module BoolChars : BoolVar.S with
   type s = Chars.t = BoolVar.Make(Chars)
 
-
 module TLV = struct
 
   module Set = struct

types/types.mli

@@ -85,10 +85,14 @@ include Custom.T
 module Node : Custom.T
 
 module Pair : Bool.S with type elem = (Node.t * Node.t)
-module BoolPair : BoolVar.S with type s = Pair.t and type elem = Pair.t Var.pairvar
+module BoolPair : BoolVar.S with 
+  type s = Pair.t and 
+  type elem = Pair.t Var.pairvar
 
 module Rec : Bool.S with type elem = bool * Node.t Ident.label_map
-module BoolRec : BoolVar.S with type s = Rec.t and type elem = Rec.t Var.pairvar
+module BoolRec : BoolVar.S with
+  type s = Rec.t and 
+  type elem = Rec.t Var.pairvar
 
 type descr = t
 

types/var.ml

 
-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
+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
+end
 
-type var = [ `Var of t ]
+type var = [ `Var of V.t ]
 type 'a pairvar = [ `Atm of 'a | var ]
 
-let dump ppf (`Var x) = Format.fprintf ppf "%a" dump x
-let print ppf (`Var x) = Format.fprintf ppf "'%s" x.id
-let compare (`Var x) (`Var y) = compare x y
+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 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 mk ?fresh id = 
+  `Var (V.make_id ?fresh id)
+
+let fresh : ?pre: string -> unit -> [> var ] =
+  let counter = ref 0 in
+  fun ?(pre="_fresh_") -> fun _ ->
+    let id = (Printf.sprintf "%s%d" pre !counter) in
+    let v = mk ~fresh:true id in
+    incr counter;
+    v
+;;
 
-let id (`Var t) = t.id
-let is_fresh (`Var t) = t.fresh
+let id (`Var t) = t.V.id
+let is_fresh (`Var t) = t.V.fresh
 
 module Set = struct
-  include Set.Make( struct type t = var let compare = compare end) 
+  include Set.Make(struct type t = var let compare = compare end) 
   let aux_print sep printer ppf s =
     let rec aux ppf = function
       |[] -> ()
@@ -39,9 +48,11 @@ module Set = struct
   let from_list l = List.fold_left (fun acc x -> add x acc) empty l
 end
 
+module type MAKE = functor (X : Custom.T) -> Custom.T with type t = X.t pairvar
+
 module Make (X : Custom.T) = struct
   type t = X.t pairvar
-  let hash = function `Atm t -> X.hash t | `Var x -> hash x
+  let hash = function `Atm t -> X.hash t | `Var x -> V.hash x
   let check = function `Atm t -> X.check t | `Var _ -> ()
   let compare t1 t2 =
     match t1,t2 with
@@ -56,15 +67,3 @@ module Make (X : Custom.T) = struct
     |`Atm x -> X.dump ppf x
     |`Var x -> dump ppf (`Var x)
 end
-
-let mk ?fresh id = 
-  `Var (make_id ?fresh id)
-
-let fresh : ?pre: string -> unit -> [> var ] =
-  let counter = ref 0 in
-  fun ?(pre="_fresh_") -> fun _ ->
-    let id = (Printf.sprintf "%s%d" pre !counter) in
-    let v = mk ~fresh:true id in
-    incr counter;
-    v
-

types/var.mli

+module V : sig
+  type 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
+
+val mk : ?fresh:bool -> string -> var
+val fresh : ?pre:string -> unit -> var
+val id : var -> string
+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 is_empty : t -> bool
+  val from_list : elt list -> t
+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 : MAKE