X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Ftactics%2FproofEngineHelpers.ml;h=b38512273081907ab6cff86c16cd56f35be304a1;hb=42f2dc48b4fef5b404f406bf512d6a0cde35c067;hp=ec2e1919c456bf2f807c865d3f5e5cff8b48d2d1;hpb=ad55bb9bc450fbccc969bca52602a6572217d565;p=helm.git diff --git a/components/tactics/proofEngineHelpers.ml b/components/tactics/proofEngineHelpers.ml index ec2e1919c..b38512273 100644 --- a/components/tactics/proofEngineHelpers.ml +++ b/components/tactics/proofEngineHelpers.ml @@ -363,25 +363,25 @@ let pattern_of ?(equality=(==)) ~term terms = if b1||b2 then true,Cic.Cast (te, ty) else not_found - | Cic.Prod (name, s, t) -> + | Cic.Prod (_, s, t) -> let b1,s = aux s in let b2,t = aux t in if b1||b2 then - true, Cic.Prod (name, s, t) + true, Cic.Prod (Cic.Anonymous, s, t) else not_found - | Cic.Lambda (name, s, t) -> + | Cic.Lambda (_, s, t) -> let b1,s = aux s in let b2,t = aux t in if b1||b2 then - true, Cic.Lambda (name, s, t) + true, Cic.Lambda (Cic.Anonymous, s, t) else not_found - | Cic.LetIn (name, s, t) -> + | Cic.LetIn (_, s, t) -> let b1,s = aux s in let b2,t = aux t in if b1||b2 then - true, Cic.LetIn (name, s, t) + true, Cic.LetIn (Cic.Anonymous, s, t) else not_found | Cic.Appl terms -> @@ -486,17 +486,33 @@ exception Fail of string Lazy.t let find_pattern_for name = try Some (snd (List.find (fun (n, pat) -> Cic.Name n = name) hyp_patterns)) with Not_found -> None in + (* Multiple hypotheses with the same name can be in the context. + In this case we need to pick the last one, but we will perform + a fold_right on the context. Thus we pre-process hyp_patterns. *) + let full_hyp_pattern = + let rec aux blacklist = + function + [] -> [] + | None::tl -> None::aux blacklist tl + | Some (name,_)::tl -> + if List.mem name blacklist then + None::aux blacklist tl + else + find_pattern_for name::aux (name::blacklist) tl + in + aux [] context + in let subst,metasenv,ugraph,ty_terms = select_in_term ~metasenv ~context ~ugraph ~term:ty ~pattern:(what,goal_pattern) in let subst,metasenv,ugraph,context_terms = let subst,metasenv,ugraph,res,_ = (List.fold_right - (fun entry (subst,metasenv,ugraph,res,context) -> + (fun (pattern,entry) (subst,metasenv,ugraph,res,context) -> match entry with - None -> subst,metasenv,ugraph,(None::res),(None::context) + None -> subst,metasenv,ugraph,None::res,None::context | Some (name,Cic.Decl term) -> - (match find_pattern_for name with + (match pattern with | None -> subst,metasenv,ugraph,((Some (`Decl []))::res),(entry::context) | Some pat -> @@ -507,7 +523,7 @@ exception Fail of string Lazy.t subst,metasenv,ugraph,((Some (`Decl terms))::res), (entry::context)) | Some (name,Cic.Def (bo, ty)) -> - (match find_pattern_for name with + (match pattern with | None -> let selected_ty=match ty with None -> None | Some _ -> Some [] in subst,metasenv,ugraph,((Some (`Def ([],selected_ty)))::res), @@ -528,7 +544,7 @@ exception Fail of string Lazy.t in subst,metasenv,ugraph,((Some (`Def (terms_bo,terms_ty)))::res), (entry::context)) - ) context (subst,metasenv,ugraph,[],[])) + ) (List.combine full_hyp_pattern context) (subst,metasenv,ugraph,[],[])) in subst,metasenv,ugraph,res in @@ -690,4 +706,3 @@ let relations_of_menv m c = let sort_metasenv (m : Cic.metasenv) = (MS.topological_sort m (relations_of_menv m) : Cic.metasenv) ;; -