X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FvariousTactics.ml;h=927552f0a60219c558dc35a38368541f90586ed7;hb=97c2d258a5c524eb5c4b85208899d80751a2c82f;hp=1f2e6b13c9bd312db7ec309b2d88cf1b045533c2;hpb=bb19a912c9d3d470163e88722e3abbd548b8bdb9;p=helm.git diff --git a/helm/ocaml/tactics/variousTactics.ml b/helm/ocaml/tactics/variousTactics.ml index 1f2e6b13c..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 @@ -94,17 +94,35 @@ let generalize_tac let term = match term with None -> None - | Some term -> Some (CicMetaSubst.apply_subst subst term) in - let u,typ,term = - match terms_with_context, term with - [], None -> - raise UnableToDetectTheTermThatMustBeGeneralizedYouMustGiveItExplicitly - | _, Some term - | (_,term)::_, None -> - let typ,u = - CicTypeChecker.type_of_aux' ~subst metasenv context term u - in - u,typ,term + | 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; @@ -118,15 +136,17 @@ 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 ~subst context term t u in if not b then