X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=components%2Ftactics%2Fdeclarative.ml;h=4a7d3e52c6329263d838cf063b6aa9020743d051;hb=2499f5fdcf4dbfecc6f4fafe925b24ae76f14be8;hp=370e326dbcd2f76fcda3efe06593f46e2ef0944c;hpb=27ebdab06ba308c431669b58a46fc0bb12c8c72e;p=helm.git diff --git a/components/tactics/declarative.ml b/components/tactics/declarative.ml index 370e326db..4a7d3e52c 100644 --- a/components/tactics/declarative.ml +++ b/components/tactics/declarative.ml @@ -45,30 +45,33 @@ let suppose t id ty = (fun _ metasenv ugraph -> ty,metasenv,ugraph)) ;; -let by_term_we_proved t ty id ty' = - match t with - None -> assert false - | Some t -> - let continuation = - match ty' with - None -> Tacticals.id_tac - | Some ty' -> - Tactics.change ~pattern:(None,[id,Cic.Implicit (Some `Hole)],None) - (fun _ metasenv ugraph -> ty,metasenv,ugraph) - in - Tacticals.thens - ~start: - (Tactics.cut ty - ~mk_fresh_name_callback:(fun _ _ _ ~typ -> Cic.Name id)) - ~continuations: - [ continuation ; Tactics.apply t ] +let by_term_we_proved ~dbd t ty id ty' = + let just = + match t with + None -> Tactics.auto ~dbd ~params:[] + | Some t -> Tactics.apply t + in + let continuation = + match ty' with + None -> Tacticals.id_tac + | Some ty' -> + Tactics.change ~pattern:(None,[id,Cic.Implicit (Some `Hole)],None) + (fun _ metasenv ugraph -> ty,metasenv,ugraph) + in + Tacticals.thens + ~start: + (Tactics.cut ty + ~mk_fresh_name_callback:(fun _ _ _ ~typ -> Cic.Name id)) + ~continuations:[ continuation ; just ] ;; -let bydone t = - match t with - None -> assert false - | Some t -> - (Tactics.apply ~term:t) +let bydone ~dbd t = + let just = + match t with + None -> Tactics.auto ~dbd ~params:[] + | Some t -> Tactics.apply t + in + just ;; let we_need_to_prove t id ty = @@ -111,13 +114,13 @@ let existselim t id1 t1 id2 t2 = let andelim = existselim;; -let rewritingstep lhs rhs just conclude = +let rewritingstep ~dbd lhs rhs just conclude = let aux ((proof,goal) as status) = let (curi,metasenv,proofbo,proofty) = proof in let _,context,_ = CicUtil.lookup_meta goal metasenv in let eq,trans = match LibraryObjects.eq_URI () with - None -> assert false (*TODO*) + None -> raise (ProofEngineTypes.Fail (lazy "You need to register the default equality first. Please use the \"default\" command")) | Some uri -> Cic.MutInd (uri,0,[]), Cic.Const (LibraryObjects.trans_eq_URI ~eq:uri,[]) in @@ -125,8 +128,10 @@ let rewritingstep lhs rhs just conclude = CicTypeChecker.type_of_aux' metasenv context rhs CicUniv.empty_ugraph in let just = match just with - None -> assert false (*TOOD*) - | Some just -> just + None -> + Tactics.auto ~dbd + ~params:["paramodulation","on"; "timeout","3"] + | Some just -> Tactics.apply just in match lhs with None -> @@ -151,7 +156,7 @@ let rewritingstep lhs rhs just conclude = ~continuations: [ Tactics.apply prhs ; Tactics.apply (Cic.Rel 1) ; - Tactics.apply just]) status + just]) status | Some name -> let mk_fresh_name_callback = fun metasenv context _ ~typ -> @@ -169,11 +174,11 @@ let rewritingstep lhs rhs just conclude = ~continuations: [ Tactics.apply prhs ; Tactics.apply (Cic.Rel 1) ; - Tactics.apply just] + just] ]) status) | Some lhs -> match conclude with - None -> ProofEngineTypes.apply_tactic (Tactics.apply just) status + None -> ProofEngineTypes.apply_tactic just status | Some name -> let mk_fresh_name_callback = fun metasenv context _ ~typ -> @@ -185,7 +190,7 @@ let rewritingstep lhs rhs just conclude = ~start: (Tactics.cut ~mk_fresh_name_callback (Cic.Appl [eq ; ty ; lhs ; rhs])) - ~continuations:[ Tacticals.id_tac ; Tactics.apply just ]) status + ~continuations:[ Tacticals.id_tac ; just ]) status in ProofEngineTypes.mk_tactic aux ;;