]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/ng_paramodulation/superposition.ml
Branched paramodulation for CNF (Horn clauses)
[helm.git] / helm / software / components / ng_paramodulation / superposition.ml
index 1a588043409a66b5f40b07014885accfe653b4a1..54f7e10466a2a3550d7c08fc50cead3246b60ba4 100644 (file)
 
 (* $Id: index.mli 9822 2009-06-03 15:37:06Z tassi $ *)
 
-module Superposition (B : Terms.Blob) = 
+module Superposition (B : Orderings.Blob) = 
   struct
     module IDX = Index.Index(B)
     module Unif = FoUnif.Founif(B)
     module Subst = FoSubst 
-    module Order = Orderings.Orderings(B)
+    module Order = B
     module Utils = FoUtils.Utils(B)
     module Pp = Pp.Pp(B)
     
-    exception Success of B.t Terms.bag * int * B.t Terms.unit_clause
+    exception Success of B.t Terms.bag * int * B.t Terms.clause
 
     let debug s = prerr_endline s;;
     let debug _ = ();;
@@ -128,6 +128,7 @@ module Superposition (B : Terms.Blob) =
     let prof_demod_u = HExtlib.profile ~enable "demod.unify";;
     let prof_demod_r = HExtlib.profile ~enable "demod.retrieve_generalizations";;
     let prof_demod_o = HExtlib.profile ~enable "demod.compare_terms";;
+    let prof_demod_s = HExtlib.profile ~enable "demod.apply_subst";;
 
     let demod table varlist subterm =
       let cands = 
@@ -143,10 +144,16 @@ module Superposition (B : Terms.Blob) =
                try 
                  let subst =
                    prof_demod_u.HExtlib.profile 
-                     (Unif.unification (varlist@vl) varlist subterm) side 
+                     (Unif.unification (* (varlist@vl) *) varlist subterm) side 
                  in 
-                 let side = Subst.apply_subst subst side in
-                 let newside = Subst.apply_subst subst newside in
+                 let side = 
+                   prof_demod_s.HExtlib.profile 
+                     (Subst.apply_subst subst) side 
+                 in
+                 let newside = 
+                   prof_demod_s.HExtlib.profile 
+                     (Subst.apply_subst subst) newside 
+                 in
                  if o = Terms.Incomparable then
                    let o = 
                      prof_demod_o.HExtlib.profile 
@@ -158,7 +165,7 @@ module Superposition (B : Terms.Blob) =
                      ((*prerr_endline ("Filtering: " ^ 
                         Pp.pp_foterm side ^ " =(< || =)" ^ 
                         Pp.pp_foterm newside ^ " coming from " ^ 
-                        Pp.pp_unit_clause uc );*)None)
+                        Pp.pp_clause uc );*)None)
                  else
                    Some (newside, subst, id, dir)
                with FoUnif.UnificationFailure _ -> None)
@@ -266,8 +273,8 @@ module Superposition (B : Terms.Blob) =
 (*      in
         if are_alpha_eq c1 c2 then bag1,c1
         else begin
-          prerr_endline (Pp.pp_unit_clause c1);
-          prerr_endline (Pp.pp_unit_clause c2);
+          prerr_endline (Pp.pp_clause c1);
+          prerr_endline (Pp.pp_clause c2);
           prerr_endline "Bag :";
           prerr_endline (Pp.pp_bag bag1);
           assert false
@@ -282,7 +289,7 @@ module Superposition (B : Terms.Blob) =
     let is_identity_clause ~unify = function
       | _, Terms.Equation (_,_,_,Terms.Eq), _, _ -> true
       | _, Terms.Equation (l,r,_,_), vl, proof when unify ->
-          (try ignore(Unif.unification vl [] l r); true
+          (try ignore(Unif.unification (* vl *) [] l r); true
           with FoUnif.UnificationFailure _ -> false)
       | _, Terms.Equation (_,_,_,_), _, _ -> false
       | _, Terms.Predicate _, _, _ -> assert false          
@@ -336,7 +343,7 @@ module Superposition (B : Terms.Blob) =
         | [] -> None
         | (id2,dir,c,vl1)::tl ->
             try
-              let subst = Unif.unification (vl@vl1) locked_vars c t in
+              let subst = Unif.unification (* (vl@vl1) *) locked_vars c t in
               Some (id2, dir, subst)
             with FoUnif.UnificationFailure _ -> aux tl
       in
@@ -367,7 +374,7 @@ module Superposition (B : Terms.Blob) =
           let l = Subst.apply_subst subst l in 
           let r = Subst.apply_subst subst r in 
             try 
-              let subst1 = Unif.unification vl [] l r in
+              let subst1 = Unif.unification (* vl *) [] l r in
               let lit = 
                 match lit with Terms.Predicate _ -> assert false
                   | Terms.Equation (l,r,ty,o) -> 
@@ -474,7 +481,7 @@ module Superposition (B : Terms.Blob) =
       match simplify atable maxvar bag new_clause with
         | bag,None -> bag,None (* new_clause has been discarded *)
         | bag,(Some clause) ->
-            let ctable = IDX.index_unit_clause IDX.DT.empty clause in
+            let ctable = IDX.index_clause IDX.DT.empty clause in
             let bag, alist, atable = 
               List.fold_left 
                 (fun (bag, alist, atable) c ->
@@ -482,7 +489,7 @@ module Superposition (B : Terms.Blob) =
                      |bag,None -> (bag,alist,atable)
                         (* an active clause as been discarded *)
                      |bag,Some c1 ->
-                        bag, c :: alist, IDX.index_unit_clause atable c)
+                        bag, c :: alist, IDX.index_clause atable c)
                 (bag,[],IDX.DT.empty) alist
             in
               bag, Some (clause, (alist,atable))
@@ -495,7 +502,7 @@ module Superposition (B : Terms.Blob) =
     let simplification_step ~new_cl cl (alist,atable) bag maxvar new_clause =
       let atable1 =
         if new_cl then atable else
-        IDX.index_unit_clause atable cl
+        IDX.index_clause atable cl
       in
         (* Simplification of new_clause with :      *
          * - actives and cl if new_clause is not cl *
@@ -506,7 +513,7 @@ module Superposition (B : Terms.Blob) =
           | bag,Some clause ->
               (* Simplification of each active clause with clause *
                * which is the simplified form of new_clause       *)
-              let ctable = IDX.index_unit_clause IDX.DT.empty clause in
+              let ctable = IDX.index_clause IDX.DT.empty clause in
               let bag, newa, alist, atable = 
                 List.fold_left 
                   (fun (bag, newa, alist, atable) c ->
@@ -516,7 +523,7 @@ module Superposition (B : Terms.Blob) =
                        |bag,Some c1 ->
                             if (c1 == c) then 
                               bag, newa, c :: alist,
-                            IDX.index_unit_clause atable c
+                            IDX.index_clause atable c
                             else
                               bag, c1 :: newa, alist, atable)                  
                   (bag,[],[],IDX.DT.empty) alist
@@ -558,7 +565,7 @@ module Superposition (B : Terms.Blob) =
                   | bag,(None, Some _) -> bag,None
                   | bag,(Some cl1, Some (clause, (alist,atable), newa)) ->
                       let alist,atable =
-                        (clause::alist, IDX.index_unit_clause atable clause)
+                        (clause::alist, IDX.index_clause atable clause)
                       in
                         keep_simplified_aux ~new_cl:(cl!=cl1) cl1 (alist,atable)
                           bag (newa@tl)
@@ -620,7 +627,7 @@ module Superposition (B : Terms.Blob) =
                let side, newside = if dir=Terms.Left2Right then l,r else r,l in
                try 
                  let subst = 
-                   Unif.unification (varlist@vl) [] subterm side 
+                   Unif.unification (* (varlist@vl)*)  [] subterm side 
                  in 
                  if o = Terms.Incomparable then
                    let side = Subst.apply_subst subst side in
@@ -686,12 +693,12 @@ module Superposition (B : Terms.Blob) =
       (* We demodulate actives clause with current until all *
        * active clauses are reduced w.r.t each other         *)
       (* let bag, (alist,atable) = keep_simplified (alist,atable) bag [current] in *)
-      let ctable = IDX.index_unit_clause IDX.DT.empty current in
+      let ctable = IDX.index_clause IDX.DT.empty current in
       (* let bag, (alist, atable) = 
         let bag, alist = 
           HExtlib.filter_map_acc (simplify ctable) bag alist
         in
-        bag, (alist, List.fold_left IDX.index_unit_clause IDX.DT.empty alist)
+        bag, (alist, List.fold_left IDX.index_clause IDX.DT.empty alist)
       in*)
         debug "Simplified active clauses with fact";
       (* We superpose active clauses with current *)
@@ -708,10 +715,10 @@ module Superposition (B : Terms.Blob) =
         (* We add current to active clauses so that it can be *
          * superposed with itself                             *)
       let alist, atable = 
-        current :: alist, IDX.index_unit_clause atable current
+        current :: alist, IDX.index_clause atable current
       in
         debug "Indexed";
-      let fresh_current, maxvar = Utils.fresh_unit_clause maxvar current in
+      let fresh_current, maxvar = Utils.fresh_clause maxvar current in
         (* We need to put fresh_current into the bag so that all *
          * variables clauses refer to are known.                 *)
       let bag, fresh_current = Terms.add_to_bag fresh_current bag in