(* $Id$ *)
-module type Comparable =
- sig
- type t
- val is_eq : t -> t -> bool
- end
-
-module C : Comparable =
- struct
- type t = NCic.term
- let is_eq a b = Pervasives.compare a b = 0 (* TODO: optimize *)
- end
-
- (*
-module C : Comparable =
- struct
- type t = Cic.term
- let is_eq a b = Pervasives.compare a b = 0 (* TODO: optimize *)
- end
-*)
-
-open Discrimination_tree
-
-module ClauseOT : Set.OrderedType
- with type t = Terms.direction * C.t Terms.unit_clause =
- struct
- type t = Terms.direction * C.t Terms.unit_clause
- let compare (d1,(id1,_,_,_)) (d2,(id2,_,_,_)) =
- Pervasives.compare (d1,id1) (d2,id2)
- end
-
-module ClauseSet = Set.Make(ClauseOT)
-
-module FotermIndexable : Indexable
-with type input = C.t Terms.foterm and
- type constant_name = C.t = struct
-
-type input = C.t Terms.foterm
-type constant_name = C.t
-
-let path_string_of =
- let rec aux arity = function
- | Terms.Leaf a -> [Constant (a, arity)]
- | Terms.Var i -> assert (arity = 0); [Variable]
- | Terms.Node (Terms.Var _::_) -> assert false
- | Terms.Node ([] | [ _ ] ) -> assert false
- | Terms.Node (Terms.Node _::_) -> assert false
- | Terms.Node (hd::tl) ->
- aux (List.length tl) hd @ List.flatten (List.map (aux 0) tl)
- in
- aux 0
-;;
-
-let compare e1 e2 =
- match e1,e2 with
- | Constant (a1,ar1), Constant (a2,ar2) ->
- if C.is_eq a1 a2 then Pervasives.compare ar1 ar2
- else Pervasives.compare e1 e2 (* TODO: OPTIMIZE *)
- | _ -> Pervasives.compare e1 e2
-;;
-
-let string_of_path l = String.concat "." (List.map (fun _ -> "*") l) ;;
+module Index(B : Orderings.Blob) = struct
+ module U = FoUtils.Utils(B)
+ module Unif = FoUnif.Founif(B)
+ module Pp = Pp.Pp(B)
-end
+ module ClauseOT =
+ struct
+ type t = Terms.direction * B.t Terms.unit_clause
+
+ let compare (d1,uc1) (d2,uc2) =
+ let c = Pervasives.compare d1 d2 in
+ if c <> 0 then c else U.compare_unit_clause uc1 uc2
+ ;;
+ end
+
+ module ClauseSet :
+ Set.S with type elt = Terms.direction * B.t Terms.unit_clause
+ = Set.Make(ClauseOT)
+
+ open Discrimination_tree
+
+ module FotermIndexable : Indexable with
+ type constant_name = B.t and
+ type input = B.t Terms.foterm
+ =
+ struct
+
+ type input = B.t Terms.foterm
+ type constant_name = B.t
+
+ let path_string_of =
+ let rec aux arity = function
+ | Terms.Leaf a -> [Constant (a, arity)]
+ | Terms.Var i -> (* assert (arity = 0); *) [Variable]
+ (* FIXME : should this be allowed or not ?
+ | Terms.Node (Terms.Var _::_) ->
+ assert false *)
+ | Terms.Node ([] | [ _ ] ) -> assert false
+ | Terms.Node (Terms.Node _::_) -> assert false
+ | Terms.Node (hd::tl) ->
+ aux (List.length tl) hd @ List.flatten (List.map (aux 0) tl)
+ in
+ aux 0
+ ;;
+
+ let compare e1 e2 =
+ match e1,e2 with
+ | Constant (a1,ar1), Constant (a2,ar2) ->
+ let c = B.compare a1 a2 in
+ if c <> 0 then c else Pervasives.compare ar1 ar2
+ | Variable, Variable -> 0
+ | Constant _, Variable -> ~-1
+ | Variable, Constant _ -> 1
+ | Proposition, _ | _, Proposition
+ | Datatype, _ | _, Datatype
+ | Dead, _ | _, Dead
+ | Bound _, _ | _, Bound _ -> assert false
+ ;;
-module DiscriminationTree = Make(FotermIndexable)(ClauseSet)
+ let string_of_path l = String.concat "." (List.map (fun _ -> "*") l) ;;
+
+ end
+
+ module DT : DiscriminationTree with
+ type constant_name = B.t and
+ type input = B.t Terms.foterm and
+ type data = ClauseSet.elt and
+ type dataset = ClauseSet.t
+ = Make(FotermIndexable)(ClauseSet)
+
+ let process op t = function
+ | (_,Terms.Equation (l,_,_,Terms.Gt),_,_) as c ->
+ op t l (Terms.Left2Right, c)
+ | (_,Terms.Equation (_,r,_,Terms.Lt),_,_) as c ->
+ op t r (Terms.Right2Left, c)
+ | (_,Terms.Equation (l,r,_,Terms.Incomparable),vl,_) as c ->
+ op (op t l (Terms.Left2Right, c))
+ r (Terms.Right2Left, c)
+ | (_,Terms.Equation (l,r,_,Terms.Invertible),vl,_) as c ->
+ op t l (Terms.Left2Right, c)
+ | (_,Terms.Equation (_,r,_,Terms.Eq),_,_) -> assert false
+ | (_,Terms.Predicate p,_,_) as c ->
+ op t p (Terms.Nodir, c)
+ ;;
+
+ let index_unit_clause =
+ process DT.index
+
+ let remove_unit_clause =
+ process DT.remove_index
+
+ let fold = DT.fold
+
+ let elems index =
+ DT.fold index (fun _ dataset acc -> ClauseSet.union dataset acc)
+ ClauseSet.empty
+
+ type active_set = B.t Terms.unit_clause list * DT.t
+
+end