diff options
Diffstat (limited to 'tactics')
| -rw-r--r-- | tactics/extratactics.ml4 | 4 | ||||
| -rw-r--r-- | tactics/tactics.ml | 20 | ||||
| -rw-r--r-- | tactics/tactics.mli | 2 |
3 files changed, 26 insertions, 0 deletions
diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4 index 37498b13f0..d595bfe43e 100644 --- a/tactics/extratactics.ml4 +++ b/tactics/extratactics.ml4 @@ -505,6 +505,10 @@ TACTIC EXTEND generalize_eqs_vars | ["generalize_eqs_vars" hyp(id) ] -> [ abstract_generalize id ~generalize_vars:true ] END +TACTIC EXTEND dependent_pattern +| ["dependent_pattern" constr(c) ] -> [ dependent_pattern c ] +END + TACTIC EXTEND conv | ["conv" constr(x) constr(y) ] -> [ conv x y ] END diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 36ec22ee61..02d9544f00 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -2073,6 +2073,26 @@ let abstract_generalize id ?(generalize_vars=true) gl = tclMAP (fun id -> tclTRY (generalize_dep (mkVar id))) vars]) gl else tac gl +let dependent_pattern c gl = + let cty = pf_type_of gl c in + let deps = + match kind_of_term cty with + | App (f, args) -> Array.to_list args + | _ -> [] + in + let varname c = match kind_of_term c with + | Var id -> id + | _ -> id_of_string (hdchar (pf_env gl) c) + in + let mklambda ty (c, id, cty) = + let conclvar = subst_term_occ all_occurrences c ty in + mkNamedLambda id cty conclvar + in + let subst = (c, varname c, cty) :: List.map (fun c -> (c, varname c, pf_type_of gl c)) deps in + let concllda = List.fold_left mklambda (pf_concl gl) subst in + let conclapp = applistc concllda (List.rev_map pi1 subst) in + convert_concl_no_check conclapp DEFAULTcast gl + let occur_rel n c = let res = not (noccurn n c) in res diff --git a/tactics/tactics.mli b/tactics/tactics.mli index 58df7155e7..1ebaec3b4e 100644 --- a/tactics/tactics.mli +++ b/tactics/tactics.mli @@ -365,5 +365,7 @@ val admit_as_an_axiom : tactic val abstract_generalize : identifier -> ?generalize_vars:bool -> tactic +val dependent_pattern : constr -> tactic + val register_general_multi_rewrite : (bool -> evars_flag -> constr with_ebindings -> clause -> tactic) -> unit |
