theory Eximports Mainbegintext {* 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)doneML {*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 *})donetext {* 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 *})donetext {* 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 *})backdonetext {* 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 thmend*}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} *})donenotation (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 *})oopslemma shows "P \<and> Q"apply(tactic {* resolve_tac [@{thm conjI}] 1 *})oopslemma shows "P \<and> Q \<Longrightarrow> False"apply(tactic {* eresolve_tac [@{thm conjE}] 1 *})oopslemma shows "False \<and> True \<Longrightarrow> False"apply(tactic {* dresolve_tac [@{thm conjunct2}] 1 *})oopstext {* 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 *})oopstext {* 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 *})oopsML {* @{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 *})oopstext {* 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 *})oopstext {* 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 *})oopstext {* 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 iproverlemma impE2: shows "\<lbrakk>(C \<and> D) \<longrightarrow> B; C \<longrightarrow> (D \<longrightarrow>B) \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"by iproverlemma impE3: shows "\<lbrakk>(C \<or> D) \<longrightarrow> B; \<lbrakk>C \<longrightarrow> B; D \<longrightarrow> B\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"by iproverlemma impE4: shows "\<lbrakk>(C \<longrightarrow> D) \<longrightarrow> B; D \<longrightarrow> B \<Longrightarrow> C \<longrightarrow> D; B \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"by iproverlemma impE5: shows "\<lbrakk>(C = D) \<longrightarrow> B; (C \<longrightarrow> D) \<longrightarrow> ((D \<longrightarrow> C) \<longrightarrow> B) \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"by iproverML {*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 elimsend*}lemma shows "((((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P) \<longrightarrow> Q) \<longrightarrow> Q"apply(tactic {* (DEPTH_SOLVE o apply_tac) 1 *})donelemma shows "((A \<longrightarrow> B) \<longrightarrow> A) \<longrightarrow> A"apply(tactic {* (TRY o DEPTH_SOLVE o apply_tac) 1 *})oopslemma 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 *})oopstext {* 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_tacend*}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 *})?oopsML {*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 *})donetext {* Setting up the goal state using the function Goal.prove. It expects the goal as a term, we have to construct manually.*}ML {* open HOLogicfun 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 |> writelnend;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