* 'default "equality"' command changed to consider also

[helm.git] / helm / software / components / tactics / equalityTactics.ml

diff --git a/helm/software/components/tactics/equalityTactics.ml b/helm/software/components/tactics/equalityTactics.ml
index 89da5c9fdc12b329b25ea35b0a70f64525d1474e..f2760c30f33f394daded905bc246cc63446e7321 100644 (file)
--- a/helm/software/components/tactics/equalityTactics.ml
+++ b/helm/software/components/tactics/equalityTactics.ml
@@ -44,8 +44,10 @@ let rec rewrite_tac ~direction ~pattern:(wanted,hyps_pat,concl_pat) equality =
  let _rewrite_tac status =
   assert (wanted = None);   (* this should be checked syntactically *)
   let proof,goal = status in
-  let curi, metasenv, pbo, pty = proof in
+  let curi, metasenv, pbo, pty, attrs = proof in
   let (metano,context,gty) = CicUtil.lookup_meta goal metasenv in
+  let gsort,_ =
+   CicTypeChecker.type_of_aux' metasenv context gty CicUniv.oblivion_ugraph in
   match hyps_pat with
      he::(_::_ as tl) ->
        PET.apply_tactic
@@ -117,8 +119,16 @@ let rec rewrite_tac ~direction ~pattern:(wanted,hyps_pat,concl_pat) equality =
     | C.Appl [C.MutInd (uri, 0, []); ty; t1; t2]
       when LibraryObjects.is_eq_URI uri ->
         let ind_uri =
-         if_right_to_left dir2
-          LibraryObjects.eq_ind_URI LibraryObjects.eq_ind_r_URI
+         match gsort with
+            C.Sort C.Prop ->
+             if_right_to_left dir2
+              LibraryObjects.eq_ind_URI LibraryObjects.eq_ind_r_URI
+          | C.Sort C.Set ->
+             if_right_to_left dir2
+              LibraryObjects.eq_rec_URI LibraryObjects.eq_rec_r_URI
+          | _ ->
+             if_right_to_left dir2
+              LibraryObjects.eq_rect_URI LibraryObjects.eq_rect_r_URI
         in
         let eq_ind = C.Const (ind_uri uri,[]) in
          if dir2 then
@@ -184,7 +194,7 @@ let rec rewrite_tac ~direction ~pattern:(wanted,hyps_pat,concl_pat) equality =
   try 
     let (proof',goals) =
       PET.apply_tactic 
-        (tac ~term:exact_proof newtyp) ((curi,metasenv',pbo,pty),goal)
+        (tac ~term:exact_proof newtyp) ((curi,metasenv',pbo,pty, attrs),goal)
     in
     let goals =
      goals@(ProofEngineHelpers.compare_metasenvs ~oldmetasenv:metasenv
@@ -217,7 +227,7 @@ let replace_tac ~(pattern: ProofEngineTypes.lazy_pattern) ~with_what =
  let replace_tac ~(pattern: ProofEngineTypes.lazy_pattern) ~with_what status =
   let _wanted, hyps_pat, concl_pat = pattern in
   let (proof, goal) = status in
-  let uri,metasenv,pbo,pty = proof in
+  let uri,metasenv,pbo,pty, attrs = proof in
   let (_,context,ty) as conjecture = CicUtil.lookup_meta goal metasenv in
   assert (hyps_pat = []); (*CSC: not implemented yet *)
   let eq_URI =
@@ -234,7 +244,7 @@ let replace_tac ~(pattern: ProofEngineTypes.lazy_pattern) ~with_what =
   let with_what = CicMetaSubst.apply_subst subst with_what in
   let pbo = CicMetaSubst.apply_subst subst pbo in
   let pty = CicMetaSubst.apply_subst subst pty in
-  let status = (uri,metasenv,pbo,pty),goal in
+  let status = (uri,metasenv,pbo,pty, attrs),goal in
   let ty_of_with_what,u =
    CicTypeChecker.type_of_aux'
     metasenv context with_what CicUniv.empty_ugraph in
@@ -301,7 +311,7 @@ let replace_tac ~(pattern: ProofEngineTypes.lazy_pattern) ~with_what =
                     ~start:(
                       ProofEngineTypes.mk_tactic
                        (function ((proof,goal) as status) ->
-                         let _,metasenv,_,_ = proof in
+                         let _,metasenv,_,_, _ = proof in
                          let _,context,_ = CicUtil.lookup_meta goal metasenv in
                          let hyps =
                           try
@@ -330,7 +340,7 @@ let reflexivity_tac =
 
 let symmetry_tac =
  let symmetry_tac (proof, goal) =
-   let (_,metasenv,_,_) = proof in
+   let (_,metasenv,_,_, _) = proof in
     let metano,context,ty = CicUtil.lookup_meta goal metasenv in
      match (R.whd context ty) with
         (C.Appl [(C.MutInd (uri, 0, [])); _; _; _])
@@ -348,7 +358,7 @@ let symmetry_tac =
 let transitivity_tac ~term =
  let transitivity_tac ~term status =
   let (proof, goal) = status in
-   let (_,metasenv,_,_) = proof in
+   let (_,metasenv,_,_, _) = proof in
     let metano,context,ty = CicUtil.lookup_meta goal metasenv in
      match (R.whd context ty) with
         (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) 
@@ -379,7 +389,7 @@ let try_tactic ~tactic =
 let rec lift_rewrite_tac ~context ~direction ~pattern equality =
    let lift_rewrite_tac status =
       let (proof, goal) = status in
-      let (_, metasenv, _, _) = proof in
+      let (_, metasenv, _, _, _) = proof in
       let _, new_context, _ = CicUtil.lookup_meta goal metasenv in
       let n = List.length new_context - List.length context in
       let equality = if n > 0 then S.lift n equality else equality in
@@ -396,7 +406,7 @@ let subst_tac ~hyp =
    let hole = C.Implicit (Some `Hole) in
    let subst_tac status =
       let (proof, goal) = status in
-      let (_, metasenv, _, _) = proof in
+      let (_, metasenv, _, _, _) = proof in
       let _, context, _ = CicUtil.lookup_meta goal metasenv in
       let what = match PEH.get_rel context hyp with
          | Some t -> t
@@ -440,7 +450,7 @@ let subst_tac =
    in
    let subst_tac status =
       let (proof, goal) = status in
-      let (_, metasenv, _, _) = proof in
+      let (_, metasenv, _, _, _) = proof in
       let _, context, _ = CicUtil.lookup_meta goal metasenv in
       let tactics = HEL.list_rev_map_filter map context in
       PET.apply_tactic (T.seq ~tactics) status