theory Ex

imports Main

begin

text {*

  An example of an apply-proof and the

  corresponding ML-code.

*}

lemma disj_swap: 

  shows "P \<or> Q \<Longrightarrow> Q \<or> P"

apply(erule disjE)

apply(rule disjI2)

apply(assumption)

apply(rule disjI1)

apply(assumption)

done

ML {*

let

  val ctxt  = @{context}

  val goal  = @{prop "P \<or> Q \<Longrightarrow> Q \<or> P"}

  val facts = []

  val schms  = ["P", "Q"]

in

  Goal.prove ctxt schms facts goal

   (fn _ =>

      etac @{thm disjE} 1

      THEN rtac @{thm disjI2} 1

      THEN atac 1

      THEN rtac @{thm disjI1} 1

      THEN atac 1)

end

*}

text {*  

  Tactics coded in ML can be applied / tried out in 

  apply-scripts using "tactic". "THEN" is a tactic

  combinator that just strings tactics together.

  Tactic combinators are also called tacticals.

*}

ML {*

val foo_tac =

      (etac @{thm disjE} 1

       THEN rtac @{thm disjI2} 1

       THEN atac 1

       THEN rtac @{thm disjI1} 1

       THEN atac 1)

*}

lemma 

  shows "P \<or> Q \<Longrightarrow> Q \<or> P"

apply(tactic {* foo_tac *})

done

text {* 

  Coding tactics with explicit subgoal addressing

  is quite brittle and limits the usage of the tactics.

  This can be avoided using the `primed' versions

  of the tactic comibinators.

*}

ML {*

val foo_tac' =

      (etac @{thm disjE}

       THEN' rtac @{thm disjI2}

       THEN' atac

       THEN' rtac @{thm disjI1}

       THEN' atac)

*}

text {*

  Now the tactic can be used on any subgoal.

*}

lemma "P1 \<or> Q1 \<Longrightarrow> Q1 \<or> P1"

  and "P2 \<or> Q2 \<Longrightarrow> Q2 \<or> P2"

apply(tactic {* foo_tac' 2 *})

apply(tactic {* foo_tac' 1 *})

done

text {* 

  The type of a tactic is from a theorem

  to a lazy sequence of (successor) theorems.

  type tactic = thm -> thm Seq.seq 

  The simplest tactics are no_tac (always

  fails) and all_tac (always succeds, but 

  does not make any progress.

*}

ML {* fun no_tac thm = Seq.empty *}

ML {* fun all_tac thm = Seq.single thm *}

text {*

  The lazy sequence can be explored using

  "back".

*}

lemma "\<lbrakk>P \<or> Q; P \<or> Q\<rbrakk> \<Longrightarrow> Q \<or> P"

apply(tactic {* foo_tac' 1 *})

back

done

text {* 

  It might be surprising that a goalstate of

  an "unfinished" proof is a theorem. Below

  we show the internals.

  In general a goalstate is of the form

  A1 \<dots> An \<Longrightarrow> #C

  where the Ai are the open subgoals and C

  is the theorem to be proved, protected by

  the constant prop. This constant is usually

  not visible.

*}

ML {*

fun my_print_tac ctxt thm =

let

   val _ = tracing (Syntax.string_of_term ctxt (prop_of thm))

in

   Seq.single thm

end

*}

notation (output) "prop" ("#_" [1000] 1000)

lemma shows "\<lbrakk>A; B\<rbrakk> \<Longrightarrow> A \<and> B"

apply(tactic {* my_print_tac @{context} *})

apply(rule conjI)

apply(tactic {* my_print_tac @{context} *})

apply(assumption)

apply(tactic {* my_print_tac @{context} *})

apply(assumption)

apply(tactic {* my_print_tac @{context} *})

done

notation (output) "prop" ("_" [1000] 1000)

text {* 

  There are some simple tactics corresponding

  to rule, erule and drule (from apply scripts).

  The examples should be self-explanatory.

*}

lemma shows "P \<Longrightarrow> P"

apply(tactic {* atac 1 *})

oops

lemma shows "P \<and> Q"

apply(tactic {* resolve_tac [@{thm conjI}] 1 *})

oops

lemma shows "P \<and> Q \<Longrightarrow> False"

apply(tactic {* eresolve_tac [@{thm conjE}] 1 *})

oops

lemma shows "False \<and> True \<Longrightarrow> False"

apply(tactic {* dresolve_tac [@{thm conjunct2}] 1 *})

oops

text {*

  For all sorts of operations on the goalstate there

  is a corresponding tactic. The following corresponds

  to "insert".

*}

lemma shows "True = False"

apply(tactic {* cut_facts_tac [@{thm True_def}, @{thm False_def}] 1 *})

oops

text {* 

  Because of schematic variables, theorems need often

  to be pre-instantiated.  

*}

lemma shows "\<forall>x \<in> A. P x \<Longrightarrow> Q x"

apply(tactic {* dresolve_tac [@{thm bspec}] 1 *})

oops

ML {* @{thm disjI1} RS @{thm conjI} *}

text {*

  Tactic combinators: every tactic (THEN),

  first applicable tactic (ORELSE).

*}

ML {*

val foo_tac' = 

  EVERY' [etac @{thm disjE}, 

          rtac @{thm disjI2},

          atac, 

          rtac @{thm disjI1}, 

          atac]

*}

ML {*

val select_tac = 

  FIRST' [rtac @{thm conjI}, 

          rtac @{thm impI},

          rtac @{thm notI}, 

          rtac @{thm allI}, K all_tac]

*}

text {*

  The most convenient order to apply tactics to subgoal

  is in reverse order. 

*}

lemma 

  shows "A \<and> B" and "A \<longrightarrow> B \<longrightarrow> C" and " \<forall> x. D x" and "E \<Longrightarrow> F"

apply(tactic {* select_tac 4 *})

apply(tactic {* select_tac 3 *})

apply(tactic {* select_tac 2 *})

apply(tactic {* select_tac 1 *})

oops

text {*

  The tactic select_tac can also be written using the 

  combinator TRY.

*}

ML {*

val select_tac' = 

  TRY o FIRST' [rtac @{thm conjI}, 

                rtac @{thm impI},

                rtac @{thm notI}, 

                rtac @{thm allI}]

*}

text {*

  Repeated application of tactics. 

*}

ML {*

val repeat_sel_tac = 

  REPEAT o CHANGED o select_tac'

*}

lemma 

  shows "A \<and> (B \<and> C)" and "A \<longrightarrow> B \<longrightarrow> C" and " \<forall> x. D x" and "E \<Longrightarrow> F"

apply(tactic {* repeat_sel_tac 4 *})

apply(tactic {* repeat_sel_tac 3 *})

apply(tactic {* repeat_sel_tac 2 *})

apply(tactic {* repeat_sel_tac 1 *})

oops

text {*  

  Application of a tactics to all new subgoals.

*}

ML {*

val repeat_all_new_sel_tac = 

  TRY o REPEAT_ALL_NEW (CHANGED o select_tac')

*}

lemma 

  shows "A \<and> (B \<and> C)" and "A \<longrightarrow> B \<longrightarrow> C" and " \<forall> x. D x" and "E \<Longrightarrow> F"

apply(tactic {* repeat_all_new_sel_tac 4 *})

apply(tactic {* repeat_all_new_sel_tac 3 *})

apply(tactic {* repeat_all_new_sel_tac 2 *})

apply(tactic {* repeat_all_new_sel_tac 1 *})

oops

text {* 

  The tactical DEPTH_SOLVED applies tactics in depth first

  search including backtracking.

  This can be used to implement a decision procedure for 

  propositional intuitionistic logic inspired by work of 

  Roy Dyckhoff.

*}

lemma impE1:

  shows "\<lbrakk>A \<longrightarrow> B; A; \<lbrakk>A; B\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"

by iprover

lemma impE2:

  shows "\<lbrakk>(C \<and> D) \<longrightarrow> B; C \<longrightarrow> (D \<longrightarrow>B) \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"

by iprover

lemma impE3:

  shows "\<lbrakk>(C \<or> D) \<longrightarrow> B; \<lbrakk>C \<longrightarrow> B; D \<longrightarrow> B\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"

by iprover

lemma impE4:

  shows "\<lbrakk>(C \<longrightarrow> D) \<longrightarrow> B; D \<longrightarrow> B \<Longrightarrow> C \<longrightarrow> D; B \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"

by iprover

lemma impE5:

  shows "\<lbrakk>(C = D) \<longrightarrow> B; (C \<longrightarrow> D) \<longrightarrow> ((D \<longrightarrow> C) \<longrightarrow> B) \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"

by iprover

ML {*

val apply_tac =

let

  val intros = [@{thm conjI}, @{thm disjI1}, @{thm disjI2}, @{thm impI}, @{thm iffI}]

  val elims  = [@{thm FalseE}, @{thm conjE}, @{thm disjE}, @{thm iffE},

                @{thm impE2}, @{thm impE3}, @{thm impE4}, @{thm impE5}, @{thm impE1}]

in

  atac 

  ORELSE' resolve_tac intros

  ORELSE' eresolve_tac elims

end

*}

lemma

  shows "((((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P) \<longrightarrow> Q) \<longrightarrow> Q"

apply(tactic {* (DEPTH_SOLVE o apply_tac) 1 *})

done

lemma 

  shows "((A \<longrightarrow> B) \<longrightarrow> A) \<longrightarrow> A"

apply(tactic {* (TRY o DEPTH_SOLVE o apply_tac) 1 *})

oops

lemma

  shows "(A \<and> B \<or> ((((A \<longrightarrow> False) \<longrightarrow> False) \<longrightarrow> Q) \<or> (B \<longrightarrow> Q)) \<longrightarrow> Q) \<longrightarrow> Q"

apply(tactic {* (TRY o DEPTH_SOLVE o apply_tac) 1 *})

oops

text {* 

  The SUBPROOF tactic gives you full access to

  all components of a goal state.

*}

ML {*

fun subproof_tac {asms, concl, prems, params, context, schematics} =

let

  fun out f xs = commas (map (Syntax.string_of_term context o f) xs)

  val str_of_asms   = out term_of asms

  val str_of_concl  = out term_of [concl]

  val str_of_prems  = out prop_of prems

  val str_of_params = out term_of params

  val str_of_schms  = out term_of (snd schematics)

  val s = ["params: "      ^ str_of_params,

           "schematics: "  ^ str_of_schms,

           "premises: "    ^ str_of_prems,

           "assumptions: " ^ str_of_asms,

           "conclusion: "  ^ str_of_concl]

in

   tracing (cat_lines s); no_tac

end

*}

lemma shows "\<And>x y. A x y \<Longrightarrow> B y x \<longrightarrow> C (?z y) x"

apply(tactic {* SUBPROOF subproof_tac @{context} 1 *})?

apply(rule impI)

apply(tactic {* SUBPROOF subproof_tac @{context} 1 *})?

oops

ML {*

val my_atac = SUBPROOF (fn {prems, ...} => resolve_tac prems 1)

*}

lemma shows "\<lbrakk>B x y; A x y; C x y \<rbrakk> \<Longrightarrow> A x y"

apply(tactic {* my_atac @{context} 1 *})

done

text {*

  Setting up the goal state using the function 

  Goal.prove. It expects the goal as a term, we

  have to construct manually.

*}

ML {* 

open HOLogic

fun P n = @{term "P::nat \<Rightarrow> bool"} $ (mk_number @{typ "nat"} n) 

fun rhs 1 = P 1

  | rhs n = mk_conj (P n, rhs (n - 1))

fun lhs 1 n = mk_imp (mk_eq (P 1, P n), rhs n)

  | lhs m n =  mk_conj (mk_imp 

                 (mk_eq (P (m - 1), P m), rhs n), lhs (m - 1) n)

*}

ML {*

fun de_bruijn_test ctxt n =

let 

  val i = 2*n + 1

  val goal = mk_Trueprop (mk_imp (lhs i i, rhs i))

in

  Syntax.string_of_term ctxt goal

  |> writeln

end;

de_bruijn_test @{context} 1   

*}

ML {*

fun de_bruijn ctxt n =

let 

  val i = 2*n+1

  val goal = mk_Trueprop (mk_imp (lhs i i, rhs i))

in

  Goal.prove ctxt ["P"] [] goal

   (fn _ => (DEPTH_SOLVE o apply_tac) 1)

end 

*}

ML{* de_bruijn @{context} 1 *}

text {*

  Below is the version which constructs the terms

  using fixed variables.

*}

ML {*

fun de_bruijn ctxt n = 

let 

  val i = 2*n+1

  val bs = replicate (i+1) "b"

  val (nbs, ctxt') = Variable.variant_fixes bs ctxt

  val fbs = map (fn z => Free (z, @{typ "bool"})) nbs

  fun P n = nth fbs n 

  fun rhs 0 = @{term "True"}

    | rhs 1 = P 1

    | rhs n = mk_conj (P n, rhs (n - 1))

  fun lhs 1 n = mk_imp (mk_eq (P 1, P n), rhs n)

    | lhs m n =  mk_conj (mk_imp 

                   (mk_eq (P (m - 1), P m), rhs n), lhs (m - 1) n)

  val goal = mk_Trueprop (mk_imp (lhs i i, rhs i))

in

  Goal.prove ctxt' [] [] goal

   (fn _ => (DEPTH_SOLVE o apply_tac) 1)

  (*|> singleton (ProofContext.export ctxt' ctxt)*)

end

*}

ML {* de_bruijn @{context} 1 *}

end