X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_paramodulation%2Findex.ml;h=4db4584a451494caf00bff8166a3a37f96d678dc;hb=94c7a260ca00f045a3ec1b371f19de757f83003b;hp=123c51650b52b827a4b3889ee5d06aa713f492ab;hpb=ddd751449e73a22af523ce78ce1d8f0bb211e941;p=helm.git diff --git a/helm/software/components/ng_paramodulation/index.ml b/helm/software/components/ng_paramodulation/index.ml index 123c51650..4db4584a4 100644 --- a/helm/software/components/ng_paramodulation/index.ml +++ b/helm/software/components/ng_paramodulation/index.ml @@ -11,68 +11,97 @@ (* $Id$ *) -module type Comparable = - sig - type t - val is_eq : t -> t -> bool - end +module Index(B : Orderings.Blob) = struct + module U = FoUtils.Utils(B) + module Unif = FoUnif.Founif(B) + module Pp = Pp.Pp(B) -module C : Comparable = - struct - type t = NCic.term - let is_eq a b = Pervasives.compare a b = 0 (* TODO: optimize *) - 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 C : Comparable = - struct - type t = Cic.term - let is_eq a b = Pervasives.compare a b = 0 (* TODO: optimize *) - end -*) + module ClauseSet : + Set.S with type elt = Terms.direction * B.t Terms.unit_clause + = Set.Make(ClauseOT) -open Discrimination_tree + 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 FotermIndexable : Indexable with + type constant_name = B.t and + type input = B.t Terms.foterm + = + struct -module ClauseSet = Set.Make(ClauseOT) + type input = B.t Terms.foterm + type constant_name = B.t -module FotermIndexable : Indexable -with type input = C.t Terms.foterm and - type constant_name = C.t = struct + 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 _::_) -> + (* FIXME : should this be allowed or not ? *) + 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 + ;; -type input = C.t Terms.foterm -type constant_name = C.t + 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 + ;; -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 string_of_path l = String.concat "." (List.map (fun _ -> "*") l) ;; -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 -;; + end -let string_of_path l = String.concat "." (List.map (fun _ -> "*") l) ;; + 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 index_unit_clause maxvar t = function + | (_,Terms.Equation (l,_,_,Terms.Gt),_,_) as c -> + DT.index t l (Terms.Left2Right, c) + | (_,Terms.Equation (_,r,_,Terms.Lt),_,_) as c -> + DT.index t r (Terms.Right2Left, c) + | (_,Terms.Equation (l,r,_,Terms.Incomparable),vl,_) as c -> +(* if are_invertible maxvar vl l r then + (prerr_endline ("Invertible " ^ (Pp.pp_foterm l) ^ "=" ^ + (Pp.pp_foterm r)); + DT.index t l (Terms.Left2Right, c)) + else *) + DT.index + (DT.index t l (Terms.Left2Right, c)) + r (Terms.Right2Left, c) + | (_,Terms.Equation (l,r,_,Terms.Invertible),vl,_) as c -> + DT.index t l (Terms.Left2Right, c) + | (_,Terms.Equation (_,r,_,Terms.Eq),_,_) -> assert false + | (_,Terms.Predicate p,_,_) as c -> + DT.index t p (Terms.Nodir, c) + ;; -end + type active_set = B.t Terms.unit_clause list * DT.t -module DiscriminationTree = Make(FotermIndexable)(ClauseSet) +end