Commit 17b988b3 authored by Pietro Abate's avatar Pietro Abate

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

parent 31208ef3
......@@ -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)
......
......@@ -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 *~); \
......
......@@ -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)
This diff is collapsed.
......@@ -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
......
......@@ -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)
......
......@@ -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 )
......
......@@ -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
......
......@@ -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
......
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
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment