X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2FequalityTactics.ml;h=f2760c30f33f394daded905bc246cc63446e7321;hb=ea651f11cbc6edb17e8d0d16c239e0cf3f526959;hp=89da5c9fdc12b329b25ea35b0a70f64525d1474e;hpb=5f00ef380aafdaae93a40a3a47491d43ec9c3a62;p=helm.git diff --git a/helm/software/components/tactics/equalityTactics.ml b/helm/software/components/tactics/equalityTactics.ml index 89da5c9fd..f2760c30f 100644 --- 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