X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FeliminationTactics.ml;h=e52fff6e4452f671c2cc6e5634c41b2e03504716;hb=3064844b2f594cfce55c0140ecb4d15e35364486;hp=15645951e29a0af9920195a60dca96ff8ce9d2ec;hpb=31851952e1cc2db59168c5fd6f6093d9bc37ea86;p=helm.git diff --git a/helm/ocaml/tactics/eliminationTactics.ml b/helm/ocaml/tactics/eliminationTactics.ml index 15645951e..e52fff6e4 100644 --- a/helm/ocaml/tactics/eliminationTactics.ml +++ b/helm/ocaml/tactics/eliminationTactics.ml @@ -27,11 +27,12 @@ (** perform debugging output? *) let debug = false +let debug_print = fun _ -> () (** debugging print *) let warn s = if debug then - prerr_endline ("DECOMPOSE: " ^ s) + debug_print ("DECOMPOSE: " ^ s) @@ -56,18 +57,19 @@ let induction_tac ~term status = ;; *) -let elim_type_tac ~term = - let elim_type_tac ~term status = +let elim_type_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) + ?depth ?using what = + let elim_type_tac 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 ]) + ~start: (P.cut_tac what) + ~continuations:[ P.elim_intros_simpl_tac ?depth ?using ~mk_fresh_name_callback (C.Rel 1) ; T.id_tac ]) status in - ProofEngineTypes.mk_tactic (elim_type_tac ~term) + ProofEngineTypes.mk_tactic elim_type_tac ;; @@ -106,7 +108,7 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term = | (C.Appl ((C.MutInd (uri,typeno,exp_named_subst))::applist)) (* when (not (List.mem (uri,typeno,exp_named_subst) urilist)) *) -> (uri,typeno,exp_named_subst)::(List.fold_left search_inductive_types urilist applist) | _ -> urilist - (* N.B: in un caso tipo (and A !C:Prop.(or B C)) l'or *non* viene selezionato! *) + (* N.B: in un caso tipo (and A forall C:Prop.(or B C)) l'or *non* viene selezionato! *) in let rec purge_duplicates urilist = let rec aux triple urilist = @@ -147,7 +149,7 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term = warn ("elim " ^ CicPp.ppterm termty); ProofEngineTypes.apply_tactic (T.then_ - ~start:(P.elim_intros_simpl_tac ~term:term') + ~start:(P.elim_intros_simpl_tac term') ~continuation:( (* clear the hyp that has just been eliminated *) ProofEngineTypes.mk_tactic (fun status -> @@ -157,12 +159,18 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term = 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 + let hyp_name = + match List.nth context new_nr_of_hyp_still_to_elim with + None + | Some (Cic.Anonymous,_) -> assert false + | Some (Cic.Name name,_) -> name + in 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) + then begin debug_print ("%%%%%%% no clear"); T.id_tac end + else begin debug_print ("%%%%%%% clear " ^ (string_of_int (new_nr_of_hyp_still_to_elim))); (S.clear ~hyp:hyp_name) end) ~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 )))