X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FequalityTactics.ml;h=ac28f9a28e225d36c1dff3f9328d916bef36f250;hb=b38de2d3fa8bbe346c59c18bbeb889f29e493f63;hp=1c2a7d37fb1a83fc9e15cfc9ec989088a9af57f5;hpb=0583c44e19ee683efab796bf21904bbfc64fbf1e;p=helm.git diff --git a/helm/ocaml/tactics/equalityTactics.ml b/helm/ocaml/tactics/equalityTactics.ml index 1c2a7d37f..ac28f9a28 100644 --- a/helm/ocaml/tactics/equalityTactics.ml +++ b/helm/ocaml/tactics/equalityTactics.ml @@ -28,7 +28,7 @@ let rewrite_tac ~term:equality ~status:(proof,goal) = let module C = Cic in let module U = UriManager in let curi,metasenv,pbo,pty = proof in - let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in + let metano,context,gty = CicUtil.lookup_meta goal metasenv in let eq_ind_r,ty,t1,t2 = match CicTypeChecker.type_of_aux' metasenv context equality with C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2] @@ -59,11 +59,11 @@ let rewrite_tac ~term:equality ~status:(proof,goal) = ~what:[t1'] ~with_what:[C.Rel 1] ~where:gty' in C.Lambda - (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'') + (FreshNamesGenerator.mk_fresh_name metasenv context C.Anonymous ty, + ty, gty'') in - let fresh_meta = ProofEngineHelpers.new_meta proof in - let irl = - ProofEngineHelpers.identity_relocation_list_for_metavariable context in + let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in + let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in let (proof',goals) = @@ -90,7 +90,7 @@ let rewrite_back_tac ~term:equality ~status:(proof,goal) = let module C = Cic in let module U = UriManager in let curi,metasenv,pbo,pty = proof in - let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in + let metano,context,gty = CicUtil.lookup_meta goal metasenv in let eq_ind_r,ty,t1,t2 = match CicTypeChecker.type_of_aux' metasenv context equality with C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2] @@ -121,11 +121,12 @@ let rewrite_back_tac ~term:equality ~status:(proof,goal) = ~what:[t1'] ~with_what:[C.Rel 1] ~where:gty' in C.Lambda - (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'') + (FreshNamesGenerator.mk_fresh_name metasenv context C.Anonymous ty, + ty, gty'') in - let fresh_meta = ProofEngineHelpers.new_meta proof in + let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in let irl = - ProofEngineHelpers.identity_relocation_list_for_metavariable context in + CicMkImplicit.identity_relocation_list_for_metavariable context in let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in let (proof',goals) = @@ -155,7 +156,7 @@ let replace_tac ~what ~with_what ~status:((proof, goal) as status) = let module P = PrimitiveTactics in let module T = Tacticals in let _,metasenv,_,_ = proof in - let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in + let _,context,_ = CicUtil.lookup_meta goal metasenv in let wty = CicTypeChecker.type_of_aux' metasenv context what in try if (wty = (CicTypeChecker.type_of_aux' metasenv context with_what)) @@ -164,6 +165,7 @@ let replace_tac ~what ~with_what ~status:((proof, goal) as status) = match CicTypeChecker.type_of_aux' metasenv context wty with C.Sort C.Set -> "cic:/Coq/Init/Logic/eq.ind" | C.Sort C.Type + | C.Sort C.CProp | C.Sort C.Prop -> "cic:/Coq/Init/Logic_Type/eqT.ind" | _ -> assert false in @@ -200,7 +202,7 @@ let symmetry_tac ~status:(proof, goal) = let module R = CicReduction in let module U = UriManager in let (_,metasenv,_,_) = proof in - let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in + let metano,context,ty = CicUtil.lookup_meta goal metasenv in match (R.whd context ty) with (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) -> PrimitiveTactics.apply_tac ~status:(proof,goal) @@ -220,7 +222,7 @@ let transitivity_tac ~term ~status:((proof, goal) as status) = let module U = UriManager in let module T = Tacticals in let (_,metasenv,_,_) = proof in - let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in + let metano,context,ty = CicUtil.lookup_meta goal metasenv in match (R.whd context ty) with (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) -> T.thens