X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FeliminationTactics.ml;h=1db11951fed63c9ac2383026412d9e859afe776a;hb=3bb4ce11fb9d4c6375483a80344beb94c4517dd7;hp=29aa1c4f1ed5157aea052a7f37f34946232745ce;hpb=a6fc115fd7d4cfba94a43f001f4c27322d3db1a8;p=helm.git diff --git a/helm/ocaml/tactics/eliminationTactics.ml b/helm/ocaml/tactics/eliminationTactics.ml index 29aa1c4f1..1db11951f 100644 --- a/helm/ocaml/tactics/eliminationTactics.ml +++ b/helm/ocaml/tactics/eliminationTactics.ml @@ -56,15 +56,18 @@ let induction_tac ~term status = ;; *) - -let elim_type_tac ~term status = - let module C = Cic in - let module P = PrimitiveTactics in - let module T = Tacticals in - T.thens - ~start: (P.cut_tac term) - ~continuations:[ P.elim_intros_simpl_tac ~term:(C.Rel 1) ; T.id_tac ] - status +let elim_type_tac ~term = + let elim_type_tac ~term status = + let module C = Cic in + let module P = PrimitiveTactics in + let module T = Tacticals in + ProofEngineTypes.apply_tactic + (T.thens + ~start: (P.cut_tac term) + ~continuations:[ P.elim_intros_simpl_tac ~term:(C.Rel 1) ; T.id_tac ]) + status + in + ProofEngineTypes.mk_tactic (elim_type_tac ~term) ;; @@ -131,7 +134,8 @@ let call_back uris = ;; *) -let decompose_tac ?(uris_choice_callback=(function l -> l)) term status = +let decompose_tac ?(uris_choice_callback=(function l -> l)) term = + let decompose_tac uris_choice_callback term status = let (proof, goal) = status in let module C = Cic in let module R = CicReduction in @@ -190,35 +194,39 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term status = | C.Appl((C.MutInd (uri,typeno,exp_named_subst))::_) when (List.mem (uri,typeno,exp_named_subst) urilist) -> warn ("elim " ^ CicPp.ppterm termty); - T.then_ + ProofEngineTypes.apply_tactic + (T.then_ ~start:(P.elim_intros_simpl_tac ~term:term') ~continuation:( (* clear the hyp that has just been eliminated *) - (fun status -> + ProofEngineTypes.mk_tactic (fun status -> let (proof, goal) = status in let _,metasenv,_,_ = proof in let _,context,_ = CicUtil.lookup_meta goal metasenv in let new_context_len = List.length context in warn ("newcon=" ^ (string_of_int new_context_len) ^ " & oldcon=" ^ (string_of_int old_context_len) ^ " & old_nr_of_hyp=" ^ (string_of_int nr_of_hyp_still_to_elim)); let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim + (new_context_len - old_context_len) - 1 in - T.then_ + ProofEngineTypes.apply_tactic + (T.then_ ~start:( if (term'==term) (* if it's the first application of elim, there's no need to clear the hyp *) then begin prerr_endline ("%%%%%%% no clear"); T.id_tac end else begin prerr_endline ("%%%%%%% clear " ^ (string_of_int (new_nr_of_hyp_still_to_elim))); (S.clear ~hyp:(List.nth context (new_nr_of_hyp_still_to_elim))) end) - ~continuation:(elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim) + ~continuation:(ProofEngineTypes.mk_tactic (elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim))) status - )) + ))) status | _ -> let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim - 1 in warn ("fail; hyp=" ^ (string_of_int new_nr_of_hyp_still_to_elim)); elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim status else (* no hyp to elim left in this goal *) - T.id_tac status + ProofEngineTypes.apply_tactic T.id_tac status in elim_clear_tac ~term':term ~nr_of_hyp_still_to_elim:1 status + in + ProofEngineTypes.mk_tactic (decompose_tac uris_choice_callback term) ;;