X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FeliminationTactics.ml;h=29aa1c4f1ed5157aea052a7f37f34946232745ce;hb=a6fc115fd7d4cfba94a43f001f4c27322d3db1a8;hp=cd401a2ec94cdaa66a0200c3bb516907b9ef3460;hpb=d651bf2e3d560e194fbe948dd950dd600a40eab6;p=helm.git diff --git a/helm/ocaml/tactics/eliminationTactics.ml b/helm/ocaml/tactics/eliminationTactics.ml index cd401a2ec..29aa1c4f1 100644 --- a/helm/ocaml/tactics/eliminationTactics.ml +++ b/helm/ocaml/tactics/eliminationTactics.ml @@ -36,7 +36,8 @@ let warn s = (* -let induction_tac ~term ~status:((proof,goal) as status) = +let induction_tac ~term status = + let (proof, goal) = status in let module C = Cic in let module R = CicReduction in let module P = PrimitiveTactics in @@ -51,19 +52,19 @@ let induction_tac ~term ~status:((proof,goal) as status) = ~tactic:(T.then_ ~start:(VariousTactics.generalize_tac ~term) (* chissa' se cosi' funziona? *) ~continuation:(P.intros)) ~continuation:(P.elim_intros_simpl ~term) - ~status + status ;; *) -let elim_type_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 + status ;; @@ -130,7 +131,8 @@ let call_back uris = ;; *) -let decompose_tac ?(uris_choice_callback=(function l -> l)) term ~status:((proof,goal) as status) = +let decompose_tac ?(uris_choice_callback=(function l -> l)) term status = + let (proof, goal) = status in let module C = Cic in let module R = CicReduction in let module P = PrimitiveTactics in @@ -174,7 +176,8 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term ~status:((proof (* N.B.: due to a bug in uris_choice_callback exp_named_subst are not significant (they all are []) *) uris_choice_callback (make_list termty) in - let rec elim_clear_tac ~term' ~nr_of_hyp_still_to_elim ~status:((proof,goal) as status) = + let rec elim_clear_tac ~term' ~nr_of_hyp_still_to_elim status = + let (proof, goal) = status in warn ("nr_of_hyp_still_to_elim=" ^ (string_of_int nr_of_hyp_still_to_elim)); if nr_of_hyp_still_to_elim <> 0 then let _,metasenv,_,_ = proof in @@ -191,7 +194,8 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term ~status:((proof ~start:(P.elim_intros_simpl_tac ~term:term') ~continuation:( (* clear the hyp that has just been eliminated *) - (fun ~status:((proof,goal) as status) -> + (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 @@ -203,18 +207,18 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term ~status:((proof 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) - ~status + status )) - ~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 + 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 + T.id_tac status in - elim_clear_tac ~term':term ~nr_of_hyp_still_to_elim:1 ~status + elim_clear_tac ~term':term ~nr_of_hyp_still_to_elim:1 status ;;