X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_paramodulation%2FfoUtils.ml;h=826687afc788b49d842b639d83467c94b88fd5de;hb=60f0eb9495af3b713c83ece46effd76dbaa40ce6;hp=d53b19c8245f8b6513889be718bef52f2c9f9e83;hpb=637114791874df9ebc4e0f0936513c71886a913f;p=helm.git diff --git a/helm/software/components/ng_paramodulation/foUtils.ml b/helm/software/components/ng_paramodulation/foUtils.ml index d53b19c82..826687afc 100644 --- a/helm/software/components/ng_paramodulation/foUtils.ml +++ b/helm/software/components/ng_paramodulation/foUtils.ml @@ -11,29 +11,29 @@ (* $Id: terms.ml 9836 2009-06-05 15:33:35Z denes $ *) - -module Utils (B : Terms.Blob) = struct - module Subst = FoSubst.Subst(B) ;; - module Order = Orderings.Orderings(B) ;; +let rec lexicograph f l1 l2 = + match l1, l2 with + | [], [] -> 0 + | x::xs, y::ys -> + let c = f x y in + if c <> 0 then c else lexicograph f xs ys + | [],_ -> ~-1 + | _,[] -> 1 +;; + +module Utils (B : Orderings.Blob) = struct + module Subst = FoSubst;; + module Order = B;; let rec eq_foterm x y = x == y || match x, y with - | Terms.Leaf t1, Terms.Leaf t2 -> B.eq t1 t2 + | Terms.Leaf t1, Terms.Leaf t2 -> B.eq t1 t2 | Terms.Var i, Terms.Var j -> i = j | Terms.Node l1, Terms.Node l2 -> List.for_all2 eq_foterm l1 l2 | _ -> false ;; - let rec lexicograph f l1 l2 = - match l1, l2 with - | [], [] -> 0 - | x::xs, y::ys -> - let c = f x y in - if c <> 0 then c else lexicograph f xs ys - | [],_ -> ~-1 - | _,[] -> 1 - ;; let rec compare_foterm x y = match x, y with @@ -72,29 +72,31 @@ module Utils (B : Terms.Blob) = struct let eq_unit_clause (id1,_,_,_) (id2,_,_,_) = id1 = id2 let compare_unit_clause (id1,_,_,_) (id2,_,_,_) = Pervasives.compare id1 id2 - let relocate maxvar varlist = + let relocate maxvar varlist subst = List.fold_right (fun i (maxvar, varlist, s) -> maxvar+1, maxvar::varlist, Subst.build_subst i (Terms.Var maxvar) s) - varlist (maxvar+1, [], Subst.id_subst) + varlist (maxvar+1, [], subst) ;; let fresh_unit_clause maxvar (id, lit, varlist, proof) = - let maxvar, varlist, subst = relocate maxvar varlist in + (* prerr_endline + ("varlist = " ^ (String.concat "," (List.map string_of_int varlist)));*) + let maxvar, varlist, subst = relocate maxvar varlist Subst.id_subst in let lit = match lit with | Terms.Equation (l,r,ty,o) -> - let l = Subst.apply_subst subst l in - let r = Subst.apply_subst subst r in - let ty = Subst.apply_subst subst ty in + let l = Subst.reloc_subst subst l in + let r = Subst.reloc_subst subst r in + let ty = Subst.reloc_subst subst ty in Terms.Equation (l,r,ty,o) | Terms.Predicate p -> - let p = Subst.apply_subst subst p in + let p = Subst.reloc_subst subst p in Terms.Predicate p in let proof = match proof with - | Terms.Exact t -> Terms.Exact (Subst.apply_subst subst t) + | Terms.Exact t -> Terms.Exact (Subst.reloc_subst subst t) | Terms.Step (rule,c1,c2,dir,pos,s) -> Terms.Step(rule,c1,c2,dir,pos,Subst.concat subst s) in @@ -102,11 +104,6 @@ module Utils (B : Terms.Blob) = struct ;; (* may be moved inside the bag *) - let mk_id = - let id = ref 0 in - fun () -> incr id; !id - ;; - let mk_unit_clause maxvar ty proofterm = let varlist = let rec aux acc = function @@ -117,25 +114,31 @@ module Utils (B : Terms.Blob) = struct aux (aux [] ty) proofterm in let lit = - match ty with - | Terms.Node [ Terms.Leaf eq ; ty; l; r ] when B.eq B.eqP eq -> + match B.is_eq ty with + | Some(ty,l,r) -> let o = Order.compare_terms l r in Terms.Equation (l, r, ty, o) - | t -> Terms.Predicate t + | None -> Terms.Predicate ty in let proof = Terms.Exact proofterm in - fresh_unit_clause maxvar (mk_id (), lit, varlist, proof) + fresh_unit_clause maxvar (0, lit, varlist, proof) ;; - let add_to_bag = - let id = ref 0 in - fun bag (_,lit,vl,proof) -> - incr id; - let clause = (!id, lit, vl, proof) in - let bag = Terms.M.add !id clause bag in - bag, clause - ;; - - let empty_bag = Terms.M.empty ;; + let mk_passive_clause cl = + (Order.compute_unit_clause_weight cl, cl) + ;; + + let mk_passive_goal g = + (Order.compute_unit_clause_weight g, g) + ;; + + let compare_passive_clauses_weight (w1,(id1,_,_,_)) (w2,(id2,_,_,_)) = + if w1 = w2 then id1 - id2 + else w1 - w2 + ;; + + let compare_passive_clauses_age (_,(id1,_,_,_)) (_,(id2,_,_,_)) = + id1 - id2 + ;; end