replaced an assert false that cause nat_ind not to be displayed with a dummy result

[helm.git] / components / acic_content / acic2content.ml

diff --git a/components/acic_content/acic2content.ml b/components/acic_content/acic2content.ml
index 99bab2de44f122fc7d099ba331982bdbe7304409..69a1f632dcf3117138c5b421dcfb94f9999adb10 100644 (file)
--- a/components/acic_content/acic2content.ml
+++ b/components/acic_content/acic2content.ml
@@ -118,7 +118,11 @@ let test_for_lifting ~ids_to_inner_types ~ids_to_inner_sorts=
   let module C2A = Cic2acic in
   (* atomic terms are never lifted, according to my policy *)
   function
-      C.ARel (id,_,_,_) -> false
+      C.ARel (id,_,_,_) ->
+         (try 
+            ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
+            true;
+          with Not_found -> false) 
     | C.AVar (id,_,_) -> 
          (try 
             ignore (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized;
@@ -356,7 +360,7 @@ let infer_dependent ~headless context metasenv = function
                   (n <> Cic.Anonymous && fstorder src, t) :: 
                   aux (CicSubstitution.subst 
                         (Deannotate.deannotate_term t) tgt) tl
-              | _ -> assert false
+              | _ -> List.map (fun s -> false,s) (t::tl)
        in
        (false, he) :: aux hety tl
      with CicTypeChecker.TypeCheckerFailure _ -> assert false
@@ -365,16 +369,19 @@ let infer_dependent ~headless context metasenv = function
 let rec build_subproofs_and_args ?(headless=false) seed context metasenv l ~ids_to_inner_types ~ids_to_inner_sorts =
   let module C = Cic in
   let module K = Content in
-  let rec aux =
+  let rec aux n =
     function
       [] -> [],[]
     | (dep, t)::l1 -> 
-       let subproofs,args = aux l1 in
-        if (test_for_lifting t ~ids_to_inner_types ~ids_to_inner_sorts) then
+       let need_lifting =
+        test_for_lifting t ~ids_to_inner_types ~ids_to_inner_sorts in
+       let subproofs,args = aux (n + if need_lifting then 1 else 0) l1 in
+        if need_lifting then
           let new_subproof = 
             acic2content 
               seed context metasenv 
-               ~name:"H" ~ids_to_inner_types ~ids_to_inner_sorts t in
+               ~name:("H" ^ string_of_int n) ~ids_to_inner_types
+               ~ids_to_inner_sorts t in
           let new_arg = 
             K.Premise
               { K.premise_id = gen_id premise_prefix seed;
@@ -440,7 +447,7 @@ let rec build_subproofs_and_args ?(headless=false) seed context metasenv l ~ids_
              | _ -> (K.Term (dep,t))) in
           subproofs,hd::args
   in 
-  match (aux (infer_dependent ~headless context metasenv l)) with
+  match (aux 1 (infer_dependent ~headless context metasenv l)) with
     [p],args -> 
       [{p with K.proof_name = None}], 
         List.map 
@@ -934,7 +941,12 @@ and rewrite seed context metasenv name id li ~ids_to_inner_types ~ids_to_inner_s
             K.proof_conclude = 
               { K.conclude_id = gen_id conclude_prefix seed; 
                 K.conclude_aref = id;
-                K.conclude_method = "Rewrite";
+                K.conclude_method =
+                 if UriManager.eq uri HelmLibraryObjects.Logic.eq_ind_URI
+                 || LibraryObjects.is_eq_ind_URI uri then
+                  "RewriteLR"
+                 else
+                  "RewriteRL";
                 K.conclude_args = 
                   K.Term (false,(C.AConst (sid,uri,exp_named_subst)))::method_args;
                 K.conclude_conclusion =