X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Ftactics%2Fdeclarative.ml;h=b0615edb36c728415c5a03e8926278f03c3006a3;hb=78ed249d75b6b65847e4739dabf7c18b8288c7d8;hp=189cd9079b4fd429a330948cbb535b720a3a8593;hpb=63f876b112e1be016e8063e6a00ec47f841ee615;p=helm.git diff --git a/components/tactics/declarative.ml b/components/tactics/declarative.ml index 189cd9079..b0615edb3 100644 --- a/components/tactics/declarative.ml +++ b/components/tactics/declarative.ml @@ -123,16 +123,15 @@ let we_need_to_prove t id ty = let existselim ~dbd ~universe t id1 t1 id2 t2 = let aux (proof, goal) = - let (n,metasenv,bo,ty,attrs) = proof in + let (n,metasenv,_subst,bo,ty,attrs) = proof in let metano,context,_ = CicUtil.lookup_meta goal metasenv in let t2, metasenv, _ = t2 (Some (Cic.Name id1, Cic.Decl t1) :: context) metasenv CicUniv.oblivion_ugraph in - let proof' = (n,metasenv,bo,ty,attrs) in - let pattern = ProofEngineTypes.conclusion_pattern (Some (Cic.Rel 1)) in + let proof' = (n,metasenv,_subst,bo,ty,attrs) in ProofEngineTypes.apply_tactic ( Tacticals.thens ~start:(Tactics.cut (Cic.Appl [Cic.MutInd (UriManager.uri_of_string "cic:/matita/logic/connectives/ex.ind", 0, []); t1 ; Cic.Lambda (Cic.Name id1, t1, t2)])) ~continuations: - [ Tactics.elim_intros pattern + [ Tactics.elim_intros (Cic.Rel 1) ~mk_fresh_name_callback: (let i = ref 0 in fun _ _ _ ~typ -> @@ -147,7 +146,7 @@ let existselim ~dbd ~universe t id1 t1 id2 t2 = ;; let andelim t id1 t1 id2 t2 = - Tactics.elim_intros (ProofEngineTypes.conclusion_pattern (Some t)) + Tactics.elim_intros t ~mk_fresh_name_callback: (let i = ref 0 in fun _ _ _ ~typ -> @@ -156,7 +155,7 @@ let andelim t id1 t1 id2 t2 = let rewritingstep ~dbd ~universe lhs rhs just last_step = let aux ((proof,goal) as status) = - let (curi,metasenv,proofbo,proofty, attrs) = proof in + let (curi,metasenv,_subst,proofbo,proofty, attrs) = proof in let _,context,gty = CicUtil.lookup_meta goal metasenv in let eq,trans = match LibraryObjects.eq_URI () with @@ -169,17 +168,33 @@ let rewritingstep ~dbd ~universe lhs rhs just last_step = let just = match just with `Auto params -> - let params = - if not (List.exists (fun (k,_) -> k = "paramodulation") params) then - ("paramodulation","1")::params - else params in let params = if not (List.exists (fun (k,_) -> k = "timeout") params) then ("timeout","3")::params else params in - Tactics.auto ~dbd ~params ~universe - | `Term just -> Tactics.apply just + let params' = + if not (List.exists (fun (k,_) -> k = "paramodulation") params) then + ("paramodulation","1")::params + else params + in + if params = params' then + Tactics.auto ~dbd ~params ~universe + else + Tacticals.first + [Tactics.auto ~dbd ~params ~universe ; + Tactics.auto ~dbd ~params:params' ~universe] + | `Term just -> + let ty,_ = + CicTypeChecker.type_of_aux' metasenv context just + CicUniv.empty_ugraph + in + Tactics.solve_rewrite + ~universe:(Universe.index Universe.empty + (Universe.key ty) just) ~steps:1 () + (* Tactics.apply just *) + | `Proof -> + Tacticals.id_tac in let plhs,prhs,prepare = match lhs with @@ -216,7 +231,7 @@ let rewritingstep ~dbd ~universe lhs rhs just last_step = FreshNamesGenerator.mk_fresh_name ~subst:[] metasenv context (Cic.Name name) ~typ in - let proof = curi,metasenv,proofbo,proofty, attrs in + let proof = curi,metasenv,_subst,proofbo,proofty, attrs in let proof,goals = ProofEngineTypes.apply_tactic (Tacticals.thens @@ -251,8 +266,8 @@ let we_proceed_by_cases_on t pat = ;; let we_proceed_by_induction_on t pat = - let pattern = Some (fun c m u -> t, m, u), [], Some pat in - Tactics.elim_intros ~depth:0 pattern + let pattern = None, [], Some pat in + Tactics.elim_intros ~depth:0 (*~pattern*) t ;; let case id ~params =