src/Tools/cong_tac.ML
author wenzelm
Fri, 20 Mar 2015 14:48:04 +0100
changeset 59763 56d2c357e6b5
parent 59642 929984c529d3
child 60784 4f590c08fd5d
permissions -rw-r--r--
tuned signature;

(*  Title:      Tools/cong_tac.ML
    Author:     Stefan Berghofer, TU Muenchen

Congruence tactic based on explicit instantiation.
*)

signature CONG_TAC =
sig
  val cong_tac: Proof.context -> thm -> int -> tactic
end;

structure Cong_Tac: CONG_TAC =
struct

fun cong_tac ctxt cong = CSUBGOAL (fn (cgoal, i) =>
  let
    val goal = Thm.term_of cgoal;
  in
    (case Logic.strip_assums_concl goal of
      _ $ (_ $ (f $ x) $ (g $ y)) =>
        let
          val cong' = Thm.lift_rule cgoal cong;
          val _ $ (_ $ (f' $ x') $ (g' $ y')) = Logic.strip_assums_concl (Thm.prop_of cong');
          val ps = Logic.strip_params (Thm.concl_of cong');
          val insts =
            [(f', f), (g', g), (x', x), (y', y)]
            |> map (fn (t, u) => apply2 (Thm.cterm_of ctxt) (Term.head_of t, fold_rev Term.abs ps u));
        in
          fn st =>
            compose_tac ctxt (false, Drule.cterm_instantiate insts cong', 2) i st
              handle THM _ => no_tac st
        end
    | _ => no_tac)
  end);

end;