X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2Fdeclarative.ml;h=15fdbf7254c02ebecfc1744d3e26479d5207806a;hb=4ccc7ef7fe3d43fb0f882768d2818a54e24c8857;hp=db1345344d741d48c4a432b05a95bd198d9cb283;hpb=5649890273cf8e660bba744e84ce5fee1e5efe69;p=helm.git diff --git a/helm/software/components/tactics/declarative.ml b/helm/software/components/tactics/declarative.ml index db1345344..15fdbf725 100644 --- a/helm/software/components/tactics/declarative.ml +++ b/helm/software/components/tactics/declarative.ml @@ -23,6 +23,14 @@ * http://cs.unibo.it/helm/. *) +type just = [ `Term of Cic.term | `Auto of Auto.auto_params ] + +let mk_just ~dbd ~universe = + function + `Auto params -> Tactics.auto ~dbd ~params ~universe + | `Term t -> Tactics.apply t +;; + let assume id t = Tacticals.then_ ~start: @@ -45,12 +53,8 @@ let suppose t id ty = (fun _ metasenv ugraph -> ty,metasenv,ugraph)) ;; -let by_term_we_proved ~dbd ~universe t ty id ty' = - let just = - match t with - | None -> Tactics.auto ~dbd ~params:([],[]) ~universe - | Some t -> Tactics.apply t - in +let by_just_we_proved ~dbd ~universe just ty id ty' = + let just = mk_just ~dbd ~universe just in match id with None -> (match ty' with @@ -83,13 +87,8 @@ let by_term_we_proved ~dbd ~universe t ty id ty' = ~continuations:[ Tacticals.id_tac ; continuation ] ;; -let bydone ~dbd ~universe t = - let just = - match t with - | None -> Tactics.auto ~dbd ~params:([],[]) ~universe - | Some t -> Tactics.apply t - in - just +let bydone ~dbd ~universe just = + mk_just ~dbd ~universe just ;; let we_need_to_prove t id ty = @@ -127,7 +126,7 @@ let we_need_to_prove t id ty = ProofEngineTypes.mk_tactic aux ;; -let existselim ~dbd ~universe t id1 t1 id2 t2 = +let existselim ~dbd ~universe just id1 t1 id2 t2 = let aux (proof, goal) = let (n,metasenv,_subst,bo,ty,attrs) = proof in let metano,context,_ = CicUtil.lookup_meta goal metasenv in @@ -143,21 +142,24 @@ let existselim ~dbd ~universe t id1 t1 id2 t2 = fun _ _ _ ~typ -> incr i; if !i = 1 then Cic.Name id1 else Cic.Name id2) ; - (match t with - | None -> Tactics.auto ~dbd ~params:([],[]) ~universe - | Some t -> Tactics.apply t) + (mk_just ~dbd ~universe just) ]) (proof', goal) in ProofEngineTypes.mk_tactic aux ;; -let andelim t id1 t1 id2 t2 = - Tactics.elim_intros t - ~mk_fresh_name_callback: - (let i = ref 0 in - fun _ _ _ ~typ -> - incr i; - if !i = 1 then Cic.Name id1 else Cic.Name id2) +let andelim ~dbd ~universe just id1 t1 id2 t2 = + Tacticals.thens + ~start:(Tactics.cut (Cic.Appl [Cic.MutInd (UriManager.uri_of_string "cic:/matita/logic/connectives/And.ind", 0, []); t1 ; t2])) + ~continuations: + [ Tactics.elim_intros (Cic.Rel 1) + ~mk_fresh_name_callback: + (let i = ref 0 in + fun _ _ _ ~typ -> + incr i; + if !i = 1 then Cic.Name id1 else Cic.Name id2) ; + (mk_just ~dbd ~universe just) ] +;; let rewritingstep ~dbd ~universe lhs rhs just last_step = let aux ((proof,goal) as status) = @@ -170,7 +172,7 @@ let rewritingstep ~dbd ~universe lhs rhs just last_step = Cic.MutInd (uri,0,[]), Cic.Const (LibraryObjects.trans_eq_URI ~eq:uri,[]) in let ty,_ = - CicTypeChecker.type_of_aux' metasenv context rhs CicUniv.empty_ugraph in + CicTypeChecker.type_of_aux' metasenv context rhs CicUniv.oblivion_ugraph in let just' = match just with `Auto (univ, params) ->