More progress in technicalities/setoids.ma.

[helm.git] / components / tactics / paramodulation / saturation.ml

diff --git a/components/tactics/paramodulation/saturation.ml b/components/tactics/paramodulation/saturation.ml
index 8442779d34dd2896c8f6777617963d9e6f82903b..30561bf07b5df933fecb0da1e3efef1be1539207 100644 (file)
--- a/components/tactics/paramodulation/saturation.ml
+++ b/components/tactics/paramodulation/saturation.ml
@@ -1319,7 +1319,7 @@ let build_proof
   if proof_menv = [] then prerr_endline "+++++++++++++++VUOTA"
   else prerr_endline (CicMetaSubst.ppmetasenv [] proof_menv);
   let proof, goalno = status in
-  let uri, metasenv, meta_proof, term_to_prove = proof in
+  let uri, metasenv, meta_proof, term_to_prove, attrs = proof in
   let _, context, type_of_goal = CicUtil.lookup_meta goalno metasenv in
   let eq_uri = eq_of_goal type_of_goal in 
   let names = Utils.names_of_context context in
@@ -1351,20 +1351,28 @@ let build_proof
   let real_menv,fixed_proof = fix_proof proof_menv context false goal_proof in
     (* prerr_endline ("PROOF: " ^ CicPp.pp goal_proof names); *)
 *)
+  let pp_error goal_proof names error exn =
+    prerr_endline "THE PROOF DOES NOT TYPECHECK! <begin>";
+    prerr_endline (CicPp.pp goal_proof names); 
+    prerr_endline "THE PROOF DOES NOT TYPECHECK!";
+    prerr_endline error;
+    prerr_endline "THE PROOF DOES NOT TYPECHECK! <end>";
+    raise exn
+  in
   let goal_proof,goal_ty,real_menv,_ = 
     (* prerr_endline ("parte la refine per: " ^ (CicPp.pp goal_proof names)); *)
     try
+            prerr_endline (CicPp.ppterm goal_proof);
       CicRefine.type_of_aux' real_menv context goal_proof CicUniv.empty_ugraph
     with 
-      | CicUtil.Meta_not_found _ 
-      | CicRefine.RefineFailure _ 
-      | CicRefine.Uncertain _ 
-      | CicRefine.AssertFailure _
+      | CicRefine.RefineFailure s 
+      | CicRefine.Uncertain s 
+      | CicRefine.AssertFailure s as exn -> 
+          pp_error goal_proof names (Lazy.force s) exn
+      | CicUtil.Meta_not_found i as exn ->
+          pp_error goal_proof names ("META NOT FOUND: "^string_of_int i) exn
       | Invalid_argument "list_fold_left2" as exn ->
-          prerr_endline "THE PROOF DOES NOT TYPECHECK!";
-          prerr_endline (CicPp.pp goal_proof names); 
-          prerr_endline "THE PROOF DOES NOT TYPECHECK!";
-          raise exn
+          pp_error goal_proof names "Invalid_argument: list_fold_left2" exn 
   in     
   let subst_side_effects,real_menv,_ = 
     try
@@ -1531,15 +1539,17 @@ let build_proof
 let pump_actives context bag maxm active passive saturation_steps max_time =
   reset_refs();
   maxmeta := maxm;
+(*
   let max_l l = 
     List.fold_left 
      (fun acc e -> let _,_,_,menv,_ = Equality.open_equality e in
       List.fold_left (fun acc (i,_,_) -> max i acc) acc menv)
      0 l in
-  let active_l = fst active in
-  let passive_l = fst passive in
-  let ma = max_l active_l in
-  let mp = max_l passive_l in
+*)
+(*   let active_l = fst active in *)
+(*   let passive_l = fst passive in *)
+(*   let ma = max_l active_l in *)
+(*   let mp = max_l passive_l in *)
   match LibraryObjects.eq_URI () with
     | None -> active, passive, !maxmeta
     | Some eq_uri -> 
@@ -1557,7 +1567,7 @@ let pump_actives context bag maxm active passive saturation_steps max_time =
 let all_subsumed bag maxm status active passive =
   maxmeta := maxm;
   let proof, goalno = status in
-  let uri, metasenv, meta_proof, term_to_prove = proof in
+  let uri, metasenv, meta_proof, term_to_prove, attrs = proof in
   let _, context, type_of_goal = CicUtil.lookup_meta goalno metasenv in
   let env = metasenv,context,CicUniv.empty_ugraph in
   let cleaned_goal = Utils.remove_local_context type_of_goal in
@@ -1591,18 +1601,20 @@ let given_clause
 =
   reset_refs();
   maxmeta := maxm;
+  let active_l = fst active in
+(*
   let max_l l = 
     List.fold_left 
      (fun acc e -> let _,_,_,menv,_ = Equality.open_equality e in
       List.fold_left (fun acc (i,_,_) -> max i acc) acc menv)
      0 l
   in
-  let active_l = fst active in
   let passive_l = fst passive in
   let ma = max_l active_l in
   let mp = max_l passive_l in
+*)
   let proof, goalno = status in
-  let uri, metasenv, meta_proof, term_to_prove = proof in
+  let uri, metasenv, meta_proof, term_to_prove, attrs = proof in
   let _, context, type_of_goal = CicUtil.lookup_meta goalno metasenv in
   let eq_uri = eq_of_goal type_of_goal in 
   let cleaned_goal = Utils.remove_local_context type_of_goal in