compose tactic restore and added nocomposites keyword

[helm.git] / components / tactics / inversion.ml

diff --git a/components/tactics/inversion.ml b/components/tactics/inversion.ml
index e381b3003d7b4940eba1b0886c007922066211d0..e610212440ac9e71840859f2c76dccf14330f276 100644 (file)
--- a/components/tactics/inversion.ml
+++ b/components/tactics/inversion.ml
@@ -123,7 +123,8 @@ let rec foo_prod nright right_param_tys rightparameters l2 base_rel goalty
      (CicSubstitution.lift 1 termty)
      isSetType (CicSubstitution.lift 1 term))
    | [] -> ProofEngineReduction.replace_lifting 
-    ~equality:(ProofEngineReduction.alpha_equivalence)
+    ~equality:(fun _ -> CicUtil.alpha_equivalence)
+    ~context:[]
     ~what: (if isSetType
      then (rightparameters_ @ [term] ) 
      else (rightparameters_ ) )
@@ -151,7 +152,8 @@ let rec foo_lambda nright right_param_tys nright_ right_param_tys_
    | [] when isSetType -> Cic.Lambda (
     (Cic.Name ("lambda" ^ (string_of_int nright))),
     (ProofEngineReduction.replace_lifting
-     ~equality:(ProofEngineReduction.alpha_equivalence)
+     ~equality:(fun _ -> CicUtil.alpha_equivalence)
+     ~context:[]
      ~what: (rightparameters_ ) 
      ~with_what: (List.map (CicSubstitution.lift (-1)) created_vars)
      ~where:termty), (* type of H with replaced right parameters *)
@@ -181,7 +183,7 @@ let private_inversion_tac ~term =
  let private_inversion_tac ~term (proof, goal) =
  
  (*DEBUG*) debug_print (lazy  ("private inversion begins"));
- let (_,metasenv,_,_) = proof in
+ let _,metasenv,_subst,_,_, _ = proof in
  let uri_of_eq =
   match LibraryObjects.eq_URI () with
      None -> raise EqualityNotDefinedYet
@@ -224,7 +226,7 @@ let private_inversion_tac ~term =
   parameters_tys goalty uri_of_eq in
  (*DEBUG*)  debug_print (lazy ("cut term " ^ CicPp.ppterm cut_term));
   debug_print (lazy ("CONTEXT before apply HCUT: " ^ 
-   (CicMetaSubst.ppcontext [] context )));
+   (CicMetaSubst.ppcontext ~metasenv [] context )));
   debug_print (lazy ("termty " ^ CicPp.ppterm termty));
  (* cut DXn=DXn \to GOAL *)
  let proof1,gl1 = PET.apply_tactic (P.cut_tac cut_term) (proof,goal) in
@@ -238,7 +240,7 @@ let private_inversion_tac ~term =
  (*DEBUG*) debug_print (lazy  ("after apply HCUT;reflexivity 
   in private inversion"));
  (* apply (ledx_ind( lambda x. lambda y, ...)) *)
- let (t1,metasenv,t3,t4) = proof2 in
+ let t1,metasenv,_subst,t3,t4, attrs = proof2 in
  let goal2 = List.hd (List.tl gl1) in
  let (_,context,_) = CicUtil.lookup_meta goal2 metasenv in
  (* rightparameters type list *)
@@ -255,7 +257,7 @@ let private_inversion_tac ~term =
  debug_print 
   (lazy ("Right param: " ^ (CicPp.ppterm (Cic.Appl rightparameters))));
  debug_print (lazy ("CONTEXT before refinement: " ^ 
-  (CicMetaSubst.ppcontext [] context )));
+  (CicMetaSubst.ppcontext ~metasenv [] context )));
   (*DEBUG*) debug_print (lazy  ("private inversion: term before refinement: " ^ 
    CicPp.ppterm t));
  let (ref_t,_,metasenv'',_) = CicRefine.type_of_aux' metasenv context t 
@@ -263,13 +265,13 @@ let private_inversion_tac ~term =
  in
  (*DEBUG*) debug_print (lazy  ("private inversion: termine after refinement: "
   ^ CicPp.ppterm ref_t));
- let proof2 = (t1,metasenv'',t3,t4) in
+ let proof2 = (t1,metasenv'',_subst,t3,t4, attrs) in
  let my_apply_tac =
   let my_apply_tac status =
    let proof,goals = 
     ProofEngineTypes.apply_tactic (P.apply_tac ref_t) status in
    let patched_new_goals =
-    let (_,metasenv''',_,_) = proof in
+    let (_,metasenv''',_subst,_,_, _) = proof in
     let new_goals = ProofEngineHelpers.compare_metasenvs
      ~oldmetasenv:metasenv ~newmetasenv:metasenv''
     in
@@ -303,7 +305,7 @@ let inversion_tac ~term =
  let module PET = ProofEngineTypes in
  let inversion_tac ~term (proof, goal) =
  (*DEBUG*) debug_print (lazy ("inversion begins"));
-  let (_,metasenv,_,_) = proof in
+  let _,metasenv,_subst,_,_, _ = proof in
   let (_,context,goalty) = CicUtil.lookup_meta goal metasenv in
   let termty,_ = T.type_of_aux' metasenv context term CicUniv.empty_ugraph in
   let uri, typeno = 
@@ -334,19 +336,19 @@ let inversion_tac ~term =
    for n = 1 to arity_consno do
     a := (Cic.Implicit None)::(!a)
    done;
-  (* apply    i_inv             ? ...?      H).     *)
-  Cic.Appl ([Cic.Const(uri,[])] @ !a @ [Cic.Rel 1])
+   (* apply    i_inv             ? ...?      H).     *)
+   Cic.Appl ([Cic.Const(uri,[])] @ !a @ [term])
   in
   let t = appl_term (arity_length + (List.length cons_list)) inversor_uri in
-  let (t1,metasenv,t3,t4) = proof in
+  let (t1,metasenv,_subst,t3,t4, attrs) = proof in
   let (ref_t,_,metasenv'',_) = CicRefine.type_of_aux' metasenv context t
   CicUniv.empty_ugraph 
   in
-  let proof = (t1,metasenv'',t3,t4) in
+  let proof = (t1,metasenv'',_subst,t3,t4, attrs) in
   let proof3,gl3 = 
      ProofEngineTypes.apply_tactic (P.apply_tac ref_t) (proof,goal) in
   let patched_new_goals =
-     let (_,metasenv''',_,_) = proof3 in
+     let (_,metasenv''',_subst,_,_, _) = proof3 in
      let new_goals = ProofEngineHelpers.compare_metasenvs
       ~oldmetasenv:metasenv ~newmetasenv:metasenv''
      in