X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fparamodulation%2Finference.ml;h=04cdb0aeb8ebf8c8cff587dc81909045b76d3004;hb=f7aedf0ebd0fb55d3587db4f0753521927dcbb69;hp=003fb958430cf9597bc46909e06867c33db6018a;hpb=b6bec181b81b3cbc56ec8914dcd7e6a029c7d84f;p=helm.git

diff --git a/helm/ocaml/paramodulation/inference.ml b/helm/ocaml/paramodulation/inference.ml
index 003fb9584..04cdb0aeb 100644
--- a/helm/ocaml/paramodulation/inference.ml
+++ b/helm/ocaml/paramodulation/inference.ml
@@ -23,6 +23,8 @@
  * http://cs.unibo.it/helm/.
  *)
 
+(* $Id$ *)
+
 open Utils;;
 
 
@@ -378,8 +380,7 @@ let unification_simple metasenv context t1 t2 ugraph =
         unif subst menv t s
     | C.Meta _, t when occurs_check subst s t ->
         raise
-          (U.UnificationFailure
-             (U.failure_msg_of_string "Inference.unification.unif"))
+          (U.UnificationFailure (lazy "Inference.unification.unif"))
     | C.Meta (i, l), t -> (
         try
           let _, _, ty = CicUtil.lookup_meta i menv in
@@ -400,20 +401,17 @@ let unification_simple metasenv context t1 t2 ugraph =
       )
     | _, C.Meta _ -> unif subst menv t s
     | C.Appl (hds::_), C.Appl (hdt::_) when hds <> hdt ->
-        raise (U.UnificationFailure
-                 (U.failure_msg_of_string "Inference.unification.unif"))
+        raise (U.UnificationFailure (lazy "Inference.unification.unif"))
     | C.Appl (hds::tls), C.Appl (hdt::tlt) -> (
         try
           List.fold_left2
             (fun (subst', menv) s t -> unif subst' menv s t)
             (subst, menv) tls tlt
         with Invalid_argument _ ->
-          raise (U.UnificationFailure
-                   (U.failure_msg_of_string "Inference.unification.unif"))
+          raise (U.UnificationFailure (lazy "Inference.unification.unif"))
       )
     | _, _ ->
-        raise (U.UnificationFailure
-                 (U.failure_msg_of_string "Inference.unification.unif"))
+        raise (U.UnificationFailure (lazy "Inference.unification.unif"))
   in
   let subst, menv = unif [] metasenv t1 t2 in
   let menv =
@@ -453,7 +451,7 @@ let unification metasenv context t1 t2 ugraph =
 ;;
 
 
-(* let unification = CicUnification.fo_unif;; *)
+let unification = CicUnification.fo_unif;;
 
 exception MatchingFailure;;
 
@@ -594,6 +592,7 @@ let find_equalities context proof =
 ;;
 
 
+(*
 let equations_blacklist =
   List.fold_left
     (fun s u -> UriManager.UriSet.add (UriManager.uri_of_string u) s)
@@ -626,6 +625,9 @@ let equations_blacklist =
       "cic:/matita/logic/equality/eq_rect.con";
     ]
 ;;
+*)
+let equations_blacklist = UriManager.UriSet.empty;;
+
 
 let find_library_equalities dbd context status maxmeta = 
   let module C = Cic in
@@ -728,13 +730,13 @@ let find_library_equalities dbd context status maxmeta =
   let uriset, eqlist = 
     (List.fold_left
        (fun (s, l) (u, e) ->
-          if List.exists (meta_convertibility_eq e) l then (
+          if List.exists (meta_convertibility_eq e) (List.map snd l) then (
             debug_print
               (lazy
                  (Printf.sprintf "NO!! %s already there!"
                     (string_of_equality e)));
             (UriManager.UriSet.add u s, l)
-          ) else (UriManager.UriSet.add u s, e::l))
+          ) else (UriManager.UriSet.add u s, (u, e)::l))
        (UriManager.UriSet.empty, []) found)
   in
   uriset, eqlist, maxm
@@ -915,9 +917,36 @@ let equality_of_term proof term =
 type environment = Cic.metasenv * Cic.context * CicUniv.universe_graph;;
 
 
-let is_identity ((_, context, ugraph) as env) = function
-  | ((_, _, (ty, left, right, _), _, _) as equality) ->
-      (left = right ||
-          (meta_convertibility left right) ||
-          (fst (CicReduction.are_convertible context left right ugraph)))
+let is_identity ((metasenv, context, ugraph) as env) = function
+  | ((_, _, (ty, left, right, _), menv, _) as equality) ->
+       (left = right ||
+          (* (meta_convertibility left right) || *)
+          (fst (CicReduction.are_convertible 
+		  ~metasenv:(metasenv @ menv) context left right ugraph)))
+;;
+
+
+let term_of_equality equality =
+  let _, _, (ty, left, right, _), menv, args = equality in
+  let eq i = function Cic.Meta (j, _) -> i = j | _ -> false in
+  let argsno = List.length args in
+  let t =
+    CicSubstitution.lift argsno
+      (Cic.Appl [Cic.MutInd (LibraryObjects.eq_URI (), 0, []); ty; left; right])
+  in
+  snd (
+    List.fold_right
+      (fun a (n, t) ->
+         match a with
+         | Cic.Meta (i, _) ->
+             let name = Cic.Name ("X" ^ (string_of_int n)) in
+             let _, _, ty = CicUtil.lookup_meta i menv in
+             let t = 
+               ProofEngineReduction.replace
+                 ~equality:eq ~what:[i]
+                 ~with_what:[Cic.Rel (argsno - (n - 1))] ~where:t
+             in
+             (n-1, Cic.Prod (name, ty, t))
+         | _ -> assert false)
+      args (argsno, t))
 ;;