X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FvariousTactics.ml;h=927552f0a60219c558dc35a38368541f90586ed7;hb=97c2d258a5c524eb5c4b85208899d80751a2c82f;hp=e2003f48d4ab1b2b437393245b5b3aa8d9fa4476;hpb=974e4dee51a81052677792c3ee242ee3396c2d8b;p=helm.git diff --git a/helm/ocaml/tactics/variousTactics.ml b/helm/ocaml/tactics/variousTactics.ml index e2003f48d..927552f0a 100644 --- a/helm/ocaml/tactics/variousTactics.ml +++ b/helm/ocaml/tactics/variousTactics.ml @@ -55,7 +55,7 @@ let assumption_tac = if b then n else find (n+1) tl | _ -> find (n+1) tl ) - | [] -> raise (PET.Fail "Assumption: No such assumption") + | [] -> raise (PET.Fail (lazy "Assumption: No such assumption")) in PET.apply_tactic (PT.apply_tac ~term:(C.Rel (find 1 context))) status in PET.mk_tactic assumption_tac @@ -81,20 +81,49 @@ let generalize_tac let module C = Cic in let module P = PrimitiveTactics in let module T = Tacticals in - let _,metasenv,_,_ = proof in + let uri,metasenv,pbo,pty = proof in let (_,context,ty) as conjecture = CicUtil.lookup_meta goal metasenv in - let selected_hyps,terms_with_context = - ProofEngineHelpers.select ~metasenv ~conjecture ~pattern in - let typ,term = - match terms_with_context, term with - [], None -> - raise UnableToDetectTheTermThatMustBeGeneralizedYouMustGiveItExplicitly - | _, Some term - | (_,term)::_, None -> - fst - (CicTypeChecker.type_of_aux' metasenv context term - CicUniv.empty_ugraph), - term in + let subst,metasenv,u,selected_hyps,terms_with_context = + ProofEngineHelpers.select ~metasenv ~ugraph:CicUniv.empty_ugraph + ~conjecture ~pattern in + let context = CicMetaSubst.apply_subst_context subst context in + let metasenv = CicMetaSubst.apply_subst_metasenv subst metasenv 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 term = + match term with + None -> None + | Some term -> + Some (fun context metasenv ugraph -> + let term, metasenv, ugraph = term context metasenv ugraph in + CicMetaSubst.apply_subst subst term, metasenv, ugraph) + in + let u,typ,term, metasenv = + let context_of_t, (t, metasenv, u) = + match terms_with_context, term with + [], None -> + raise + UnableToDetectTheTermThatMustBeGeneralizedYouMustGiveItExplicitly + | [], Some t -> context, t context metasenv u + | (context_of_t, _)::_, Some t -> + context_of_t, t context_of_t metasenv u + | (context_of_t, t)::_, None -> context_of_t, (t, metasenv, u) + in + let t,subst,metasenv' = + try + CicMetaSubst.delift_rels [] metasenv + (List.length context_of_t - List.length context) t + with + CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable -> + raise TheSelectedTermsMustLiveInTheGoalContext in + (*CSC: I am not sure about the following two assertions; + maybe I need to propagate the new subst and metasenv *) + assert (subst = []); + assert (metasenv' = metasenv); + let typ,u = CicTypeChecker.type_of_aux' ~subst metasenv context t u in + u,typ,t,metasenv + in (* We need to check: 1. whether they live in the context of the goal; if they do they are also well-typed since they are closed subterms @@ -107,22 +136,24 @@ let generalize_tac List.fold_left (fun u (context_of_t,t) -> (* 1 *) - begin + let t,subst,metasenv' = try - ignore - (CicMetaSubst.delift_rels [] metasenv - (List.length context_of_t - List.length context) t) + CicMetaSubst.delift_rels [] metasenv + (List.length context_of_t - List.length context) t with CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable -> - raise TheSelectedTermsMustLiveInTheGoalContext - end; + raise TheSelectedTermsMustLiveInTheGoalContext in + (*CSC: I am not sure about the following two assertions; + maybe I need to propagate the new subst and metasenv *) + assert (subst = []); + assert (metasenv' = metasenv); (* 2 *) - let b,u1 = CicReduction.are_convertible context term t u in + let b,u1 = CicReduction.are_convertible ~subst context term t u in if not b then raise AllSelectedTermsMustBeConvertible else u1 - ) CicUniv.empty_ugraph terms_with_context) ; + ) u terms_with_context) ; PET.apply_tactic (T.thens ~start: