# HG changeset patch
# User wenzelm
# Date 1256061124 -7200
# Node ID 9cf389429f6df980c84b68fb90238c58900fad0b
# Parent  8f35633c492244048ecd6367e5e15abd0cd768cc
modernized session Metis_Examples;

diff -r 8f35633c4922 -r 9cf389429f6d Admin/isatest/isatest-stats
--- a/Admin/isatest/isatest-stats	Tue Oct 20 19:37:09 2009 +0200
+++ b/Admin/isatest/isatest-stats	Tue Oct 20 19:52:04 2009 +0200
@@ -21,7 +21,7 @@
   HOL-HoareParallel \
   HOL-Lambda \
   HOL-Library \
-  HOL-MetisExamples \
+  HOL-Metis_Examples \
   HOL-MicroJava \
   HOL-NSA \
   HOL-Nominal-Examples \
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/IsaMakefile
--- a/src/HOL/IsaMakefile	Tue Oct 20 19:37:09 2009 +0200
+++ b/src/HOL/IsaMakefile	Tue Oct 20 19:52:04 2009 +0200
@@ -29,7 +29,7 @@
   HOL-Lambda \
   HOL-Lattice \
   HOL-Matrix \
-  HOL-MetisExamples \
+  HOL-Metis_Examples \
   HOL-MicroJava \
   HOL-Mirabelle \
   HOL-Modelcheck \
@@ -556,16 +556,16 @@
 	@$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL Hoare_Parallel
 
 
-## HOL-MetisExamples
+## HOL-Metis_Examples
 
-HOL-MetisExamples: HOL $(LOG)/HOL-MetisExamples.gz
+HOL-Metis_Examples: HOL $(LOG)/HOL-Metis_Examples.gz
 
-$(LOG)/HOL-MetisExamples.gz: $(OUT)/HOL MetisExamples/ROOT.ML	\
-  MetisExamples/Abstraction.thy MetisExamples/BigO.thy		\
-  MetisExamples/BT.thy MetisExamples/Message.thy		\
-  MetisExamples/Tarski.thy MetisExamples/TransClosure.thy	\
-  MetisExamples/set.thy
-	@$(ISABELLE_TOOL) usedir $(OUT)/HOL MetisExamples
+$(LOG)/HOL-Metis_Examples.gz: $(OUT)/HOL Metis_Examples/ROOT.ML	\
+  Metis_Examples/Abstraction.thy Metis_Examples/BigO.thy	\
+  Metis_Examples/BT.thy Metis_Examples/Message.thy		\
+  Metis_Examples/Tarski.thy Metis_Examples/TransClosure.thy	\
+  Metis_Examples/set.thy
+	@$(ISABELLE_TOOL) usedir $(OUT)/HOL Metis_Examples
 
 
 ## HOL-Algebra
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/Abstraction.thy
--- a/src/HOL/MetisExamples/Abstraction.thy	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,298 +0,0 @@
-(*  Title:      HOL/MetisExamples/Abstraction.thy
-    ID:         $Id$
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method
-*)
-
-theory Abstraction
-imports Main FuncSet
-begin
-
-(*For Christoph Benzmueller*)
-lemma "x<1 & ((op=) = (op=)) ==> ((op=) = (op=)) & (x<(2::nat))";
-  by (metis One_nat_def less_Suc0 not_less0 not_less_eq numeral_2_eq_2)
-
-(*this is a theorem, but we can't prove it unless ext is applied explicitly
-lemma "(op=) = (%x y. y=x)"
-*)
-
-consts
-  monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool"
-  pset  :: "'a set => 'a set"
-  order :: "'a set => ('a * 'a) set"
-
-declare [[ atp_problem_prefix = "Abstraction__Collect_triv" ]]
-lemma (*Collect_triv:*) "a \<in> {x. P x} ==> P a"
-proof (neg_clausify)
-assume 0: "(a\<Colon>'a\<Colon>type) \<in> Collect (P\<Colon>'a\<Colon>type \<Rightarrow> bool)"
-assume 1: "\<not> (P\<Colon>'a\<Colon>type \<Rightarrow> bool) (a\<Colon>'a\<Colon>type)"
-have 2: "(P\<Colon>'a\<Colon>type \<Rightarrow> bool) (a\<Colon>'a\<Colon>type)"
-  by (metis CollectD 0)
-show "False"
-  by (metis 2 1)
-qed
-
-lemma Collect_triv: "a \<in> {x. P x} ==> P a"
-by (metis mem_Collect_eq)
-
-
-declare [[ atp_problem_prefix = "Abstraction__Collect_mp" ]]
-lemma "a \<in> {x. P x --> Q x} ==> a \<in> {x. P x} ==> a \<in> {x. Q x}"
-  by (metis CollectI Collect_imp_eq ComplD UnE mem_Collect_eq);
-  --{*34 secs*}
-
-declare [[ atp_problem_prefix = "Abstraction__Sigma_triv" ]]
-lemma "(a,b) \<in> Sigma A B ==> a \<in> A & b \<in> B a"
-proof (neg_clausify)
-assume 0: "(a\<Colon>'a\<Colon>type, b\<Colon>'b\<Colon>type) \<in> Sigma (A\<Colon>'a\<Colon>type set) (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set)"
-assume 1: "(a\<Colon>'a\<Colon>type) \<notin> (A\<Colon>'a\<Colon>type set) \<or> (b\<Colon>'b\<Colon>type) \<notin> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) a"
-have 2: "(a\<Colon>'a\<Colon>type) \<in> (A\<Colon>'a\<Colon>type set)"
-  by (metis SigmaD1 0)
-have 3: "(b\<Colon>'b\<Colon>type) \<in> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) (a\<Colon>'a\<Colon>type)"
-  by (metis SigmaD2 0)
-have 4: "(b\<Colon>'b\<Colon>type) \<notin> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) (a\<Colon>'a\<Colon>type)"
-  by (metis 1 2)
-show "False"
-  by (metis 3 4)
-qed
-
-lemma Sigma_triv: "(a,b) \<in> Sigma A B ==> a \<in> A & b \<in> B a"
-by (metis SigmaD1 SigmaD2)
-
-declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect" ]]
-lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
-(*???metis says this is satisfiable!
-by (metis CollectD SigmaD1 SigmaD2)
-*)
-by (meson CollectD SigmaD1 SigmaD2)
-
-
-(*single-step*)
-lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
-by (metis SigmaD1 SigmaD2 insert_def singleton_conv2 Un_empty_right vimage_Collect_eq vimage_def vimage_singleton_eq)
-
-
-lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
-proof (neg_clausify)
-assume 0: "(a\<Colon>'a\<Colon>type, b\<Colon>'b\<Colon>type)
-\<in> Sigma (A\<Colon>'a\<Colon>type set)
-   (COMBB Collect (COMBC (COMBB COMBB op =) (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type)))"
-assume 1: "(a\<Colon>'a\<Colon>type) \<notin> (A\<Colon>'a\<Colon>type set) \<or> a \<noteq> (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type) (b\<Colon>'b\<Colon>type)"
-have 2: "(a\<Colon>'a\<Colon>type) \<in> (A\<Colon>'a\<Colon>type set)"
-  by (metis 0 SigmaD1)
-have 3: "(b\<Colon>'b\<Colon>type)
-\<in> COMBB Collect (COMBC (COMBB COMBB op =) (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type)) (a\<Colon>'a\<Colon>type)"
-  by (metis 0 SigmaD2) 
-have 4: "(b\<Colon>'b\<Colon>type) \<in> Collect (COMBB (op = (a\<Colon>'a\<Colon>type)) (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type))"
-  by (metis 3)
-have 5: "(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type) (b\<Colon>'b\<Colon>type) \<noteq> (a\<Colon>'a\<Colon>type)"
-  by (metis 1 2)
-have 6: "(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type) (b\<Colon>'b\<Colon>type) = (a\<Colon>'a\<Colon>type)"
-  by (metis 4 vimage_singleton_eq insert_def singleton_conv2 Un_empty_right vimage_Collect_eq vimage_def)
-show "False"
-  by (metis 5 6)
-qed
-
-(*Alternative structured proof, untyped*)
-lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
-proof (neg_clausify)
-assume 0: "(a, b) \<in> Sigma A (COMBB Collect (COMBC (COMBB COMBB op =) f))"
-have 1: "b \<in> Collect (COMBB (op = a) f)"
-  by (metis 0 SigmaD2)
-have 2: "f b = a"
-  by (metis 1 vimage_Collect_eq singleton_conv2 insert_def Un_empty_right vimage_singleton_eq vimage_def)
-assume 3: "a \<notin> A \<or> a \<noteq> f b"
-have 4: "a \<in> A"
-  by (metis 0 SigmaD1)
-have 5: "f b \<noteq> a"
-  by (metis 4 3)
-show "False"
-  by (metis 5 2)
-qed
-
-
-declare [[ atp_problem_prefix = "Abstraction__CLF_eq_in_pp" ]]
-lemma "(cl,f) \<in> CLF ==> CLF = (SIGMA cl: CL.{f. f \<in> pset cl}) ==> f \<in> pset cl"
-by (metis Collect_mem_eq SigmaD2)
-
-lemma "(cl,f) \<in> CLF ==> CLF = (SIGMA cl: CL.{f. f \<in> pset cl}) ==> f \<in> pset cl"
-proof (neg_clausify)
-assume 0: "(cl, f) \<in> CLF"
-assume 1: "CLF = Sigma CL (COMBB Collect (COMBB (COMBC op \<in>) pset))"
-assume 2: "f \<notin> pset cl"
-have 3: "\<And>X1 X2. X2 \<in> COMBB Collect (COMBB (COMBC op \<in>) pset) X1 \<or> (X1, X2) \<notin> CLF"
-  by (metis SigmaD2 1)
-have 4: "\<And>X1 X2. X2 \<in> pset X1 \<or> (X1, X2) \<notin> CLF"
-  by (metis 3 Collect_mem_eq)
-have 5: "(cl, f) \<notin> CLF"
-  by (metis 2 4)
-show "False"
-  by (metis 5 0)
-qed
-
-declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect_Pi" ]]
-lemma
-    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl}) ==> 
-    f \<in> pset cl \<rightarrow> pset cl"
-proof (neg_clausify)
-assume 0: "f \<notin> Pi (pset cl) (COMBK (pset cl))"
-assume 1: "(cl, f)
-\<in> Sigma CL
-   (COMBB Collect
-     (COMBB (COMBC op \<in>) (COMBS (COMBB Pi pset) (COMBB COMBK pset))))"
-show "False"
-(*  by (metis 0 Collect_mem_eq SigmaD2 1) ??doesn't terminate*)
-  by (insert 0 1, simp add: COMBB_def COMBS_def COMBC_def)
-qed
-
-
-declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect_Int" ]]
-lemma
-    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
-   f \<in> pset cl \<inter> cl"
-proof (neg_clausify)
-assume 0: "(cl, f)
-\<in> Sigma CL
-   (COMBB Collect (COMBB (COMBC op \<in>) (COMBS (COMBB op \<inter> pset) COMBI)))"
-assume 1: "f \<notin> pset cl \<inter> cl"
-have 2: "f \<in> COMBB Collect (COMBB (COMBC op \<in>) (COMBS (COMBB op \<inter> pset) COMBI)) cl" 
-  by (insert 0, simp add: COMBB_def) 
-(*  by (metis SigmaD2 0)  ??doesn't terminate*)
-have 3: "f \<in> COMBS (COMBB op \<inter> pset) COMBI cl"
-  by (metis 2 Collect_mem_eq)
-have 4: "f \<notin> cl \<inter> pset cl"
-  by (metis 1 Int_commute)
-have 5: "f \<in> cl \<inter> pset cl"
-  by (metis 3 Int_commute)
-show "False"
-  by (metis 5 4)
-qed
-
-
-declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect_Pi_mono" ]]
-lemma
-    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl & monotone f (pset cl) (order cl)}) ==>
-   (f \<in> pset cl \<rightarrow> pset cl)  &  (monotone f (pset cl) (order cl))"
-by auto
-
-declare [[ atp_problem_prefix = "Abstraction__CLF_subset_Collect_Int" ]]
-lemma "(cl,f) \<in> CLF ==> 
-   CLF \<subseteq> (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
-   f \<in> pset cl \<inter> cl"
-by auto
-
-(*??no longer terminates, with combinators
-by (metis Collect_mem_eq Int_def SigmaD2 UnCI Un_absorb1)
-  --{*@{text Int_def} is redundant*}
-*)
-
-declare [[ atp_problem_prefix = "Abstraction__CLF_eq_Collect_Int" ]]
-lemma "(cl,f) \<in> CLF ==> 
-   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
-   f \<in> pset cl \<inter> cl"
-by auto
-(*??no longer terminates, with combinators
-by (metis Collect_mem_eq Int_commute SigmaD2)
-*)
-
-declare [[ atp_problem_prefix = "Abstraction__CLF_subset_Collect_Pi" ]]
-lemma 
-   "(cl,f) \<in> CLF ==> 
-    CLF \<subseteq> (SIGMA cl': CL. {f. f \<in> pset cl' \<rightarrow> pset cl'}) ==> 
-    f \<in> pset cl \<rightarrow> pset cl"
-by fast
-(*??no longer terminates, with combinators
-by (metis Collect_mem_eq SigmaD2 subsetD)
-*)
-
-declare [[ atp_problem_prefix = "Abstraction__CLF_eq_Collect_Pi" ]]
-lemma 
-  "(cl,f) \<in> CLF ==> 
-   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl}) ==> 
-   f \<in> pset cl \<rightarrow> pset cl"
-by auto
-(*??no longer terminates, with combinators
-by (metis Collect_mem_eq SigmaD2 contra_subsetD equalityE)
-*)
-
-declare [[ atp_problem_prefix = "Abstraction__CLF_eq_Collect_Pi_mono" ]]
-lemma 
-  "(cl,f) \<in> CLF ==> 
-   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl & monotone f (pset cl) (order cl)}) ==>
-   (f \<in> pset cl \<rightarrow> pset cl)  &  (monotone f (pset cl) (order cl))"
-by auto
-
-declare [[ atp_problem_prefix = "Abstraction__map_eq_zipA" ]]
-lemma "map (%x. (f x, g x)) xs = zip (map f xs) (map g xs)"
-apply (induct xs)
-(*sledgehammer*)  
-apply auto
-done
-
-declare [[ atp_problem_prefix = "Abstraction__map_eq_zipB" ]]
-lemma "map (%w. (w -> w, w \<times> w)) xs = 
-       zip (map (%w. w -> w) xs) (map (%w. w \<times> w) xs)"
-apply (induct xs)
-(*sledgehammer*)  
-apply auto
-done
-
-declare [[ atp_problem_prefix = "Abstraction__image_evenA" ]]
-lemma "(%x. Suc(f x)) ` {x. even x} <= A ==> (\<forall>x. even x --> Suc(f x) \<in> A)";
-(*sledgehammer*)  
-by auto
-
-declare [[ atp_problem_prefix = "Abstraction__image_evenB" ]]
-lemma "(%x. f (f x)) ` ((%x. Suc(f x)) ` {x. even x}) <= A 
-       ==> (\<forall>x. even x --> f (f (Suc(f x))) \<in> A)";
-(*sledgehammer*)  
-by auto
-
-declare [[ atp_problem_prefix = "Abstraction__image_curry" ]]
-lemma "f \<in> (%u v. b \<times> u \<times> v) ` A ==> \<forall>u v. P (b \<times> u \<times> v) ==> P(f y)" 
-(*sledgehammer*)  
-by auto
-
-declare [[ atp_problem_prefix = "Abstraction__image_TimesA" ]]
-lemma image_TimesA: "(%(x,y). (f x, g y)) ` (A \<times> B) = (f`A) \<times> (g`B)"
-(*sledgehammer*) 
-apply (rule equalityI)
-(***Even the two inclusions are far too difficult
-using [[ atp_problem_prefix = "Abstraction__image_TimesA_simpler"]]
-***)
-apply (rule subsetI)
-apply (erule imageE)
-(*V manages from here with help: Abstraction__image_TimesA_simpler_1_b.p*)
-apply (erule ssubst)
-apply (erule SigmaE)
-(*V manages from here: Abstraction__image_TimesA_simpler_1_a.p*)
-apply (erule ssubst)
-apply (subst split_conv)
-apply (rule SigmaI) 
-apply (erule imageI) +
-txt{*subgoal 2*}
-apply (clarify );
-apply (simp add: );  
-apply (rule rev_image_eqI)  
-apply (blast intro: elim:); 
-apply (simp add: );
-done
-
-(*Given the difficulty of the previous problem, these two are probably
-impossible*)
-
-declare [[ atp_problem_prefix = "Abstraction__image_TimesB" ]]
-lemma image_TimesB:
-    "(%(x,y,z). (f x, g y, h z)) ` (A \<times> B \<times> C) = (f`A) \<times> (g`B) \<times> (h`C)" 
-(*sledgehammer*) 
-by force
-
-declare [[ atp_problem_prefix = "Abstraction__image_TimesC" ]]
-lemma image_TimesC:
-    "(%(x,y). (x \<rightarrow> x, y \<times> y)) ` (A \<times> B) = 
-     ((%x. x \<rightarrow> x) ` A) \<times> ((%y. y \<times> y) ` B)" 
-(*sledgehammer*) 
-by auto
-
-end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/BT.thy
--- a/src/HOL/MetisExamples/BT.thy	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,243 +0,0 @@
-(*  Title:      HOL/MetisTest/BT.thy
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method
-*)
-
-header {* Binary trees *}
-
-theory BT
-imports Main
-begin
-
-
-datatype 'a bt =
-    Lf
-  | Br 'a  "'a bt"  "'a bt"
-
-consts
-  n_nodes   :: "'a bt => nat"
-  n_leaves  :: "'a bt => nat"
-  depth     :: "'a bt => nat"
-  reflect   :: "'a bt => 'a bt"
-  bt_map    :: "('a => 'b) => ('a bt => 'b bt)"
-  preorder  :: "'a bt => 'a list"
-  inorder   :: "'a bt => 'a list"
-  postorder :: "'a bt => 'a list"
-  appnd    :: "'a bt => 'a bt => 'a bt"
-
-primrec
-  "n_nodes Lf = 0"
-  "n_nodes (Br a t1 t2) = Suc (n_nodes t1 + n_nodes t2)"
-
-primrec
-  "n_leaves Lf = Suc 0"
-  "n_leaves (Br a t1 t2) = n_leaves t1 + n_leaves t2"
-
-primrec
-  "depth Lf = 0"
-  "depth (Br a t1 t2) = Suc (max (depth t1) (depth t2))"
-
-primrec
-  "reflect Lf = Lf"
-  "reflect (Br a t1 t2) = Br a (reflect t2) (reflect t1)"
-
-primrec
-  "bt_map f Lf = Lf"
-  "bt_map f (Br a t1 t2) = Br (f a) (bt_map f t1) (bt_map f t2)"
-
-primrec
-  "preorder Lf = []"
-  "preorder (Br a t1 t2) = [a] @ (preorder t1) @ (preorder t2)"
-
-primrec
-  "inorder Lf = []"
-  "inorder (Br a t1 t2) = (inorder t1) @ [a] @ (inorder t2)"
-
-primrec
-  "postorder Lf = []"
-  "postorder (Br a t1 t2) = (postorder t1) @ (postorder t2) @ [a]"
-
-primrec
-  "appnd Lf t = t"
-  "appnd (Br a t1 t2) t = Br a (appnd t1 t) (appnd t2 t)"
-
-
-text {* \medskip BT simplification *}
-
-declare [[ atp_problem_prefix = "BT__n_leaves_reflect" ]]
-lemma n_leaves_reflect: "n_leaves (reflect t) = n_leaves t"
-  apply (induct t)
-  apply (metis add_right_cancel n_leaves.simps(1) reflect.simps(1))
-  apply (metis add_commute n_leaves.simps(2) reflect.simps(2))
-  done
-
-declare [[ atp_problem_prefix = "BT__n_nodes_reflect" ]]
-lemma n_nodes_reflect: "n_nodes (reflect t) = n_nodes t"
-  apply (induct t)
-  apply (metis reflect.simps(1))
-  apply (metis n_nodes.simps(2) nat_add_commute reflect.simps(2))
-  done
-
-declare [[ atp_problem_prefix = "BT__depth_reflect" ]]
-lemma depth_reflect: "depth (reflect t) = depth t"
-  apply (induct t)
-  apply (metis depth.simps(1) reflect.simps(1))
-  apply (metis depth.simps(2) min_max.sup_commute reflect.simps(2))
-  done
-
-text {*
-  The famous relationship between the numbers of leaves and nodes.
-*}
-
-declare [[ atp_problem_prefix = "BT__n_leaves_nodes" ]]
-lemma n_leaves_nodes: "n_leaves t = Suc (n_nodes t)"
-  apply (induct t)
-  apply (metis n_leaves.simps(1) n_nodes.simps(1))
-  apply auto
-  done
-
-declare [[ atp_problem_prefix = "BT__reflect_reflect_ident" ]]
-lemma reflect_reflect_ident: "reflect (reflect t) = t"
-  apply (induct t)
-  apply (metis add_right_cancel reflect.simps(1));
-  apply (metis reflect.simps(2))
-  done
-
-declare [[ atp_problem_prefix = "BT__bt_map_ident" ]]
-lemma bt_map_ident: "bt_map (%x. x) = (%y. y)"
-apply (rule ext) 
-apply (induct_tac y)
-  apply (metis bt_map.simps(1))
-txt{*BUG involving flex-flex pairs*}
-(*  apply (metis bt_map.simps(2)) *)
-apply auto
-done
-
-
-declare [[ atp_problem_prefix = "BT__bt_map_appnd" ]]
-lemma bt_map_appnd: "bt_map f (appnd t u) = appnd (bt_map f t) (bt_map f u)"
-apply (induct t)
-  apply (metis appnd.simps(1) bt_map.simps(1))
-  apply (metis appnd.simps(2) bt_map.simps(2))  (*slow!!*)
-done
-
-
-declare [[ atp_problem_prefix = "BT__bt_map_compose" ]]
-lemma bt_map_compose: "bt_map (f o g) t = bt_map f (bt_map g t)"
-apply (induct t) 
-  apply (metis bt_map.simps(1))
-txt{*Metis runs forever*}
-(*  apply (metis bt_map.simps(2) o_apply)*)
-apply auto
-done
-
-
-declare [[ atp_problem_prefix = "BT__bt_map_reflect" ]]
-lemma bt_map_reflect: "bt_map f (reflect t) = reflect (bt_map f t)"
-  apply (induct t)
-  apply (metis add_right_cancel bt_map.simps(1) reflect.simps(1))
-  apply (metis add_right_cancel bt_map.simps(2) reflect.simps(2))
-  done
-
-declare [[ atp_problem_prefix = "BT__preorder_bt_map" ]]
-lemma preorder_bt_map: "preorder (bt_map f t) = map f (preorder t)"
-  apply (induct t)
-  apply (metis bt_map.simps(1) map.simps(1) preorder.simps(1))
-   apply simp
-  done
-
-declare [[ atp_problem_prefix = "BT__inorder_bt_map" ]]
-lemma inorder_bt_map: "inorder (bt_map f t) = map f (inorder t)"
-  apply (induct t)
-  apply (metis bt_map.simps(1) inorder.simps(1) map.simps(1))
-  apply simp
-  done
-
-declare [[ atp_problem_prefix = "BT__postorder_bt_map" ]]
-lemma postorder_bt_map: "postorder (bt_map f t) = map f (postorder t)"
-  apply (induct t)
-  apply (metis bt_map.simps(1) map.simps(1) postorder.simps(1))
-   apply simp
-  done
-
-declare [[ atp_problem_prefix = "BT__depth_bt_map" ]]
-lemma depth_bt_map [simp]: "depth (bt_map f t) = depth t"
-  apply (induct t)
-  apply (metis bt_map.simps(1) depth.simps(1))
-   apply simp
-  done
-
-declare [[ atp_problem_prefix = "BT__n_leaves_bt_map" ]]
-lemma n_leaves_bt_map [simp]: "n_leaves (bt_map f t) = n_leaves t"
-  apply (induct t)
-  apply (metis One_nat_def Suc_eq_plus1 bt_map.simps(1) less_add_one less_antisym linorder_neq_iff n_leaves.simps(1))
-  apply (metis bt_map.simps(2) n_leaves.simps(2))
-  done
-
-
-declare [[ atp_problem_prefix = "BT__preorder_reflect" ]]
-lemma preorder_reflect: "preorder (reflect t) = rev (postorder t)"
-  apply (induct t)
-  apply (metis postorder.simps(1) preorder.simps(1) reflect.simps(1) rev_is_Nil_conv)
-  apply (metis append_Nil Cons_eq_append_conv postorder.simps(2) preorder.simps(2) reflect.simps(2) rev.simps(2) rev_append rev_rev_ident)
-  done
-
-declare [[ atp_problem_prefix = "BT__inorder_reflect" ]]
-lemma inorder_reflect: "inorder (reflect t) = rev (inorder t)"
-  apply (induct t)
-  apply (metis inorder.simps(1) reflect.simps(1) rev.simps(1))
-  apply simp
-  done
-
-declare [[ atp_problem_prefix = "BT__postorder_reflect" ]]
-lemma postorder_reflect: "postorder (reflect t) = rev (preorder t)"
-  apply (induct t)
-  apply (metis postorder.simps(1) preorder.simps(1) reflect.simps(1) rev.simps(1))
-  apply (metis Cons_eq_appendI postorder.simps(2) preorder.simps(2) reflect.simps(2) rev.simps(2) rev_append self_append_conv2)
-  done
-
-text {*
- Analogues of the standard properties of the append function for lists.
-*}
-
-declare [[ atp_problem_prefix = "BT__appnd_assoc" ]]
-lemma appnd_assoc [simp]:
-     "appnd (appnd t1 t2) t3 = appnd t1 (appnd t2 t3)"
-  apply (induct t1)
-  apply (metis appnd.simps(1))
-  apply (metis appnd.simps(2))
-  done
-
-declare [[ atp_problem_prefix = "BT__appnd_Lf2" ]]
-lemma appnd_Lf2 [simp]: "appnd t Lf = t"
-  apply (induct t)
-  apply (metis appnd.simps(1))
-  apply (metis appnd.simps(2))
-  done
-
-declare [[ atp_problem_prefix = "BT__depth_appnd" ]]
-  declare max_add_distrib_left [simp]
-lemma depth_appnd [simp]: "depth (appnd t1 t2) = depth t1 + depth t2"
-  apply (induct t1)
-  apply (metis add_0 appnd.simps(1) depth.simps(1))
-apply (simp add: ); 
-  done
-
-declare [[ atp_problem_prefix = "BT__n_leaves_appnd" ]]
-lemma n_leaves_appnd [simp]:
-     "n_leaves (appnd t1 t2) = n_leaves t1 * n_leaves t2"
-  apply (induct t1)
-  apply (metis One_nat_def appnd.simps(1) less_irrefl less_linear n_leaves.simps(1) nat_mult_1) 
-  apply (simp add: left_distrib)
-  done
-
-declare [[ atp_problem_prefix = "BT__bt_map_appnd" ]]
-lemma (*bt_map_appnd:*)
-     "bt_map f (appnd t1 t2) = appnd (bt_map f t1) (bt_map f t2)"
-  apply (induct t1)
-  apply (metis appnd.simps(1) bt_map_appnd)
-  apply (metis bt_map_appnd)
-  done
-
-end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/BigO.thy
--- a/src/HOL/MetisExamples/BigO.thy	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1231 +0,0 @@
-(*  Title:      HOL/MetisExamples/BigO.thy
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method
-*)
-
-header {* Big O notation *}
-
-theory BigO
-imports "~~/src/HOL/Decision_Procs/Dense_Linear_Order" Main SetsAndFunctions 
-begin
-
-subsection {* Definitions *}
-
-definition bigo :: "('a => 'b::ordered_idom) => ('a => 'b) set"    ("(1O'(_'))") where
-  "O(f::('a => 'b)) ==   {h. EX c. ALL x. abs (h x) <= c * abs (f x)}"
-
-declare [[ atp_problem_prefix = "BigO__bigo_pos_const" ]]
-lemma bigo_pos_const: "(EX (c::'a::ordered_idom). 
-    ALL x. (abs (h x)) <= (c * (abs (f x))))
-      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
-  apply auto
-  apply (case_tac "c = 0", simp)
-  apply (rule_tac x = "1" in exI, simp)
-  apply (rule_tac x = "abs c" in exI, auto)
-  apply (metis abs_ge_minus_self abs_ge_zero abs_minus_cancel abs_of_nonneg equation_minus_iff Orderings.xt1(6) abs_mult)
-  done
-
-(*** Now various verions with an increasing modulus ***)
-
-declare [[sledgehammer_modulus = 1]]
-
-lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
-    ALL x. (abs (h x)) <= (c * (abs (f x))))
-      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
-  apply auto
-  apply (case_tac "c = 0", simp)
-  apply (rule_tac x = "1" in exI, simp)
-  apply (rule_tac x = "abs c" in exI, auto)
-proof (neg_clausify)
-fix c x
-have 0: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * X2\<bar> = \<bar>X2 * X1\<bar>"
-  by (metis abs_mult mult_commute)
-have 1: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
-   X1 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> \<bar>X2\<bar> * X1 = \<bar>X2 * X1\<bar>"
-  by (metis abs_mult_pos linorder_linear)
-have 2: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
-   \<not> (0\<Colon>'a\<Colon>ordered_idom) < X1 * X2 \<or>
-   \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> X2 \<or> \<not> X1 \<le> (0\<Colon>'a\<Colon>ordered_idom)"
-  by (metis linorder_not_less mult_nonneg_nonpos2)
-assume 3: "\<And>x\<Colon>'b\<Colon>type.
-   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>
-   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-assume 4: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
-  \<le> \<bar>c\<Colon>'a\<Colon>ordered_idom\<bar> * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-have 5: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
-  \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-  by (metis 4 abs_mult)
-have 6: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
-   \<not> X1 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> X1 \<le> \<bar>X2\<bar>"
-  by (metis abs_ge_zero xt1(6))
-have 7: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
-   X1 \<le> \<bar>X2\<bar> \<or> (0\<Colon>'a\<Colon>ordered_idom) < X1"
-  by (metis not_leE 6)
-have 8: "(0\<Colon>'a\<Colon>ordered_idom) < \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
-  by (metis 5 7)
-have 9: "\<And>X1\<Colon>'a\<Colon>ordered_idom.
-   \<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar> \<le> X1 \<or>
-   (0\<Colon>'a\<Colon>ordered_idom) < X1"
-  by (metis 8 order_less_le_trans)
-have 10: "(0\<Colon>'a\<Colon>ordered_idom)
-< (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
-  by (metis 3 9)
-have 11: "\<not> (c\<Colon>'a\<Colon>ordered_idom) \<le> (0\<Colon>'a\<Colon>ordered_idom)"
-  by (metis abs_ge_zero 2 10)
-have 12: "\<And>X1\<Colon>'a\<Colon>ordered_idom. (c\<Colon>'a\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>X1 * c\<bar>"
-  by (metis mult_commute 1 11)
-have 13: "\<And>X1\<Colon>'b\<Colon>type.
-   - (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
-   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
-  by (metis 3 abs_le_D2)
-have 14: "\<And>X1\<Colon>'b\<Colon>type.
-   - (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
-   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
-  by (metis 0 12 13)
-have 15: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * \<bar>X2\<bar>\<bar> = \<bar>X1 * X2\<bar>"
-  by (metis abs_mult abs_mult_pos abs_ge_zero)
-have 16: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. X1 \<le> \<bar>X2\<bar> \<or> \<not> X1 \<le> X2"
-  by (metis xt1(6) abs_ge_self)
-have 17: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<not> \<bar>X1\<bar> \<le> X2 \<or> X1 \<le> \<bar>X2\<bar>"
-  by (metis 16 abs_le_D1)
-have 18: "\<And>X1\<Colon>'b\<Colon>type.
-   (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
-   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
-  by (metis 17 3 15)
-show "False"
-  by (metis abs_le_iff 5 18 14)
-qed
-
-declare [[sledgehammer_modulus = 2]]
-
-lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
-    ALL x. (abs (h x)) <= (c * (abs (f x))))
-      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
-  apply auto
-  apply (case_tac "c = 0", simp)
-  apply (rule_tac x = "1" in exI, simp)
-  apply (rule_tac x = "abs c" in exI, auto);
-proof (neg_clausify)
-fix c x
-have 0: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * X2\<bar> = \<bar>X2 * X1\<bar>"
-  by (metis abs_mult mult_commute)
-assume 1: "\<And>x\<Colon>'b\<Colon>type.
-   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>
-   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-assume 2: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
-  \<le> \<bar>c\<Colon>'a\<Colon>ordered_idom\<bar> * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-have 3: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
-  \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-  by (metis 2 abs_mult)
-have 4: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
-   \<not> X1 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> X1 \<le> \<bar>X2\<bar>"
-  by (metis abs_ge_zero xt1(6))
-have 5: "(0\<Colon>'a\<Colon>ordered_idom) < \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
-  by (metis not_leE 4 3)
-have 6: "(0\<Colon>'a\<Colon>ordered_idom)
-< (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
-  by (metis 1 order_less_le_trans 5)
-have 7: "\<And>X1\<Colon>'a\<Colon>ordered_idom. (c\<Colon>'a\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>X1 * c\<bar>"
-  by (metis abs_ge_zero linorder_not_less mult_nonneg_nonpos2 6 linorder_linear abs_mult_pos mult_commute)
-have 8: "\<And>X1\<Colon>'b\<Colon>type.
-   - (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
-   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
-  by (metis 0 7 abs_le_D2 1)
-have 9: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<not> \<bar>X1\<bar> \<le> X2 \<or> X1 \<le> \<bar>X2\<bar>"
-  by (metis abs_ge_self xt1(6) abs_le_D1)
-show "False"
-  by (metis 8 abs_ge_zero abs_mult_pos abs_mult 1 9 3 abs_le_iff)
-qed
-
-declare [[sledgehammer_modulus = 3]]
-
-lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
-    ALL x. (abs (h x)) <= (c * (abs (f x))))
-      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
-  apply auto
-  apply (case_tac "c = 0", simp)
-  apply (rule_tac x = "1" in exI, simp)
-  apply (rule_tac x = "abs c" in exI, auto);
-proof (neg_clausify)
-fix c x
-assume 0: "\<And>x\<Colon>'b\<Colon>type.
-   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>
-   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-assume 1: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
-  \<le> \<bar>c\<Colon>'a\<Colon>ordered_idom\<bar> * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
-have 2: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
-   X1 \<le> \<bar>X2\<bar> \<or> (0\<Colon>'a\<Colon>ordered_idom) < X1"
-  by (metis abs_ge_zero xt1(6) not_leE)
-have 3: "\<not> (c\<Colon>'a\<Colon>ordered_idom) \<le> (0\<Colon>'a\<Colon>ordered_idom)"
-  by (metis abs_ge_zero mult_nonneg_nonpos2 linorder_not_less order_less_le_trans 1 abs_mult 2 0)
-have 4: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * \<bar>X2\<bar>\<bar> = \<bar>X1 * X2\<bar>"
-  by (metis abs_ge_zero abs_mult_pos abs_mult)
-have 5: "\<And>X1\<Colon>'b\<Colon>type.
-   (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
-   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
-  by (metis 4 0 xt1(6) abs_ge_self abs_le_D1)
-show "False"
-  by (metis abs_mult mult_commute 3 abs_mult_pos linorder_linear 0 abs_le_D2 5 1 abs_le_iff)
-qed
-
-
-declare [[sledgehammer_modulus = 1]]
-
-lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
-    ALL x. (abs (h x)) <= (c * (abs (f x))))
-      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
-  apply auto
-  apply (case_tac "c = 0", simp)
-  apply (rule_tac x = "1" in exI, simp)
-  apply (rule_tac x = "abs c" in exI, auto);
-proof (neg_clausify)
-fix c x  (*sort/type constraint inserted by hand!*)
-have 0: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2. \<bar>X1 * \<bar>X2\<bar>\<bar> = \<bar>X1 * X2\<bar>"
-  by (metis abs_ge_zero abs_mult_pos abs_mult)
-assume 1: "\<And>A. \<bar>h A\<bar> \<le> c * \<bar>f A\<bar>"
-have 2: "\<And>X1 X2. \<not> \<bar>X1\<bar> \<le> X2 \<or> (0\<Colon>'a) \<le> X2"
-  by (metis abs_ge_zero order_trans)
-have 3: "\<And>X1. (0\<Colon>'a) \<le> c * \<bar>f X1\<bar>"
-  by (metis 1 2)
-have 4: "\<And>X1. c * \<bar>f X1\<bar> = \<bar>c * f X1\<bar>"
-  by (metis 0 abs_of_nonneg 3)
-have 5: "\<And>X1. - h X1 \<le> c * \<bar>f X1\<bar>"
-  by (metis 1 abs_le_D2)
-have 6: "\<And>X1. - h X1 \<le> \<bar>c * f X1\<bar>"
-  by (metis 4 5)
-have 7: "\<And>X1. h X1 \<le> c * \<bar>f X1\<bar>"
-  by (metis 1 abs_le_D1)
-have 8: "\<And>X1. h X1 \<le> \<bar>c * f X1\<bar>"
-  by (metis 4 7)
-assume 9: "\<not> \<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>"
-have 10: "\<not> \<bar>h x\<bar> \<le> \<bar>c * f x\<bar>"
-  by (metis abs_mult 9)
-show "False"
-  by (metis 6 8 10 abs_leI)
-qed
-
-
-declare [[sledgehammer_sorts = true]]
-
-lemma bigo_alt_def: "O(f) = 
-    {h. EX c. (0 < c & (ALL x. abs (h x) <= c * abs (f x)))}"
-by (auto simp add: bigo_def bigo_pos_const)
-
-declare [[ atp_problem_prefix = "BigO__bigo_elt_subset" ]]
-lemma bigo_elt_subset [intro]: "f : O(g) ==> O(f) <= O(g)"
-  apply (auto simp add: bigo_alt_def)
-  apply (rule_tac x = "ca * c" in exI)
-  apply (rule conjI)
-  apply (rule mult_pos_pos)
-  apply (assumption)+ 
-(*sledgehammer*);
-  apply (rule allI)
-  apply (drule_tac x = "xa" in spec)+
-  apply (subgoal_tac "ca * abs(f xa) <= ca * (c * abs(g xa))");
-  apply (erule order_trans)
-  apply (simp add: mult_ac)
-  apply (rule mult_left_mono, assumption)
-  apply (rule order_less_imp_le, assumption);
-done
-
-
-declare [[ atp_problem_prefix = "BigO__bigo_refl" ]]
-lemma bigo_refl [intro]: "f : O(f)"
-  apply(auto simp add: bigo_def)
-proof (neg_clausify)
-fix x
-assume 0: "\<And>xa. \<not> \<bar>f (x xa)\<bar> \<le> xa * \<bar>f (x xa)\<bar>"
-have 1: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2 \<or> \<not> (1\<Colon>'b) \<le> (1\<Colon>'b)"
-  by (metis mult_le_cancel_right1 order_eq_iff)
-have 2: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2"
-  by (metis order_eq_iff 1)
-show "False"
-  by (metis 0 2)
-qed
-
-declare [[ atp_problem_prefix = "BigO__bigo_zero" ]]
-lemma bigo_zero: "0 : O(g)"
-  apply (auto simp add: bigo_def func_zero)
-proof (neg_clausify)
-fix x
-assume 0: "\<And>xa. \<not> (0\<Colon>'b) \<le> xa * \<bar>g (x xa)\<bar>"
-have 1: "\<not> (0\<Colon>'b) \<le> (0\<Colon>'b)"
-  by (metis 0 mult_eq_0_iff)
-show "False"
-  by (metis 1 linorder_neq_iff linorder_antisym_conv1)
-qed
-
-lemma bigo_zero2: "O(%x.0) = {%x.0}"
-  apply (auto simp add: bigo_def) 
-  apply (rule ext)
-  apply auto
-done
-
-lemma bigo_plus_self_subset [intro]: 
-  "O(f) \<oplus> O(f) <= O(f)"
-  apply (auto simp add: bigo_alt_def set_plus_def)
-  apply (rule_tac x = "c + ca" in exI)
-  apply auto
-  apply (simp add: ring_distribs func_plus)
-  apply (blast intro:order_trans abs_triangle_ineq add_mono elim:) 
-done
-
-lemma bigo_plus_idemp [simp]: "O(f) \<oplus> O(f) = O(f)"
-  apply (rule equalityI)
-  apply (rule bigo_plus_self_subset)
-  apply (rule set_zero_plus2) 
-  apply (rule bigo_zero)
-done
-
-lemma bigo_plus_subset [intro]: "O(f + g) <= O(f) \<oplus> O(g)"
-  apply (rule subsetI)
-  apply (auto simp add: bigo_def bigo_pos_const func_plus set_plus_def)
-  apply (subst bigo_pos_const [symmetric])+
-  apply (rule_tac x = 
-    "%n. if abs (g n) <= (abs (f n)) then x n else 0" in exI)
-  apply (rule conjI)
-  apply (rule_tac x = "c + c" in exI)
-  apply (clarsimp)
-  apply (auto)
-  apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (f xa)")
-  apply (erule_tac x = xa in allE)
-  apply (erule order_trans)
-  apply (simp)
-  apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
-  apply (erule order_trans)
-  apply (simp add: ring_distribs)
-  apply (rule mult_left_mono)
-  apply assumption
-  apply (simp add: order_less_le)
-  apply (rule mult_left_mono)
-  apply (simp add: abs_triangle_ineq)
-  apply (simp add: order_less_le)
-  apply (rule mult_nonneg_nonneg)
-  apply (rule add_nonneg_nonneg)
-  apply auto
-  apply (rule_tac x = "%n. if (abs (f n)) <  abs (g n) then x n else 0" 
-     in exI)
-  apply (rule conjI)
-  apply (rule_tac x = "c + c" in exI)
-  apply auto
-  apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
-  apply (erule_tac x = xa in allE)
-  apply (erule order_trans)
-  apply (simp)
-  apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
-  apply (erule order_trans)
-  apply (simp add: ring_distribs)
-  apply (rule mult_left_mono)
-  apply (simp add: order_less_le)
-  apply (simp add: order_less_le)
-  apply (rule mult_left_mono)
-  apply (rule abs_triangle_ineq)
-  apply (simp add: order_less_le)
-apply (metis abs_not_less_zero double_less_0_iff less_not_permute linorder_not_less mult_less_0_iff)
-  apply (rule ext)
-  apply (auto simp add: if_splits linorder_not_le)
-done
-
-lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A \<oplus> B <= O(f)"
-  apply (subgoal_tac "A \<oplus> B <= O(f) \<oplus> O(f)")
-  apply (erule order_trans)
-  apply simp
-  apply (auto del: subsetI simp del: bigo_plus_idemp)
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_plus_eq" ]]
-lemma bigo_plus_eq: "ALL x. 0 <= f x ==> ALL x. 0 <= g x ==> 
-  O(f + g) = O(f) \<oplus> O(g)"
-  apply (rule equalityI)
-  apply (rule bigo_plus_subset)
-  apply (simp add: bigo_alt_def set_plus_def func_plus)
-  apply clarify 
-(*sledgehammer*); 
-  apply (rule_tac x = "max c ca" in exI)
-  apply (rule conjI)
-   apply (metis Orderings.less_max_iff_disj)
-  apply clarify
-  apply (drule_tac x = "xa" in spec)+
-  apply (subgoal_tac "0 <= f xa + g xa")
-  apply (simp add: ring_distribs)
-  apply (subgoal_tac "abs(a xa + b xa) <= abs(a xa) + abs(b xa)")
-  apply (subgoal_tac "abs(a xa) + abs(b xa) <= 
-      max c ca * f xa + max c ca * g xa")
-  apply (blast intro: order_trans)
-  defer 1
-  apply (rule abs_triangle_ineq)
-  apply (metis add_nonneg_nonneg)
-  apply (rule add_mono)
-using [[ atp_problem_prefix = "BigO__bigo_plus_eq_simpler" ]] 
-(*Found by SPASS; SLOW*)
-apply (metis le_maxI2 linorder_linear linorder_not_le min_max.sup_absorb1 mult_le_cancel_right order_trans)
-apply (metis le_maxI2 linorder_not_le mult_le_cancel_right order_trans)
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_bounded_alt" ]]
-lemma bigo_bounded_alt: "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> 
-    f : O(g)" 
-  apply (auto simp add: bigo_def)
-(*Version 1: one-shot proof*)
-  apply (metis OrderedGroup.abs_le_D1 linorder_class.not_less  order_less_le  Orderings.xt1(12)  Ring_and_Field.abs_mult)
-  done
-
-lemma (*bigo_bounded_alt:*) "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> 
-    f : O(g)" 
-  apply (auto simp add: bigo_def)
-(*Version 2: single-step proof*)
-proof (neg_clausify)
-fix x
-assume 0: "\<And>x. f x \<le> c * g x"
-assume 1: "\<And>xa. \<not> f (x xa) \<le> xa * \<bar>g (x xa)\<bar>"
-have 2: "\<And>X3. c * g X3 = f X3 \<or> \<not> c * g X3 \<le> f X3"
-  by (metis 0 order_antisym_conv)
-have 3: "\<And>X3. \<not> f (x \<bar>X3\<bar>) \<le> \<bar>X3 * g (x \<bar>X3\<bar>)\<bar>"
-  by (metis 1 abs_mult)
-have 4: "\<And>X1 X3\<Colon>'b\<Colon>ordered_idom. X3 \<le> X1 \<or> X1 \<le> \<bar>X3\<bar>"
-  by (metis linorder_linear abs_le_D1)
-have 5: "\<And>X3::'b. \<bar>X3\<bar> * \<bar>X3\<bar> = X3 * X3"
-  by (metis abs_mult_self)
-have 6: "\<And>X3. \<not> X3 * X3 < (0\<Colon>'b\<Colon>ordered_idom)"
-  by (metis not_square_less_zero)
-have 7: "\<And>X1 X3::'b. \<bar>X1\<bar> * \<bar>X3\<bar> = \<bar>X3 * X1\<bar>"
-  by (metis abs_mult mult_commute)
-have 8: "\<And>X3::'b. X3 * X3 = \<bar>X3 * X3\<bar>"
-  by (metis abs_mult 5)
-have 9: "\<And>X3. X3 * g (x \<bar>X3\<bar>) \<le> f (x \<bar>X3\<bar>)"
-  by (metis 3 4)
-have 10: "c * g (x \<bar>c\<bar>) = f (x \<bar>c\<bar>)"
-  by (metis 2 9)
-have 11: "\<And>X3::'b. \<bar>X3\<bar> * \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar> * \<bar>X3\<bar>"
-  by (metis abs_idempotent abs_mult 8)
-have 12: "\<And>X3::'b. \<bar>X3 * \<bar>X3\<bar>\<bar> = \<bar>X3\<bar> * \<bar>X3\<bar>"
-  by (metis mult_commute 7 11)
-have 13: "\<And>X3::'b. \<bar>X3 * \<bar>X3\<bar>\<bar> = X3 * X3"
-  by (metis 8 7 12)
-have 14: "\<And>X3. X3 \<le> \<bar>X3\<bar> \<or> X3 < (0\<Colon>'b)"
-  by (metis abs_ge_self abs_le_D1 abs_if)
-have 15: "\<And>X3. X3 \<le> \<bar>X3\<bar> \<or> \<bar>X3\<bar> < (0\<Colon>'b)"
-  by (metis abs_ge_self abs_le_D1 abs_if)
-have 16: "\<And>X3. X3 * X3 < (0\<Colon>'b) \<or> X3 * \<bar>X3\<bar> \<le> X3 * X3"
-  by (metis 15 13)
-have 17: "\<And>X3::'b. X3 * \<bar>X3\<bar> \<le> X3 * X3"
-  by (metis 16 6)
-have 18: "\<And>X3. X3 \<le> \<bar>X3\<bar> \<or> \<not> X3 < (0\<Colon>'b)"
-  by (metis mult_le_cancel_left 17)
-have 19: "\<And>X3::'b. X3 \<le> \<bar>X3\<bar>"
-  by (metis 18 14)
-have 20: "\<not> f (x \<bar>c\<bar>) \<le> \<bar>f (x \<bar>c\<bar>)\<bar>"
-  by (metis 3 10)
-show "False"
-  by (metis 20 19)
-qed
-
-
-text{*So here is the easier (and more natural) problem using transitivity*}
-declare [[ atp_problem_prefix = "BigO__bigo_bounded_alt_trans" ]]
-lemma "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> f : O(g)" 
-  apply (auto simp add: bigo_def)
-  (*Version 1: one-shot proof*) 
-  apply (metis Orderings.leD Orderings.leI abs_ge_self abs_le_D1 abs_mult abs_of_nonneg order_le_less)
-  done
-
-text{*So here is the easier (and more natural) problem using transitivity*}
-declare [[ atp_problem_prefix = "BigO__bigo_bounded_alt_trans" ]]
-lemma "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> f : O(g)" 
-  apply (auto simp add: bigo_def)
-(*Version 2: single-step proof*)
-proof (neg_clausify)
-fix x
-assume 0: "\<And>A\<Colon>'a\<Colon>type.
-   (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) A
-   \<le> (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) A"
-assume 1: "\<And>A\<Colon>'b\<Colon>ordered_idom.
-   \<not> (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) A)
-     \<le> A * \<bar>(g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x A)\<bar>"
-have 2: "\<And>X2\<Colon>'a\<Colon>type.
-   \<not> (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) X2
-     < (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) X2"
-  by (metis 0 linorder_not_le)
-have 3: "\<And>X2\<Colon>'b\<Colon>ordered_idom.
-   \<not> (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) \<bar>X2\<bar>)
-     \<le> \<bar>X2 * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X2\<bar>)\<bar>"
-  by (metis abs_mult 1)
-have 4: "\<And>X2\<Colon>'b\<Colon>ordered_idom.
-   \<bar>X2 * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) \<bar>X2\<bar>)\<bar>
-   < (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X2\<bar>)"
-  by (metis 3 linorder_not_less)
-have 5: "\<And>X2\<Colon>'b\<Colon>ordered_idom.
-   X2 * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) \<bar>X2\<bar>)
-   < (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X2\<bar>)"
-  by (metis abs_less_iff 4)
-show "False"
-  by (metis 2 5)
-qed
-
-
-lemma bigo_bounded: "ALL x. 0 <= f x ==> ALL x. f x <= g x ==> 
-    f : O(g)" 
-  apply (erule bigo_bounded_alt [of f 1 g])
-  apply simp
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_bounded2" ]]
-lemma bigo_bounded2: "ALL x. lb x <= f x ==> ALL x. f x <= lb x + g x ==>
-    f : lb +o O(g)"
-  apply (rule set_minus_imp_plus)
-  apply (rule bigo_bounded)
-  apply (auto simp add: diff_minus fun_Compl_def func_plus)
-  prefer 2
-  apply (drule_tac x = x in spec)+ 
-  apply arith (*not clear that it's provable otherwise*) 
-proof (neg_clausify)
-fix x
-assume 0: "\<And>y. lb y \<le> f y"
-assume 1: "\<not> (0\<Colon>'b) \<le> f x + - lb x"
-have 2: "\<And>X3. (0\<Colon>'b) + X3 = X3"
-  by (metis diff_eq_eq right_minus_eq)
-have 3: "\<not> (0\<Colon>'b) \<le> f x - lb x"
-  by (metis 1 diff_minus)
-have 4: "\<not> (0\<Colon>'b) + lb x \<le> f x"
-  by (metis 3 le_diff_eq)
-show "False"
-  by (metis 4 2 0)
-qed
-
-declare [[ atp_problem_prefix = "BigO__bigo_abs" ]]
-lemma bigo_abs: "(%x. abs(f x)) =o O(f)" 
-  apply (unfold bigo_def)
-  apply auto
-proof (neg_clausify)
-fix x
-assume 0: "\<And>xa. \<not> \<bar>f (x xa)\<bar> \<le> xa * \<bar>f (x xa)\<bar>"
-have 1: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2 \<or> \<not> (1\<Colon>'b) \<le> (1\<Colon>'b)"
-  by (metis mult_le_cancel_right1 order_eq_iff)
-have 2: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2"
-  by (metis order_eq_iff 1)
-show "False"
-  by (metis 0 2)
-qed
-
-declare [[ atp_problem_prefix = "BigO__bigo_abs2" ]]
-lemma bigo_abs2: "f =o O(%x. abs(f x))"
-  apply (unfold bigo_def)
-  apply auto
-proof (neg_clausify)
-fix x
-assume 0: "\<And>xa. \<not> \<bar>f (x xa)\<bar> \<le> xa * \<bar>f (x xa)\<bar>"
-have 1: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2 \<or> \<not> (1\<Colon>'b) \<le> (1\<Colon>'b)"
-  by (metis mult_le_cancel_right1 order_eq_iff)
-have 2: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2"
-  by (metis order_eq_iff 1)
-show "False"
-  by (metis 0 2)
-qed
- 
-lemma bigo_abs3: "O(f) = O(%x. abs(f x))"
-  apply (rule equalityI)
-  apply (rule bigo_elt_subset)
-  apply (rule bigo_abs2)
-  apply (rule bigo_elt_subset)
-  apply (rule bigo_abs)
-done
-
-lemma bigo_abs4: "f =o g +o O(h) ==> 
-    (%x. abs (f x)) =o (%x. abs (g x)) +o O(h)"
-  apply (drule set_plus_imp_minus)
-  apply (rule set_minus_imp_plus)
-  apply (subst fun_diff_def)
-proof -
-  assume a: "f - g : O(h)"
-  have "(%x. abs (f x) - abs (g x)) =o O(%x. abs(abs (f x) - abs (g x)))"
-    by (rule bigo_abs2)
-  also have "... <= O(%x. abs (f x - g x))"
-    apply (rule bigo_elt_subset)
-    apply (rule bigo_bounded)
-    apply force
-    apply (rule allI)
-    apply (rule abs_triangle_ineq3)
-    done
-  also have "... <= O(f - g)"
-    apply (rule bigo_elt_subset)
-    apply (subst fun_diff_def)
-    apply (rule bigo_abs)
-    done
-  also have "... <= O(h)"
-    using a by (rule bigo_elt_subset)
-  finally show "(%x. abs (f x) - abs (g x)) : O(h)".
-qed
-
-lemma bigo_abs5: "f =o O(g) ==> (%x. abs(f x)) =o O(g)" 
-by (unfold bigo_def, auto)
-
-lemma bigo_elt_subset2 [intro]: "f : g +o O(h) ==> O(f) <= O(g) \<oplus> O(h)"
-proof -
-  assume "f : g +o O(h)"
-  also have "... <= O(g) \<oplus> O(h)"
-    by (auto del: subsetI)
-  also have "... = O(%x. abs(g x)) \<oplus> O(%x. abs(h x))"
-    apply (subst bigo_abs3 [symmetric])+
-    apply (rule refl)
-    done
-  also have "... = O((%x. abs(g x)) + (%x. abs(h x)))"
-    by (rule bigo_plus_eq [symmetric], auto)
-  finally have "f : ...".
-  then have "O(f) <= ..."
-    by (elim bigo_elt_subset)
-  also have "... = O(%x. abs(g x)) \<oplus> O(%x. abs(h x))"
-    by (rule bigo_plus_eq, auto)
-  finally show ?thesis
-    by (simp add: bigo_abs3 [symmetric])
-qed
-
-declare [[ atp_problem_prefix = "BigO__bigo_mult" ]]
-lemma bigo_mult [intro]: "O(f)\<otimes>O(g) <= O(f * g)"
-  apply (rule subsetI)
-  apply (subst bigo_def)
-  apply (auto simp del: abs_mult mult_ac
-              simp add: bigo_alt_def set_times_def func_times)
-(*sledgehammer*); 
-  apply (rule_tac x = "c * ca" in exI)
-  apply(rule allI)
-  apply(erule_tac x = x in allE)+
-  apply(subgoal_tac "c * ca * abs(f x * g x) = 
-      (c * abs(f x)) * (ca * abs(g x))")
-using [[ atp_problem_prefix = "BigO__bigo_mult_simpler" ]]
-prefer 2 
-apply (metis mult_assoc mult_left_commute
-  OrderedGroup.abs_of_pos OrderedGroup.mult_left_commute
-  Ring_and_Field.abs_mult Ring_and_Field.mult_pos_pos)
-  apply (erule ssubst) 
-  apply (subst abs_mult)
-(*not qute BigO__bigo_mult_simpler_1 (a hard problem!) as abs_mult has
-  just been done*)
-proof (neg_clausify)
-fix a c b ca x
-assume 0: "(0\<Colon>'b\<Colon>ordered_idom) < (c\<Colon>'b\<Colon>ordered_idom)"
-assume 1: "\<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
-\<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
-assume 2: "\<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
-\<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
-assume 3: "\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> *
-  \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
-  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> *
-    ((ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>)"
-have 4: "\<bar>c\<Colon>'b\<Colon>ordered_idom\<bar> = c"
-  by (metis OrderedGroup.abs_of_pos 0)
-have 5: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (c\<Colon>'b\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>c * X1\<bar>"
-  by (metis Ring_and_Field.abs_mult 4)
-have 6: "(0\<Colon>'b\<Colon>ordered_idom) = (1\<Colon>'b\<Colon>ordered_idom) \<or>
-(0\<Colon>'b\<Colon>ordered_idom) < (1\<Colon>'b\<Colon>ordered_idom)"
-  by (metis OrderedGroup.abs_not_less_zero Ring_and_Field.abs_one Ring_and_Field.linorder_neqE_ordered_idom)
-have 7: "(0\<Colon>'b\<Colon>ordered_idom) < (1\<Colon>'b\<Colon>ordered_idom)"
-  by (metis 6 Ring_and_Field.one_neq_zero)
-have 8: "\<bar>1\<Colon>'b\<Colon>ordered_idom\<bar> = (1\<Colon>'b\<Colon>ordered_idom)"
-  by (metis OrderedGroup.abs_of_pos 7)
-have 9: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>X1\<bar>"
-  by (metis OrderedGroup.abs_ge_zero 5)
-have 10: "\<And>X1\<Colon>'b\<Colon>ordered_idom. X1 * (1\<Colon>'b\<Colon>ordered_idom) = X1"
-  by (metis Ring_and_Field.mult_cancel_right2 mult_commute)
-have 11: "\<And>X1\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X1\<bar>\<bar> = \<bar>X1\<bar> * \<bar>1\<Colon>'b\<Colon>ordered_idom\<bar>"
-  by (metis Ring_and_Field.abs_mult OrderedGroup.abs_idempotent 10)
-have 12: "\<And>X1\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X1\<bar>\<bar> = \<bar>X1\<bar>"
-  by (metis 11 8 10)
-have 13: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>X1\<bar>"
-  by (metis OrderedGroup.abs_ge_zero 12)
-have 14: "\<not> (0\<Colon>'b\<Colon>ordered_idom)
-  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> \<or>
-\<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
-\<not> \<bar>b x\<bar> \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
-\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<le> c * \<bar>f x\<bar>"
-  by (metis 3 Ring_and_Field.mult_mono)
-have 15: "\<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> \<or>
-\<not> \<bar>b x\<bar> \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
-\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
-  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
-  by (metis 14 9)
-have 16: "\<not> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
-  \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
-\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
-  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
-  by (metis 15 13)
-have 17: "\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
-  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
-  by (metis 16 2)
-show 18: "False"
-  by (metis 17 1)
-qed
-
-
-declare [[ atp_problem_prefix = "BigO__bigo_mult2" ]]
-lemma bigo_mult2 [intro]: "f *o O(g) <= O(f * g)"
-  apply (auto simp add: bigo_def elt_set_times_def func_times abs_mult)
-(*sledgehammer*); 
-  apply (rule_tac x = c in exI)
-  apply clarify
-  apply (drule_tac x = x in spec)
-using [[ atp_problem_prefix = "BigO__bigo_mult2_simpler" ]]
-(*sledgehammer [no luck]*); 
-  apply (subgoal_tac "abs(f x) * abs(b x) <= abs(f x) * (c * abs(g x))")
-  apply (simp add: mult_ac)
-  apply (rule mult_left_mono, assumption)
-  apply (rule abs_ge_zero)
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_mult3" ]]
-lemma bigo_mult3: "f : O(h) ==> g : O(j) ==> f * g : O(h * j)"
-by (metis bigo_mult set_times_intro subset_iff)
-
-declare [[ atp_problem_prefix = "BigO__bigo_mult4" ]]
-lemma bigo_mult4 [intro]:"f : k +o O(h) ==> g * f : (g * k) +o O(g * h)"
-by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
-
-
-lemma bigo_mult5: "ALL x. f x ~= 0 ==>
-    O(f * g) <= (f::'a => ('b::ordered_field)) *o O(g)"
-proof -
-  assume "ALL x. f x ~= 0"
-  show "O(f * g) <= f *o O(g)"
-  proof
-    fix h
-    assume "h : O(f * g)"
-    then have "(%x. 1 / (f x)) * h : (%x. 1 / f x) *o O(f * g)"
-      by auto
-    also have "... <= O((%x. 1 / f x) * (f * g))"
-      by (rule bigo_mult2)
-    also have "(%x. 1 / f x) * (f * g) = g"
-      apply (simp add: func_times) 
-      apply (rule ext)
-      apply (simp add: prems nonzero_divide_eq_eq mult_ac)
-      done
-    finally have "(%x. (1::'b) / f x) * h : O(g)".
-    then have "f * ((%x. (1::'b) / f x) * h) : f *o O(g)"
-      by auto
-    also have "f * ((%x. (1::'b) / f x) * h) = h"
-      apply (simp add: func_times) 
-      apply (rule ext)
-      apply (simp add: prems nonzero_divide_eq_eq mult_ac)
-      done
-    finally show "h : f *o O(g)".
-  qed
-qed
-
-declare [[ atp_problem_prefix = "BigO__bigo_mult6" ]]
-lemma bigo_mult6: "ALL x. f x ~= 0 ==>
-    O(f * g) = (f::'a => ('b::ordered_field)) *o O(g)"
-by (metis bigo_mult2 bigo_mult5 order_antisym)
-
-(*proof requires relaxing relevance: 2007-01-25*)
-declare [[ atp_problem_prefix = "BigO__bigo_mult7" ]]
-  declare bigo_mult6 [simp]
-lemma bigo_mult7: "ALL x. f x ~= 0 ==>
-    O(f * g) <= O(f::'a => ('b::ordered_field)) \<otimes> O(g)"
-(*sledgehammer*)
-  apply (subst bigo_mult6)
-  apply assumption
-  apply (rule set_times_mono3) 
-  apply (rule bigo_refl)
-done
-  declare bigo_mult6 [simp del]
-
-declare [[ atp_problem_prefix = "BigO__bigo_mult8" ]]
-  declare bigo_mult7[intro!]
-lemma bigo_mult8: "ALL x. f x ~= 0 ==>
-    O(f * g) = O(f::'a => ('b::ordered_field)) \<otimes> O(g)"
-by (metis bigo_mult bigo_mult7 order_antisym_conv)
-
-lemma bigo_minus [intro]: "f : O(g) ==> - f : O(g)"
-  by (auto simp add: bigo_def fun_Compl_def)
-
-lemma bigo_minus2: "f : g +o O(h) ==> -f : -g +o O(h)"
-  apply (rule set_minus_imp_plus)
-  apply (drule set_plus_imp_minus)
-  apply (drule bigo_minus)
-  apply (simp add: diff_minus)
-done
-
-lemma bigo_minus3: "O(-f) = O(f)"
-  by (auto simp add: bigo_def fun_Compl_def abs_minus_cancel)
-
-lemma bigo_plus_absorb_lemma1: "f : O(g) ==> f +o O(g) <= O(g)"
-proof -
-  assume a: "f : O(g)"
-  show "f +o O(g) <= O(g)"
-  proof -
-    have "f : O(f)" by auto
-    then have "f +o O(g) <= O(f) \<oplus> O(g)"
-      by (auto del: subsetI)
-    also have "... <= O(g) \<oplus> O(g)"
-    proof -
-      from a have "O(f) <= O(g)" by (auto del: subsetI)
-      thus ?thesis by (auto del: subsetI)
-    qed
-    also have "... <= O(g)" by (simp add: bigo_plus_idemp)
-    finally show ?thesis .
-  qed
-qed
-
-lemma bigo_plus_absorb_lemma2: "f : O(g) ==> O(g) <= f +o O(g)"
-proof -
-  assume a: "f : O(g)"
-  show "O(g) <= f +o O(g)"
-  proof -
-    from a have "-f : O(g)" by auto
-    then have "-f +o O(g) <= O(g)" by (elim bigo_plus_absorb_lemma1)
-    then have "f +o (-f +o O(g)) <= f +o O(g)" by auto
-    also have "f +o (-f +o O(g)) = O(g)"
-      by (simp add: set_plus_rearranges)
-    finally show ?thesis .
-  qed
-qed
-
-declare [[ atp_problem_prefix = "BigO__bigo_plus_absorb" ]]
-lemma bigo_plus_absorb [simp]: "f : O(g) ==> f +o O(g) = O(g)"
-by (metis bigo_plus_absorb_lemma1 bigo_plus_absorb_lemma2 order_eq_iff);
-
-lemma bigo_plus_absorb2 [intro]: "f : O(g) ==> A <= O(g) ==> f +o A <= O(g)"
-  apply (subgoal_tac "f +o A <= f +o O(g)")
-  apply force+
-done
-
-lemma bigo_add_commute_imp: "f : g +o O(h) ==> g : f +o O(h)"
-  apply (subst set_minus_plus [symmetric])
-  apply (subgoal_tac "g - f = - (f - g)")
-  apply (erule ssubst)
-  apply (rule bigo_minus)
-  apply (subst set_minus_plus)
-  apply assumption
-  apply  (simp add: diff_minus add_ac)
-done
-
-lemma bigo_add_commute: "(f : g +o O(h)) = (g : f +o O(h))"
-  apply (rule iffI)
-  apply (erule bigo_add_commute_imp)+
-done
-
-lemma bigo_const1: "(%x. c) : O(%x. 1)"
-by (auto simp add: bigo_def mult_ac)
-
-declare [[ atp_problem_prefix = "BigO__bigo_const2" ]]
-lemma (*bigo_const2 [intro]:*) "O(%x. c) <= O(%x. 1)"
-by (metis bigo_const1 bigo_elt_subset);
-
-lemma bigo_const2 [intro]: "O(%x. c::'b::ordered_idom) <= O(%x. 1)";
-(*??FAILS because the two occurrences of COMBK have different polymorphic types
-proof (neg_clausify)
-assume 0: "\<not> O(COMBK (c\<Colon>'b\<Colon>ordered_idom)) \<subseteq> O(COMBK (1\<Colon>'b\<Colon>ordered_idom))"
-have 1: "COMBK (c\<Colon>'b\<Colon>ordered_idom) \<notin> O(COMBK (1\<Colon>'b\<Colon>ordered_idom))"
-apply (rule notI) 
-apply (rule 0 [THEN notE]) 
-apply (rule bigo_elt_subset) 
-apply assumption; 
-sorry
-  by (metis 0 bigo_elt_subset)  loops??
-show "False"
-  by (metis 1 bigo_const1)
-qed
-*)
-  apply (rule bigo_elt_subset)
-  apply (rule bigo_const1)
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_const3" ]]
-lemma bigo_const3: "(c::'a::ordered_field) ~= 0 ==> (%x. 1) : O(%x. c)"
-apply (simp add: bigo_def)
-proof (neg_clausify)
-assume 0: "(c\<Colon>'a\<Colon>ordered_field) \<noteq> (0\<Colon>'a\<Colon>ordered_field)"
-assume 1: "\<And>A\<Colon>'a\<Colon>ordered_field. \<not> (1\<Colon>'a\<Colon>ordered_field) \<le> A * \<bar>c\<Colon>'a\<Colon>ordered_field\<bar>"
-have 2: "(0\<Colon>'a\<Colon>ordered_field) = \<bar>c\<Colon>'a\<Colon>ordered_field\<bar> \<or>
-\<not> (1\<Colon>'a\<Colon>ordered_field) \<le> (1\<Colon>'a\<Colon>ordered_field)"
-  by (metis 1 field_inverse)
-have 3: "\<bar>c\<Colon>'a\<Colon>ordered_field\<bar> = (0\<Colon>'a\<Colon>ordered_field)"
-  by (metis linorder_neq_iff linorder_antisym_conv1 2)
-have 4: "(0\<Colon>'a\<Colon>ordered_field) = (c\<Colon>'a\<Colon>ordered_field)"
-  by (metis 3 abs_eq_0)
-show "False"
-  by (metis 0 4)
-qed
-
-lemma bigo_const4: "(c::'a::ordered_field) ~= 0 ==> O(%x. 1) <= O(%x. c)"
-by (rule bigo_elt_subset, rule bigo_const3, assumption)
-
-lemma bigo_const [simp]: "(c::'a::ordered_field) ~= 0 ==> 
-    O(%x. c) = O(%x. 1)"
-by (rule equalityI, rule bigo_const2, rule bigo_const4, assumption)
-
-declare [[ atp_problem_prefix = "BigO__bigo_const_mult1" ]]
-lemma bigo_const_mult1: "(%x. c * f x) : O(f)"
-  apply (simp add: bigo_def abs_mult)
-proof (neg_clausify)
-fix x
-assume 0: "\<And>xa\<Colon>'b\<Colon>ordered_idom.
-   \<not> \<bar>c\<Colon>'b\<Colon>ordered_idom\<bar> *
-     \<bar>(f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) xa)\<bar>
-     \<le> xa * \<bar>f (x xa)\<bar>"
-show "False"
-  by (metis linorder_neq_iff linorder_antisym_conv1 0)
-qed
-
-lemma bigo_const_mult2: "O(%x. c * f x) <= O(f)"
-by (rule bigo_elt_subset, rule bigo_const_mult1)
-
-declare [[ atp_problem_prefix = "BigO__bigo_const_mult3" ]]
-lemma bigo_const_mult3: "(c::'a::ordered_field) ~= 0 ==> f : O(%x. c * f x)"
-  apply (simp add: bigo_def)
-(*sledgehammer [no luck]*); 
-  apply (rule_tac x = "abs(inverse c)" in exI)
-  apply (simp only: abs_mult [symmetric] mult_assoc [symmetric])
-apply (subst left_inverse) 
-apply (auto ); 
-done
-
-lemma bigo_const_mult4: "(c::'a::ordered_field) ~= 0 ==> 
-    O(f) <= O(%x. c * f x)"
-by (rule bigo_elt_subset, rule bigo_const_mult3, assumption)
-
-lemma bigo_const_mult [simp]: "(c::'a::ordered_field) ~= 0 ==> 
-    O(%x. c * f x) = O(f)"
-by (rule equalityI, rule bigo_const_mult2, erule bigo_const_mult4)
-
-declare [[ atp_problem_prefix = "BigO__bigo_const_mult5" ]]
-lemma bigo_const_mult5 [simp]: "(c::'a::ordered_field) ~= 0 ==> 
-    (%x. c) *o O(f) = O(f)"
-  apply (auto del: subsetI)
-  apply (rule order_trans)
-  apply (rule bigo_mult2)
-  apply (simp add: func_times)
-  apply (auto intro!: subsetI simp add: bigo_def elt_set_times_def func_times)
-  apply (rule_tac x = "%y. inverse c * x y" in exI)
-  apply (rename_tac g d) 
-  apply safe
-  apply (rule_tac [2] ext) 
-   prefer 2 
-   apply simp
-  apply (simp add: mult_assoc [symmetric] abs_mult)
-  (*couldn't get this proof without the step above; SLOW*)
-  apply (metis mult_assoc abs_ge_zero mult_left_mono)
-done
-
-
-declare [[ atp_problem_prefix = "BigO__bigo_const_mult6" ]]
-lemma bigo_const_mult6 [intro]: "(%x. c) *o O(f) <= O(f)"
-  apply (auto intro!: subsetI
-    simp add: bigo_def elt_set_times_def func_times
-    simp del: abs_mult mult_ac)
-(*sledgehammer*); 
-  apply (rule_tac x = "ca * (abs c)" in exI)
-  apply (rule allI)
-  apply (subgoal_tac "ca * abs(c) * abs(f x) = abs(c) * (ca * abs(f x))")
-  apply (erule ssubst)
-  apply (subst abs_mult)
-  apply (rule mult_left_mono)
-  apply (erule spec)
-  apply simp
-  apply(simp add: mult_ac)
-done
-
-lemma bigo_const_mult7 [intro]: "f =o O(g) ==> (%x. c * f x) =o O(g)"
-proof -
-  assume "f =o O(g)"
-  then have "(%x. c) * f =o (%x. c) *o O(g)"
-    by auto
-  also have "(%x. c) * f = (%x. c * f x)"
-    by (simp add: func_times)
-  also have "(%x. c) *o O(g) <= O(g)"
-    by (auto del: subsetI)
-  finally show ?thesis .
-qed
-
-lemma bigo_compose1: "f =o O(g) ==> (%x. f(k x)) =o O(%x. g(k x))"
-by (unfold bigo_def, auto)
-
-lemma bigo_compose2: "f =o g +o O(h) ==> (%x. f(k x)) =o (%x. g(k x)) +o 
-    O(%x. h(k x))"
-  apply (simp only: set_minus_plus [symmetric] diff_minus fun_Compl_def
-      func_plus)
-  apply (erule bigo_compose1)
-done
-
-subsection {* Setsum *}
-
-lemma bigo_setsum_main: "ALL x. ALL y : A x. 0 <= h x y ==> 
-    EX c. ALL x. ALL y : A x. abs(f x y) <= c * (h x y) ==>
-      (%x. SUM y : A x. f x y) =o O(%x. SUM y : A x. h x y)"  
-  apply (auto simp add: bigo_def)
-  apply (rule_tac x = "abs c" in exI)
-  apply (subst abs_of_nonneg) back back
-  apply (rule setsum_nonneg)
-  apply force
-  apply (subst setsum_right_distrib)
-  apply (rule allI)
-  apply (rule order_trans)
-  apply (rule setsum_abs)
-  apply (rule setsum_mono)
-apply (blast intro: order_trans mult_right_mono abs_ge_self) 
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_setsum1" ]]
-lemma bigo_setsum1: "ALL x y. 0 <= h x y ==> 
-    EX c. ALL x y. abs(f x y) <= c * (h x y) ==>
-      (%x. SUM y : A x. f x y) =o O(%x. SUM y : A x. h x y)"
-  apply (rule bigo_setsum_main)
-(*sledgehammer*); 
-  apply force
-  apply clarsimp
-  apply (rule_tac x = c in exI)
-  apply force
-done
-
-lemma bigo_setsum2: "ALL y. 0 <= h y ==> 
-    EX c. ALL y. abs(f y) <= c * (h y) ==>
-      (%x. SUM y : A x. f y) =o O(%x. SUM y : A x. h y)"
-by (rule bigo_setsum1, auto)  
-
-declare [[ atp_problem_prefix = "BigO__bigo_setsum3" ]]
-lemma bigo_setsum3: "f =o O(h) ==>
-    (%x. SUM y : A x. (l x y) * f(k x y)) =o
-      O(%x. SUM y : A x. abs(l x y * h(k x y)))"
-  apply (rule bigo_setsum1)
-  apply (rule allI)+
-  apply (rule abs_ge_zero)
-  apply (unfold bigo_def)
-  apply (auto simp add: abs_mult);
-(*sledgehammer*); 
-  apply (rule_tac x = c in exI)
-  apply (rule allI)+
-  apply (subst mult_left_commute)
-  apply (rule mult_left_mono)
-  apply (erule spec)
-  apply (rule abs_ge_zero)
-done
-
-lemma bigo_setsum4: "f =o g +o O(h) ==>
-    (%x. SUM y : A x. l x y * f(k x y)) =o
-      (%x. SUM y : A x. l x y * g(k x y)) +o
-        O(%x. SUM y : A x. abs(l x y * h(k x y)))"
-  apply (rule set_minus_imp_plus)
-  apply (subst fun_diff_def)
-  apply (subst setsum_subtractf [symmetric])
-  apply (subst right_diff_distrib [symmetric])
-  apply (rule bigo_setsum3)
-  apply (subst fun_diff_def [symmetric])
-  apply (erule set_plus_imp_minus)
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_setsum5" ]]
-lemma bigo_setsum5: "f =o O(h) ==> ALL x y. 0 <= l x y ==> 
-    ALL x. 0 <= h x ==>
-      (%x. SUM y : A x. (l x y) * f(k x y)) =o
-        O(%x. SUM y : A x. (l x y) * h(k x y))" 
-  apply (subgoal_tac "(%x. SUM y : A x. (l x y) * h(k x y)) = 
-      (%x. SUM y : A x. abs((l x y) * h(k x y)))")
-  apply (erule ssubst)
-  apply (erule bigo_setsum3)
-  apply (rule ext)
-  apply (rule setsum_cong2)
-  apply (thin_tac "f \<in> O(h)") 
-apply (metis abs_of_nonneg zero_le_mult_iff)
-done
-
-lemma bigo_setsum6: "f =o g +o O(h) ==> ALL x y. 0 <= l x y ==>
-    ALL x. 0 <= h x ==>
-      (%x. SUM y : A x. (l x y) * f(k x y)) =o
-        (%x. SUM y : A x. (l x y) * g(k x y)) +o
-          O(%x. SUM y : A x. (l x y) * h(k x y))" 
-  apply (rule set_minus_imp_plus)
-  apply (subst fun_diff_def)
-  apply (subst setsum_subtractf [symmetric])
-  apply (subst right_diff_distrib [symmetric])
-  apply (rule bigo_setsum5)
-  apply (subst fun_diff_def [symmetric])
-  apply (drule set_plus_imp_minus)
-  apply auto
-done
-
-subsection {* Misc useful stuff *}
-
-lemma bigo_useful_intro: "A <= O(f) ==> B <= O(f) ==>
-  A \<oplus> B <= O(f)"
-  apply (subst bigo_plus_idemp [symmetric])
-  apply (rule set_plus_mono2)
-  apply assumption+
-done
-
-lemma bigo_useful_add: "f =o O(h) ==> g =o O(h) ==> f + g =o O(h)"
-  apply (subst bigo_plus_idemp [symmetric])
-  apply (rule set_plus_intro)
-  apply assumption+
-done
-  
-lemma bigo_useful_const_mult: "(c::'a::ordered_field) ~= 0 ==> 
-    (%x. c) * f =o O(h) ==> f =o O(h)"
-  apply (rule subsetD)
-  apply (subgoal_tac "(%x. 1 / c) *o O(h) <= O(h)")
-  apply assumption
-  apply (rule bigo_const_mult6)
-  apply (subgoal_tac "f = (%x. 1 / c) * ((%x. c) * f)")
-  apply (erule ssubst)
-  apply (erule set_times_intro2)
-  apply (simp add: func_times) 
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_fix" ]]
-lemma bigo_fix: "(%x. f ((x::nat) + 1)) =o O(%x. h(x + 1)) ==> f 0 = 0 ==>
-    f =o O(h)"
-  apply (simp add: bigo_alt_def)
-(*sledgehammer*); 
-  apply clarify
-  apply (rule_tac x = c in exI)
-  apply safe
-  apply (case_tac "x = 0")
-apply (metis OrderedGroup.abs_ge_zero  OrderedGroup.abs_zero  order_less_le  Ring_and_Field.split_mult_pos_le) 
-  apply (subgoal_tac "x = Suc (x - 1)")
-  apply metis
-  apply simp
-  done
-
-
-lemma bigo_fix2: 
-    "(%x. f ((x::nat) + 1)) =o (%x. g(x + 1)) +o O(%x. h(x + 1)) ==> 
-       f 0 = g 0 ==> f =o g +o O(h)"
-  apply (rule set_minus_imp_plus)
-  apply (rule bigo_fix)
-  apply (subst fun_diff_def)
-  apply (subst fun_diff_def [symmetric])
-  apply (rule set_plus_imp_minus)
-  apply simp
-  apply (simp add: fun_diff_def)
-done
-
-subsection {* Less than or equal to *}
-
-constdefs 
-  lesso :: "('a => 'b::ordered_idom) => ('a => 'b) => ('a => 'b)"
-      (infixl "<o" 70)
-  "f <o g == (%x. max (f x - g x) 0)"
-
-lemma bigo_lesseq1: "f =o O(h) ==> ALL x. abs (g x) <= abs (f x) ==>
-    g =o O(h)"
-  apply (unfold bigo_def)
-  apply clarsimp
-apply (blast intro: order_trans) 
-done
-
-lemma bigo_lesseq2: "f =o O(h) ==> ALL x. abs (g x) <= f x ==>
-      g =o O(h)"
-  apply (erule bigo_lesseq1)
-apply (blast intro: abs_ge_self order_trans) 
-done
-
-lemma bigo_lesseq3: "f =o O(h) ==> ALL x. 0 <= g x ==> ALL x. g x <= f x ==>
-      g =o O(h)"
-  apply (erule bigo_lesseq2)
-  apply (rule allI)
-  apply (subst abs_of_nonneg)
-  apply (erule spec)+
-done
-
-lemma bigo_lesseq4: "f =o O(h) ==>
-    ALL x. 0 <= g x ==> ALL x. g x <= abs (f x) ==>
-      g =o O(h)"
-  apply (erule bigo_lesseq1)
-  apply (rule allI)
-  apply (subst abs_of_nonneg)
-  apply (erule spec)+
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_lesso1" ]]
-lemma bigo_lesso1: "ALL x. f x <= g x ==> f <o g =o O(h)"
-  apply (unfold lesso_def)
-  apply (subgoal_tac "(%x. max (f x - g x) 0) = 0")
-(*??Translation of TSTP raised an exception: Type unification failed: Variable ?'X2.0::type not of sort ord*)
-apply (metis bigo_zero)
-  apply (unfold func_zero)
-  apply (rule ext)
-  apply (simp split: split_max)
-done
-
-
-declare [[ atp_problem_prefix = "BigO__bigo_lesso2" ]]
-lemma bigo_lesso2: "f =o g +o O(h) ==>
-    ALL x. 0 <= k x ==> ALL x. k x <= f x ==>
-      k <o g =o O(h)"
-  apply (unfold lesso_def)
-  apply (rule bigo_lesseq4)
-  apply (erule set_plus_imp_minus)
-  apply (rule allI)
-  apply (rule le_maxI2)
-  apply (rule allI)
-  apply (subst fun_diff_def)
-apply (erule thin_rl)
-(*sledgehammer*);  
-  apply (case_tac "0 <= k x - g x")
-  prefer 2 (*re-order subgoals because I don't know what to put after a structured proof*)
-   apply (metis abs_ge_zero abs_minus_commute linorder_linear min_max.sup_absorb1 min_max.sup_commute)
-proof (neg_clausify)
-fix x
-assume 0: "\<And>A. k A \<le> f A"
-have 1: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X2. \<not> max X1 X2 < X1"
-  by (metis linorder_not_less le_maxI1)  (*sort inserted by hand*)
-assume 2: "(0\<Colon>'b) \<le> k x - g x"
-have 3: "\<not> k x - g x < (0\<Colon>'b)"
-  by (metis 2 linorder_not_less)
-have 4: "\<And>X1 X2. min X1 (k X2) \<le> f X2"
-  by (metis min_max.inf_le2 min_max.le_inf_iff min_max.le_iff_inf 0)
-have 5: "\<bar>g x - f x\<bar> = f x - g x"
-  by (metis abs_minus_commute combine_common_factor mult_zero_right minus_add_cancel minus_zero abs_if diff_less_eq min_max.inf_commute 4 linorder_not_le min_max.le_iff_inf 3 diff_less_0_iff_less linorder_not_less)
-have 6: "max (0\<Colon>'b) (k x - g x) = k x - g x"
-  by (metis min_max.le_iff_sup 2)
-assume 7: "\<not> max (k x - g x) (0\<Colon>'b) \<le> \<bar>f x - g x\<bar>"
-have 8: "\<not> k x - g x \<le> f x - g x"
-  by (metis 5 abs_minus_commute 7 min_max.sup_commute 6)
-show "False"
-  by (metis min_max.sup_commute min_max.inf_commute min_max.sup_inf_absorb min_max.le_iff_inf 0 max_diff_distrib_left 1 linorder_not_le 8)
-qed
-
-declare [[ atp_problem_prefix = "BigO__bigo_lesso3" ]]
-lemma bigo_lesso3: "f =o g +o O(h) ==>
-    ALL x. 0 <= k x ==> ALL x. g x <= k x ==>
-      f <o k =o O(h)"
-  apply (unfold lesso_def)
-  apply (rule bigo_lesseq4)
-  apply (erule set_plus_imp_minus)
-  apply (rule allI)
-  apply (rule le_maxI2)
-  apply (rule allI)
-  apply (subst fun_diff_def)
-apply (erule thin_rl) 
-(*sledgehammer*); 
-  apply (case_tac "0 <= f x - k x")
-  apply (simp)
-  apply (subst abs_of_nonneg)
-  apply (drule_tac x = x in spec) back
-using [[ atp_problem_prefix = "BigO__bigo_lesso3_simpler" ]]
-apply (metis diff_less_0_iff_less linorder_not_le not_leE uminus_add_conv_diff xt1(12) xt1(6))
-apply (metis add_minus_cancel diff_le_eq le_diff_eq uminus_add_conv_diff)
-apply (metis abs_ge_zero linorder_linear min_max.sup_absorb1 min_max.sup_commute)
-done
-
-lemma bigo_lesso4: "f <o g =o O(k::'a=>'b::ordered_field) ==>
-    g =o h +o O(k) ==> f <o h =o O(k)"
-  apply (unfold lesso_def)
-  apply (drule set_plus_imp_minus)
-  apply (drule bigo_abs5) back
-  apply (simp add: fun_diff_def)
-  apply (drule bigo_useful_add)
-  apply assumption
-  apply (erule bigo_lesseq2) back
-  apply (rule allI)
-  apply (auto simp add: func_plus fun_diff_def algebra_simps
-    split: split_max abs_split)
-done
-
-declare [[ atp_problem_prefix = "BigO__bigo_lesso5" ]]
-lemma bigo_lesso5: "f <o g =o O(h) ==>
-    EX C. ALL x. f x <= g x + C * abs(h x)"
-  apply (simp only: lesso_def bigo_alt_def)
-  apply clarsimp
-  apply (metis abs_if abs_mult add_commute diff_le_eq less_not_permute)  
-done
-
-end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/Message.thy
--- a/src/HOL/MetisExamples/Message.thy	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,812 +0,0 @@
-(*  Title:      HOL/MetisTest/Message.thy
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method.
-*)
-
-theory Message imports Main begin
-
-(*Needed occasionally with spy_analz_tac, e.g. in analz_insert_Key_newK*)
-lemma strange_Un_eq [simp]: "A \<union> (B \<union> A) = B \<union> A"
-by blast
-
-types 
-  key = nat
-
-consts
-  all_symmetric :: bool        --{*true if all keys are symmetric*}
-  invKey        :: "key=>key"  --{*inverse of a symmetric key*}
-
-specification (invKey)
-  invKey [simp]: "invKey (invKey K) = K"
-  invKey_symmetric: "all_symmetric --> invKey = id"
-    by (rule exI [of _ id], auto)
-
-
-text{*The inverse of a symmetric key is itself; that of a public key
-      is the private key and vice versa*}
-
-constdefs
-  symKeys :: "key set"
-  "symKeys == {K. invKey K = K}"
-
-datatype  --{*We allow any number of friendly agents*}
-  agent = Server | Friend nat | Spy
-
-datatype
-     msg = Agent  agent     --{*Agent names*}
-         | Number nat       --{*Ordinary integers, timestamps, ...*}
-         | Nonce  nat       --{*Unguessable nonces*}
-         | Key    key       --{*Crypto keys*}
-         | Hash   msg       --{*Hashing*}
-         | MPair  msg msg   --{*Compound messages*}
-         | Crypt  key msg   --{*Encryption, public- or shared-key*}
-
-
-text{*Concrete syntax: messages appear as {|A,B,NA|}, etc...*}
-syntax
-  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2{|_,/ _|})")
-
-syntax (xsymbols)
-  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2\<lbrace>_,/ _\<rbrace>)")
-
-translations
-  "{|x, y, z|}"   == "{|x, {|y, z|}|}"
-  "{|x, y|}"      == "MPair x y"
-
-
-constdefs
-  HPair :: "[msg,msg] => msg"                       ("(4Hash[_] /_)" [0, 1000])
-    --{*Message Y paired with a MAC computed with the help of X*}
-    "Hash[X] Y == {| Hash{|X,Y|}, Y|}"
-
-  keysFor :: "msg set => key set"
-    --{*Keys useful to decrypt elements of a message set*}
-  "keysFor H == invKey ` {K. \<exists>X. Crypt K X \<in> H}"
-
-
-subsubsection{*Inductive Definition of All Parts" of a Message*}
-
-inductive_set
-  parts :: "msg set => msg set"
-  for H :: "msg set"
-  where
-    Inj [intro]:               "X \<in> H ==> X \<in> parts H"
-  | Fst:         "{|X,Y|}   \<in> parts H ==> X \<in> parts H"
-  | Snd:         "{|X,Y|}   \<in> parts H ==> Y \<in> parts H"
-  | Body:        "Crypt K X \<in> parts H ==> X \<in> parts H"
-
-
-declare [[ atp_problem_prefix = "Message__parts_mono" ]]
-lemma parts_mono: "G \<subseteq> H ==> parts(G) \<subseteq> parts(H)"
-apply auto
-apply (erule parts.induct) 
-apply (metis Inj set_mp)
-apply (metis Fst)
-apply (metis Snd)
-apply (metis Body)
-done
-
-
-text{*Equations hold because constructors are injective.*}
-lemma Friend_image_eq [simp]: "(Friend x \<in> Friend`A) = (x:A)"
-by auto
-
-lemma Key_image_eq [simp]: "(Key x \<in> Key`A) = (x\<in>A)"
-by auto
-
-lemma Nonce_Key_image_eq [simp]: "(Nonce x \<notin> Key`A)"
-by auto
-
-
-subsubsection{*Inverse of keys *}
-
-declare [[ atp_problem_prefix = "Message__invKey_eq" ]]
-lemma invKey_eq [simp]: "(invKey K = invKey K') = (K=K')"
-by (metis invKey)
-
-
-subsection{*keysFor operator*}
-
-lemma keysFor_empty [simp]: "keysFor {} = {}"
-by (unfold keysFor_def, blast)
-
-lemma keysFor_Un [simp]: "keysFor (H \<union> H') = keysFor H \<union> keysFor H'"
-by (unfold keysFor_def, blast)
-
-lemma keysFor_UN [simp]: "keysFor (\<Union>i\<in>A. H i) = (\<Union>i\<in>A. keysFor (H i))"
-by (unfold keysFor_def, blast)
-
-text{*Monotonicity*}
-lemma keysFor_mono: "G \<subseteq> H ==> keysFor(G) \<subseteq> keysFor(H)"
-by (unfold keysFor_def, blast)
-
-lemma keysFor_insert_Agent [simp]: "keysFor (insert (Agent A) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Nonce [simp]: "keysFor (insert (Nonce N) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Number [simp]: "keysFor (insert (Number N) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Key [simp]: "keysFor (insert (Key K) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Hash [simp]: "keysFor (insert (Hash X) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_MPair [simp]: "keysFor (insert {|X,Y|} H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Crypt [simp]: 
-    "keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H)"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_image_Key [simp]: "keysFor (Key`E) = {}"
-by (unfold keysFor_def, auto)
-
-lemma Crypt_imp_invKey_keysFor: "Crypt K X \<in> H ==> invKey K \<in> keysFor H"
-by (unfold keysFor_def, blast)
-
-
-subsection{*Inductive relation "parts"*}
-
-lemma MPair_parts:
-     "[| {|X,Y|} \<in> parts H;        
-         [| X \<in> parts H; Y \<in> parts H |] ==> P |] ==> P"
-by (blast dest: parts.Fst parts.Snd) 
-
-    declare MPair_parts [elim!]  parts.Body [dest!]
-text{*NB These two rules are UNSAFE in the formal sense, as they discard the
-     compound message.  They work well on THIS FILE.  
-  @{text MPair_parts} is left as SAFE because it speeds up proofs.
-  The Crypt rule is normally kept UNSAFE to avoid breaking up certificates.*}
-
-lemma parts_increasing: "H \<subseteq> parts(H)"
-by blast
-
-lemmas parts_insertI = subset_insertI [THEN parts_mono, THEN subsetD, standard]
-
-lemma parts_empty [simp]: "parts{} = {}"
-apply safe
-apply (erule parts.induct)
-apply blast+
-done
-
-lemma parts_emptyE [elim!]: "X\<in> parts{} ==> P"
-by simp
-
-text{*WARNING: loops if H = {Y}, therefore must not be repeated!*}
-lemma parts_singleton: "X\<in> parts H ==> \<exists>Y\<in>H. X\<in> parts {Y}"
-apply (erule parts.induct)
-apply fast+
-done
-
-
-subsubsection{*Unions *}
-
-lemma parts_Un_subset1: "parts(G) \<union> parts(H) \<subseteq> parts(G \<union> H)"
-by (intro Un_least parts_mono Un_upper1 Un_upper2)
-
-lemma parts_Un_subset2: "parts(G \<union> H) \<subseteq> parts(G) \<union> parts(H)"
-apply (rule subsetI)
-apply (erule parts.induct, blast+)
-done
-
-lemma parts_Un [simp]: "parts(G \<union> H) = parts(G) \<union> parts(H)"
-by (intro equalityI parts_Un_subset1 parts_Un_subset2)
-
-lemma parts_insert: "parts (insert X H) = parts {X} \<union> parts H"
-apply (subst insert_is_Un [of _ H])
-apply (simp only: parts_Un)
-done
-
-declare [[ atp_problem_prefix = "Message__parts_insert_two" ]]
-lemma parts_insert2:
-     "parts (insert X (insert Y H)) = parts {X} \<union> parts {Y} \<union> parts H"
-by (metis Un_commute Un_empty_left Un_empty_right Un_insert_left Un_insert_right parts_Un)
-
-
-lemma parts_UN_subset1: "(\<Union>x\<in>A. parts(H x)) \<subseteq> parts(\<Union>x\<in>A. H x)"
-by (intro UN_least parts_mono UN_upper)
-
-lemma parts_UN_subset2: "parts(\<Union>x\<in>A. H x) \<subseteq> (\<Union>x\<in>A. parts(H x))"
-apply (rule subsetI)
-apply (erule parts.induct, blast+)
-done
-
-lemma parts_UN [simp]: "parts(\<Union>x\<in>A. H x) = (\<Union>x\<in>A. parts(H x))"
-by (intro equalityI parts_UN_subset1 parts_UN_subset2)
-
-text{*Added to simplify arguments to parts, analz and synth.
-  NOTE: the UN versions are no longer used!*}
-
-
-text{*This allows @{text blast} to simplify occurrences of 
-  @{term "parts(G\<union>H)"} in the assumption.*}
-lemmas in_parts_UnE = parts_Un [THEN equalityD1, THEN subsetD, THEN UnE] 
-declare in_parts_UnE [elim!]
-
-lemma parts_insert_subset: "insert X (parts H) \<subseteq> parts(insert X H)"
-by (blast intro: parts_mono [THEN [2] rev_subsetD])
-
-subsubsection{*Idempotence and transitivity *}
-
-lemma parts_partsD [dest!]: "X\<in> parts (parts H) ==> X\<in> parts H"
-by (erule parts.induct, blast+)
-
-lemma parts_idem [simp]: "parts (parts H) = parts H"
-by blast
-
-declare [[ atp_problem_prefix = "Message__parts_subset_iff" ]]
-lemma parts_subset_iff [simp]: "(parts G \<subseteq> parts H) = (G \<subseteq> parts H)"
-apply (rule iffI) 
-apply (metis Un_absorb1 Un_subset_iff parts_Un parts_increasing)
-apply (metis parts_idem parts_mono)
-done
-
-lemma parts_trans: "[| X\<in> parts G;  G \<subseteq> parts H |] ==> X\<in> parts H"
-by (blast dest: parts_mono); 
-
-
-declare [[ atp_problem_prefix = "Message__parts_cut" ]]
-lemma parts_cut: "[|Y\<in> parts(insert X G);  X\<in> parts H|] ==> Y\<in> parts(G \<union> H)"
-by (metis Un_subset_iff insert_subset parts_increasing parts_trans) 
-
-
-
-subsubsection{*Rewrite rules for pulling out atomic messages *}
-
-lemmas parts_insert_eq_I = equalityI [OF subsetI parts_insert_subset]
-
-
-lemma parts_insert_Agent [simp]:
-     "parts (insert (Agent agt) H) = insert (Agent agt) (parts H)"
-apply (rule parts_insert_eq_I) 
-apply (erule parts.induct, auto) 
-done
-
-lemma parts_insert_Nonce [simp]:
-     "parts (insert (Nonce N) H) = insert (Nonce N) (parts H)"
-apply (rule parts_insert_eq_I) 
-apply (erule parts.induct, auto) 
-done
-
-lemma parts_insert_Number [simp]:
-     "parts (insert (Number N) H) = insert (Number N) (parts H)"
-apply (rule parts_insert_eq_I) 
-apply (erule parts.induct, auto) 
-done
-
-lemma parts_insert_Key [simp]:
-     "parts (insert (Key K) H) = insert (Key K) (parts H)"
-apply (rule parts_insert_eq_I) 
-apply (erule parts.induct, auto) 
-done
-
-lemma parts_insert_Hash [simp]:
-     "parts (insert (Hash X) H) = insert (Hash X) (parts H)"
-apply (rule parts_insert_eq_I) 
-apply (erule parts.induct, auto) 
-done
-
-lemma parts_insert_Crypt [simp]:
-     "parts (insert (Crypt K X) H) =  
-          insert (Crypt K X) (parts (insert X H))"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule parts.induct, auto)
-apply (blast intro: parts.Body)
-done
-
-lemma parts_insert_MPair [simp]:
-     "parts (insert {|X,Y|} H) =  
-          insert {|X,Y|} (parts (insert X (insert Y H)))"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule parts.induct, auto)
-apply (blast intro: parts.Fst parts.Snd)+
-done
-
-lemma parts_image_Key [simp]: "parts (Key`N) = Key`N"
-apply auto
-apply (erule parts.induct, auto)
-done
-
-
-declare [[ atp_problem_prefix = "Message__msg_Nonce_supply" ]]
-lemma msg_Nonce_supply: "\<exists>N. \<forall>n. N\<le>n --> Nonce n \<notin> parts {msg}"
-apply (induct_tac "msg") 
-apply (simp_all add: parts_insert2)
-apply (metis Suc_n_not_le_n)
-apply (metis le_trans linorder_linear)
-done
-
-subsection{*Inductive relation "analz"*}
-
-text{*Inductive definition of "analz" -- what can be broken down from a set of
-    messages, including keys.  A form of downward closure.  Pairs can
-    be taken apart; messages decrypted with known keys.  *}
-
-inductive_set
-  analz :: "msg set => msg set"
-  for H :: "msg set"
-  where
-    Inj [intro,simp] :    "X \<in> H ==> X \<in> analz H"
-  | Fst:     "{|X,Y|} \<in> analz H ==> X \<in> analz H"
-  | Snd:     "{|X,Y|} \<in> analz H ==> Y \<in> analz H"
-  | Decrypt [dest]: 
-             "[|Crypt K X \<in> analz H; Key(invKey K): analz H|] ==> X \<in> analz H"
-
-
-text{*Monotonicity; Lemma 1 of Lowe's paper*}
-lemma analz_mono: "G\<subseteq>H ==> analz(G) \<subseteq> analz(H)"
-apply auto
-apply (erule analz.induct) 
-apply (auto dest: analz.Fst analz.Snd) 
-done
-
-text{*Making it safe speeds up proofs*}
-lemma MPair_analz [elim!]:
-     "[| {|X,Y|} \<in> analz H;        
-             [| X \<in> analz H; Y \<in> analz H |] ==> P   
-          |] ==> P"
-by (blast dest: analz.Fst analz.Snd)
-
-lemma analz_increasing: "H \<subseteq> analz(H)"
-by blast
-
-lemma analz_subset_parts: "analz H \<subseteq> parts H"
-apply (rule subsetI)
-apply (erule analz.induct, blast+)
-done
-
-lemmas analz_into_parts = analz_subset_parts [THEN subsetD, standard]
-
-lemmas not_parts_not_analz = analz_subset_parts [THEN contra_subsetD, standard]
-
-
-declare [[ atp_problem_prefix = "Message__parts_analz" ]]
-lemma parts_analz [simp]: "parts (analz H) = parts H"
-apply (rule equalityI)
-apply (metis analz_subset_parts parts_subset_iff)
-apply (metis analz_increasing parts_mono)
-done
-
-
-lemma analz_parts [simp]: "analz (parts H) = parts H"
-apply auto
-apply (erule analz.induct, auto)
-done
-
-lemmas analz_insertI = subset_insertI [THEN analz_mono, THEN [2] rev_subsetD, standard]
-
-subsubsection{*General equational properties *}
-
-lemma analz_empty [simp]: "analz{} = {}"
-apply safe
-apply (erule analz.induct, blast+)
-done
-
-text{*Converse fails: we can analz more from the union than from the 
-  separate parts, as a key in one might decrypt a message in the other*}
-lemma analz_Un: "analz(G) \<union> analz(H) \<subseteq> analz(G \<union> H)"
-by (intro Un_least analz_mono Un_upper1 Un_upper2)
-
-lemma analz_insert: "insert X (analz H) \<subseteq> analz(insert X H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-subsubsection{*Rewrite rules for pulling out atomic messages *}
-
-lemmas analz_insert_eq_I = equalityI [OF subsetI analz_insert]
-
-lemma analz_insert_Agent [simp]:
-     "analz (insert (Agent agt) H) = insert (Agent agt) (analz H)"
-apply (rule analz_insert_eq_I) 
-apply (erule analz.induct, auto) 
-done
-
-lemma analz_insert_Nonce [simp]:
-     "analz (insert (Nonce N) H) = insert (Nonce N) (analz H)"
-apply (rule analz_insert_eq_I) 
-apply (erule analz.induct, auto) 
-done
-
-lemma analz_insert_Number [simp]:
-     "analz (insert (Number N) H) = insert (Number N) (analz H)"
-apply (rule analz_insert_eq_I) 
-apply (erule analz.induct, auto) 
-done
-
-lemma analz_insert_Hash [simp]:
-     "analz (insert (Hash X) H) = insert (Hash X) (analz H)"
-apply (rule analz_insert_eq_I) 
-apply (erule analz.induct, auto) 
-done
-
-text{*Can only pull out Keys if they are not needed to decrypt the rest*}
-lemma analz_insert_Key [simp]: 
-    "K \<notin> keysFor (analz H) ==>   
-          analz (insert (Key K) H) = insert (Key K) (analz H)"
-apply (unfold keysFor_def)
-apply (rule analz_insert_eq_I) 
-apply (erule analz.induct, auto) 
-done
-
-lemma analz_insert_MPair [simp]:
-     "analz (insert {|X,Y|} H) =  
-          insert {|X,Y|} (analz (insert X (insert Y H)))"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule analz.induct, auto)
-apply (erule analz.induct)
-apply (blast intro: analz.Fst analz.Snd)+
-done
-
-text{*Can pull out enCrypted message if the Key is not known*}
-lemma analz_insert_Crypt:
-     "Key (invKey K) \<notin> analz H 
-      ==> analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)"
-apply (rule analz_insert_eq_I) 
-apply (erule analz.induct, auto) 
-
-done
-
-lemma lemma1: "Key (invKey K) \<in> analz H ==>   
-               analz (insert (Crypt K X) H) \<subseteq>  
-               insert (Crypt K X) (analz (insert X H))" 
-apply (rule subsetI)
-apply (erule_tac x = x in analz.induct, auto)
-done
-
-lemma lemma2: "Key (invKey K) \<in> analz H ==>   
-               insert (Crypt K X) (analz (insert X H)) \<subseteq>  
-               analz (insert (Crypt K X) H)"
-apply auto
-apply (erule_tac x = x in analz.induct, auto)
-apply (blast intro: analz_insertI analz.Decrypt)
-done
-
-lemma analz_insert_Decrypt:
-     "Key (invKey K) \<in> analz H ==>   
-               analz (insert (Crypt K X) H) =  
-               insert (Crypt K X) (analz (insert X H))"
-by (intro equalityI lemma1 lemma2)
-
-text{*Case analysis: either the message is secure, or it is not! Effective,
-but can cause subgoals to blow up! Use with @{text "split_if"}; apparently
-@{text "split_tac"} does not cope with patterns such as @{term"analz (insert
-(Crypt K X) H)"} *} 
-lemma analz_Crypt_if [simp]:
-     "analz (insert (Crypt K X) H) =                 
-          (if (Key (invKey K) \<in> analz H)                 
-           then insert (Crypt K X) (analz (insert X H))  
-           else insert (Crypt K X) (analz H))"
-by (simp add: analz_insert_Crypt analz_insert_Decrypt)
-
-
-text{*This rule supposes "for the sake of argument" that we have the key.*}
-lemma analz_insert_Crypt_subset:
-     "analz (insert (Crypt K X) H) \<subseteq>   
-           insert (Crypt K X) (analz (insert X H))"
-apply (rule subsetI)
-apply (erule analz.induct, auto)
-done
-
-
-lemma analz_image_Key [simp]: "analz (Key`N) = Key`N"
-apply auto
-apply (erule analz.induct, auto)
-done
-
-
-subsubsection{*Idempotence and transitivity *}
-
-lemma analz_analzD [dest!]: "X\<in> analz (analz H) ==> X\<in> analz H"
-by (erule analz.induct, blast+)
-
-lemma analz_idem [simp]: "analz (analz H) = analz H"
-by blast
-
-lemma analz_subset_iff [simp]: "(analz G \<subseteq> analz H) = (G \<subseteq> analz H)"
-apply (rule iffI)
-apply (iprover intro: subset_trans analz_increasing)  
-apply (frule analz_mono, simp) 
-done
-
-lemma analz_trans: "[| X\<in> analz G;  G \<subseteq> analz H |] ==> X\<in> analz H"
-by (drule analz_mono, blast)
-
-
-declare [[ atp_problem_prefix = "Message__analz_cut" ]]
-    declare analz_trans[intro]
-lemma analz_cut: "[| Y\<in> analz (insert X H);  X\<in> analz H |] ==> Y\<in> analz H"
-(*TOO SLOW
-by (metis analz_idem analz_increasing analz_mono insert_absorb insert_mono insert_subset) --{*317s*}
-??*)
-by (erule analz_trans, blast)
-
-
-text{*This rewrite rule helps in the simplification of messages that involve
-  the forwarding of unknown components (X).  Without it, removing occurrences
-  of X can be very complicated. *}
-lemma analz_insert_eq: "X\<in> analz H ==> analz (insert X H) = analz H"
-by (blast intro: analz_cut analz_insertI)
-
-
-text{*A congruence rule for "analz" *}
-
-declare [[ atp_problem_prefix = "Message__analz_subset_cong" ]]
-lemma analz_subset_cong:
-     "[| analz G \<subseteq> analz G'; analz H \<subseteq> analz H' |] 
-      ==> analz (G \<union> H) \<subseteq> analz (G' \<union> H')"
-apply simp
-apply (metis Un_absorb2 Un_commute Un_subset_iff Un_upper1 Un_upper2 analz_mono)
-done
-
-
-lemma analz_cong:
-     "[| analz G = analz G'; analz H = analz H'  
-               |] ==> analz (G \<union> H) = analz (G' \<union> H')"
-by (intro equalityI analz_subset_cong, simp_all) 
-
-lemma analz_insert_cong:
-     "analz H = analz H' ==> analz(insert X H) = analz(insert X H')"
-by (force simp only: insert_def intro!: analz_cong)
-
-text{*If there are no pairs or encryptions then analz does nothing*}
-lemma analz_trivial:
-     "[| \<forall>X Y. {|X,Y|} \<notin> H;  \<forall>X K. Crypt K X \<notin> H |] ==> analz H = H"
-apply safe
-apply (erule analz.induct, blast+)
-done
-
-text{*These two are obsolete (with a single Spy) but cost little to prove...*}
-lemma analz_UN_analz_lemma:
-     "X\<in> analz (\<Union>i\<in>A. analz (H i)) ==> X\<in> analz (\<Union>i\<in>A. H i)"
-apply (erule analz.induct)
-apply (blast intro: analz_mono [THEN [2] rev_subsetD])+
-done
-
-lemma analz_UN_analz [simp]: "analz (\<Union>i\<in>A. analz (H i)) = analz (\<Union>i\<in>A. H i)"
-by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD])
-
-
-subsection{*Inductive relation "synth"*}
-
-text{*Inductive definition of "synth" -- what can be built up from a set of
-    messages.  A form of upward closure.  Pairs can be built, messages
-    encrypted with known keys.  Agent names are public domain.
-    Numbers can be guessed, but Nonces cannot be.  *}
-
-inductive_set
-  synth :: "msg set => msg set"
-  for H :: "msg set"
-  where
-    Inj    [intro]:   "X \<in> H ==> X \<in> synth H"
-  | Agent  [intro]:   "Agent agt \<in> synth H"
-  | Number [intro]:   "Number n  \<in> synth H"
-  | Hash   [intro]:   "X \<in> synth H ==> Hash X \<in> synth H"
-  | MPair  [intro]:   "[|X \<in> synth H;  Y \<in> synth H|] ==> {|X,Y|} \<in> synth H"
-  | Crypt  [intro]:   "[|X \<in> synth H;  Key(K) \<in> H|] ==> Crypt K X \<in> synth H"
-
-text{*Monotonicity*}
-lemma synth_mono: "G\<subseteq>H ==> synth(G) \<subseteq> synth(H)"
-  by (auto, erule synth.induct, auto)  
-
-text{*NO @{text Agent_synth}, as any Agent name can be synthesized.  
-  The same holds for @{term Number}*}
-inductive_cases Nonce_synth [elim!]: "Nonce n \<in> synth H"
-inductive_cases Key_synth   [elim!]: "Key K \<in> synth H"
-inductive_cases Hash_synth  [elim!]: "Hash X \<in> synth H"
-inductive_cases MPair_synth [elim!]: "{|X,Y|} \<in> synth H"
-inductive_cases Crypt_synth [elim!]: "Crypt K X \<in> synth H"
-
-
-lemma synth_increasing: "H \<subseteq> synth(H)"
-by blast
-
-subsubsection{*Unions *}
-
-text{*Converse fails: we can synth more from the union than from the 
-  separate parts, building a compound message using elements of each.*}
-lemma synth_Un: "synth(G) \<union> synth(H) \<subseteq> synth(G \<union> H)"
-by (intro Un_least synth_mono Un_upper1 Un_upper2)
-
-
-declare [[ atp_problem_prefix = "Message__synth_insert" ]]
- 
-lemma synth_insert: "insert X (synth H) \<subseteq> synth(insert X H)"
-by (metis insert_iff insert_subset subset_insertI synth.Inj synth_mono)
-
-subsubsection{*Idempotence and transitivity *}
-
-lemma synth_synthD [dest!]: "X\<in> synth (synth H) ==> X\<in> synth H"
-by (erule synth.induct, blast+)
-
-lemma synth_idem: "synth (synth H) = synth H"
-by blast
-
-lemma synth_subset_iff [simp]: "(synth G \<subseteq> synth H) = (G \<subseteq> synth H)"
-apply (rule iffI)
-apply (iprover intro: subset_trans synth_increasing)  
-apply (frule synth_mono, simp add: synth_idem) 
-done
-
-lemma synth_trans: "[| X\<in> synth G;  G \<subseteq> synth H |] ==> X\<in> synth H"
-by (drule synth_mono, blast)
-
-declare [[ atp_problem_prefix = "Message__synth_cut" ]]
-lemma synth_cut: "[| Y\<in> synth (insert X H);  X\<in> synth H |] ==> Y\<in> synth H"
-(*TOO SLOW
-by (metis insert_absorb insert_mono insert_subset synth_idem synth_increasing synth_mono)
-*)
-by (erule synth_trans, blast)
-
-
-lemma Agent_synth [simp]: "Agent A \<in> synth H"
-by blast
-
-lemma Number_synth [simp]: "Number n \<in> synth H"
-by blast
-
-lemma Nonce_synth_eq [simp]: "(Nonce N \<in> synth H) = (Nonce N \<in> H)"
-by blast
-
-lemma Key_synth_eq [simp]: "(Key K \<in> synth H) = (Key K \<in> H)"
-by blast
-
-lemma Crypt_synth_eq [simp]:
-     "Key K \<notin> H ==> (Crypt K X \<in> synth H) = (Crypt K X \<in> H)"
-by blast
-
-
-lemma keysFor_synth [simp]: 
-    "keysFor (synth H) = keysFor H \<union> invKey`{K. Key K \<in> H}"
-by (unfold keysFor_def, blast)
-
-
-subsubsection{*Combinations of parts, analz and synth *}
-
-declare [[ atp_problem_prefix = "Message__parts_synth" ]]
-lemma parts_synth [simp]: "parts (synth H) = parts H \<union> synth H"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule parts.induct)
-apply (metis UnCI)
-apply (metis MPair_synth UnCI UnE insert_absorb insert_subset parts.Fst parts_increasing)
-apply (metis MPair_synth UnCI UnE insert_absorb insert_subset parts.Snd parts_increasing)
-apply (metis Body Crypt_synth UnCI UnE insert_absorb insert_subset parts_increasing)
-apply (metis Un_subset_iff parts_increasing parts_mono synth_increasing)
-done
-
-
-
-
-declare [[ atp_problem_prefix = "Message__analz_analz_Un" ]]
-lemma analz_analz_Un [simp]: "analz (analz G \<union> H) = analz (G \<union> H)"
-apply (rule equalityI);
-apply (metis analz_idem analz_subset_cong order_eq_refl)
-apply (metis analz_increasing analz_subset_cong order_eq_refl)
-done
-
-declare [[ atp_problem_prefix = "Message__analz_synth_Un" ]]
-    declare analz_mono [intro] analz.Fst [intro] analz.Snd [intro] Un_least [intro]
-lemma analz_synth_Un [simp]: "analz (synth G \<union> H) = analz (G \<union> H) \<union> synth G"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule analz.induct)
-apply (metis UnCI UnE Un_commute analz.Inj)
-apply (metis MPair_synth UnCI UnE Un_commute Un_upper1 analz.Fst analz_increasing analz_mono insert_absorb insert_subset)
-apply (metis MPair_synth UnCI UnE Un_commute Un_upper1 analz.Snd analz_increasing analz_mono insert_absorb insert_subset)
-apply (blast intro: analz.Decrypt)
-apply blast
-done
-
-
-declare [[ atp_problem_prefix = "Message__analz_synth" ]]
-lemma analz_synth [simp]: "analz (synth H) = analz H \<union> synth H"
-proof (neg_clausify)
-assume 0: "analz (synth H) \<noteq> analz H \<union> synth H"
-have 1: "\<And>X1 X3. sup (analz (sup X3 X1)) (synth X3) = analz (sup (synth X3) X1)"
-  by (metis analz_synth_Un)
-have 2: "sup (analz H) (synth H) \<noteq> analz (synth H)"
-  by (metis 0)
-have 3: "\<And>X1 X3. sup (synth X3) (analz (sup X3 X1)) = analz (sup (synth X3) X1)"
-  by (metis 1 Un_commute)
-have 4: "\<And>X3. sup (synth X3) (analz X3) = analz (sup (synth X3) {})"
-  by (metis 3 Un_empty_right)
-have 5: "\<And>X3. sup (synth X3) (analz X3) = analz (synth X3)"
-  by (metis 4 Un_empty_right)
-have 6: "\<And>X3. sup (analz X3) (synth X3) = analz (synth X3)"
-  by (metis 5 Un_commute)
-show "False"
-  by (metis 2 6)
-qed
-
-
-subsubsection{*For reasoning about the Fake rule in traces *}
-
-declare [[ atp_problem_prefix = "Message__parts_insert_subset_Un" ]]
-lemma parts_insert_subset_Un: "X\<in> G ==> parts(insert X H) \<subseteq> parts G \<union> parts H"
-proof (neg_clausify)
-assume 0: "X \<in> G"
-assume 1: "\<not> parts (insert X H) \<subseteq> parts G \<union> parts H"
-have 2: "\<not> parts (insert X H) \<subseteq> parts (G \<union> H)"
-  by (metis 1 parts_Un)
-have 3: "\<not> insert X H \<subseteq> G \<union> H"
-  by (metis 2 parts_mono)
-have 4: "X \<notin> G \<union> H \<or> \<not> H \<subseteq> G \<union> H"
-  by (metis 3 insert_subset)
-have 5: "X \<notin> G \<union> H"
-  by (metis 4 Un_upper2)
-have 6: "X \<notin> G"
-  by (metis 5 UnCI)
-show "False"
-  by (metis 6 0)
-qed
-
-declare [[ atp_problem_prefix = "Message__Fake_parts_insert" ]]
-lemma Fake_parts_insert:
-     "X \<in> synth (analz H) ==>  
-      parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
-proof (neg_clausify)
-assume 0: "X \<in> synth (analz H)"
-assume 1: "\<not> parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
-have 2: "\<And>X3. parts X3 \<union> synth (analz X3) = parts (synth (analz X3))"
-  by (metis parts_synth parts_analz)
-have 3: "\<And>X3. analz X3 \<union> synth (analz X3) = analz (synth (analz X3))"
-  by (metis analz_synth analz_idem)
-have 4: "\<And>X3. analz X3 \<subseteq> analz (synth X3)"
-  by (metis Un_upper1 analz_synth)
-have 5: "\<not> parts (insert X H) \<subseteq> parts H \<union> synth (analz H)"
-  by (metis 1 Un_commute)
-have 6: "\<not> parts (insert X H) \<subseteq> parts (synth (analz H))"
-  by (metis 5 2)
-have 7: "\<not> insert X H \<subseteq> synth (analz H)"
-  by (metis 6 parts_mono)
-have 8: "X \<notin> synth (analz H) \<or> \<not> H \<subseteq> synth (analz H)"
-  by (metis 7 insert_subset)
-have 9: "\<not> H \<subseteq> synth (analz H)"
-  by (metis 8 0)
-have 10: "\<And>X3. X3 \<subseteq> analz (synth X3)"
-  by (metis analz_subset_iff 4)
-have 11: "\<And>X3. X3 \<subseteq> analz (synth (analz X3))"
-  by (metis analz_subset_iff 10)
-have 12: "\<And>X3. analz (synth (analz X3)) = synth (analz X3) \<or>
-     \<not> analz X3 \<subseteq> synth (analz X3)"
-  by (metis Un_absorb1 3)
-have 13: "\<And>X3. analz (synth (analz X3)) = synth (analz X3)"
-  by (metis 12 synth_increasing)
-have 14: "\<And>X3. X3 \<subseteq> synth (analz X3)"
-  by (metis 11 13)
-show "False"
-  by (metis 9 14)
-qed
-
-lemma Fake_parts_insert_in_Un:
-     "[|Z \<in> parts (insert X H);  X: synth (analz H)|] 
-      ==> Z \<in>  synth (analz H) \<union> parts H";
-by (blast dest: Fake_parts_insert  [THEN subsetD, dest])
-
-declare [[ atp_problem_prefix = "Message__Fake_analz_insert" ]]
-    declare analz_mono [intro] synth_mono [intro] 
-lemma Fake_analz_insert:
-     "X\<in> synth (analz G) ==>  
-      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
-by (metis Un_commute Un_insert_left Un_insert_right Un_upper1 analz_analz_Un analz_mono analz_synth_Un equalityE insert_absorb order_le_less xt1(12))
-
-declare [[ atp_problem_prefix = "Message__Fake_analz_insert_simpler" ]]
-(*simpler problems?  BUT METIS CAN'T PROVE
-lemma Fake_analz_insert_simpler:
-     "X\<in> synth (analz G) ==>  
-      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
-apply (rule subsetI)
-apply (subgoal_tac "x \<in> analz (synth (analz G) \<union> H) ")
-apply (metis Un_commute analz_analz_Un analz_synth_Un)
-apply (metis Un_commute Un_upper1 Un_upper2 analz_cut analz_increasing analz_mono insert_absorb insert_mono insert_subset)
-done
-*)
-
-end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/ROOT.ML
--- a/src/HOL/MetisExamples/ROOT.ML	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(*  Title:      HOL/MetisExamples/ROOT.ML
-    ID:         $Id$
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method.
-*)
-
-use_thys ["set", "BigO", "Abstraction", "BT", "Message", "Tarski", "TransClosure"];
-
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/Tarski.thy
--- a/src/HOL/MetisExamples/Tarski.thy	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1110 +0,0 @@
-(*  Title:      HOL/MetisTest/Tarski.thy
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method.
-*)
-
-header {* The Full Theorem of Tarski *}
-
-theory Tarski
-imports Main FuncSet
-begin
-
-(*Many of these higher-order problems appear to be impossible using the
-current linkup. They often seem to need either higher-order unification
-or explicit reasoning about connectives such as conjunction. The numerous
-set comprehensions are to blame.*)
-
-
-record 'a potype =
-  pset  :: "'a set"
-  order :: "('a * 'a) set"
-
-constdefs
-  monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool"
-  "monotone f A r == \<forall>x\<in>A. \<forall>y\<in>A. (x, y): r --> ((f x), (f y)) : r"
-
-  least :: "['a => bool, 'a potype] => 'a"
-  "least P po == @ x. x: pset po & P x &
-                       (\<forall>y \<in> pset po. P y --> (x,y): order po)"
-
-  greatest :: "['a => bool, 'a potype] => 'a"
-  "greatest P po == @ x. x: pset po & P x &
-                          (\<forall>y \<in> pset po. P y --> (y,x): order po)"
-
-  lub  :: "['a set, 'a potype] => 'a"
-  "lub S po == least (%x. \<forall>y\<in>S. (y,x): order po) po"
-
-  glb  :: "['a set, 'a potype] => 'a"
-  "glb S po == greatest (%x. \<forall>y\<in>S. (x,y): order po) po"
-
-  isLub :: "['a set, 'a potype, 'a] => bool"
-  "isLub S po == %L. (L: pset po & (\<forall>y\<in>S. (y,L): order po) &
-                   (\<forall>z\<in>pset po. (\<forall>y\<in>S. (y,z): order po) --> (L,z): order po))"
-
-  isGlb :: "['a set, 'a potype, 'a] => bool"
-  "isGlb S po == %G. (G: pset po & (\<forall>y\<in>S. (G,y): order po) &
-                 (\<forall>z \<in> pset po. (\<forall>y\<in>S. (z,y): order po) --> (z,G): order po))"
-
-  "fix"    :: "[('a => 'a), 'a set] => 'a set"
-  "fix f A  == {x. x: A & f x = x}"
-
-  interval :: "[('a*'a) set,'a, 'a ] => 'a set"
-  "interval r a b == {x. (a,x): r & (x,b): r}"
-
-constdefs
-  Bot :: "'a potype => 'a"
-  "Bot po == least (%x. True) po"
-
-  Top :: "'a potype => 'a"
-  "Top po == greatest (%x. True) po"
-
-  PartialOrder :: "('a potype) set"
-  "PartialOrder == {P. refl_on (pset P) (order P) & antisym (order P) &
-                       trans (order P)}"
-
-  CompleteLattice :: "('a potype) set"
-  "CompleteLattice == {cl. cl: PartialOrder &
-                        (\<forall>S. S \<subseteq> pset cl --> (\<exists>L. isLub S cl L)) &
-                        (\<forall>S. S \<subseteq> pset cl --> (\<exists>G. isGlb S cl G))}"
-
-  induced :: "['a set, ('a * 'a) set] => ('a *'a)set"
-  "induced A r == {(a,b). a : A & b: A & (a,b): r}"
-
-constdefs
-  sublattice :: "('a potype * 'a set)set"
-  "sublattice ==
-      SIGMA cl: CompleteLattice.
-          {S. S \<subseteq> pset cl &
-           (| pset = S, order = induced S (order cl) |): CompleteLattice }"
-
-syntax
-  "@SL"  :: "['a set, 'a potype] => bool" ("_ <<= _" [51,50]50)
-
-translations
-  "S <<= cl" == "S : sublattice `` {cl}"
-
-constdefs
-  dual :: "'a potype => 'a potype"
-  "dual po == (| pset = pset po, order = converse (order po) |)"
-
-locale PO =
-  fixes cl :: "'a potype"
-    and A  :: "'a set"
-    and r  :: "('a * 'a) set"
-  assumes cl_po:  "cl : PartialOrder"
-  defines A_def: "A == pset cl"
-     and  r_def: "r == order cl"
-
-locale CL = PO +
-  assumes cl_co:  "cl : CompleteLattice"
-
-definition CLF_set :: "('a potype * ('a => 'a)) set" where
-  "CLF_set = (SIGMA cl: CompleteLattice.
-            {f. f: pset cl -> pset cl & monotone f (pset cl) (order cl)})"
-
-locale CLF = CL +
-  fixes f :: "'a => 'a"
-    and P :: "'a set"
-  assumes f_cl:  "(cl,f) : CLF_set" (*was the equivalent "f : CLF``{cl}"*)
-  defines P_def: "P == fix f A"
-
-
-locale Tarski = CLF +
-  fixes Y     :: "'a set"
-    and intY1 :: "'a set"
-    and v     :: "'a"
-  assumes
-    Y_ss: "Y \<subseteq> P"
-  defines
-    intY1_def: "intY1 == interval r (lub Y cl) (Top cl)"
-    and v_def: "v == glb {x. ((%x: intY1. f x) x, x): induced intY1 r &
-                             x: intY1}
-                      (| pset=intY1, order=induced intY1 r|)"
-
-
-subsection {* Partial Order *}
-
-lemma (in PO) PO_imp_refl_on: "refl_on A r"
-apply (insert cl_po)
-apply (simp add: PartialOrder_def A_def r_def)
-done
-
-lemma (in PO) PO_imp_sym: "antisym r"
-apply (insert cl_po)
-apply (simp add: PartialOrder_def r_def)
-done
-
-lemma (in PO) PO_imp_trans: "trans r"
-apply (insert cl_po)
-apply (simp add: PartialOrder_def r_def)
-done
-
-lemma (in PO) reflE: "x \<in> A ==> (x, x) \<in> r"
-apply (insert cl_po)
-apply (simp add: PartialOrder_def refl_on_def A_def r_def)
-done
-
-lemma (in PO) antisymE: "[| (a, b) \<in> r; (b, a) \<in> r |] ==> a = b"
-apply (insert cl_po)
-apply (simp add: PartialOrder_def antisym_def r_def)
-done
-
-lemma (in PO) transE: "[| (a, b) \<in> r; (b, c) \<in> r|] ==> (a,c) \<in> r"
-apply (insert cl_po)
-apply (simp add: PartialOrder_def r_def)
-apply (unfold trans_def, fast)
-done
-
-lemma (in PO) monotoneE:
-     "[| monotone f A r;  x \<in> A; y \<in> A; (x, y) \<in> r |] ==> (f x, f y) \<in> r"
-by (simp add: monotone_def)
-
-lemma (in PO) po_subset_po:
-     "S \<subseteq> A ==> (| pset = S, order = induced S r |) \<in> PartialOrder"
-apply (simp (no_asm) add: PartialOrder_def)
-apply auto
--- {* refl *}
-apply (simp add: refl_on_def induced_def)
-apply (blast intro: reflE)
--- {* antisym *}
-apply (simp add: antisym_def induced_def)
-apply (blast intro: antisymE)
--- {* trans *}
-apply (simp add: trans_def induced_def)
-apply (blast intro: transE)
-done
-
-lemma (in PO) indE: "[| (x, y) \<in> induced S r; S \<subseteq> A |] ==> (x, y) \<in> r"
-by (simp add: add: induced_def)
-
-lemma (in PO) indI: "[| (x, y) \<in> r; x \<in> S; y \<in> S |] ==> (x, y) \<in> induced S r"
-by (simp add: add: induced_def)
-
-lemma (in CL) CL_imp_ex_isLub: "S \<subseteq> A ==> \<exists>L. isLub S cl L"
-apply (insert cl_co)
-apply (simp add: CompleteLattice_def A_def)
-done
-
-declare (in CL) cl_co [simp]
-
-lemma isLub_lub: "(\<exists>L. isLub S cl L) = isLub S cl (lub S cl)"
-by (simp add: lub_def least_def isLub_def some_eq_ex [symmetric])
-
-lemma isGlb_glb: "(\<exists>G. isGlb S cl G) = isGlb S cl (glb S cl)"
-by (simp add: glb_def greatest_def isGlb_def some_eq_ex [symmetric])
-
-lemma isGlb_dual_isLub: "isGlb S cl = isLub S (dual cl)"
-by (simp add: isLub_def isGlb_def dual_def converse_def)
-
-lemma isLub_dual_isGlb: "isLub S cl = isGlb S (dual cl)"
-by (simp add: isLub_def isGlb_def dual_def converse_def)
-
-lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
-apply (insert cl_po)
-apply (simp add: PartialOrder_def dual_def refl_on_converse
-                 trans_converse antisym_converse)
-done
-
-lemma Rdual:
-     "\<forall>S. (S \<subseteq> A -->( \<exists>L. isLub S (| pset = A, order = r|) L))
-      ==> \<forall>S. (S \<subseteq> A --> (\<exists>G. isGlb S (| pset = A, order = r|) G))"
-apply safe
-apply (rule_tac x = "lub {y. y \<in> A & (\<forall>k \<in> S. (y, k) \<in> r)}
-                      (|pset = A, order = r|) " in exI)
-apply (drule_tac x = "{y. y \<in> A & (\<forall>k \<in> S. (y,k) \<in> r) }" in spec)
-apply (drule mp, fast)
-apply (simp add: isLub_lub isGlb_def)
-apply (simp add: isLub_def, blast)
-done
-
-lemma lub_dual_glb: "lub S cl = glb S (dual cl)"
-by (simp add: lub_def glb_def least_def greatest_def dual_def converse_def)
-
-lemma glb_dual_lub: "glb S cl = lub S (dual cl)"
-by (simp add: lub_def glb_def least_def greatest_def dual_def converse_def)
-
-lemma CL_subset_PO: "CompleteLattice \<subseteq> PartialOrder"
-by (simp add: PartialOrder_def CompleteLattice_def, fast)
-
-lemmas CL_imp_PO = CL_subset_PO [THEN subsetD]
-
-declare PO.PO_imp_refl_on  [OF PO.intro [OF CL_imp_PO], simp]
-declare PO.PO_imp_sym   [OF PO.intro [OF CL_imp_PO], simp]
-declare PO.PO_imp_trans [OF PO.intro [OF CL_imp_PO], simp]
-
-lemma (in CL) CO_refl_on: "refl_on A r"
-by (rule PO_imp_refl_on)
-
-lemma (in CL) CO_antisym: "antisym r"
-by (rule PO_imp_sym)
-
-lemma (in CL) CO_trans: "trans r"
-by (rule PO_imp_trans)
-
-lemma CompleteLatticeI:
-     "[| po \<in> PartialOrder; (\<forall>S. S \<subseteq> pset po --> (\<exists>L. isLub S po L));
-         (\<forall>S. S \<subseteq> pset po --> (\<exists>G. isGlb S po G))|]
-      ==> po \<in> CompleteLattice"
-apply (unfold CompleteLattice_def, blast)
-done
-
-lemma (in CL) CL_dualCL: "dual cl \<in> CompleteLattice"
-apply (insert cl_co)
-apply (simp add: CompleteLattice_def dual_def)
-apply (fold dual_def)
-apply (simp add: isLub_dual_isGlb [symmetric] isGlb_dual_isLub [symmetric]
-                 dualPO)
-done
-
-lemma (in PO) dualA_iff: "pset (dual cl) = pset cl"
-by (simp add: dual_def)
-
-lemma (in PO) dualr_iff: "((x, y) \<in> (order(dual cl))) = ((y, x) \<in> order cl)"
-by (simp add: dual_def)
-
-lemma (in PO) monotone_dual:
-     "monotone f (pset cl) (order cl) 
-     ==> monotone f (pset (dual cl)) (order(dual cl))"
-by (simp add: monotone_def dualA_iff dualr_iff)
-
-lemma (in PO) interval_dual:
-     "[| x \<in> A; y \<in> A|] ==> interval r x y = interval (order(dual cl)) y x"
-apply (simp add: interval_def dualr_iff)
-apply (fold r_def, fast)
-done
-
-lemma (in PO) interval_not_empty:
-     "[| trans r; interval r a b \<noteq> {} |] ==> (a, b) \<in> r"
-apply (simp add: interval_def)
-apply (unfold trans_def, blast)
-done
-
-lemma (in PO) interval_imp_mem: "x \<in> interval r a b ==> (a, x) \<in> r"
-by (simp add: interval_def)
-
-lemma (in PO) left_in_interval:
-     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |] ==> a \<in> interval r a b"
-apply (simp (no_asm_simp) add: interval_def)
-apply (simp add: PO_imp_trans interval_not_empty)
-apply (simp add: reflE)
-done
-
-lemma (in PO) right_in_interval:
-     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |] ==> b \<in> interval r a b"
-apply (simp (no_asm_simp) add: interval_def)
-apply (simp add: PO_imp_trans interval_not_empty)
-apply (simp add: reflE)
-done
-
-
-subsection {* sublattice *}
-
-lemma (in PO) sublattice_imp_CL:
-     "S <<= cl  ==> (| pset = S, order = induced S r |) \<in> CompleteLattice"
-by (simp add: sublattice_def CompleteLattice_def A_def r_def)
-
-lemma (in CL) sublatticeI:
-     "[| S \<subseteq> A; (| pset = S, order = induced S r |) \<in> CompleteLattice |]
-      ==> S <<= cl"
-by (simp add: sublattice_def A_def r_def)
-
-
-subsection {* lub *}
-
-lemma (in CL) lub_unique: "[| S \<subseteq> A; isLub S cl x; isLub S cl L|] ==> x = L"
-apply (rule antisymE)
-apply (auto simp add: isLub_def r_def)
-done
-
-lemma (in CL) lub_upper: "[|S \<subseteq> A; x \<in> S|] ==> (x, lub S cl) \<in> r"
-apply (rule CL_imp_ex_isLub [THEN exE], assumption)
-apply (unfold lub_def least_def)
-apply (rule some_equality [THEN ssubst])
-  apply (simp add: isLub_def)
- apply (simp add: lub_unique A_def isLub_def)
-apply (simp add: isLub_def r_def)
-done
-
-lemma (in CL) lub_least:
-     "[| S \<subseteq> A; L \<in> A; \<forall>x \<in> S. (x,L) \<in> r |] ==> (lub S cl, L) \<in> r"
-apply (rule CL_imp_ex_isLub [THEN exE], assumption)
-apply (unfold lub_def least_def)
-apply (rule_tac s=x in some_equality [THEN ssubst])
-  apply (simp add: isLub_def)
- apply (simp add: lub_unique A_def isLub_def)
-apply (simp add: isLub_def r_def A_def)
-done
-
-lemma (in CL) lub_in_lattice: "S \<subseteq> A ==> lub S cl \<in> A"
-apply (rule CL_imp_ex_isLub [THEN exE], assumption)
-apply (unfold lub_def least_def)
-apply (subst some_equality)
-apply (simp add: isLub_def)
-prefer 2 apply (simp add: isLub_def A_def)
-apply (simp add: lub_unique A_def isLub_def)
-done
-
-lemma (in CL) lubI:
-     "[| S \<subseteq> A; L \<in> A; \<forall>x \<in> S. (x,L) \<in> r;
-         \<forall>z \<in> A. (\<forall>y \<in> S. (y,z) \<in> r) --> (L,z) \<in> r |] ==> L = lub S cl"
-apply (rule lub_unique, assumption)
-apply (simp add: isLub_def A_def r_def)
-apply (unfold isLub_def)
-apply (rule conjI)
-apply (fold A_def r_def)
-apply (rule lub_in_lattice, assumption)
-apply (simp add: lub_upper lub_least)
-done
-
-lemma (in CL) lubIa: "[| S \<subseteq> A; isLub S cl L |] ==> L = lub S cl"
-by (simp add: lubI isLub_def A_def r_def)
-
-lemma (in CL) isLub_in_lattice: "isLub S cl L ==> L \<in> A"
-by (simp add: isLub_def  A_def)
-
-lemma (in CL) isLub_upper: "[|isLub S cl L; y \<in> S|] ==> (y, L) \<in> r"
-by (simp add: isLub_def r_def)
-
-lemma (in CL) isLub_least:
-     "[| isLub S cl L; z \<in> A; \<forall>y \<in> S. (y, z) \<in> r|] ==> (L, z) \<in> r"
-by (simp add: isLub_def A_def r_def)
-
-lemma (in CL) isLubI:
-     "[| L \<in> A; \<forall>y \<in> S. (y, L) \<in> r;
-         (\<forall>z \<in> A. (\<forall>y \<in> S. (y, z):r) --> (L, z) \<in> r)|] ==> isLub S cl L"
-by (simp add: isLub_def A_def r_def)
-
-
-
-subsection {* glb *}
-
-lemma (in CL) glb_in_lattice: "S \<subseteq> A ==> glb S cl \<in> A"
-apply (subst glb_dual_lub)
-apply (simp add: A_def)
-apply (rule dualA_iff [THEN subst])
-apply (rule CL.lub_in_lattice)
-apply (rule CL.intro)
-apply (rule PO.intro)
-apply (rule dualPO)
-apply (rule CL_axioms.intro)
-apply (rule CL_dualCL)
-apply (simp add: dualA_iff)
-done
-
-lemma (in CL) glb_lower: "[|S \<subseteq> A; x \<in> S|] ==> (glb S cl, x) \<in> r"
-apply (subst glb_dual_lub)
-apply (simp add: r_def)
-apply (rule dualr_iff [THEN subst])
-apply (rule CL.lub_upper)
-apply (rule CL.intro)
-apply (rule PO.intro)
-apply (rule dualPO)
-apply (rule CL_axioms.intro)
-apply (rule CL_dualCL)
-apply (simp add: dualA_iff A_def, assumption)
-done
-
-text {*
-  Reduce the sublattice property by using substructural properties;
-  abandoned see @{text "Tarski_4.ML"}.
-*}
-
-declare (in CLF) f_cl [simp]
-
-(*never proved, 2007-01-22: Tarski__CLF_unnamed_lemma
-  NOT PROVABLE because of the conjunction used in the definition: we don't
-  allow reasoning with rules like conjE, which is essential here.*)
-declare [[ atp_problem_prefix = "Tarski__CLF_unnamed_lemma" ]]
-lemma (in CLF) [simp]:
-    "f: pset cl -> pset cl & monotone f (pset cl) (order cl)" 
-apply (insert f_cl)
-apply (unfold CLF_set_def)
-apply (erule SigmaE2) 
-apply (erule CollectE) 
-apply assumption
-done
-
-lemma (in CLF) f_in_funcset: "f \<in> A -> A"
-by (simp add: A_def)
-
-lemma (in CLF) monotone_f: "monotone f A r"
-by (simp add: A_def r_def)
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__CLF_CLF_dual" ]]
-declare (in CLF) CLF_set_def [simp] CL_dualCL [simp] monotone_dual [simp] dualA_iff [simp]
-
-lemma (in CLF) CLF_dual: "(dual cl, f) \<in> CLF_set" 
-apply (simp del: dualA_iff)
-apply (simp)
-done
-
-declare (in CLF) CLF_set_def[simp del] CL_dualCL[simp del] monotone_dual[simp del]
-          dualA_iff[simp del]
-
-
-subsection {* fixed points *}
-
-lemma fix_subset: "fix f A \<subseteq> A"
-by (simp add: fix_def, fast)
-
-lemma fix_imp_eq: "x \<in> fix f A ==> f x = x"
-by (simp add: fix_def)
-
-lemma fixf_subset:
-     "[| A \<subseteq> B; x \<in> fix (%y: A. f y) A |] ==> x \<in> fix f B"
-by (simp add: fix_def, auto)
-
-
-subsection {* lemmas for Tarski, lub *}
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__CLF_lubH_le_flubH" ]]
-  declare CL.lub_least[intro] CLF.f_in_funcset[intro] funcset_mem[intro] CL.lub_in_lattice[intro] PO.transE[intro] PO.monotoneE[intro] CLF.monotone_f[intro] CL.lub_upper[intro] 
-lemma (in CLF) lubH_le_flubH:
-     "H = {x. (x, f x) \<in> r & x \<in> A} ==> (lub H cl, f (lub H cl)) \<in> r"
-apply (rule lub_least, fast)
-apply (rule f_in_funcset [THEN funcset_mem])
-apply (rule lub_in_lattice, fast)
--- {* @{text "\<forall>x:H. (x, f (lub H r)) \<in> r"} *}
-apply (rule ballI)
-(*never proved, 2007-01-22*)
-using [[ atp_problem_prefix = "Tarski__CLF_lubH_le_flubH_simpler" ]]
-apply (rule transE)
--- {* instantiates @{text "(x, ?z) \<in> order cl to (x, f x)"}, *}
--- {* because of the def of @{text H} *}
-apply fast
--- {* so it remains to show @{text "(f x, f (lub H cl)) \<in> r"} *}
-apply (rule_tac f = "f" in monotoneE)
-apply (rule monotone_f, fast)
-apply (rule lub_in_lattice, fast)
-apply (rule lub_upper, fast)
-apply assumption
-done
-  declare CL.lub_least[rule del] CLF.f_in_funcset[rule del] 
-          funcset_mem[rule del] CL.lub_in_lattice[rule del] 
-          PO.transE[rule del] PO.monotoneE[rule del] 
-          CLF.monotone_f[rule del] CL.lub_upper[rule del] 
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__CLF_flubH_le_lubH" ]]
-  declare CLF.f_in_funcset[intro] funcset_mem[intro] CL.lub_in_lattice[intro]
-       PO.monotoneE[intro] CLF.monotone_f[intro] CL.lub_upper[intro] 
-       CLF.lubH_le_flubH[simp]
-lemma (in CLF) flubH_le_lubH:
-     "[|  H = {x. (x, f x) \<in> r & x \<in> A} |] ==> (f (lub H cl), lub H cl) \<in> r"
-apply (rule lub_upper, fast)
-apply (rule_tac t = "H" in ssubst, assumption)
-apply (rule CollectI)
-apply (rule conjI)
-using [[ atp_problem_prefix = "Tarski__CLF_flubH_le_lubH_simpler" ]]
-(*??no longer terminates, with combinators
-apply (metis CO_refl_on lubH_le_flubH monotone_def monotone_f reflD1 reflD2) 
-*)
-apply (metis CO_refl_on lubH_le_flubH monotoneE [OF monotone_f] refl_onD1 refl_onD2)
-apply (metis CO_refl_on lubH_le_flubH refl_onD2)
-done
-  declare CLF.f_in_funcset[rule del] funcset_mem[rule del] 
-          CL.lub_in_lattice[rule del] PO.monotoneE[rule del] 
-          CLF.monotone_f[rule del] CL.lub_upper[rule del] 
-          CLF.lubH_le_flubH[simp del]
-
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__CLF_lubH_is_fixp" ]]
-(*Single-step version fails. The conjecture clauses refer to local abstraction
-functions (Frees), which prevents expand_defs_tac from removing those 
-"definitions" at the end of the proof. *)
-lemma (in CLF) lubH_is_fixp:
-     "H = {x. (x, f x) \<in> r & x \<in> A} ==> lub H cl \<in> fix f A"
-apply (simp add: fix_def)
-apply (rule conjI)
-proof (neg_clausify)
-assume 0: "H =
-Collect
- (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r)) (COMBC op \<in> A))"
-assume 1: "lub (Collect
-      (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
-        (COMBC op \<in> A)))
- cl
-\<notin> A"
-have 2: "lub H cl \<notin> A"
-  by (metis 1 0)
-have 3: "(lub H cl, f (lub H cl)) \<in> r"
-  by (metis lubH_le_flubH 0)
-have 4: "(f (lub H cl), lub H cl) \<in> r"
-  by (metis flubH_le_lubH 0)
-have 5: "lub H cl = f (lub H cl) \<or> (lub H cl, f (lub H cl)) \<notin> r"
-  by (metis antisymE 4)
-have 6: "lub H cl = f (lub H cl)"
-  by (metis 5 3)
-have 7: "(lub H cl, lub H cl) \<in> r"
-  by (metis 6 4)
-have 8: "\<And>X1. lub H cl \<in> X1 \<or> \<not> refl_on X1 r"
-  by (metis 7 refl_onD2)
-have 9: "\<not> refl_on A r"
-  by (metis 8 2)
-show "False"
-  by (metis CO_refl_on 9);
-next --{*apparently the way to insert a second structured proof*}
-  show "H = {x. (x, f x) \<in> r \<and> x \<in> A} \<Longrightarrow>
-  f (lub {x. (x, f x) \<in> r \<and> x \<in> A} cl) = lub {x. (x, f x) \<in> r \<and> x \<in> A} cl"
-  proof (neg_clausify)
-  assume 0: "H =
-  Collect
-   (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r)) (COMBC op \<in> A))"
-  assume 1: "f (lub (Collect
-           (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
-             (COMBC op \<in> A)))
-      cl) \<noteq>
-  lub (Collect
-        (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
-          (COMBC op \<in> A)))
-   cl"
-  have 2: "f (lub H cl) \<noteq>
-  lub (Collect
-        (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
-          (COMBC op \<in> A)))
-   cl"
-    by (metis 1 0)
-  have 3: "f (lub H cl) \<noteq> lub H cl"
-    by (metis 2 0)
-  have 4: "(lub H cl, f (lub H cl)) \<in> r"
-    by (metis lubH_le_flubH 0)
-  have 5: "(f (lub H cl), lub H cl) \<in> r"
-    by (metis flubH_le_lubH 0)
-  have 6: "lub H cl = f (lub H cl) \<or> (lub H cl, f (lub H cl)) \<notin> r"
-    by (metis antisymE 5)
-  have 7: "lub H cl = f (lub H cl)"
-    by (metis 6 4)
-  show "False"
-    by (metis 3 7)
-  qed
-qed
-
-lemma (in CLF) (*lubH_is_fixp:*)
-     "H = {x. (x, f x) \<in> r & x \<in> A} ==> lub H cl \<in> fix f A"
-apply (simp add: fix_def)
-apply (rule conjI)
-using [[ atp_problem_prefix = "Tarski__CLF_lubH_is_fixp_simpler" ]]
-apply (metis CO_refl_on lubH_le_flubH refl_onD1)
-apply (metis antisymE flubH_le_lubH lubH_le_flubH)
-done
-
-lemma (in CLF) fix_in_H:
-     "[| H = {x. (x, f x) \<in> r & x \<in> A};  x \<in> P |] ==> x \<in> H"
-by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl_on
-                    fix_subset [of f A, THEN subsetD])
-
-
-lemma (in CLF) fixf_le_lubH:
-     "H = {x. (x, f x) \<in> r & x \<in> A} ==> \<forall>x \<in> fix f A. (x, lub H cl) \<in> r"
-apply (rule ballI)
-apply (rule lub_upper, fast)
-apply (rule fix_in_H)
-apply (simp_all add: P_def)
-done
-
-declare [[ atp_problem_prefix = "Tarski__CLF_lubH_least_fixf" ]]
-lemma (in CLF) lubH_least_fixf:
-     "H = {x. (x, f x) \<in> r & x \<in> A}
-      ==> \<forall>L. (\<forall>y \<in> fix f A. (y,L) \<in> r) --> (lub H cl, L) \<in> r"
-apply (metis P_def lubH_is_fixp)
-done
-
-subsection {* Tarski fixpoint theorem 1, first part *}
-declare [[ atp_problem_prefix = "Tarski__CLF_T_thm_1_lub" ]]
-  declare CL.lubI[intro] fix_subset[intro] CL.lub_in_lattice[intro] 
-          CLF.fixf_le_lubH[simp] CLF.lubH_least_fixf[simp]
-lemma (in CLF) T_thm_1_lub: "lub P cl = lub {x. (x, f x) \<in> r & x \<in> A} cl"
-(*sledgehammer;*)
-apply (rule sym)
-apply (simp add: P_def)
-apply (rule lubI)
-using [[ atp_problem_prefix = "Tarski__CLF_T_thm_1_lub_simpler" ]]
-apply (metis P_def fix_subset) 
-apply (metis Collect_conj_eq Collect_mem_eq Int_commute Int_lower1 lub_in_lattice vimage_def)
-(*??no longer terminates, with combinators
-apply (metis P_def fix_def fixf_le_lubH)
-apply (metis P_def fix_def lubH_least_fixf)
-*)
-apply (simp add: fixf_le_lubH)
-apply (simp add: lubH_least_fixf)
-done
-  declare CL.lubI[rule del] fix_subset[rule del] CL.lub_in_lattice[rule del] 
-          CLF.fixf_le_lubH[simp del] CLF.lubH_least_fixf[simp del]
-
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__CLF_glbH_is_fixp" ]]
-  declare glb_dual_lub[simp] PO.dualA_iff[intro] CLF.lubH_is_fixp[intro] 
-          PO.dualPO[intro] CL.CL_dualCL[intro] PO.dualr_iff[simp]
-lemma (in CLF) glbH_is_fixp: "H = {x. (f x, x) \<in> r & x \<in> A} ==> glb H cl \<in> P"
-  -- {* Tarski for glb *}
-(*sledgehammer;*)
-apply (simp add: glb_dual_lub P_def A_def r_def)
-apply (rule dualA_iff [THEN subst])
-apply (rule CLF.lubH_is_fixp)
-apply (rule CLF.intro)
-apply (rule CL.intro)
-apply (rule PO.intro)
-apply (rule dualPO)
-apply (rule CL_axioms.intro)
-apply (rule CL_dualCL)
-apply (rule CLF_axioms.intro)
-apply (rule CLF_dual)
-apply (simp add: dualr_iff dualA_iff)
-done
-  declare glb_dual_lub[simp del] PO.dualA_iff[rule del] CLF.lubH_is_fixp[rule del] 
-          PO.dualPO[rule del] CL.CL_dualCL[rule del] PO.dualr_iff[simp del]
-
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__T_thm_1_glb" ]]  (*ALL THEOREMS*)
-lemma (in CLF) T_thm_1_glb: "glb P cl = glb {x. (f x, x) \<in> r & x \<in> A} cl"
-(*sledgehammer;*)
-apply (simp add: glb_dual_lub P_def A_def r_def)
-apply (rule dualA_iff [THEN subst])
-(*never proved, 2007-01-22*)
-using [[ atp_problem_prefix = "Tarski__T_thm_1_glb_simpler" ]]  (*ALL THEOREMS*)
-(*sledgehammer;*)
-apply (simp add: CLF.T_thm_1_lub [of _ f, OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro,
-  OF dualPO CL_dualCL] dualPO CL_dualCL CLF_dual dualr_iff)
-done
-
-subsection {* interval *}
-
-
-declare [[ atp_problem_prefix = "Tarski__rel_imp_elem" ]]
-  declare (in CLF) CO_refl_on[simp] refl_on_def [simp]
-lemma (in CLF) rel_imp_elem: "(x, y) \<in> r ==> x \<in> A"
-by (metis CO_refl_on refl_onD1)
-  declare (in CLF) CO_refl_on[simp del]  refl_on_def [simp del]
-
-declare [[ atp_problem_prefix = "Tarski__interval_subset" ]]
-  declare (in CLF) rel_imp_elem[intro] 
-  declare interval_def [simp]
-lemma (in CLF) interval_subset: "[| a \<in> A; b \<in> A |] ==> interval r a b \<subseteq> A"
-by (metis CO_refl_on interval_imp_mem refl_onD refl_onD2 rel_imp_elem subset_eq)
-  declare (in CLF) rel_imp_elem[rule del] 
-  declare interval_def [simp del]
-
-
-lemma (in CLF) intervalI:
-     "[| (a, x) \<in> r; (x, b) \<in> r |] ==> x \<in> interval r a b"
-by (simp add: interval_def)
-
-lemma (in CLF) interval_lemma1:
-     "[| S \<subseteq> interval r a b; x \<in> S |] ==> (a, x) \<in> r"
-by (unfold interval_def, fast)
-
-lemma (in CLF) interval_lemma2:
-     "[| S \<subseteq> interval r a b; x \<in> S |] ==> (x, b) \<in> r"
-by (unfold interval_def, fast)
-
-lemma (in CLF) a_less_lub:
-     "[| S \<subseteq> A; S \<noteq> {};
-         \<forall>x \<in> S. (a,x) \<in> r; \<forall>y \<in> S. (y, L) \<in> r |] ==> (a,L) \<in> r"
-by (blast intro: transE)
-
-lemma (in CLF) glb_less_b:
-     "[| S \<subseteq> A; S \<noteq> {};
-         \<forall>x \<in> S. (x,b) \<in> r; \<forall>y \<in> S. (G, y) \<in> r |] ==> (G,b) \<in> r"
-by (blast intro: transE)
-
-lemma (in CLF) S_intv_cl:
-     "[| a \<in> A; b \<in> A; S \<subseteq> interval r a b |]==> S \<subseteq> A"
-by (simp add: subset_trans [OF _ interval_subset])
-
-declare [[ atp_problem_prefix = "Tarski__L_in_interval" ]]  (*ALL THEOREMS*)
-lemma (in CLF) L_in_interval:
-     "[| a \<in> A; b \<in> A; S \<subseteq> interval r a b;
-         S \<noteq> {}; isLub S cl L; interval r a b \<noteq> {} |] ==> L \<in> interval r a b" 
-(*WON'T TERMINATE
-apply (metis CO_trans intervalI interval_lemma1 interval_lemma2 isLub_least isLub_upper subset_empty subset_iff trans_def)
-*)
-apply (rule intervalI)
-apply (rule a_less_lub)
-prefer 2 apply assumption
-apply (simp add: S_intv_cl)
-apply (rule ballI)
-apply (simp add: interval_lemma1)
-apply (simp add: isLub_upper)
--- {* @{text "(L, b) \<in> r"} *}
-apply (simp add: isLub_least interval_lemma2)
-done
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__G_in_interval" ]]  (*ALL THEOREMS*)
-lemma (in CLF) G_in_interval:
-     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {}; S \<subseteq> interval r a b; isGlb S cl G;
-         S \<noteq> {} |] ==> G \<in> interval r a b"
-apply (simp add: interval_dual)
-apply (simp add: CLF.L_in_interval [of _ f, OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro]
-                 dualA_iff A_def dualPO CL_dualCL CLF_dual isGlb_dual_isLub)
-done
-
-declare [[ atp_problem_prefix = "Tarski__intervalPO" ]]  (*ALL THEOREMS*)
-lemma (in CLF) intervalPO:
-     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
-      ==> (| pset = interval r a b, order = induced (interval r a b) r |)
-          \<in> PartialOrder"
-proof (neg_clausify)
-assume 0: "a \<in> A"
-assume 1: "b \<in> A"
-assume 2: "\<lparr>pset = interval r a b, order = induced (interval r a b) r\<rparr> \<notin> PartialOrder"
-have 3: "\<not> interval r a b \<subseteq> A"
-  by (metis 2 po_subset_po)
-have 4: "b \<notin> A \<or> a \<notin> A"
-  by (metis 3 interval_subset)
-have 5: "a \<notin> A"
-  by (metis 4 1)
-show "False"
-  by (metis 5 0)
-qed
-
-lemma (in CLF) intv_CL_lub:
- "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
-  ==> \<forall>S. S \<subseteq> interval r a b -->
-          (\<exists>L. isLub S (| pset = interval r a b,
-                          order = induced (interval r a b) r |)  L)"
-apply (intro strip)
-apply (frule S_intv_cl [THEN CL_imp_ex_isLub])
-prefer 2 apply assumption
-apply assumption
-apply (erule exE)
--- {* define the lub for the interval as *}
-apply (rule_tac x = "if S = {} then a else L" in exI)
-apply (simp (no_asm_simp) add: isLub_def split del: split_if)
-apply (intro impI conjI)
--- {* @{text "(if S = {} then a else L) \<in> interval r a b"} *}
-apply (simp add: CL_imp_PO L_in_interval)
-apply (simp add: left_in_interval)
--- {* lub prop 1 *}
-apply (case_tac "S = {}")
--- {* @{text "S = {}, y \<in> S = False => everything"} *}
-apply fast
--- {* @{text "S \<noteq> {}"} *}
-apply simp
--- {* @{text "\<forall>y:S. (y, L) \<in> induced (interval r a b) r"} *}
-apply (rule ballI)
-apply (simp add: induced_def  L_in_interval)
-apply (rule conjI)
-apply (rule subsetD)
-apply (simp add: S_intv_cl, assumption)
-apply (simp add: isLub_upper)
--- {* @{text "\<forall>z:interval r a b. (\<forall>y:S. (y, z) \<in> induced (interval r a b) r \<longrightarrow> (if S = {} then a else L, z) \<in> induced (interval r a b) r"} *}
-apply (rule ballI)
-apply (rule impI)
-apply (case_tac "S = {}")
--- {* @{text "S = {}"} *}
-apply simp
-apply (simp add: induced_def  interval_def)
-apply (rule conjI)
-apply (rule reflE, assumption)
-apply (rule interval_not_empty)
-apply (rule CO_trans)
-apply (simp add: interval_def)
--- {* @{text "S \<noteq> {}"} *}
-apply simp
-apply (simp add: induced_def  L_in_interval)
-apply (rule isLub_least, assumption)
-apply (rule subsetD)
-prefer 2 apply assumption
-apply (simp add: S_intv_cl, fast)
-done
-
-lemmas (in CLF) intv_CL_glb = intv_CL_lub [THEN Rdual]
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__interval_is_sublattice" ]]  (*ALL THEOREMS*)
-lemma (in CLF) interval_is_sublattice:
-     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
-        ==> interval r a b <<= cl"
-(*sledgehammer *)
-apply (rule sublatticeI)
-apply (simp add: interval_subset)
-(*never proved, 2007-01-22*)
-using [[ atp_problem_prefix = "Tarski__interval_is_sublattice_simpler" ]]
-(*sledgehammer *)
-apply (rule CompleteLatticeI)
-apply (simp add: intervalPO)
- apply (simp add: intv_CL_lub)
-apply (simp add: intv_CL_glb)
-done
-
-lemmas (in CLF) interv_is_compl_latt =
-    interval_is_sublattice [THEN sublattice_imp_CL]
-
-
-subsection {* Top and Bottom *}
-lemma (in CLF) Top_dual_Bot: "Top cl = Bot (dual cl)"
-by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff)
-
-lemma (in CLF) Bot_dual_Top: "Bot cl = Top (dual cl)"
-by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff)
-
-declare [[ atp_problem_prefix = "Tarski__Bot_in_lattice" ]]  (*ALL THEOREMS*)
-lemma (in CLF) Bot_in_lattice: "Bot cl \<in> A"
-(*sledgehammer; *)
-apply (simp add: Bot_def least_def)
-apply (rule_tac a="glb A cl" in someI2)
-apply (simp_all add: glb_in_lattice glb_lower 
-                     r_def [symmetric] A_def [symmetric])
-done
-
-(*first proved 2007-01-25 after relaxing relevance*)
-declare [[ atp_problem_prefix = "Tarski__Top_in_lattice" ]]  (*ALL THEOREMS*)
-lemma (in CLF) Top_in_lattice: "Top cl \<in> A"
-(*sledgehammer;*)
-apply (simp add: Top_dual_Bot A_def)
-(*first proved 2007-01-25 after relaxing relevance*)
-using [[ atp_problem_prefix = "Tarski__Top_in_lattice_simpler" ]]  (*ALL THEOREMS*)
-(*sledgehammer*)
-apply (rule dualA_iff [THEN subst])
-apply (blast intro!: CLF.Bot_in_lattice [OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro] dualPO CL_dualCL CLF_dual)
-done
-
-lemma (in CLF) Top_prop: "x \<in> A ==> (x, Top cl) \<in> r"
-apply (simp add: Top_def greatest_def)
-apply (rule_tac a="lub A cl" in someI2)
-apply (rule someI2)
-apply (simp_all add: lub_in_lattice lub_upper 
-                     r_def [symmetric] A_def [symmetric])
-done
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__Bot_prop" ]]  (*ALL THEOREMS*) 
-lemma (in CLF) Bot_prop: "x \<in> A ==> (Bot cl, x) \<in> r"
-(*sledgehammer*) 
-apply (simp add: Bot_dual_Top r_def)
-apply (rule dualr_iff [THEN subst])
-apply (simp add: CLF.Top_prop [of _ f, OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro]
-                 dualA_iff A_def dualPO CL_dualCL CLF_dual)
-done
-
-declare [[ atp_problem_prefix = "Tarski__Bot_in_lattice" ]]  (*ALL THEOREMS*)
-lemma (in CLF) Top_intv_not_empty: "x \<in> A  ==> interval r x (Top cl) \<noteq> {}" 
-apply (metis Top_in_lattice Top_prop empty_iff intervalI reflE)
-done
-
-declare [[ atp_problem_prefix = "Tarski__Bot_intv_not_empty" ]]  (*ALL THEOREMS*)
-lemma (in CLF) Bot_intv_not_empty: "x \<in> A ==> interval r (Bot cl) x \<noteq> {}" 
-apply (metis Bot_prop ex_in_conv intervalI reflE rel_imp_elem)
-done
-
-
-subsection {* fixed points form a partial order *}
-
-lemma (in CLF) fixf_po: "(| pset = P, order = induced P r|) \<in> PartialOrder"
-by (simp add: P_def fix_subset po_subset_po)
-
-(*first proved 2007-01-25 after relaxing relevance*)
-declare [[ atp_problem_prefix = "Tarski__Y_subset_A" ]]
-  declare (in Tarski) P_def[simp] Y_ss [simp]
-  declare fix_subset [intro] subset_trans [intro]
-lemma (in Tarski) Y_subset_A: "Y \<subseteq> A"
-(*sledgehammer*) 
-apply (rule subset_trans [OF _ fix_subset])
-apply (rule Y_ss [simplified P_def])
-done
-  declare (in Tarski) P_def[simp del] Y_ss [simp del]
-  declare fix_subset [rule del] subset_trans [rule del]
-
-
-lemma (in Tarski) lubY_in_A: "lub Y cl \<in> A"
-  by (rule Y_subset_A [THEN lub_in_lattice])
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__lubY_le_flubY" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) lubY_le_flubY: "(lub Y cl, f (lub Y cl)) \<in> r"
-(*sledgehammer*) 
-apply (rule lub_least)
-apply (rule Y_subset_A)
-apply (rule f_in_funcset [THEN funcset_mem])
-apply (rule lubY_in_A)
--- {* @{text "Y \<subseteq> P ==> f x = x"} *}
-apply (rule ballI)
-using [[ atp_problem_prefix = "Tarski__lubY_le_flubY_simpler" ]]  (*ALL THEOREMS*)
-(*sledgehammer *)
-apply (rule_tac t = "x" in fix_imp_eq [THEN subst])
-apply (erule Y_ss [simplified P_def, THEN subsetD])
--- {* @{text "reduce (f x, f (lub Y cl)) \<in> r to (x, lub Y cl) \<in> r"} by monotonicity *}
-using [[ atp_problem_prefix = "Tarski__lubY_le_flubY_simplest" ]]  (*ALL THEOREMS*)
-(*sledgehammer*)
-apply (rule_tac f = "f" in monotoneE)
-apply (rule monotone_f)
-apply (simp add: Y_subset_A [THEN subsetD])
-apply (rule lubY_in_A)
-apply (simp add: lub_upper Y_subset_A)
-done
-
-(*first proved 2007-01-25 after relaxing relevance*)
-declare [[ atp_problem_prefix = "Tarski__intY1_subset" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) intY1_subset: "intY1 \<subseteq> A"
-(*sledgehammer*) 
-apply (unfold intY1_def)
-apply (rule interval_subset)
-apply (rule lubY_in_A)
-apply (rule Top_in_lattice)
-done
-
-lemmas (in Tarski) intY1_elem = intY1_subset [THEN subsetD]
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__intY1_f_closed" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) intY1_f_closed: "x \<in> intY1 \<Longrightarrow> f x \<in> intY1"
-(*sledgehammer*) 
-apply (simp add: intY1_def  interval_def)
-apply (rule conjI)
-apply (rule transE)
-apply (rule lubY_le_flubY)
--- {* @{text "(f (lub Y cl), f x) \<in> r"} *}
-using [[ atp_problem_prefix = "Tarski__intY1_f_closed_simpler" ]]  (*ALL THEOREMS*)
-(*sledgehammer [has been proved before now...]*)
-apply (rule_tac f=f in monotoneE)
-apply (rule monotone_f)
-apply (rule lubY_in_A)
-apply (simp add: intY1_def interval_def  intY1_elem)
-apply (simp add: intY1_def  interval_def)
--- {* @{text "(f x, Top cl) \<in> r"} *} 
-apply (rule Top_prop)
-apply (rule f_in_funcset [THEN funcset_mem])
-apply (simp add: intY1_def interval_def  intY1_elem)
-done
-
-declare [[ atp_problem_prefix = "Tarski__intY1_func" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) intY1_func: "(%x: intY1. f x) \<in> intY1 -> intY1"
-apply (rule restrict_in_funcset)
-apply (metis intY1_f_closed restrict_in_funcset)
-done
-
-declare [[ atp_problem_prefix = "Tarski__intY1_mono" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) intY1_mono:
-     "monotone (%x: intY1. f x) intY1 (induced intY1 r)"
-(*sledgehammer *)
-apply (auto simp add: monotone_def induced_def intY1_f_closed)
-apply (blast intro: intY1_elem monotone_f [THEN monotoneE])
-done
-
-(*proof requires relaxing relevance: 2007-01-25*)
-declare [[ atp_problem_prefix = "Tarski__intY1_is_cl" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) intY1_is_cl:
-    "(| pset = intY1, order = induced intY1 r |) \<in> CompleteLattice"
-(*sledgehammer*) 
-apply (unfold intY1_def)
-apply (rule interv_is_compl_latt)
-apply (rule lubY_in_A)
-apply (rule Top_in_lattice)
-apply (rule Top_intv_not_empty)
-apply (rule lubY_in_A)
-done
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__v_in_P" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) v_in_P: "v \<in> P"
-(*sledgehammer*) 
-apply (unfold P_def)
-apply (rule_tac A = "intY1" in fixf_subset)
-apply (rule intY1_subset)
-apply (simp add: CLF.glbH_is_fixp [OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro, OF _ intY1_is_cl, simplified]
-                 v_def CL_imp_PO intY1_is_cl CLF_set_def intY1_func intY1_mono)
-done
-
-declare [[ atp_problem_prefix = "Tarski__z_in_interval" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) z_in_interval:
-     "[| z \<in> P; \<forall>y\<in>Y. (y, z) \<in> induced P r |] ==> z \<in> intY1"
-(*sledgehammer *)
-apply (unfold intY1_def P_def)
-apply (rule intervalI)
-prefer 2
- apply (erule fix_subset [THEN subsetD, THEN Top_prop])
-apply (rule lub_least)
-apply (rule Y_subset_A)
-apply (fast elim!: fix_subset [THEN subsetD])
-apply (simp add: induced_def)
-done
-
-declare [[ atp_problem_prefix = "Tarski__fz_in_int_rel" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) f'z_in_int_rel: "[| z \<in> P; \<forall>y\<in>Y. (y, z) \<in> induced P r |]
-      ==> ((%x: intY1. f x) z, z) \<in> induced intY1 r" 
-apply (metis P_def acc_def fix_imp_eq fix_subset indI reflE restrict_apply subset_eq z_in_interval)
-done
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__tarski_full_lemma" ]]  (*ALL THEOREMS*)
-lemma (in Tarski) tarski_full_lemma:
-     "\<exists>L. isLub Y (| pset = P, order = induced P r |) L"
-apply (rule_tac x = "v" in exI)
-apply (simp add: isLub_def)
--- {* @{text "v \<in> P"} *}
-apply (simp add: v_in_P)
-apply (rule conjI)
-(*sledgehammer*) 
--- {* @{text v} is lub *}
--- {* @{text "1. \<forall>y:Y. (y, v) \<in> induced P r"} *}
-apply (rule ballI)
-apply (simp add: induced_def subsetD v_in_P)
-apply (rule conjI)
-apply (erule Y_ss [THEN subsetD])
-apply (rule_tac b = "lub Y cl" in transE)
-apply (rule lub_upper)
-apply (rule Y_subset_A, assumption)
-apply (rule_tac b = "Top cl" in interval_imp_mem)
-apply (simp add: v_def)
-apply (fold intY1_def)
-apply (rule CL.glb_in_lattice [OF CL.intro, OF PO.intro CL_axioms.intro, OF _ intY1_is_cl, simplified])
- apply (simp add: CL_imp_PO intY1_is_cl, force)
--- {* @{text v} is LEAST ub *}
-apply clarify
-apply (rule indI)
-  prefer 3 apply assumption
- prefer 2 apply (simp add: v_in_P)
-apply (unfold v_def)
-(*never proved, 2007-01-22*)
-using [[ atp_problem_prefix = "Tarski__tarski_full_lemma_simpler" ]]
-(*sledgehammer*) 
-apply (rule indE)
-apply (rule_tac [2] intY1_subset)
-(*never proved, 2007-01-22*)
-using [[ atp_problem_prefix = "Tarski__tarski_full_lemma_simplest" ]]
-(*sledgehammer*) 
-apply (rule CL.glb_lower [OF CL.intro, OF PO.intro CL_axioms.intro, OF _ intY1_is_cl, simplified])
-  apply (simp add: CL_imp_PO intY1_is_cl)
- apply force
-apply (simp add: induced_def intY1_f_closed z_in_interval)
-apply (simp add: P_def fix_imp_eq [of _ f A] reflE
-                 fix_subset [of f A, THEN subsetD])
-done
-
-lemma CompleteLatticeI_simp:
-     "[| (| pset = A, order = r |) \<in> PartialOrder;
-         \<forall>S. S \<subseteq> A --> (\<exists>L. isLub S (| pset = A, order = r |)  L) |]
-    ==> (| pset = A, order = r |) \<in> CompleteLattice"
-by (simp add: CompleteLatticeI Rdual)
-
-
-(*never proved, 2007-01-22*)
-declare [[ atp_problem_prefix = "Tarski__Tarski_full" ]]
-  declare (in CLF) fixf_po[intro] P_def [simp] A_def [simp] r_def [simp]
-               Tarski.tarski_full_lemma [intro] cl_po [intro] cl_co [intro]
-               CompleteLatticeI_simp [intro]
-theorem (in CLF) Tarski_full:
-     "(| pset = P, order = induced P r|) \<in> CompleteLattice"
-(*sledgehammer*) 
-apply (rule CompleteLatticeI_simp)
-apply (rule fixf_po, clarify)
-(*never proved, 2007-01-22*)
-using [[ atp_problem_prefix = "Tarski__Tarski_full_simpler" ]]
-(*sledgehammer*) 
-apply (simp add: P_def A_def r_def)
-apply (blast intro!: Tarski.tarski_full_lemma [OF Tarski.intro, OF CLF.intro Tarski_axioms.intro,
-  OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro] cl_po cl_co f_cl)
-done
-  declare (in CLF) fixf_po[rule del] P_def [simp del] A_def [simp del] r_def [simp del]
-         Tarski.tarski_full_lemma [rule del] cl_po [rule del] cl_co [rule del]
-         CompleteLatticeI_simp [rule del]
-
-
-end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/TransClosure.thy
--- a/src/HOL/MetisExamples/TransClosure.thy	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,62 +0,0 @@
-(*  Title:      HOL/MetisTest/TransClosure.thy
-    ID:         $Id$
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method
-*)
-
-theory TransClosure
-imports Main
-begin
-
-types addr = nat
-
-datatype val
-  = Unit        -- "dummy result value of void expressions"
-  | Null        -- "null reference"
-  | Bool bool   -- "Boolean value"
-  | Intg int    -- "integer value" 
-  | Addr addr   -- "addresses of objects in the heap"
-
-consts R::"(addr \<times> addr) set"
-
-consts f:: "addr \<Rightarrow> val"
-
-declare [[ atp_problem_prefix = "TransClosure__test" ]]
-lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
-   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"  
-by (metis Transitive_Closure.rtrancl_into_rtrancl converse_rtranclE trancl_reflcl)
-
-lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
-   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"
-proof (neg_clausify)
-assume 0: "f c = Intg x"
-assume 1: "(a, b) \<in> R\<^sup>*"
-assume 2: "(b, c) \<in> R\<^sup>*"
-assume 3: "f b \<noteq> Intg x"
-assume 4: "\<And>A. (b, A) \<notin> R \<or> (a, A) \<notin> R\<^sup>*"
-have 5: "b = c \<or> b \<in> Domain R"
-  by (metis Not_Domain_rtrancl 2)
-have 6: "\<And>X1. (a, X1) \<in> R\<^sup>* \<or> (b, X1) \<notin> R"
-  by (metis Transitive_Closure.rtrancl_into_rtrancl 1)
-have 7: "\<And>X1. (b, X1) \<notin> R"
-  by (metis 6 4)
-have 8: "b \<notin> Domain R"
-  by (metis 7 DomainE)
-have 9: "c = b"
-  by (metis 5 8)
-have 10: "f b = Intg x"
-  by (metis 0 9)
-show "False"
-  by (metis 10 3)
-qed
-
-declare [[ atp_problem_prefix = "TransClosure__test_simpler" ]]
-lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
-   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"
-apply (erule_tac x="b" in converse_rtranclE)
-apply (metis rel_pow_0_E rel_pow_0_I)
-apply (metis DomainE Domain_iff Transitive_Closure.rtrancl_into_rtrancl)
-done
-
-end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/MetisExamples/set.thy
--- a/src/HOL/MetisExamples/set.thy	Tue Oct 20 19:37:09 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,283 +0,0 @@
-(*  Title:      HOL/MetisExamples/set.thy
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-
-Testing the metis method
-*)
-
-theory set imports Main
-
-begin
-
-lemma "EX x X. ALL y. EX z Z. (~P(y,y) | P(x,x) | ~S(z,x)) &
-               (S(x,y) | ~S(y,z) | Q(Z,Z))  &
-               (Q(X,y) | ~Q(y,Z) | S(X,X))" 
-by metis
-(*??But metis can't prove the single-step version...*)
-
-
-
-lemma "P(n::nat) ==> ~P(0) ==> n ~= 0"
-by metis
-
-declare [[sledgehammer_modulus = 1]]
-
-
-(*multiple versions of this example*)
-lemma (*equal_union: *)
-   "(X = Y \<union> Z) =
-    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
-proof (neg_clausify)
-fix x
-assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
-assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
-assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
-have 6: "sup Y Z = X \<or> Y \<subseteq> X"
-  by (metis 0)
-have 7: "sup Y Z = X \<or> Z \<subseteq> X"
-  by (metis 1)
-have 8: "\<And>X3. sup Y Z = X \<or> X \<subseteq> X3 \<or> \<not> Y \<subseteq> X3 \<or> \<not> Z \<subseteq> X3"
-  by (metis 5)
-have 9: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
-  by (metis 2)
-have 10: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
-  by (metis 3)
-have 11: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
-  by (metis 4)
-have 12: "Z \<subseteq> X"
-  by (metis Un_upper2 7)
-have 13: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
-  by (metis 8 Un_upper2)
-have 14: "Y \<subseteq> X"
-  by (metis Un_upper1 6)
-have 15: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis 10 12)
-have 16: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis 9 12)
-have 17: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X"
-  by (metis 11 12)
-have 18: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x"
-  by (metis 17 14)
-have 19: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
-  by (metis 15 14)
-have 20: "Y \<subseteq> x \<or> sup Y Z \<noteq> X"
-  by (metis 16 14)
-have 21: "sup Y Z = X \<or> X \<subseteq> sup Y Z"
-  by (metis 13 Un_upper1)
-have 22: "sup Y Z = X \<or> \<not> sup Y Z \<subseteq> X"
-  by (metis equalityI 21)
-have 23: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis 22 Un_least)
-have 24: "sup Y Z = X \<or> \<not> Y \<subseteq> X"
-  by (metis 23 12)
-have 25: "sup Y Z = X"
-  by (metis 24 14)
-have 26: "\<And>X3. X \<subseteq> X3 \<or> \<not> Z \<subseteq> X3 \<or> \<not> Y \<subseteq> X3"
-  by (metis Un_least 25)
-have 27: "Y \<subseteq> x"
-  by (metis 20 25)
-have 28: "Z \<subseteq> x"
-  by (metis 19 25)
-have 29: "\<not> X \<subseteq> x"
-  by (metis 18 25)
-have 30: "X \<subseteq> x \<or> \<not> Y \<subseteq> x"
-  by (metis 26 28)
-have 31: "X \<subseteq> x"
-  by (metis 30 27)
-show "False"
-  by (metis 31 29)
-qed
-
-declare [[sledgehammer_modulus = 2]]
-
-lemma (*equal_union: *)
-   "(X = Y \<union> Z) =
-    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
-proof (neg_clausify)
-fix x
-assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
-assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
-assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
-have 6: "sup Y Z = X \<or> Y \<subseteq> X"
-  by (metis 0)
-have 7: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
-  by (metis 2)
-have 8: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
-  by (metis 4)
-have 9: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
-  by (metis 5 Un_upper2)
-have 10: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis 3 Un_upper2)
-have 11: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X"
-  by (metis 8 Un_upper2)
-have 12: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
-  by (metis 10 Un_upper1)
-have 13: "sup Y Z = X \<or> X \<subseteq> sup Y Z"
-  by (metis 9 Un_upper1)
-have 14: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis equalityI 13 Un_least)
-have 15: "sup Y Z = X"
-  by (metis 14 1 6)
-have 16: "Y \<subseteq> x"
-  by (metis 7 Un_upper2 Un_upper1 15)
-have 17: "\<not> X \<subseteq> x"
-  by (metis 11 Un_upper1 15)
-have 18: "X \<subseteq> x"
-  by (metis Un_least 15 12 15 16)
-show "False"
-  by (metis 18 17)
-qed
-
-declare [[sledgehammer_modulus = 3]]
-
-lemma (*equal_union: *)
-   "(X = Y \<union> Z) =
-    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
-proof (neg_clausify)
-fix x
-assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
-assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
-assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
-have 6: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
-  by (metis 3)
-have 7: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
-  by (metis 5 Un_upper2)
-have 8: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis 2 Un_upper2)
-have 9: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
-  by (metis 6 Un_upper2 Un_upper1)
-have 10: "sup Y Z = X \<or> \<not> sup Y Z \<subseteq> X"
-  by (metis equalityI 7 Un_upper1)
-have 11: "sup Y Z = X"
-  by (metis 10 Un_least 1 0)
-have 12: "Z \<subseteq> x"
-  by (metis 9 11)
-have 13: "X \<subseteq> x"
-  by (metis Un_least 11 12 8 Un_upper1 11)
-show "False"
-  by (metis 13 4 Un_upper2 Un_upper1 11)
-qed
-
-(*Example included in TPHOLs paper*)
-
-declare [[sledgehammer_modulus = 4]]
-
-lemma (*equal_union: *)
-   "(X = Y \<union> Z) =
-    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
-proof (neg_clausify)
-fix x
-assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
-assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
-assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
-assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
-have 6: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
-  by (metis 4)
-have 7: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis 3 Un_upper2)
-have 8: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
-  by (metis 7 Un_upper1)
-have 9: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
-  by (metis equalityI 5 Un_upper2 Un_upper1 Un_least)
-have 10: "Y \<subseteq> x"
-  by (metis 2 Un_upper2 1 Un_upper1 0 9 Un_upper2 1 Un_upper1 0)
-have 11: "X \<subseteq> x"
-  by (metis Un_least 9 Un_upper2 1 Un_upper1 0 8 9 Un_upper2 1 Un_upper1 0 10)
-show "False"
-  by (metis 11 6 Un_upper2 1 Un_upper1 0 9 Un_upper2 1 Un_upper1 0)
-qed 
-
-declare [[ atp_problem_prefix = "set__equal_union" ]]
-lemma (*equal_union: *)
-   "(X = Y \<union> Z) =
-    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" 
-(*One shot proof: hand-reduced. Metis can't do the full proof any more.*)
-by (metis Un_least Un_upper1 Un_upper2 set_eq_subset)
-
-
-declare [[ atp_problem_prefix = "set__equal_inter" ]]
-lemma "(X = Y \<inter> Z) =
-    (X \<subseteq> Y \<and> X \<subseteq> Z \<and> (\<forall>V. V \<subseteq> Y \<and> V \<subseteq> Z \<longrightarrow> V \<subseteq> X))"
-by (metis Int_greatest Int_lower1 Int_lower2 set_eq_subset)
-
-declare [[ atp_problem_prefix = "set__fixedpoint" ]]
-lemma fixedpoint:
-    "\<exists>!x. f (g x) = x \<Longrightarrow> \<exists>!y. g (f y) = y"
-by metis
-
-lemma (*fixedpoint:*)
-    "\<exists>!x. f (g x) = x \<Longrightarrow> \<exists>!y. g (f y) = y"
-proof (neg_clausify)
-fix x xa
-assume 0: "f (g x) = x"
-assume 1: "\<And>y. y = x \<or> f (g y) \<noteq> y"
-assume 2: "\<And>x. g (f (xa x)) = xa x \<or> g (f x) \<noteq> x"
-assume 3: "\<And>x. g (f x) \<noteq> x \<or> xa x \<noteq> x"
-have 4: "\<And>X1. g (f X1) \<noteq> X1 \<or> g x \<noteq> X1"
-  by (metis 3 1 2)
-show "False"
-  by (metis 4 0)
-qed
-
-declare [[ atp_problem_prefix = "set__singleton_example" ]]
-lemma (*singleton_example_2:*)
-     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
-by (metis Set.subsetI Union_upper insertCI set_eq_subset)
-  --{*found by SPASS*}
-
-lemma (*singleton_example_2:*)
-     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
-by (metis Set.subsetI Union_upper insert_iff set_eq_subset)
-
-lemma singleton_example_2:
-     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
-proof (neg_clausify)
-assume 0: "\<And>x. \<not> S \<subseteq> {x}"
-assume 1: "\<And>x. x \<notin> S \<or> \<Union>S \<subseteq> x"
-have 2: "\<And>X3. X3 = \<Union>S \<or> \<not> X3 \<subseteq> \<Union>S \<or> X3 \<notin> S"
-  by (metis set_eq_subset 1)
-have 3: "\<And>X3. S \<subseteq> insert (\<Union>S) X3"
-  by (metis insert_iff Set.subsetI Union_upper 2 Set.subsetI)
-show "False"
-  by (metis 3 0)
-qed
-
-
-
-text {*
-  From W. W. Bledsoe and Guohui Feng, SET-VAR. JAR 11 (3), 1993, pages
-  293-314.
-*}
-
-declare [[ atp_problem_prefix = "set__Bledsoe_Fung" ]]
-(*Notes: 1, the numbering doesn't completely agree with the paper. 
-2, we must rename set variables to avoid type clashes.*)
-lemma "\<exists>B. (\<forall>x \<in> B. x \<le> (0::int))"
-      "D \<in> F \<Longrightarrow> \<exists>G. \<forall>A \<in> G. \<exists>B \<in> F. A \<subseteq> B"
-      "P a \<Longrightarrow> \<exists>A. (\<forall>x \<in> A. P x) \<and> (\<exists>y. y \<in> A)"
-      "a < b \<and> b < (c::int) \<Longrightarrow> \<exists>B. a \<notin> B \<and> b \<in> B \<and> c \<notin> B"
-      "P (f b) \<Longrightarrow> \<exists>s A. (\<forall>x \<in> A. P x) \<and> f s \<in> A"
-      "P (f b) \<Longrightarrow> \<exists>s A. (\<forall>x \<in> A. P x) \<and> f s \<in> A"
-      "\<exists>A. a \<notin> A"
-      "(\<forall>C. (0, 0) \<in> C \<and> (\<forall>x y. (x, y) \<in> C \<longrightarrow> (Suc x, Suc y) \<in> C) \<longrightarrow> (n, m) \<in> C) \<and> Q n \<longrightarrow> Q m" 
-apply (metis atMost_iff)
-apply (metis emptyE)
-apply (metis insert_iff singletonE)
-apply (metis insertCI singletonE zless_le)
-apply (metis Collect_def Collect_mem_eq)
-apply (metis Collect_def Collect_mem_eq)
-apply (metis DiffE)
-apply (metis pair_in_Id_conv) 
-done
-
-end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/Abstraction.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/Abstraction.thy	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,297 @@
+(*  Title:      HOL/Metis_Examples/Abstraction.thy
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method.
+*)
+
+theory Abstraction
+imports Main FuncSet
+begin
+
+(*For Christoph Benzmueller*)
+lemma "x<1 & ((op=) = (op=)) ==> ((op=) = (op=)) & (x<(2::nat))";
+  by (metis One_nat_def less_Suc0 not_less0 not_less_eq numeral_2_eq_2)
+
+(*this is a theorem, but we can't prove it unless ext is applied explicitly
+lemma "(op=) = (%x y. y=x)"
+*)
+
+consts
+  monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool"
+  pset  :: "'a set => 'a set"
+  order :: "'a set => ('a * 'a) set"
+
+declare [[ atp_problem_prefix = "Abstraction__Collect_triv" ]]
+lemma (*Collect_triv:*) "a \<in> {x. P x} ==> P a"
+proof (neg_clausify)
+assume 0: "(a\<Colon>'a\<Colon>type) \<in> Collect (P\<Colon>'a\<Colon>type \<Rightarrow> bool)"
+assume 1: "\<not> (P\<Colon>'a\<Colon>type \<Rightarrow> bool) (a\<Colon>'a\<Colon>type)"
+have 2: "(P\<Colon>'a\<Colon>type \<Rightarrow> bool) (a\<Colon>'a\<Colon>type)"
+  by (metis CollectD 0)
+show "False"
+  by (metis 2 1)
+qed
+
+lemma Collect_triv: "a \<in> {x. P x} ==> P a"
+by (metis mem_Collect_eq)
+
+
+declare [[ atp_problem_prefix = "Abstraction__Collect_mp" ]]
+lemma "a \<in> {x. P x --> Q x} ==> a \<in> {x. P x} ==> a \<in> {x. Q x}"
+  by (metis CollectI Collect_imp_eq ComplD UnE mem_Collect_eq);
+  --{*34 secs*}
+
+declare [[ atp_problem_prefix = "Abstraction__Sigma_triv" ]]
+lemma "(a,b) \<in> Sigma A B ==> a \<in> A & b \<in> B a"
+proof (neg_clausify)
+assume 0: "(a\<Colon>'a\<Colon>type, b\<Colon>'b\<Colon>type) \<in> Sigma (A\<Colon>'a\<Colon>type set) (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set)"
+assume 1: "(a\<Colon>'a\<Colon>type) \<notin> (A\<Colon>'a\<Colon>type set) \<or> (b\<Colon>'b\<Colon>type) \<notin> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) a"
+have 2: "(a\<Colon>'a\<Colon>type) \<in> (A\<Colon>'a\<Colon>type set)"
+  by (metis SigmaD1 0)
+have 3: "(b\<Colon>'b\<Colon>type) \<in> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) (a\<Colon>'a\<Colon>type)"
+  by (metis SigmaD2 0)
+have 4: "(b\<Colon>'b\<Colon>type) \<notin> (B\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>type set) (a\<Colon>'a\<Colon>type)"
+  by (metis 1 2)
+show "False"
+  by (metis 3 4)
+qed
+
+lemma Sigma_triv: "(a,b) \<in> Sigma A B ==> a \<in> A & b \<in> B a"
+by (metis SigmaD1 SigmaD2)
+
+declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect" ]]
+lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
+(*???metis says this is satisfiable!
+by (metis CollectD SigmaD1 SigmaD2)
+*)
+by (meson CollectD SigmaD1 SigmaD2)
+
+
+(*single-step*)
+lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
+by (metis SigmaD1 SigmaD2 insert_def singleton_conv2 Un_empty_right vimage_Collect_eq vimage_def vimage_singleton_eq)
+
+
+lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
+proof (neg_clausify)
+assume 0: "(a\<Colon>'a\<Colon>type, b\<Colon>'b\<Colon>type)
+\<in> Sigma (A\<Colon>'a\<Colon>type set)
+   (COMBB Collect (COMBC (COMBB COMBB op =) (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type)))"
+assume 1: "(a\<Colon>'a\<Colon>type) \<notin> (A\<Colon>'a\<Colon>type set) \<or> a \<noteq> (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type) (b\<Colon>'b\<Colon>type)"
+have 2: "(a\<Colon>'a\<Colon>type) \<in> (A\<Colon>'a\<Colon>type set)"
+  by (metis 0 SigmaD1)
+have 3: "(b\<Colon>'b\<Colon>type)
+\<in> COMBB Collect (COMBC (COMBB COMBB op =) (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type)) (a\<Colon>'a\<Colon>type)"
+  by (metis 0 SigmaD2) 
+have 4: "(b\<Colon>'b\<Colon>type) \<in> Collect (COMBB (op = (a\<Colon>'a\<Colon>type)) (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type))"
+  by (metis 3)
+have 5: "(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type) (b\<Colon>'b\<Colon>type) \<noteq> (a\<Colon>'a\<Colon>type)"
+  by (metis 1 2)
+have 6: "(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>type) (b\<Colon>'b\<Colon>type) = (a\<Colon>'a\<Colon>type)"
+  by (metis 4 vimage_singleton_eq insert_def singleton_conv2 Un_empty_right vimage_Collect_eq vimage_def)
+show "False"
+  by (metis 5 6)
+qed
+
+(*Alternative structured proof, untyped*)
+lemma "(a,b) \<in> (SIGMA x: A. {y. x = f y}) ==> a \<in> A & a = f b"
+proof (neg_clausify)
+assume 0: "(a, b) \<in> Sigma A (COMBB Collect (COMBC (COMBB COMBB op =) f))"
+have 1: "b \<in> Collect (COMBB (op = a) f)"
+  by (metis 0 SigmaD2)
+have 2: "f b = a"
+  by (metis 1 vimage_Collect_eq singleton_conv2 insert_def Un_empty_right vimage_singleton_eq vimage_def)
+assume 3: "a \<notin> A \<or> a \<noteq> f b"
+have 4: "a \<in> A"
+  by (metis 0 SigmaD1)
+have 5: "f b \<noteq> a"
+  by (metis 4 3)
+show "False"
+  by (metis 5 2)
+qed
+
+
+declare [[ atp_problem_prefix = "Abstraction__CLF_eq_in_pp" ]]
+lemma "(cl,f) \<in> CLF ==> CLF = (SIGMA cl: CL.{f. f \<in> pset cl}) ==> f \<in> pset cl"
+by (metis Collect_mem_eq SigmaD2)
+
+lemma "(cl,f) \<in> CLF ==> CLF = (SIGMA cl: CL.{f. f \<in> pset cl}) ==> f \<in> pset cl"
+proof (neg_clausify)
+assume 0: "(cl, f) \<in> CLF"
+assume 1: "CLF = Sigma CL (COMBB Collect (COMBB (COMBC op \<in>) pset))"
+assume 2: "f \<notin> pset cl"
+have 3: "\<And>X1 X2. X2 \<in> COMBB Collect (COMBB (COMBC op \<in>) pset) X1 \<or> (X1, X2) \<notin> CLF"
+  by (metis SigmaD2 1)
+have 4: "\<And>X1 X2. X2 \<in> pset X1 \<or> (X1, X2) \<notin> CLF"
+  by (metis 3 Collect_mem_eq)
+have 5: "(cl, f) \<notin> CLF"
+  by (metis 2 4)
+show "False"
+  by (metis 5 0)
+qed
+
+declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect_Pi" ]]
+lemma
+    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl}) ==> 
+    f \<in> pset cl \<rightarrow> pset cl"
+proof (neg_clausify)
+assume 0: "f \<notin> Pi (pset cl) (COMBK (pset cl))"
+assume 1: "(cl, f)
+\<in> Sigma CL
+   (COMBB Collect
+     (COMBB (COMBC op \<in>) (COMBS (COMBB Pi pset) (COMBB COMBK pset))))"
+show "False"
+(*  by (metis 0 Collect_mem_eq SigmaD2 1) ??doesn't terminate*)
+  by (insert 0 1, simp add: COMBB_def COMBS_def COMBC_def)
+qed
+
+
+declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect_Int" ]]
+lemma
+    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
+   f \<in> pset cl \<inter> cl"
+proof (neg_clausify)
+assume 0: "(cl, f)
+\<in> Sigma CL
+   (COMBB Collect (COMBB (COMBC op \<in>) (COMBS (COMBB op \<inter> pset) COMBI)))"
+assume 1: "f \<notin> pset cl \<inter> cl"
+have 2: "f \<in> COMBB Collect (COMBB (COMBC op \<in>) (COMBS (COMBB op \<inter> pset) COMBI)) cl" 
+  by (insert 0, simp add: COMBB_def) 
+(*  by (metis SigmaD2 0)  ??doesn't terminate*)
+have 3: "f \<in> COMBS (COMBB op \<inter> pset) COMBI cl"
+  by (metis 2 Collect_mem_eq)
+have 4: "f \<notin> cl \<inter> pset cl"
+  by (metis 1 Int_commute)
+have 5: "f \<in> cl \<inter> pset cl"
+  by (metis 3 Int_commute)
+show "False"
+  by (metis 5 4)
+qed
+
+
+declare [[ atp_problem_prefix = "Abstraction__Sigma_Collect_Pi_mono" ]]
+lemma
+    "(cl,f) \<in> (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl & monotone f (pset cl) (order cl)}) ==>
+   (f \<in> pset cl \<rightarrow> pset cl)  &  (monotone f (pset cl) (order cl))"
+by auto
+
+declare [[ atp_problem_prefix = "Abstraction__CLF_subset_Collect_Int" ]]
+lemma "(cl,f) \<in> CLF ==> 
+   CLF \<subseteq> (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
+   f \<in> pset cl \<inter> cl"
+by auto
+
+(*??no longer terminates, with combinators
+by (metis Collect_mem_eq Int_def SigmaD2 UnCI Un_absorb1)
+  --{*@{text Int_def} is redundant*}
+*)
+
+declare [[ atp_problem_prefix = "Abstraction__CLF_eq_Collect_Int" ]]
+lemma "(cl,f) \<in> CLF ==> 
+   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<inter> cl}) ==>
+   f \<in> pset cl \<inter> cl"
+by auto
+(*??no longer terminates, with combinators
+by (metis Collect_mem_eq Int_commute SigmaD2)
+*)
+
+declare [[ atp_problem_prefix = "Abstraction__CLF_subset_Collect_Pi" ]]
+lemma 
+   "(cl,f) \<in> CLF ==> 
+    CLF \<subseteq> (SIGMA cl': CL. {f. f \<in> pset cl' \<rightarrow> pset cl'}) ==> 
+    f \<in> pset cl \<rightarrow> pset cl"
+by fast
+(*??no longer terminates, with combinators
+by (metis Collect_mem_eq SigmaD2 subsetD)
+*)
+
+declare [[ atp_problem_prefix = "Abstraction__CLF_eq_Collect_Pi" ]]
+lemma 
+  "(cl,f) \<in> CLF ==> 
+   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl}) ==> 
+   f \<in> pset cl \<rightarrow> pset cl"
+by auto
+(*??no longer terminates, with combinators
+by (metis Collect_mem_eq SigmaD2 contra_subsetD equalityE)
+*)
+
+declare [[ atp_problem_prefix = "Abstraction__CLF_eq_Collect_Pi_mono" ]]
+lemma 
+  "(cl,f) \<in> CLF ==> 
+   CLF = (SIGMA cl: CL. {f. f \<in> pset cl \<rightarrow> pset cl & monotone f (pset cl) (order cl)}) ==>
+   (f \<in> pset cl \<rightarrow> pset cl)  &  (monotone f (pset cl) (order cl))"
+by auto
+
+declare [[ atp_problem_prefix = "Abstraction__map_eq_zipA" ]]
+lemma "map (%x. (f x, g x)) xs = zip (map f xs) (map g xs)"
+apply (induct xs)
+(*sledgehammer*)  
+apply auto
+done
+
+declare [[ atp_problem_prefix = "Abstraction__map_eq_zipB" ]]
+lemma "map (%w. (w -> w, w \<times> w)) xs = 
+       zip (map (%w. w -> w) xs) (map (%w. w \<times> w) xs)"
+apply (induct xs)
+(*sledgehammer*)  
+apply auto
+done
+
+declare [[ atp_problem_prefix = "Abstraction__image_evenA" ]]
+lemma "(%x. Suc(f x)) ` {x. even x} <= A ==> (\<forall>x. even x --> Suc(f x) \<in> A)";
+(*sledgehammer*)  
+by auto
+
+declare [[ atp_problem_prefix = "Abstraction__image_evenB" ]]
+lemma "(%x. f (f x)) ` ((%x. Suc(f x)) ` {x. even x}) <= A 
+       ==> (\<forall>x. even x --> f (f (Suc(f x))) \<in> A)";
+(*sledgehammer*)  
+by auto
+
+declare [[ atp_problem_prefix = "Abstraction__image_curry" ]]
+lemma "f \<in> (%u v. b \<times> u \<times> v) ` A ==> \<forall>u v. P (b \<times> u \<times> v) ==> P(f y)" 
+(*sledgehammer*)  
+by auto
+
+declare [[ atp_problem_prefix = "Abstraction__image_TimesA" ]]
+lemma image_TimesA: "(%(x,y). (f x, g y)) ` (A \<times> B) = (f`A) \<times> (g`B)"
+(*sledgehammer*) 
+apply (rule equalityI)
+(***Even the two inclusions are far too difficult
+using [[ atp_problem_prefix = "Abstraction__image_TimesA_simpler"]]
+***)
+apply (rule subsetI)
+apply (erule imageE)
+(*V manages from here with help: Abstraction__image_TimesA_simpler_1_b.p*)
+apply (erule ssubst)
+apply (erule SigmaE)
+(*V manages from here: Abstraction__image_TimesA_simpler_1_a.p*)
+apply (erule ssubst)
+apply (subst split_conv)
+apply (rule SigmaI) 
+apply (erule imageI) +
+txt{*subgoal 2*}
+apply (clarify );
+apply (simp add: );  
+apply (rule rev_image_eqI)  
+apply (blast intro: elim:); 
+apply (simp add: );
+done
+
+(*Given the difficulty of the previous problem, these two are probably
+impossible*)
+
+declare [[ atp_problem_prefix = "Abstraction__image_TimesB" ]]
+lemma image_TimesB:
+    "(%(x,y,z). (f x, g y, h z)) ` (A \<times> B \<times> C) = (f`A) \<times> (g`B) \<times> (h`C)" 
+(*sledgehammer*) 
+by force
+
+declare [[ atp_problem_prefix = "Abstraction__image_TimesC" ]]
+lemma image_TimesC:
+    "(%(x,y). (x \<rightarrow> x, y \<times> y)) ` (A \<times> B) = 
+     ((%x. x \<rightarrow> x) ` A) \<times> ((%y. y \<times> y) ` B)" 
+(*sledgehammer*) 
+by auto
+
+end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/BT.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/BT.thy	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,243 @@
+(*  Title:      HOL/MetisTest/BT.thy
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method
+*)
+
+header {* Binary trees *}
+
+theory BT
+imports Main
+begin
+
+
+datatype 'a bt =
+    Lf
+  | Br 'a  "'a bt"  "'a bt"
+
+consts
+  n_nodes   :: "'a bt => nat"
+  n_leaves  :: "'a bt => nat"
+  depth     :: "'a bt => nat"
+  reflect   :: "'a bt => 'a bt"
+  bt_map    :: "('a => 'b) => ('a bt => 'b bt)"
+  preorder  :: "'a bt => 'a list"
+  inorder   :: "'a bt => 'a list"
+  postorder :: "'a bt => 'a list"
+  appnd    :: "'a bt => 'a bt => 'a bt"
+
+primrec
+  "n_nodes Lf = 0"
+  "n_nodes (Br a t1 t2) = Suc (n_nodes t1 + n_nodes t2)"
+
+primrec
+  "n_leaves Lf = Suc 0"
+  "n_leaves (Br a t1 t2) = n_leaves t1 + n_leaves t2"
+
+primrec
+  "depth Lf = 0"
+  "depth (Br a t1 t2) = Suc (max (depth t1) (depth t2))"
+
+primrec
+  "reflect Lf = Lf"
+  "reflect (Br a t1 t2) = Br a (reflect t2) (reflect t1)"
+
+primrec
+  "bt_map f Lf = Lf"
+  "bt_map f (Br a t1 t2) = Br (f a) (bt_map f t1) (bt_map f t2)"
+
+primrec
+  "preorder Lf = []"
+  "preorder (Br a t1 t2) = [a] @ (preorder t1) @ (preorder t2)"
+
+primrec
+  "inorder Lf = []"
+  "inorder (Br a t1 t2) = (inorder t1) @ [a] @ (inorder t2)"
+
+primrec
+  "postorder Lf = []"
+  "postorder (Br a t1 t2) = (postorder t1) @ (postorder t2) @ [a]"
+
+primrec
+  "appnd Lf t = t"
+  "appnd (Br a t1 t2) t = Br a (appnd t1 t) (appnd t2 t)"
+
+
+text {* \medskip BT simplification *}
+
+declare [[ atp_problem_prefix = "BT__n_leaves_reflect" ]]
+lemma n_leaves_reflect: "n_leaves (reflect t) = n_leaves t"
+  apply (induct t)
+  apply (metis add_right_cancel n_leaves.simps(1) reflect.simps(1))
+  apply (metis add_commute n_leaves.simps(2) reflect.simps(2))
+  done
+
+declare [[ atp_problem_prefix = "BT__n_nodes_reflect" ]]
+lemma n_nodes_reflect: "n_nodes (reflect t) = n_nodes t"
+  apply (induct t)
+  apply (metis reflect.simps(1))
+  apply (metis n_nodes.simps(2) nat_add_commute reflect.simps(2))
+  done
+
+declare [[ atp_problem_prefix = "BT__depth_reflect" ]]
+lemma depth_reflect: "depth (reflect t) = depth t"
+  apply (induct t)
+  apply (metis depth.simps(1) reflect.simps(1))
+  apply (metis depth.simps(2) min_max.sup_commute reflect.simps(2))
+  done
+
+text {*
+  The famous relationship between the numbers of leaves and nodes.
+*}
+
+declare [[ atp_problem_prefix = "BT__n_leaves_nodes" ]]
+lemma n_leaves_nodes: "n_leaves t = Suc (n_nodes t)"
+  apply (induct t)
+  apply (metis n_leaves.simps(1) n_nodes.simps(1))
+  apply auto
+  done
+
+declare [[ atp_problem_prefix = "BT__reflect_reflect_ident" ]]
+lemma reflect_reflect_ident: "reflect (reflect t) = t"
+  apply (induct t)
+  apply (metis add_right_cancel reflect.simps(1));
+  apply (metis reflect.simps(2))
+  done
+
+declare [[ atp_problem_prefix = "BT__bt_map_ident" ]]
+lemma bt_map_ident: "bt_map (%x. x) = (%y. y)"
+apply (rule ext) 
+apply (induct_tac y)
+  apply (metis bt_map.simps(1))
+txt{*BUG involving flex-flex pairs*}
+(*  apply (metis bt_map.simps(2)) *)
+apply auto
+done
+
+
+declare [[ atp_problem_prefix = "BT__bt_map_appnd" ]]
+lemma bt_map_appnd: "bt_map f (appnd t u) = appnd (bt_map f t) (bt_map f u)"
+apply (induct t)
+  apply (metis appnd.simps(1) bt_map.simps(1))
+  apply (metis appnd.simps(2) bt_map.simps(2))  (*slow!!*)
+done
+
+
+declare [[ atp_problem_prefix = "BT__bt_map_compose" ]]
+lemma bt_map_compose: "bt_map (f o g) t = bt_map f (bt_map g t)"
+apply (induct t) 
+  apply (metis bt_map.simps(1))
+txt{*Metis runs forever*}
+(*  apply (metis bt_map.simps(2) o_apply)*)
+apply auto
+done
+
+
+declare [[ atp_problem_prefix = "BT__bt_map_reflect" ]]
+lemma bt_map_reflect: "bt_map f (reflect t) = reflect (bt_map f t)"
+  apply (induct t)
+  apply (metis add_right_cancel bt_map.simps(1) reflect.simps(1))
+  apply (metis add_right_cancel bt_map.simps(2) reflect.simps(2))
+  done
+
+declare [[ atp_problem_prefix = "BT__preorder_bt_map" ]]
+lemma preorder_bt_map: "preorder (bt_map f t) = map f (preorder t)"
+  apply (induct t)
+  apply (metis bt_map.simps(1) map.simps(1) preorder.simps(1))
+   apply simp
+  done
+
+declare [[ atp_problem_prefix = "BT__inorder_bt_map" ]]
+lemma inorder_bt_map: "inorder (bt_map f t) = map f (inorder t)"
+  apply (induct t)
+  apply (metis bt_map.simps(1) inorder.simps(1) map.simps(1))
+  apply simp
+  done
+
+declare [[ atp_problem_prefix = "BT__postorder_bt_map" ]]
+lemma postorder_bt_map: "postorder (bt_map f t) = map f (postorder t)"
+  apply (induct t)
+  apply (metis bt_map.simps(1) map.simps(1) postorder.simps(1))
+   apply simp
+  done
+
+declare [[ atp_problem_prefix = "BT__depth_bt_map" ]]
+lemma depth_bt_map [simp]: "depth (bt_map f t) = depth t"
+  apply (induct t)
+  apply (metis bt_map.simps(1) depth.simps(1))
+   apply simp
+  done
+
+declare [[ atp_problem_prefix = "BT__n_leaves_bt_map" ]]
+lemma n_leaves_bt_map [simp]: "n_leaves (bt_map f t) = n_leaves t"
+  apply (induct t)
+  apply (metis One_nat_def Suc_eq_plus1 bt_map.simps(1) less_add_one less_antisym linorder_neq_iff n_leaves.simps(1))
+  apply (metis bt_map.simps(2) n_leaves.simps(2))
+  done
+
+
+declare [[ atp_problem_prefix = "BT__preorder_reflect" ]]
+lemma preorder_reflect: "preorder (reflect t) = rev (postorder t)"
+  apply (induct t)
+  apply (metis postorder.simps(1) preorder.simps(1) reflect.simps(1) rev_is_Nil_conv)
+  apply (metis append_Nil Cons_eq_append_conv postorder.simps(2) preorder.simps(2) reflect.simps(2) rev.simps(2) rev_append rev_rev_ident)
+  done
+
+declare [[ atp_problem_prefix = "BT__inorder_reflect" ]]
+lemma inorder_reflect: "inorder (reflect t) = rev (inorder t)"
+  apply (induct t)
+  apply (metis inorder.simps(1) reflect.simps(1) rev.simps(1))
+  apply simp
+  done
+
+declare [[ atp_problem_prefix = "BT__postorder_reflect" ]]
+lemma postorder_reflect: "postorder (reflect t) = rev (preorder t)"
+  apply (induct t)
+  apply (metis postorder.simps(1) preorder.simps(1) reflect.simps(1) rev.simps(1))
+  apply (metis Cons_eq_appendI postorder.simps(2) preorder.simps(2) reflect.simps(2) rev.simps(2) rev_append self_append_conv2)
+  done
+
+text {*
+ Analogues of the standard properties of the append function for lists.
+*}
+
+declare [[ atp_problem_prefix = "BT__appnd_assoc" ]]
+lemma appnd_assoc [simp]:
+     "appnd (appnd t1 t2) t3 = appnd t1 (appnd t2 t3)"
+  apply (induct t1)
+  apply (metis appnd.simps(1))
+  apply (metis appnd.simps(2))
+  done
+
+declare [[ atp_problem_prefix = "BT__appnd_Lf2" ]]
+lemma appnd_Lf2 [simp]: "appnd t Lf = t"
+  apply (induct t)
+  apply (metis appnd.simps(1))
+  apply (metis appnd.simps(2))
+  done
+
+declare [[ atp_problem_prefix = "BT__depth_appnd" ]]
+  declare max_add_distrib_left [simp]
+lemma depth_appnd [simp]: "depth (appnd t1 t2) = depth t1 + depth t2"
+  apply (induct t1)
+  apply (metis add_0 appnd.simps(1) depth.simps(1))
+apply (simp add: ); 
+  done
+
+declare [[ atp_problem_prefix = "BT__n_leaves_appnd" ]]
+lemma n_leaves_appnd [simp]:
+     "n_leaves (appnd t1 t2) = n_leaves t1 * n_leaves t2"
+  apply (induct t1)
+  apply (metis One_nat_def appnd.simps(1) less_irrefl less_linear n_leaves.simps(1) nat_mult_1) 
+  apply (simp add: left_distrib)
+  done
+
+declare [[ atp_problem_prefix = "BT__bt_map_appnd" ]]
+lemma (*bt_map_appnd:*)
+     "bt_map f (appnd t1 t2) = appnd (bt_map f t1) (bt_map f t2)"
+  apply (induct t1)
+  apply (metis appnd.simps(1) bt_map_appnd)
+  apply (metis bt_map_appnd)
+  done
+
+end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/BigO.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/BigO.thy	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,1231 @@
+(*  Title:      HOL/Metis_Examples/BigO.thy
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method.
+*)
+
+header {* Big O notation *}
+
+theory BigO
+imports "~~/src/HOL/Decision_Procs/Dense_Linear_Order" Main SetsAndFunctions 
+begin
+
+subsection {* Definitions *}
+
+definition bigo :: "('a => 'b::ordered_idom) => ('a => 'b) set"    ("(1O'(_'))") where
+  "O(f::('a => 'b)) ==   {h. EX c. ALL x. abs (h x) <= c * abs (f x)}"
+
+declare [[ atp_problem_prefix = "BigO__bigo_pos_const" ]]
+lemma bigo_pos_const: "(EX (c::'a::ordered_idom). 
+    ALL x. (abs (h x)) <= (c * (abs (f x))))
+      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
+  apply auto
+  apply (case_tac "c = 0", simp)
+  apply (rule_tac x = "1" in exI, simp)
+  apply (rule_tac x = "abs c" in exI, auto)
+  apply (metis abs_ge_minus_self abs_ge_zero abs_minus_cancel abs_of_nonneg equation_minus_iff Orderings.xt1(6) abs_mult)
+  done
+
+(*** Now various verions with an increasing modulus ***)
+
+declare [[sledgehammer_modulus = 1]]
+
+lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
+    ALL x. (abs (h x)) <= (c * (abs (f x))))
+      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
+  apply auto
+  apply (case_tac "c = 0", simp)
+  apply (rule_tac x = "1" in exI, simp)
+  apply (rule_tac x = "abs c" in exI, auto)
+proof (neg_clausify)
+fix c x
+have 0: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * X2\<bar> = \<bar>X2 * X1\<bar>"
+  by (metis abs_mult mult_commute)
+have 1: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
+   X1 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> \<bar>X2\<bar> * X1 = \<bar>X2 * X1\<bar>"
+  by (metis abs_mult_pos linorder_linear)
+have 2: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
+   \<not> (0\<Colon>'a\<Colon>ordered_idom) < X1 * X2 \<or>
+   \<not> (0\<Colon>'a\<Colon>ordered_idom) \<le> X2 \<or> \<not> X1 \<le> (0\<Colon>'a\<Colon>ordered_idom)"
+  by (metis linorder_not_less mult_nonneg_nonpos2)
+assume 3: "\<And>x\<Colon>'b\<Colon>type.
+   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>
+   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+assume 4: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
+  \<le> \<bar>c\<Colon>'a\<Colon>ordered_idom\<bar> * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+have 5: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
+  \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+  by (metis 4 abs_mult)
+have 6: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
+   \<not> X1 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> X1 \<le> \<bar>X2\<bar>"
+  by (metis abs_ge_zero xt1(6))
+have 7: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
+   X1 \<le> \<bar>X2\<bar> \<or> (0\<Colon>'a\<Colon>ordered_idom) < X1"
+  by (metis not_leE 6)
+have 8: "(0\<Colon>'a\<Colon>ordered_idom) < \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
+  by (metis 5 7)
+have 9: "\<And>X1\<Colon>'a\<Colon>ordered_idom.
+   \<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar> \<le> X1 \<or>
+   (0\<Colon>'a\<Colon>ordered_idom) < X1"
+  by (metis 8 order_less_le_trans)
+have 10: "(0\<Colon>'a\<Colon>ordered_idom)
+< (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
+  by (metis 3 9)
+have 11: "\<not> (c\<Colon>'a\<Colon>ordered_idom) \<le> (0\<Colon>'a\<Colon>ordered_idom)"
+  by (metis abs_ge_zero 2 10)
+have 12: "\<And>X1\<Colon>'a\<Colon>ordered_idom. (c\<Colon>'a\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>X1 * c\<bar>"
+  by (metis mult_commute 1 11)
+have 13: "\<And>X1\<Colon>'b\<Colon>type.
+   - (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
+   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
+  by (metis 3 abs_le_D2)
+have 14: "\<And>X1\<Colon>'b\<Colon>type.
+   - (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
+   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
+  by (metis 0 12 13)
+have 15: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * \<bar>X2\<bar>\<bar> = \<bar>X1 * X2\<bar>"
+  by (metis abs_mult abs_mult_pos abs_ge_zero)
+have 16: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. X1 \<le> \<bar>X2\<bar> \<or> \<not> X1 \<le> X2"
+  by (metis xt1(6) abs_ge_self)
+have 17: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<not> \<bar>X1\<bar> \<le> X2 \<or> X1 \<le> \<bar>X2\<bar>"
+  by (metis 16 abs_le_D1)
+have 18: "\<And>X1\<Colon>'b\<Colon>type.
+   (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
+   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
+  by (metis 17 3 15)
+show "False"
+  by (metis abs_le_iff 5 18 14)
+qed
+
+declare [[sledgehammer_modulus = 2]]
+
+lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
+    ALL x. (abs (h x)) <= (c * (abs (f x))))
+      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
+  apply auto
+  apply (case_tac "c = 0", simp)
+  apply (rule_tac x = "1" in exI, simp)
+  apply (rule_tac x = "abs c" in exI, auto);
+proof (neg_clausify)
+fix c x
+have 0: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * X2\<bar> = \<bar>X2 * X1\<bar>"
+  by (metis abs_mult mult_commute)
+assume 1: "\<And>x\<Colon>'b\<Colon>type.
+   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>
+   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+assume 2: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
+  \<le> \<bar>c\<Colon>'a\<Colon>ordered_idom\<bar> * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+have 3: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
+  \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+  by (metis 2 abs_mult)
+have 4: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
+   \<not> X1 \<le> (0\<Colon>'a\<Colon>ordered_idom) \<or> X1 \<le> \<bar>X2\<bar>"
+  by (metis abs_ge_zero xt1(6))
+have 5: "(0\<Colon>'a\<Colon>ordered_idom) < \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
+  by (metis not_leE 4 3)
+have 6: "(0\<Colon>'a\<Colon>ordered_idom)
+< (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>"
+  by (metis 1 order_less_le_trans 5)
+have 7: "\<And>X1\<Colon>'a\<Colon>ordered_idom. (c\<Colon>'a\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>X1 * c\<bar>"
+  by (metis abs_ge_zero linorder_not_less mult_nonneg_nonpos2 6 linorder_linear abs_mult_pos mult_commute)
+have 8: "\<And>X1\<Colon>'b\<Colon>type.
+   - (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
+   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
+  by (metis 0 7 abs_le_D2 1)
+have 9: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<not> \<bar>X1\<bar> \<le> X2 \<or> X1 \<le> \<bar>X2\<bar>"
+  by (metis abs_ge_self xt1(6) abs_le_D1)
+show "False"
+  by (metis 8 abs_ge_zero abs_mult_pos abs_mult 1 9 3 abs_le_iff)
+qed
+
+declare [[sledgehammer_modulus = 3]]
+
+lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
+    ALL x. (abs (h x)) <= (c * (abs (f x))))
+      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
+  apply auto
+  apply (case_tac "c = 0", simp)
+  apply (rule_tac x = "1" in exI, simp)
+  apply (rule_tac x = "abs c" in exI, auto);
+proof (neg_clausify)
+fix c x
+assume 0: "\<And>x\<Colon>'b\<Colon>type.
+   \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>
+   \<le> (c\<Colon>'a\<Colon>ordered_idom) * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+assume 1: "\<not> \<bar>(h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) (x\<Colon>'b\<Colon>type)\<bar>
+  \<le> \<bar>c\<Colon>'a\<Colon>ordered_idom\<bar> * \<bar>(f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) x\<bar>"
+have 2: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom.
+   X1 \<le> \<bar>X2\<bar> \<or> (0\<Colon>'a\<Colon>ordered_idom) < X1"
+  by (metis abs_ge_zero xt1(6) not_leE)
+have 3: "\<not> (c\<Colon>'a\<Colon>ordered_idom) \<le> (0\<Colon>'a\<Colon>ordered_idom)"
+  by (metis abs_ge_zero mult_nonneg_nonpos2 linorder_not_less order_less_le_trans 1 abs_mult 2 0)
+have 4: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2\<Colon>'a\<Colon>ordered_idom. \<bar>X1 * \<bar>X2\<bar>\<bar> = \<bar>X1 * X2\<bar>"
+  by (metis abs_ge_zero abs_mult_pos abs_mult)
+have 5: "\<And>X1\<Colon>'b\<Colon>type.
+   (h\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1
+   \<le> \<bar>(c\<Colon>'a\<Colon>ordered_idom) * (f\<Colon>'b\<Colon>type \<Rightarrow> 'a\<Colon>ordered_idom) X1\<bar>"
+  by (metis 4 0 xt1(6) abs_ge_self abs_le_D1)
+show "False"
+  by (metis abs_mult mult_commute 3 abs_mult_pos linorder_linear 0 abs_le_D2 5 1 abs_le_iff)
+qed
+
+
+declare [[sledgehammer_modulus = 1]]
+
+lemma (*bigo_pos_const:*) "(EX (c::'a::ordered_idom). 
+    ALL x. (abs (h x)) <= (c * (abs (f x))))
+      = (EX c. 0 < c & (ALL x. (abs(h x)) <= (c * (abs (f x)))))"
+  apply auto
+  apply (case_tac "c = 0", simp)
+  apply (rule_tac x = "1" in exI, simp)
+  apply (rule_tac x = "abs c" in exI, auto);
+proof (neg_clausify)
+fix c x  (*sort/type constraint inserted by hand!*)
+have 0: "\<And>(X1\<Colon>'a\<Colon>ordered_idom) X2. \<bar>X1 * \<bar>X2\<bar>\<bar> = \<bar>X1 * X2\<bar>"
+  by (metis abs_ge_zero abs_mult_pos abs_mult)
+assume 1: "\<And>A. \<bar>h A\<bar> \<le> c * \<bar>f A\<bar>"
+have 2: "\<And>X1 X2. \<not> \<bar>X1\<bar> \<le> X2 \<or> (0\<Colon>'a) \<le> X2"
+  by (metis abs_ge_zero order_trans)
+have 3: "\<And>X1. (0\<Colon>'a) \<le> c * \<bar>f X1\<bar>"
+  by (metis 1 2)
+have 4: "\<And>X1. c * \<bar>f X1\<bar> = \<bar>c * f X1\<bar>"
+  by (metis 0 abs_of_nonneg 3)
+have 5: "\<And>X1. - h X1 \<le> c * \<bar>f X1\<bar>"
+  by (metis 1 abs_le_D2)
+have 6: "\<And>X1. - h X1 \<le> \<bar>c * f X1\<bar>"
+  by (metis 4 5)
+have 7: "\<And>X1. h X1 \<le> c * \<bar>f X1\<bar>"
+  by (metis 1 abs_le_D1)
+have 8: "\<And>X1. h X1 \<le> \<bar>c * f X1\<bar>"
+  by (metis 4 7)
+assume 9: "\<not> \<bar>h x\<bar> \<le> \<bar>c\<bar> * \<bar>f x\<bar>"
+have 10: "\<not> \<bar>h x\<bar> \<le> \<bar>c * f x\<bar>"
+  by (metis abs_mult 9)
+show "False"
+  by (metis 6 8 10 abs_leI)
+qed
+
+
+declare [[sledgehammer_sorts = true]]
+
+lemma bigo_alt_def: "O(f) = 
+    {h. EX c. (0 < c & (ALL x. abs (h x) <= c * abs (f x)))}"
+by (auto simp add: bigo_def bigo_pos_const)
+
+declare [[ atp_problem_prefix = "BigO__bigo_elt_subset" ]]
+lemma bigo_elt_subset [intro]: "f : O(g) ==> O(f) <= O(g)"
+  apply (auto simp add: bigo_alt_def)
+  apply (rule_tac x = "ca * c" in exI)
+  apply (rule conjI)
+  apply (rule mult_pos_pos)
+  apply (assumption)+ 
+(*sledgehammer*);
+  apply (rule allI)
+  apply (drule_tac x = "xa" in spec)+
+  apply (subgoal_tac "ca * abs(f xa) <= ca * (c * abs(g xa))");
+  apply (erule order_trans)
+  apply (simp add: mult_ac)
+  apply (rule mult_left_mono, assumption)
+  apply (rule order_less_imp_le, assumption);
+done
+
+
+declare [[ atp_problem_prefix = "BigO__bigo_refl" ]]
+lemma bigo_refl [intro]: "f : O(f)"
+  apply(auto simp add: bigo_def)
+proof (neg_clausify)
+fix x
+assume 0: "\<And>xa. \<not> \<bar>f (x xa)\<bar> \<le> xa * \<bar>f (x xa)\<bar>"
+have 1: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2 \<or> \<not> (1\<Colon>'b) \<le> (1\<Colon>'b)"
+  by (metis mult_le_cancel_right1 order_eq_iff)
+have 2: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2"
+  by (metis order_eq_iff 1)
+show "False"
+  by (metis 0 2)
+qed
+
+declare [[ atp_problem_prefix = "BigO__bigo_zero" ]]
+lemma bigo_zero: "0 : O(g)"
+  apply (auto simp add: bigo_def func_zero)
+proof (neg_clausify)
+fix x
+assume 0: "\<And>xa. \<not> (0\<Colon>'b) \<le> xa * \<bar>g (x xa)\<bar>"
+have 1: "\<not> (0\<Colon>'b) \<le> (0\<Colon>'b)"
+  by (metis 0 mult_eq_0_iff)
+show "False"
+  by (metis 1 linorder_neq_iff linorder_antisym_conv1)
+qed
+
+lemma bigo_zero2: "O(%x.0) = {%x.0}"
+  apply (auto simp add: bigo_def) 
+  apply (rule ext)
+  apply auto
+done
+
+lemma bigo_plus_self_subset [intro]: 
+  "O(f) \<oplus> O(f) <= O(f)"
+  apply (auto simp add: bigo_alt_def set_plus_def)
+  apply (rule_tac x = "c + ca" in exI)
+  apply auto
+  apply (simp add: ring_distribs func_plus)
+  apply (blast intro:order_trans abs_triangle_ineq add_mono elim:) 
+done
+
+lemma bigo_plus_idemp [simp]: "O(f) \<oplus> O(f) = O(f)"
+  apply (rule equalityI)
+  apply (rule bigo_plus_self_subset)
+  apply (rule set_zero_plus2) 
+  apply (rule bigo_zero)
+done
+
+lemma bigo_plus_subset [intro]: "O(f + g) <= O(f) \<oplus> O(g)"
+  apply (rule subsetI)
+  apply (auto simp add: bigo_def bigo_pos_const func_plus set_plus_def)
+  apply (subst bigo_pos_const [symmetric])+
+  apply (rule_tac x = 
+    "%n. if abs (g n) <= (abs (f n)) then x n else 0" in exI)
+  apply (rule conjI)
+  apply (rule_tac x = "c + c" in exI)
+  apply (clarsimp)
+  apply (auto)
+  apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (f xa)")
+  apply (erule_tac x = xa in allE)
+  apply (erule order_trans)
+  apply (simp)
+  apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
+  apply (erule order_trans)
+  apply (simp add: ring_distribs)
+  apply (rule mult_left_mono)
+  apply assumption
+  apply (simp add: order_less_le)
+  apply (rule mult_left_mono)
+  apply (simp add: abs_triangle_ineq)
+  apply (simp add: order_less_le)
+  apply (rule mult_nonneg_nonneg)
+  apply (rule add_nonneg_nonneg)
+  apply auto
+  apply (rule_tac x = "%n. if (abs (f n)) <  abs (g n) then x n else 0" 
+     in exI)
+  apply (rule conjI)
+  apply (rule_tac x = "c + c" in exI)
+  apply auto
+  apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
+  apply (erule_tac x = xa in allE)
+  apply (erule order_trans)
+  apply (simp)
+  apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
+  apply (erule order_trans)
+  apply (simp add: ring_distribs)
+  apply (rule mult_left_mono)
+  apply (simp add: order_less_le)
+  apply (simp add: order_less_le)
+  apply (rule mult_left_mono)
+  apply (rule abs_triangle_ineq)
+  apply (simp add: order_less_le)
+apply (metis abs_not_less_zero double_less_0_iff less_not_permute linorder_not_less mult_less_0_iff)
+  apply (rule ext)
+  apply (auto simp add: if_splits linorder_not_le)
+done
+
+lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A \<oplus> B <= O(f)"
+  apply (subgoal_tac "A \<oplus> B <= O(f) \<oplus> O(f)")
+  apply (erule order_trans)
+  apply simp
+  apply (auto del: subsetI simp del: bigo_plus_idemp)
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_plus_eq" ]]
+lemma bigo_plus_eq: "ALL x. 0 <= f x ==> ALL x. 0 <= g x ==> 
+  O(f + g) = O(f) \<oplus> O(g)"
+  apply (rule equalityI)
+  apply (rule bigo_plus_subset)
+  apply (simp add: bigo_alt_def set_plus_def func_plus)
+  apply clarify 
+(*sledgehammer*); 
+  apply (rule_tac x = "max c ca" in exI)
+  apply (rule conjI)
+   apply (metis Orderings.less_max_iff_disj)
+  apply clarify
+  apply (drule_tac x = "xa" in spec)+
+  apply (subgoal_tac "0 <= f xa + g xa")
+  apply (simp add: ring_distribs)
+  apply (subgoal_tac "abs(a xa + b xa) <= abs(a xa) + abs(b xa)")
+  apply (subgoal_tac "abs(a xa) + abs(b xa) <= 
+      max c ca * f xa + max c ca * g xa")
+  apply (blast intro: order_trans)
+  defer 1
+  apply (rule abs_triangle_ineq)
+  apply (metis add_nonneg_nonneg)
+  apply (rule add_mono)
+using [[ atp_problem_prefix = "BigO__bigo_plus_eq_simpler" ]] 
+(*Found by SPASS; SLOW*)
+apply (metis le_maxI2 linorder_linear linorder_not_le min_max.sup_absorb1 mult_le_cancel_right order_trans)
+apply (metis le_maxI2 linorder_not_le mult_le_cancel_right order_trans)
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_bounded_alt" ]]
+lemma bigo_bounded_alt: "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> 
+    f : O(g)" 
+  apply (auto simp add: bigo_def)
+(*Version 1: one-shot proof*)
+  apply (metis OrderedGroup.abs_le_D1 linorder_class.not_less  order_less_le  Orderings.xt1(12)  Ring_and_Field.abs_mult)
+  done
+
+lemma (*bigo_bounded_alt:*) "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> 
+    f : O(g)" 
+  apply (auto simp add: bigo_def)
+(*Version 2: single-step proof*)
+proof (neg_clausify)
+fix x
+assume 0: "\<And>x. f x \<le> c * g x"
+assume 1: "\<And>xa. \<not> f (x xa) \<le> xa * \<bar>g (x xa)\<bar>"
+have 2: "\<And>X3. c * g X3 = f X3 \<or> \<not> c * g X3 \<le> f X3"
+  by (metis 0 order_antisym_conv)
+have 3: "\<And>X3. \<not> f (x \<bar>X3\<bar>) \<le> \<bar>X3 * g (x \<bar>X3\<bar>)\<bar>"
+  by (metis 1 abs_mult)
+have 4: "\<And>X1 X3\<Colon>'b\<Colon>ordered_idom. X3 \<le> X1 \<or> X1 \<le> \<bar>X3\<bar>"
+  by (metis linorder_linear abs_le_D1)
+have 5: "\<And>X3::'b. \<bar>X3\<bar> * \<bar>X3\<bar> = X3 * X3"
+  by (metis abs_mult_self)
+have 6: "\<And>X3. \<not> X3 * X3 < (0\<Colon>'b\<Colon>ordered_idom)"
+  by (metis not_square_less_zero)
+have 7: "\<And>X1 X3::'b. \<bar>X1\<bar> * \<bar>X3\<bar> = \<bar>X3 * X1\<bar>"
+  by (metis abs_mult mult_commute)
+have 8: "\<And>X3::'b. X3 * X3 = \<bar>X3 * X3\<bar>"
+  by (metis abs_mult 5)
+have 9: "\<And>X3. X3 * g (x \<bar>X3\<bar>) \<le> f (x \<bar>X3\<bar>)"
+  by (metis 3 4)
+have 10: "c * g (x \<bar>c\<bar>) = f (x \<bar>c\<bar>)"
+  by (metis 2 9)
+have 11: "\<And>X3::'b. \<bar>X3\<bar> * \<bar>\<bar>X3\<bar>\<bar> = \<bar>X3\<bar> * \<bar>X3\<bar>"
+  by (metis abs_idempotent abs_mult 8)
+have 12: "\<And>X3::'b. \<bar>X3 * \<bar>X3\<bar>\<bar> = \<bar>X3\<bar> * \<bar>X3\<bar>"
+  by (metis mult_commute 7 11)
+have 13: "\<And>X3::'b. \<bar>X3 * \<bar>X3\<bar>\<bar> = X3 * X3"
+  by (metis 8 7 12)
+have 14: "\<And>X3. X3 \<le> \<bar>X3\<bar> \<or> X3 < (0\<Colon>'b)"
+  by (metis abs_ge_self abs_le_D1 abs_if)
+have 15: "\<And>X3. X3 \<le> \<bar>X3\<bar> \<or> \<bar>X3\<bar> < (0\<Colon>'b)"
+  by (metis abs_ge_self abs_le_D1 abs_if)
+have 16: "\<And>X3. X3 * X3 < (0\<Colon>'b) \<or> X3 * \<bar>X3\<bar> \<le> X3 * X3"
+  by (metis 15 13)
+have 17: "\<And>X3::'b. X3 * \<bar>X3\<bar> \<le> X3 * X3"
+  by (metis 16 6)
+have 18: "\<And>X3. X3 \<le> \<bar>X3\<bar> \<or> \<not> X3 < (0\<Colon>'b)"
+  by (metis mult_le_cancel_left 17)
+have 19: "\<And>X3::'b. X3 \<le> \<bar>X3\<bar>"
+  by (metis 18 14)
+have 20: "\<not> f (x \<bar>c\<bar>) \<le> \<bar>f (x \<bar>c\<bar>)\<bar>"
+  by (metis 3 10)
+show "False"
+  by (metis 20 19)
+qed
+
+
+text{*So here is the easier (and more natural) problem using transitivity*}
+declare [[ atp_problem_prefix = "BigO__bigo_bounded_alt_trans" ]]
+lemma "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> f : O(g)" 
+  apply (auto simp add: bigo_def)
+  (*Version 1: one-shot proof*) 
+  apply (metis Orderings.leD Orderings.leI abs_ge_self abs_le_D1 abs_mult abs_of_nonneg order_le_less)
+  done
+
+text{*So here is the easier (and more natural) problem using transitivity*}
+declare [[ atp_problem_prefix = "BigO__bigo_bounded_alt_trans" ]]
+lemma "ALL x. 0 <= f x ==> ALL x. f x <= c * g x ==> f : O(g)" 
+  apply (auto simp add: bigo_def)
+(*Version 2: single-step proof*)
+proof (neg_clausify)
+fix x
+assume 0: "\<And>A\<Colon>'a\<Colon>type.
+   (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) A
+   \<le> (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) A"
+assume 1: "\<And>A\<Colon>'b\<Colon>ordered_idom.
+   \<not> (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) A)
+     \<le> A * \<bar>(g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x A)\<bar>"
+have 2: "\<And>X2\<Colon>'a\<Colon>type.
+   \<not> (c\<Colon>'b\<Colon>ordered_idom) * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) X2
+     < (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) X2"
+  by (metis 0 linorder_not_le)
+have 3: "\<And>X2\<Colon>'b\<Colon>ordered_idom.
+   \<not> (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) \<bar>X2\<bar>)
+     \<le> \<bar>X2 * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X2\<bar>)\<bar>"
+  by (metis abs_mult 1)
+have 4: "\<And>X2\<Colon>'b\<Colon>ordered_idom.
+   \<bar>X2 * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) \<bar>X2\<bar>)\<bar>
+   < (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X2\<bar>)"
+  by (metis 3 linorder_not_less)
+have 5: "\<And>X2\<Colon>'b\<Colon>ordered_idom.
+   X2 * (g\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) \<bar>X2\<bar>)
+   < (f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) (x \<bar>X2\<bar>)"
+  by (metis abs_less_iff 4)
+show "False"
+  by (metis 2 5)
+qed
+
+
+lemma bigo_bounded: "ALL x. 0 <= f x ==> ALL x. f x <= g x ==> 
+    f : O(g)" 
+  apply (erule bigo_bounded_alt [of f 1 g])
+  apply simp
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_bounded2" ]]
+lemma bigo_bounded2: "ALL x. lb x <= f x ==> ALL x. f x <= lb x + g x ==>
+    f : lb +o O(g)"
+  apply (rule set_minus_imp_plus)
+  apply (rule bigo_bounded)
+  apply (auto simp add: diff_minus fun_Compl_def func_plus)
+  prefer 2
+  apply (drule_tac x = x in spec)+ 
+  apply arith (*not clear that it's provable otherwise*) 
+proof (neg_clausify)
+fix x
+assume 0: "\<And>y. lb y \<le> f y"
+assume 1: "\<not> (0\<Colon>'b) \<le> f x + - lb x"
+have 2: "\<And>X3. (0\<Colon>'b) + X3 = X3"
+  by (metis diff_eq_eq right_minus_eq)
+have 3: "\<not> (0\<Colon>'b) \<le> f x - lb x"
+  by (metis 1 diff_minus)
+have 4: "\<not> (0\<Colon>'b) + lb x \<le> f x"
+  by (metis 3 le_diff_eq)
+show "False"
+  by (metis 4 2 0)
+qed
+
+declare [[ atp_problem_prefix = "BigO__bigo_abs" ]]
+lemma bigo_abs: "(%x. abs(f x)) =o O(f)" 
+  apply (unfold bigo_def)
+  apply auto
+proof (neg_clausify)
+fix x
+assume 0: "\<And>xa. \<not> \<bar>f (x xa)\<bar> \<le> xa * \<bar>f (x xa)\<bar>"
+have 1: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2 \<or> \<not> (1\<Colon>'b) \<le> (1\<Colon>'b)"
+  by (metis mult_le_cancel_right1 order_eq_iff)
+have 2: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2"
+  by (metis order_eq_iff 1)
+show "False"
+  by (metis 0 2)
+qed
+
+declare [[ atp_problem_prefix = "BigO__bigo_abs2" ]]
+lemma bigo_abs2: "f =o O(%x. abs(f x))"
+  apply (unfold bigo_def)
+  apply auto
+proof (neg_clausify)
+fix x
+assume 0: "\<And>xa. \<not> \<bar>f (x xa)\<bar> \<le> xa * \<bar>f (x xa)\<bar>"
+have 1: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2 \<or> \<not> (1\<Colon>'b) \<le> (1\<Colon>'b)"
+  by (metis mult_le_cancel_right1 order_eq_iff)
+have 2: "\<And>X2. X2 \<le> (1\<Colon>'b) * X2"
+  by (metis order_eq_iff 1)
+show "False"
+  by (metis 0 2)
+qed
+ 
+lemma bigo_abs3: "O(f) = O(%x. abs(f x))"
+  apply (rule equalityI)
+  apply (rule bigo_elt_subset)
+  apply (rule bigo_abs2)
+  apply (rule bigo_elt_subset)
+  apply (rule bigo_abs)
+done
+
+lemma bigo_abs4: "f =o g +o O(h) ==> 
+    (%x. abs (f x)) =o (%x. abs (g x)) +o O(h)"
+  apply (drule set_plus_imp_minus)
+  apply (rule set_minus_imp_plus)
+  apply (subst fun_diff_def)
+proof -
+  assume a: "f - g : O(h)"
+  have "(%x. abs (f x) - abs (g x)) =o O(%x. abs(abs (f x) - abs (g x)))"
+    by (rule bigo_abs2)
+  also have "... <= O(%x. abs (f x - g x))"
+    apply (rule bigo_elt_subset)
+    apply (rule bigo_bounded)
+    apply force
+    apply (rule allI)
+    apply (rule abs_triangle_ineq3)
+    done
+  also have "... <= O(f - g)"
+    apply (rule bigo_elt_subset)
+    apply (subst fun_diff_def)
+    apply (rule bigo_abs)
+    done
+  also have "... <= O(h)"
+    using a by (rule bigo_elt_subset)
+  finally show "(%x. abs (f x) - abs (g x)) : O(h)".
+qed
+
+lemma bigo_abs5: "f =o O(g) ==> (%x. abs(f x)) =o O(g)" 
+by (unfold bigo_def, auto)
+
+lemma bigo_elt_subset2 [intro]: "f : g +o O(h) ==> O(f) <= O(g) \<oplus> O(h)"
+proof -
+  assume "f : g +o O(h)"
+  also have "... <= O(g) \<oplus> O(h)"
+    by (auto del: subsetI)
+  also have "... = O(%x. abs(g x)) \<oplus> O(%x. abs(h x))"
+    apply (subst bigo_abs3 [symmetric])+
+    apply (rule refl)
+    done
+  also have "... = O((%x. abs(g x)) + (%x. abs(h x)))"
+    by (rule bigo_plus_eq [symmetric], auto)
+  finally have "f : ...".
+  then have "O(f) <= ..."
+    by (elim bigo_elt_subset)
+  also have "... = O(%x. abs(g x)) \<oplus> O(%x. abs(h x))"
+    by (rule bigo_plus_eq, auto)
+  finally show ?thesis
+    by (simp add: bigo_abs3 [symmetric])
+qed
+
+declare [[ atp_problem_prefix = "BigO__bigo_mult" ]]
+lemma bigo_mult [intro]: "O(f)\<otimes>O(g) <= O(f * g)"
+  apply (rule subsetI)
+  apply (subst bigo_def)
+  apply (auto simp del: abs_mult mult_ac
+              simp add: bigo_alt_def set_times_def func_times)
+(*sledgehammer*); 
+  apply (rule_tac x = "c * ca" in exI)
+  apply(rule allI)
+  apply(erule_tac x = x in allE)+
+  apply(subgoal_tac "c * ca * abs(f x * g x) = 
+      (c * abs(f x)) * (ca * abs(g x))")
+using [[ atp_problem_prefix = "BigO__bigo_mult_simpler" ]]
+prefer 2 
+apply (metis mult_assoc mult_left_commute
+  OrderedGroup.abs_of_pos OrderedGroup.mult_left_commute
+  Ring_and_Field.abs_mult Ring_and_Field.mult_pos_pos)
+  apply (erule ssubst) 
+  apply (subst abs_mult)
+(*not qute BigO__bigo_mult_simpler_1 (a hard problem!) as abs_mult has
+  just been done*)
+proof (neg_clausify)
+fix a c b ca x
+assume 0: "(0\<Colon>'b\<Colon>ordered_idom) < (c\<Colon>'b\<Colon>ordered_idom)"
+assume 1: "\<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
+\<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
+assume 2: "\<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
+\<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
+assume 3: "\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> *
+  \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
+  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> *
+    ((ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>)"
+have 4: "\<bar>c\<Colon>'b\<Colon>ordered_idom\<bar> = c"
+  by (metis OrderedGroup.abs_of_pos 0)
+have 5: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (c\<Colon>'b\<Colon>ordered_idom) * \<bar>X1\<bar> = \<bar>c * X1\<bar>"
+  by (metis Ring_and_Field.abs_mult 4)
+have 6: "(0\<Colon>'b\<Colon>ordered_idom) = (1\<Colon>'b\<Colon>ordered_idom) \<or>
+(0\<Colon>'b\<Colon>ordered_idom) < (1\<Colon>'b\<Colon>ordered_idom)"
+  by (metis OrderedGroup.abs_not_less_zero Ring_and_Field.abs_one Ring_and_Field.linorder_neqE_ordered_idom)
+have 7: "(0\<Colon>'b\<Colon>ordered_idom) < (1\<Colon>'b\<Colon>ordered_idom)"
+  by (metis 6 Ring_and_Field.one_neq_zero)
+have 8: "\<bar>1\<Colon>'b\<Colon>ordered_idom\<bar> = (1\<Colon>'b\<Colon>ordered_idom)"
+  by (metis OrderedGroup.abs_of_pos 7)
+have 9: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>X1\<bar>"
+  by (metis OrderedGroup.abs_ge_zero 5)
+have 10: "\<And>X1\<Colon>'b\<Colon>ordered_idom. X1 * (1\<Colon>'b\<Colon>ordered_idom) = X1"
+  by (metis Ring_and_Field.mult_cancel_right2 mult_commute)
+have 11: "\<And>X1\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X1\<bar>\<bar> = \<bar>X1\<bar> * \<bar>1\<Colon>'b\<Colon>ordered_idom\<bar>"
+  by (metis Ring_and_Field.abs_mult OrderedGroup.abs_idempotent 10)
+have 12: "\<And>X1\<Colon>'b\<Colon>ordered_idom. \<bar>\<bar>X1\<bar>\<bar> = \<bar>X1\<bar>"
+  by (metis 11 8 10)
+have 13: "\<And>X1\<Colon>'b\<Colon>ordered_idom. (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>X1\<bar>"
+  by (metis OrderedGroup.abs_ge_zero 12)
+have 14: "\<not> (0\<Colon>'b\<Colon>ordered_idom)
+  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> \<or>
+\<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
+\<not> \<bar>b x\<bar> \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
+\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<le> c * \<bar>f x\<bar>"
+  by (metis 3 Ring_and_Field.mult_mono)
+have 15: "\<not> (0\<Colon>'b\<Colon>ordered_idom) \<le> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar> \<or>
+\<not> \<bar>b x\<bar> \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
+\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
+  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
+  by (metis 14 9)
+have 16: "\<not> \<bar>(b\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
+  \<le> (ca\<Colon>'b\<Colon>ordered_idom) * \<bar>(g\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar> \<or>
+\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>
+  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
+  by (metis 15 13)
+have 17: "\<not> \<bar>(a\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) (x\<Colon>'a)\<bar>
+  \<le> (c\<Colon>'b\<Colon>ordered_idom) * \<bar>(f\<Colon>'a \<Rightarrow> 'b\<Colon>ordered_idom) x\<bar>"
+  by (metis 16 2)
+show 18: "False"
+  by (metis 17 1)
+qed
+
+
+declare [[ atp_problem_prefix = "BigO__bigo_mult2" ]]
+lemma bigo_mult2 [intro]: "f *o O(g) <= O(f * g)"
+  apply (auto simp add: bigo_def elt_set_times_def func_times abs_mult)
+(*sledgehammer*); 
+  apply (rule_tac x = c in exI)
+  apply clarify
+  apply (drule_tac x = x in spec)
+using [[ atp_problem_prefix = "BigO__bigo_mult2_simpler" ]]
+(*sledgehammer [no luck]*); 
+  apply (subgoal_tac "abs(f x) * abs(b x) <= abs(f x) * (c * abs(g x))")
+  apply (simp add: mult_ac)
+  apply (rule mult_left_mono, assumption)
+  apply (rule abs_ge_zero)
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_mult3" ]]
+lemma bigo_mult3: "f : O(h) ==> g : O(j) ==> f * g : O(h * j)"
+by (metis bigo_mult set_times_intro subset_iff)
+
+declare [[ atp_problem_prefix = "BigO__bigo_mult4" ]]
+lemma bigo_mult4 [intro]:"f : k +o O(h) ==> g * f : (g * k) +o O(g * h)"
+by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
+
+
+lemma bigo_mult5: "ALL x. f x ~= 0 ==>
+    O(f * g) <= (f::'a => ('b::ordered_field)) *o O(g)"
+proof -
+  assume "ALL x. f x ~= 0"
+  show "O(f * g) <= f *o O(g)"
+  proof
+    fix h
+    assume "h : O(f * g)"
+    then have "(%x. 1 / (f x)) * h : (%x. 1 / f x) *o O(f * g)"
+      by auto
+    also have "... <= O((%x. 1 / f x) * (f * g))"
+      by (rule bigo_mult2)
+    also have "(%x. 1 / f x) * (f * g) = g"
+      apply (simp add: func_times) 
+      apply (rule ext)
+      apply (simp add: prems nonzero_divide_eq_eq mult_ac)
+      done
+    finally have "(%x. (1::'b) / f x) * h : O(g)".
+    then have "f * ((%x. (1::'b) / f x) * h) : f *o O(g)"
+      by auto
+    also have "f * ((%x. (1::'b) / f x) * h) = h"
+      apply (simp add: func_times) 
+      apply (rule ext)
+      apply (simp add: prems nonzero_divide_eq_eq mult_ac)
+      done
+    finally show "h : f *o O(g)".
+  qed
+qed
+
+declare [[ atp_problem_prefix = "BigO__bigo_mult6" ]]
+lemma bigo_mult6: "ALL x. f x ~= 0 ==>
+    O(f * g) = (f::'a => ('b::ordered_field)) *o O(g)"
+by (metis bigo_mult2 bigo_mult5 order_antisym)
+
+(*proof requires relaxing relevance: 2007-01-25*)
+declare [[ atp_problem_prefix = "BigO__bigo_mult7" ]]
+  declare bigo_mult6 [simp]
+lemma bigo_mult7: "ALL x. f x ~= 0 ==>
+    O(f * g) <= O(f::'a => ('b::ordered_field)) \<otimes> O(g)"
+(*sledgehammer*)
+  apply (subst bigo_mult6)
+  apply assumption
+  apply (rule set_times_mono3) 
+  apply (rule bigo_refl)
+done
+  declare bigo_mult6 [simp del]
+
+declare [[ atp_problem_prefix = "BigO__bigo_mult8" ]]
+  declare bigo_mult7[intro!]
+lemma bigo_mult8: "ALL x. f x ~= 0 ==>
+    O(f * g) = O(f::'a => ('b::ordered_field)) \<otimes> O(g)"
+by (metis bigo_mult bigo_mult7 order_antisym_conv)
+
+lemma bigo_minus [intro]: "f : O(g) ==> - f : O(g)"
+  by (auto simp add: bigo_def fun_Compl_def)
+
+lemma bigo_minus2: "f : g +o O(h) ==> -f : -g +o O(h)"
+  apply (rule set_minus_imp_plus)
+  apply (drule set_plus_imp_minus)
+  apply (drule bigo_minus)
+  apply (simp add: diff_minus)
+done
+
+lemma bigo_minus3: "O(-f) = O(f)"
+  by (auto simp add: bigo_def fun_Compl_def abs_minus_cancel)
+
+lemma bigo_plus_absorb_lemma1: "f : O(g) ==> f +o O(g) <= O(g)"
+proof -
+  assume a: "f : O(g)"
+  show "f +o O(g) <= O(g)"
+  proof -
+    have "f : O(f)" by auto
+    then have "f +o O(g) <= O(f) \<oplus> O(g)"
+      by (auto del: subsetI)
+    also have "... <= O(g) \<oplus> O(g)"
+    proof -
+      from a have "O(f) <= O(g)" by (auto del: subsetI)
+      thus ?thesis by (auto del: subsetI)
+    qed
+    also have "... <= O(g)" by (simp add: bigo_plus_idemp)
+    finally show ?thesis .
+  qed
+qed
+
+lemma bigo_plus_absorb_lemma2: "f : O(g) ==> O(g) <= f +o O(g)"
+proof -
+  assume a: "f : O(g)"
+  show "O(g) <= f +o O(g)"
+  proof -
+    from a have "-f : O(g)" by auto
+    then have "-f +o O(g) <= O(g)" by (elim bigo_plus_absorb_lemma1)
+    then have "f +o (-f +o O(g)) <= f +o O(g)" by auto
+    also have "f +o (-f +o O(g)) = O(g)"
+      by (simp add: set_plus_rearranges)
+    finally show ?thesis .
+  qed
+qed
+
+declare [[ atp_problem_prefix = "BigO__bigo_plus_absorb" ]]
+lemma bigo_plus_absorb [simp]: "f : O(g) ==> f +o O(g) = O(g)"
+by (metis bigo_plus_absorb_lemma1 bigo_plus_absorb_lemma2 order_eq_iff);
+
+lemma bigo_plus_absorb2 [intro]: "f : O(g) ==> A <= O(g) ==> f +o A <= O(g)"
+  apply (subgoal_tac "f +o A <= f +o O(g)")
+  apply force+
+done
+
+lemma bigo_add_commute_imp: "f : g +o O(h) ==> g : f +o O(h)"
+  apply (subst set_minus_plus [symmetric])
+  apply (subgoal_tac "g - f = - (f - g)")
+  apply (erule ssubst)
+  apply (rule bigo_minus)
+  apply (subst set_minus_plus)
+  apply assumption
+  apply  (simp add: diff_minus add_ac)
+done
+
+lemma bigo_add_commute: "(f : g +o O(h)) = (g : f +o O(h))"
+  apply (rule iffI)
+  apply (erule bigo_add_commute_imp)+
+done
+
+lemma bigo_const1: "(%x. c) : O(%x. 1)"
+by (auto simp add: bigo_def mult_ac)
+
+declare [[ atp_problem_prefix = "BigO__bigo_const2" ]]
+lemma (*bigo_const2 [intro]:*) "O(%x. c) <= O(%x. 1)"
+by (metis bigo_const1 bigo_elt_subset);
+
+lemma bigo_const2 [intro]: "O(%x. c::'b::ordered_idom) <= O(%x. 1)";
+(*??FAILS because the two occurrences of COMBK have different polymorphic types
+proof (neg_clausify)
+assume 0: "\<not> O(COMBK (c\<Colon>'b\<Colon>ordered_idom)) \<subseteq> O(COMBK (1\<Colon>'b\<Colon>ordered_idom))"
+have 1: "COMBK (c\<Colon>'b\<Colon>ordered_idom) \<notin> O(COMBK (1\<Colon>'b\<Colon>ordered_idom))"
+apply (rule notI) 
+apply (rule 0 [THEN notE]) 
+apply (rule bigo_elt_subset) 
+apply assumption; 
+sorry
+  by (metis 0 bigo_elt_subset)  loops??
+show "False"
+  by (metis 1 bigo_const1)
+qed
+*)
+  apply (rule bigo_elt_subset)
+  apply (rule bigo_const1)
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_const3" ]]
+lemma bigo_const3: "(c::'a::ordered_field) ~= 0 ==> (%x. 1) : O(%x. c)"
+apply (simp add: bigo_def)
+proof (neg_clausify)
+assume 0: "(c\<Colon>'a\<Colon>ordered_field) \<noteq> (0\<Colon>'a\<Colon>ordered_field)"
+assume 1: "\<And>A\<Colon>'a\<Colon>ordered_field. \<not> (1\<Colon>'a\<Colon>ordered_field) \<le> A * \<bar>c\<Colon>'a\<Colon>ordered_field\<bar>"
+have 2: "(0\<Colon>'a\<Colon>ordered_field) = \<bar>c\<Colon>'a\<Colon>ordered_field\<bar> \<or>
+\<not> (1\<Colon>'a\<Colon>ordered_field) \<le> (1\<Colon>'a\<Colon>ordered_field)"
+  by (metis 1 field_inverse)
+have 3: "\<bar>c\<Colon>'a\<Colon>ordered_field\<bar> = (0\<Colon>'a\<Colon>ordered_field)"
+  by (metis linorder_neq_iff linorder_antisym_conv1 2)
+have 4: "(0\<Colon>'a\<Colon>ordered_field) = (c\<Colon>'a\<Colon>ordered_field)"
+  by (metis 3 abs_eq_0)
+show "False"
+  by (metis 0 4)
+qed
+
+lemma bigo_const4: "(c::'a::ordered_field) ~= 0 ==> O(%x. 1) <= O(%x. c)"
+by (rule bigo_elt_subset, rule bigo_const3, assumption)
+
+lemma bigo_const [simp]: "(c::'a::ordered_field) ~= 0 ==> 
+    O(%x. c) = O(%x. 1)"
+by (rule equalityI, rule bigo_const2, rule bigo_const4, assumption)
+
+declare [[ atp_problem_prefix = "BigO__bigo_const_mult1" ]]
+lemma bigo_const_mult1: "(%x. c * f x) : O(f)"
+  apply (simp add: bigo_def abs_mult)
+proof (neg_clausify)
+fix x
+assume 0: "\<And>xa\<Colon>'b\<Colon>ordered_idom.
+   \<not> \<bar>c\<Colon>'b\<Colon>ordered_idom\<bar> *
+     \<bar>(f\<Colon>'a\<Colon>type \<Rightarrow> 'b\<Colon>ordered_idom) ((x\<Colon>'b\<Colon>ordered_idom \<Rightarrow> 'a\<Colon>type) xa)\<bar>
+     \<le> xa * \<bar>f (x xa)\<bar>"
+show "False"
+  by (metis linorder_neq_iff linorder_antisym_conv1 0)
+qed
+
+lemma bigo_const_mult2: "O(%x. c * f x) <= O(f)"
+by (rule bigo_elt_subset, rule bigo_const_mult1)
+
+declare [[ atp_problem_prefix = "BigO__bigo_const_mult3" ]]
+lemma bigo_const_mult3: "(c::'a::ordered_field) ~= 0 ==> f : O(%x. c * f x)"
+  apply (simp add: bigo_def)
+(*sledgehammer [no luck]*); 
+  apply (rule_tac x = "abs(inverse c)" in exI)
+  apply (simp only: abs_mult [symmetric] mult_assoc [symmetric])
+apply (subst left_inverse) 
+apply (auto ); 
+done
+
+lemma bigo_const_mult4: "(c::'a::ordered_field) ~= 0 ==> 
+    O(f) <= O(%x. c * f x)"
+by (rule bigo_elt_subset, rule bigo_const_mult3, assumption)
+
+lemma bigo_const_mult [simp]: "(c::'a::ordered_field) ~= 0 ==> 
+    O(%x. c * f x) = O(f)"
+by (rule equalityI, rule bigo_const_mult2, erule bigo_const_mult4)
+
+declare [[ atp_problem_prefix = "BigO__bigo_const_mult5" ]]
+lemma bigo_const_mult5 [simp]: "(c::'a::ordered_field) ~= 0 ==> 
+    (%x. c) *o O(f) = O(f)"
+  apply (auto del: subsetI)
+  apply (rule order_trans)
+  apply (rule bigo_mult2)
+  apply (simp add: func_times)
+  apply (auto intro!: subsetI simp add: bigo_def elt_set_times_def func_times)
+  apply (rule_tac x = "%y. inverse c * x y" in exI)
+  apply (rename_tac g d) 
+  apply safe
+  apply (rule_tac [2] ext) 
+   prefer 2 
+   apply simp
+  apply (simp add: mult_assoc [symmetric] abs_mult)
+  (*couldn't get this proof without the step above; SLOW*)
+  apply (metis mult_assoc abs_ge_zero mult_left_mono)
+done
+
+
+declare [[ atp_problem_prefix = "BigO__bigo_const_mult6" ]]
+lemma bigo_const_mult6 [intro]: "(%x. c) *o O(f) <= O(f)"
+  apply (auto intro!: subsetI
+    simp add: bigo_def elt_set_times_def func_times
+    simp del: abs_mult mult_ac)
+(*sledgehammer*); 
+  apply (rule_tac x = "ca * (abs c)" in exI)
+  apply (rule allI)
+  apply (subgoal_tac "ca * abs(c) * abs(f x) = abs(c) * (ca * abs(f x))")
+  apply (erule ssubst)
+  apply (subst abs_mult)
+  apply (rule mult_left_mono)
+  apply (erule spec)
+  apply simp
+  apply(simp add: mult_ac)
+done
+
+lemma bigo_const_mult7 [intro]: "f =o O(g) ==> (%x. c * f x) =o O(g)"
+proof -
+  assume "f =o O(g)"
+  then have "(%x. c) * f =o (%x. c) *o O(g)"
+    by auto
+  also have "(%x. c) * f = (%x. c * f x)"
+    by (simp add: func_times)
+  also have "(%x. c) *o O(g) <= O(g)"
+    by (auto del: subsetI)
+  finally show ?thesis .
+qed
+
+lemma bigo_compose1: "f =o O(g) ==> (%x. f(k x)) =o O(%x. g(k x))"
+by (unfold bigo_def, auto)
+
+lemma bigo_compose2: "f =o g +o O(h) ==> (%x. f(k x)) =o (%x. g(k x)) +o 
+    O(%x. h(k x))"
+  apply (simp only: set_minus_plus [symmetric] diff_minus fun_Compl_def
+      func_plus)
+  apply (erule bigo_compose1)
+done
+
+subsection {* Setsum *}
+
+lemma bigo_setsum_main: "ALL x. ALL y : A x. 0 <= h x y ==> 
+    EX c. ALL x. ALL y : A x. abs(f x y) <= c * (h x y) ==>
+      (%x. SUM y : A x. f x y) =o O(%x. SUM y : A x. h x y)"  
+  apply (auto simp add: bigo_def)
+  apply (rule_tac x = "abs c" in exI)
+  apply (subst abs_of_nonneg) back back
+  apply (rule setsum_nonneg)
+  apply force
+  apply (subst setsum_right_distrib)
+  apply (rule allI)
+  apply (rule order_trans)
+  apply (rule setsum_abs)
+  apply (rule setsum_mono)
+apply (blast intro: order_trans mult_right_mono abs_ge_self) 
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_setsum1" ]]
+lemma bigo_setsum1: "ALL x y. 0 <= h x y ==> 
+    EX c. ALL x y. abs(f x y) <= c * (h x y) ==>
+      (%x. SUM y : A x. f x y) =o O(%x. SUM y : A x. h x y)"
+  apply (rule bigo_setsum_main)
+(*sledgehammer*); 
+  apply force
+  apply clarsimp
+  apply (rule_tac x = c in exI)
+  apply force
+done
+
+lemma bigo_setsum2: "ALL y. 0 <= h y ==> 
+    EX c. ALL y. abs(f y) <= c * (h y) ==>
+      (%x. SUM y : A x. f y) =o O(%x. SUM y : A x. h y)"
+by (rule bigo_setsum1, auto)  
+
+declare [[ atp_problem_prefix = "BigO__bigo_setsum3" ]]
+lemma bigo_setsum3: "f =o O(h) ==>
+    (%x. SUM y : A x. (l x y) * f(k x y)) =o
+      O(%x. SUM y : A x. abs(l x y * h(k x y)))"
+  apply (rule bigo_setsum1)
+  apply (rule allI)+
+  apply (rule abs_ge_zero)
+  apply (unfold bigo_def)
+  apply (auto simp add: abs_mult);
+(*sledgehammer*); 
+  apply (rule_tac x = c in exI)
+  apply (rule allI)+
+  apply (subst mult_left_commute)
+  apply (rule mult_left_mono)
+  apply (erule spec)
+  apply (rule abs_ge_zero)
+done
+
+lemma bigo_setsum4: "f =o g +o O(h) ==>
+    (%x. SUM y : A x. l x y * f(k x y)) =o
+      (%x. SUM y : A x. l x y * g(k x y)) +o
+        O(%x. SUM y : A x. abs(l x y * h(k x y)))"
+  apply (rule set_minus_imp_plus)
+  apply (subst fun_diff_def)
+  apply (subst setsum_subtractf [symmetric])
+  apply (subst right_diff_distrib [symmetric])
+  apply (rule bigo_setsum3)
+  apply (subst fun_diff_def [symmetric])
+  apply (erule set_plus_imp_minus)
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_setsum5" ]]
+lemma bigo_setsum5: "f =o O(h) ==> ALL x y. 0 <= l x y ==> 
+    ALL x. 0 <= h x ==>
+      (%x. SUM y : A x. (l x y) * f(k x y)) =o
+        O(%x. SUM y : A x. (l x y) * h(k x y))" 
+  apply (subgoal_tac "(%x. SUM y : A x. (l x y) * h(k x y)) = 
+      (%x. SUM y : A x. abs((l x y) * h(k x y)))")
+  apply (erule ssubst)
+  apply (erule bigo_setsum3)
+  apply (rule ext)
+  apply (rule setsum_cong2)
+  apply (thin_tac "f \<in> O(h)") 
+apply (metis abs_of_nonneg zero_le_mult_iff)
+done
+
+lemma bigo_setsum6: "f =o g +o O(h) ==> ALL x y. 0 <= l x y ==>
+    ALL x. 0 <= h x ==>
+      (%x. SUM y : A x. (l x y) * f(k x y)) =o
+        (%x. SUM y : A x. (l x y) * g(k x y)) +o
+          O(%x. SUM y : A x. (l x y) * h(k x y))" 
+  apply (rule set_minus_imp_plus)
+  apply (subst fun_diff_def)
+  apply (subst setsum_subtractf [symmetric])
+  apply (subst right_diff_distrib [symmetric])
+  apply (rule bigo_setsum5)
+  apply (subst fun_diff_def [symmetric])
+  apply (drule set_plus_imp_minus)
+  apply auto
+done
+
+subsection {* Misc useful stuff *}
+
+lemma bigo_useful_intro: "A <= O(f) ==> B <= O(f) ==>
+  A \<oplus> B <= O(f)"
+  apply (subst bigo_plus_idemp [symmetric])
+  apply (rule set_plus_mono2)
+  apply assumption+
+done
+
+lemma bigo_useful_add: "f =o O(h) ==> g =o O(h) ==> f + g =o O(h)"
+  apply (subst bigo_plus_idemp [symmetric])
+  apply (rule set_plus_intro)
+  apply assumption+
+done
+  
+lemma bigo_useful_const_mult: "(c::'a::ordered_field) ~= 0 ==> 
+    (%x. c) * f =o O(h) ==> f =o O(h)"
+  apply (rule subsetD)
+  apply (subgoal_tac "(%x. 1 / c) *o O(h) <= O(h)")
+  apply assumption
+  apply (rule bigo_const_mult6)
+  apply (subgoal_tac "f = (%x. 1 / c) * ((%x. c) * f)")
+  apply (erule ssubst)
+  apply (erule set_times_intro2)
+  apply (simp add: func_times) 
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_fix" ]]
+lemma bigo_fix: "(%x. f ((x::nat) + 1)) =o O(%x. h(x + 1)) ==> f 0 = 0 ==>
+    f =o O(h)"
+  apply (simp add: bigo_alt_def)
+(*sledgehammer*); 
+  apply clarify
+  apply (rule_tac x = c in exI)
+  apply safe
+  apply (case_tac "x = 0")
+apply (metis OrderedGroup.abs_ge_zero  OrderedGroup.abs_zero  order_less_le  Ring_and_Field.split_mult_pos_le) 
+  apply (subgoal_tac "x = Suc (x - 1)")
+  apply metis
+  apply simp
+  done
+
+
+lemma bigo_fix2: 
+    "(%x. f ((x::nat) + 1)) =o (%x. g(x + 1)) +o O(%x. h(x + 1)) ==> 
+       f 0 = g 0 ==> f =o g +o O(h)"
+  apply (rule set_minus_imp_plus)
+  apply (rule bigo_fix)
+  apply (subst fun_diff_def)
+  apply (subst fun_diff_def [symmetric])
+  apply (rule set_plus_imp_minus)
+  apply simp
+  apply (simp add: fun_diff_def)
+done
+
+subsection {* Less than or equal to *}
+
+constdefs 
+  lesso :: "('a => 'b::ordered_idom) => ('a => 'b) => ('a => 'b)"
+      (infixl "<o" 70)
+  "f <o g == (%x. max (f x - g x) 0)"
+
+lemma bigo_lesseq1: "f =o O(h) ==> ALL x. abs (g x) <= abs (f x) ==>
+    g =o O(h)"
+  apply (unfold bigo_def)
+  apply clarsimp
+apply (blast intro: order_trans) 
+done
+
+lemma bigo_lesseq2: "f =o O(h) ==> ALL x. abs (g x) <= f x ==>
+      g =o O(h)"
+  apply (erule bigo_lesseq1)
+apply (blast intro: abs_ge_self order_trans) 
+done
+
+lemma bigo_lesseq3: "f =o O(h) ==> ALL x. 0 <= g x ==> ALL x. g x <= f x ==>
+      g =o O(h)"
+  apply (erule bigo_lesseq2)
+  apply (rule allI)
+  apply (subst abs_of_nonneg)
+  apply (erule spec)+
+done
+
+lemma bigo_lesseq4: "f =o O(h) ==>
+    ALL x. 0 <= g x ==> ALL x. g x <= abs (f x) ==>
+      g =o O(h)"
+  apply (erule bigo_lesseq1)
+  apply (rule allI)
+  apply (subst abs_of_nonneg)
+  apply (erule spec)+
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_lesso1" ]]
+lemma bigo_lesso1: "ALL x. f x <= g x ==> f <o g =o O(h)"
+  apply (unfold lesso_def)
+  apply (subgoal_tac "(%x. max (f x - g x) 0) = 0")
+(*??Translation of TSTP raised an exception: Type unification failed: Variable ?'X2.0::type not of sort ord*)
+apply (metis bigo_zero)
+  apply (unfold func_zero)
+  apply (rule ext)
+  apply (simp split: split_max)
+done
+
+
+declare [[ atp_problem_prefix = "BigO__bigo_lesso2" ]]
+lemma bigo_lesso2: "f =o g +o O(h) ==>
+    ALL x. 0 <= k x ==> ALL x. k x <= f x ==>
+      k <o g =o O(h)"
+  apply (unfold lesso_def)
+  apply (rule bigo_lesseq4)
+  apply (erule set_plus_imp_minus)
+  apply (rule allI)
+  apply (rule le_maxI2)
+  apply (rule allI)
+  apply (subst fun_diff_def)
+apply (erule thin_rl)
+(*sledgehammer*);  
+  apply (case_tac "0 <= k x - g x")
+  prefer 2 (*re-order subgoals because I don't know what to put after a structured proof*)
+   apply (metis abs_ge_zero abs_minus_commute linorder_linear min_max.sup_absorb1 min_max.sup_commute)
+proof (neg_clausify)
+fix x
+assume 0: "\<And>A. k A \<le> f A"
+have 1: "\<And>(X1\<Colon>'b\<Colon>ordered_idom) X2. \<not> max X1 X2 < X1"
+  by (metis linorder_not_less le_maxI1)  (*sort inserted by hand*)
+assume 2: "(0\<Colon>'b) \<le> k x - g x"
+have 3: "\<not> k x - g x < (0\<Colon>'b)"
+  by (metis 2 linorder_not_less)
+have 4: "\<And>X1 X2. min X1 (k X2) \<le> f X2"
+  by (metis min_max.inf_le2 min_max.le_inf_iff min_max.le_iff_inf 0)
+have 5: "\<bar>g x - f x\<bar> = f x - g x"
+  by (metis abs_minus_commute combine_common_factor mult_zero_right minus_add_cancel minus_zero abs_if diff_less_eq min_max.inf_commute 4 linorder_not_le min_max.le_iff_inf 3 diff_less_0_iff_less linorder_not_less)
+have 6: "max (0\<Colon>'b) (k x - g x) = k x - g x"
+  by (metis min_max.le_iff_sup 2)
+assume 7: "\<not> max (k x - g x) (0\<Colon>'b) \<le> \<bar>f x - g x\<bar>"
+have 8: "\<not> k x - g x \<le> f x - g x"
+  by (metis 5 abs_minus_commute 7 min_max.sup_commute 6)
+show "False"
+  by (metis min_max.sup_commute min_max.inf_commute min_max.sup_inf_absorb min_max.le_iff_inf 0 max_diff_distrib_left 1 linorder_not_le 8)
+qed
+
+declare [[ atp_problem_prefix = "BigO__bigo_lesso3" ]]
+lemma bigo_lesso3: "f =o g +o O(h) ==>
+    ALL x. 0 <= k x ==> ALL x. g x <= k x ==>
+      f <o k =o O(h)"
+  apply (unfold lesso_def)
+  apply (rule bigo_lesseq4)
+  apply (erule set_plus_imp_minus)
+  apply (rule allI)
+  apply (rule le_maxI2)
+  apply (rule allI)
+  apply (subst fun_diff_def)
+apply (erule thin_rl) 
+(*sledgehammer*); 
+  apply (case_tac "0 <= f x - k x")
+  apply (simp)
+  apply (subst abs_of_nonneg)
+  apply (drule_tac x = x in spec) back
+using [[ atp_problem_prefix = "BigO__bigo_lesso3_simpler" ]]
+apply (metis diff_less_0_iff_less linorder_not_le not_leE uminus_add_conv_diff xt1(12) xt1(6))
+apply (metis add_minus_cancel diff_le_eq le_diff_eq uminus_add_conv_diff)
+apply (metis abs_ge_zero linorder_linear min_max.sup_absorb1 min_max.sup_commute)
+done
+
+lemma bigo_lesso4: "f <o g =o O(k::'a=>'b::ordered_field) ==>
+    g =o h +o O(k) ==> f <o h =o O(k)"
+  apply (unfold lesso_def)
+  apply (drule set_plus_imp_minus)
+  apply (drule bigo_abs5) back
+  apply (simp add: fun_diff_def)
+  apply (drule bigo_useful_add)
+  apply assumption
+  apply (erule bigo_lesseq2) back
+  apply (rule allI)
+  apply (auto simp add: func_plus fun_diff_def algebra_simps
+    split: split_max abs_split)
+done
+
+declare [[ atp_problem_prefix = "BigO__bigo_lesso5" ]]
+lemma bigo_lesso5: "f <o g =o O(h) ==>
+    EX C. ALL x. f x <= g x + C * abs(h x)"
+  apply (simp only: lesso_def bigo_alt_def)
+  apply clarsimp
+  apply (metis abs_if abs_mult add_commute diff_le_eq less_not_permute)  
+done
+
+end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/Message.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/Message.thy	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,812 @@
+(*  Title:      HOL/MetisTest/Message.thy
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method.
+*)
+
+theory Message imports Main begin
+
+(*Needed occasionally with spy_analz_tac, e.g. in analz_insert_Key_newK*)
+lemma strange_Un_eq [simp]: "A \<union> (B \<union> A) = B \<union> A"
+by blast
+
+types 
+  key = nat
+
+consts
+  all_symmetric :: bool        --{*true if all keys are symmetric*}
+  invKey        :: "key=>key"  --{*inverse of a symmetric key*}
+
+specification (invKey)
+  invKey [simp]: "invKey (invKey K) = K"
+  invKey_symmetric: "all_symmetric --> invKey = id"
+    by (rule exI [of _ id], auto)
+
+
+text{*The inverse of a symmetric key is itself; that of a public key
+      is the private key and vice versa*}
+
+constdefs
+  symKeys :: "key set"
+  "symKeys == {K. invKey K = K}"
+
+datatype  --{*We allow any number of friendly agents*}
+  agent = Server | Friend nat | Spy
+
+datatype
+     msg = Agent  agent     --{*Agent names*}
+         | Number nat       --{*Ordinary integers, timestamps, ...*}
+         | Nonce  nat       --{*Unguessable nonces*}
+         | Key    key       --{*Crypto keys*}
+         | Hash   msg       --{*Hashing*}
+         | MPair  msg msg   --{*Compound messages*}
+         | Crypt  key msg   --{*Encryption, public- or shared-key*}
+
+
+text{*Concrete syntax: messages appear as {|A,B,NA|}, etc...*}
+syntax
+  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2{|_,/ _|})")
+
+syntax (xsymbols)
+  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2\<lbrace>_,/ _\<rbrace>)")
+
+translations
+  "{|x, y, z|}"   == "{|x, {|y, z|}|}"
+  "{|x, y|}"      == "MPair x y"
+
+
+constdefs
+  HPair :: "[msg,msg] => msg"                       ("(4Hash[_] /_)" [0, 1000])
+    --{*Message Y paired with a MAC computed with the help of X*}
+    "Hash[X] Y == {| Hash{|X,Y|}, Y|}"
+
+  keysFor :: "msg set => key set"
+    --{*Keys useful to decrypt elements of a message set*}
+  "keysFor H == invKey ` {K. \<exists>X. Crypt K X \<in> H}"
+
+
+subsubsection{*Inductive Definition of All Parts" of a Message*}
+
+inductive_set
+  parts :: "msg set => msg set"
+  for H :: "msg set"
+  where
+    Inj [intro]:               "X \<in> H ==> X \<in> parts H"
+  | Fst:         "{|X,Y|}   \<in> parts H ==> X \<in> parts H"
+  | Snd:         "{|X,Y|}   \<in> parts H ==> Y \<in> parts H"
+  | Body:        "Crypt K X \<in> parts H ==> X \<in> parts H"
+
+
+declare [[ atp_problem_prefix = "Message__parts_mono" ]]
+lemma parts_mono: "G \<subseteq> H ==> parts(G) \<subseteq> parts(H)"
+apply auto
+apply (erule parts.induct) 
+apply (metis Inj set_mp)
+apply (metis Fst)
+apply (metis Snd)
+apply (metis Body)
+done
+
+
+text{*Equations hold because constructors are injective.*}
+lemma Friend_image_eq [simp]: "(Friend x \<in> Friend`A) = (x:A)"
+by auto
+
+lemma Key_image_eq [simp]: "(Key x \<in> Key`A) = (x\<in>A)"
+by auto
+
+lemma Nonce_Key_image_eq [simp]: "(Nonce x \<notin> Key`A)"
+by auto
+
+
+subsubsection{*Inverse of keys *}
+
+declare [[ atp_problem_prefix = "Message__invKey_eq" ]]
+lemma invKey_eq [simp]: "(invKey K = invKey K') = (K=K')"
+by (metis invKey)
+
+
+subsection{*keysFor operator*}
+
+lemma keysFor_empty [simp]: "keysFor {} = {}"
+by (unfold keysFor_def, blast)
+
+lemma keysFor_Un [simp]: "keysFor (H \<union> H') = keysFor H \<union> keysFor H'"
+by (unfold keysFor_def, blast)
+
+lemma keysFor_UN [simp]: "keysFor (\<Union>i\<in>A. H i) = (\<Union>i\<in>A. keysFor (H i))"
+by (unfold keysFor_def, blast)
+
+text{*Monotonicity*}
+lemma keysFor_mono: "G \<subseteq> H ==> keysFor(G) \<subseteq> keysFor(H)"
+by (unfold keysFor_def, blast)
+
+lemma keysFor_insert_Agent [simp]: "keysFor (insert (Agent A) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Nonce [simp]: "keysFor (insert (Nonce N) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Number [simp]: "keysFor (insert (Number N) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Key [simp]: "keysFor (insert (Key K) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Hash [simp]: "keysFor (insert (Hash X) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_MPair [simp]: "keysFor (insert {|X,Y|} H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Crypt [simp]: 
+    "keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H)"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_image_Key [simp]: "keysFor (Key`E) = {}"
+by (unfold keysFor_def, auto)
+
+lemma Crypt_imp_invKey_keysFor: "Crypt K X \<in> H ==> invKey K \<in> keysFor H"
+by (unfold keysFor_def, blast)
+
+
+subsection{*Inductive relation "parts"*}
+
+lemma MPair_parts:
+     "[| {|X,Y|} \<in> parts H;        
+         [| X \<in> parts H; Y \<in> parts H |] ==> P |] ==> P"
+by (blast dest: parts.Fst parts.Snd) 
+
+    declare MPair_parts [elim!]  parts.Body [dest!]
+text{*NB These two rules are UNSAFE in the formal sense, as they discard the
+     compound message.  They work well on THIS FILE.  
+  @{text MPair_parts} is left as SAFE because it speeds up proofs.
+  The Crypt rule is normally kept UNSAFE to avoid breaking up certificates.*}
+
+lemma parts_increasing: "H \<subseteq> parts(H)"
+by blast
+
+lemmas parts_insertI = subset_insertI [THEN parts_mono, THEN subsetD, standard]
+
+lemma parts_empty [simp]: "parts{} = {}"
+apply safe
+apply (erule parts.induct)
+apply blast+
+done
+
+lemma parts_emptyE [elim!]: "X\<in> parts{} ==> P"
+by simp
+
+text{*WARNING: loops if H = {Y}, therefore must not be repeated!*}
+lemma parts_singleton: "X\<in> parts H ==> \<exists>Y\<in>H. X\<in> parts {Y}"
+apply (erule parts.induct)
+apply fast+
+done
+
+
+subsubsection{*Unions *}
+
+lemma parts_Un_subset1: "parts(G) \<union> parts(H) \<subseteq> parts(G \<union> H)"
+by (intro Un_least parts_mono Un_upper1 Un_upper2)
+
+lemma parts_Un_subset2: "parts(G \<union> H) \<subseteq> parts(G) \<union> parts(H)"
+apply (rule subsetI)
+apply (erule parts.induct, blast+)
+done
+
+lemma parts_Un [simp]: "parts(G \<union> H) = parts(G) \<union> parts(H)"
+by (intro equalityI parts_Un_subset1 parts_Un_subset2)
+
+lemma parts_insert: "parts (insert X H) = parts {X} \<union> parts H"
+apply (subst insert_is_Un [of _ H])
+apply (simp only: parts_Un)
+done
+
+declare [[ atp_problem_prefix = "Message__parts_insert_two" ]]
+lemma parts_insert2:
+     "parts (insert X (insert Y H)) = parts {X} \<union> parts {Y} \<union> parts H"
+by (metis Un_commute Un_empty_left Un_empty_right Un_insert_left Un_insert_right parts_Un)
+
+
+lemma parts_UN_subset1: "(\<Union>x\<in>A. parts(H x)) \<subseteq> parts(\<Union>x\<in>A. H x)"
+by (intro UN_least parts_mono UN_upper)
+
+lemma parts_UN_subset2: "parts(\<Union>x\<in>A. H x) \<subseteq> (\<Union>x\<in>A. parts(H x))"
+apply (rule subsetI)
+apply (erule parts.induct, blast+)
+done
+
+lemma parts_UN [simp]: "parts(\<Union>x\<in>A. H x) = (\<Union>x\<in>A. parts(H x))"
+by (intro equalityI parts_UN_subset1 parts_UN_subset2)
+
+text{*Added to simplify arguments to parts, analz and synth.
+  NOTE: the UN versions are no longer used!*}
+
+
+text{*This allows @{text blast} to simplify occurrences of 
+  @{term "parts(G\<union>H)"} in the assumption.*}
+lemmas in_parts_UnE = parts_Un [THEN equalityD1, THEN subsetD, THEN UnE] 
+declare in_parts_UnE [elim!]
+
+lemma parts_insert_subset: "insert X (parts H) \<subseteq> parts(insert X H)"
+by (blast intro: parts_mono [THEN [2] rev_subsetD])
+
+subsubsection{*Idempotence and transitivity *}
+
+lemma parts_partsD [dest!]: "X\<in> parts (parts H) ==> X\<in> parts H"
+by (erule parts.induct, blast+)
+
+lemma parts_idem [simp]: "parts (parts H) = parts H"
+by blast
+
+declare [[ atp_problem_prefix = "Message__parts_subset_iff" ]]
+lemma parts_subset_iff [simp]: "(parts G \<subseteq> parts H) = (G \<subseteq> parts H)"
+apply (rule iffI) 
+apply (metis Un_absorb1 Un_subset_iff parts_Un parts_increasing)
+apply (metis parts_idem parts_mono)
+done
+
+lemma parts_trans: "[| X\<in> parts G;  G \<subseteq> parts H |] ==> X\<in> parts H"
+by (blast dest: parts_mono); 
+
+
+declare [[ atp_problem_prefix = "Message__parts_cut" ]]
+lemma parts_cut: "[|Y\<in> parts(insert X G);  X\<in> parts H|] ==> Y\<in> parts(G \<union> H)"
+by (metis Un_subset_iff insert_subset parts_increasing parts_trans) 
+
+
+
+subsubsection{*Rewrite rules for pulling out atomic messages *}
+
+lemmas parts_insert_eq_I = equalityI [OF subsetI parts_insert_subset]
+
+
+lemma parts_insert_Agent [simp]:
+     "parts (insert (Agent agt) H) = insert (Agent agt) (parts H)"
+apply (rule parts_insert_eq_I) 
+apply (erule parts.induct, auto) 
+done
+
+lemma parts_insert_Nonce [simp]:
+     "parts (insert (Nonce N) H) = insert (Nonce N) (parts H)"
+apply (rule parts_insert_eq_I) 
+apply (erule parts.induct, auto) 
+done
+
+lemma parts_insert_Number [simp]:
+     "parts (insert (Number N) H) = insert (Number N) (parts H)"
+apply (rule parts_insert_eq_I) 
+apply (erule parts.induct, auto) 
+done
+
+lemma parts_insert_Key [simp]:
+     "parts (insert (Key K) H) = insert (Key K) (parts H)"
+apply (rule parts_insert_eq_I) 
+apply (erule parts.induct, auto) 
+done
+
+lemma parts_insert_Hash [simp]:
+     "parts (insert (Hash X) H) = insert (Hash X) (parts H)"
+apply (rule parts_insert_eq_I) 
+apply (erule parts.induct, auto) 
+done
+
+lemma parts_insert_Crypt [simp]:
+     "parts (insert (Crypt K X) H) =  
+          insert (Crypt K X) (parts (insert X H))"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule parts.induct, auto)
+apply (blast intro: parts.Body)
+done
+
+lemma parts_insert_MPair [simp]:
+     "parts (insert {|X,Y|} H) =  
+          insert {|X,Y|} (parts (insert X (insert Y H)))"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule parts.induct, auto)
+apply (blast intro: parts.Fst parts.Snd)+
+done
+
+lemma parts_image_Key [simp]: "parts (Key`N) = Key`N"
+apply auto
+apply (erule parts.induct, auto)
+done
+
+
+declare [[ atp_problem_prefix = "Message__msg_Nonce_supply" ]]
+lemma msg_Nonce_supply: "\<exists>N. \<forall>n. N\<le>n --> Nonce n \<notin> parts {msg}"
+apply (induct_tac "msg") 
+apply (simp_all add: parts_insert2)
+apply (metis Suc_n_not_le_n)
+apply (metis le_trans linorder_linear)
+done
+
+subsection{*Inductive relation "analz"*}
+
+text{*Inductive definition of "analz" -- what can be broken down from a set of
+    messages, including keys.  A form of downward closure.  Pairs can
+    be taken apart; messages decrypted with known keys.  *}
+
+inductive_set
+  analz :: "msg set => msg set"
+  for H :: "msg set"
+  where
+    Inj [intro,simp] :    "X \<in> H ==> X \<in> analz H"
+  | Fst:     "{|X,Y|} \<in> analz H ==> X \<in> analz H"
+  | Snd:     "{|X,Y|} \<in> analz H ==> Y \<in> analz H"
+  | Decrypt [dest]: 
+             "[|Crypt K X \<in> analz H; Key(invKey K): analz H|] ==> X \<in> analz H"
+
+
+text{*Monotonicity; Lemma 1 of Lowe's paper*}
+lemma analz_mono: "G\<subseteq>H ==> analz(G) \<subseteq> analz(H)"
+apply auto
+apply (erule analz.induct) 
+apply (auto dest: analz.Fst analz.Snd) 
+done
+
+text{*Making it safe speeds up proofs*}
+lemma MPair_analz [elim!]:
+     "[| {|X,Y|} \<in> analz H;        
+             [| X \<in> analz H; Y \<in> analz H |] ==> P   
+          |] ==> P"
+by (blast dest: analz.Fst analz.Snd)
+
+lemma analz_increasing: "H \<subseteq> analz(H)"
+by blast
+
+lemma analz_subset_parts: "analz H \<subseteq> parts H"
+apply (rule subsetI)
+apply (erule analz.induct, blast+)
+done
+
+lemmas analz_into_parts = analz_subset_parts [THEN subsetD, standard]
+
+lemmas not_parts_not_analz = analz_subset_parts [THEN contra_subsetD, standard]
+
+
+declare [[ atp_problem_prefix = "Message__parts_analz" ]]
+lemma parts_analz [simp]: "parts (analz H) = parts H"
+apply (rule equalityI)
+apply (metis analz_subset_parts parts_subset_iff)
+apply (metis analz_increasing parts_mono)
+done
+
+
+lemma analz_parts [simp]: "analz (parts H) = parts H"
+apply auto
+apply (erule analz.induct, auto)
+done
+
+lemmas analz_insertI = subset_insertI [THEN analz_mono, THEN [2] rev_subsetD, standard]
+
+subsubsection{*General equational properties *}
+
+lemma analz_empty [simp]: "analz{} = {}"
+apply safe
+apply (erule analz.induct, blast+)
+done
+
+text{*Converse fails: we can analz more from the union than from the 
+  separate parts, as a key in one might decrypt a message in the other*}
+lemma analz_Un: "analz(G) \<union> analz(H) \<subseteq> analz(G \<union> H)"
+by (intro Un_least analz_mono Un_upper1 Un_upper2)
+
+lemma analz_insert: "insert X (analz H) \<subseteq> analz(insert X H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+subsubsection{*Rewrite rules for pulling out atomic messages *}
+
+lemmas analz_insert_eq_I = equalityI [OF subsetI analz_insert]
+
+lemma analz_insert_Agent [simp]:
+     "analz (insert (Agent agt) H) = insert (Agent agt) (analz H)"
+apply (rule analz_insert_eq_I) 
+apply (erule analz.induct, auto) 
+done
+
+lemma analz_insert_Nonce [simp]:
+     "analz (insert (Nonce N) H) = insert (Nonce N) (analz H)"
+apply (rule analz_insert_eq_I) 
+apply (erule analz.induct, auto) 
+done
+
+lemma analz_insert_Number [simp]:
+     "analz (insert (Number N) H) = insert (Number N) (analz H)"
+apply (rule analz_insert_eq_I) 
+apply (erule analz.induct, auto) 
+done
+
+lemma analz_insert_Hash [simp]:
+     "analz (insert (Hash X) H) = insert (Hash X) (analz H)"
+apply (rule analz_insert_eq_I) 
+apply (erule analz.induct, auto) 
+done
+
+text{*Can only pull out Keys if they are not needed to decrypt the rest*}
+lemma analz_insert_Key [simp]: 
+    "K \<notin> keysFor (analz H) ==>   
+          analz (insert (Key K) H) = insert (Key K) (analz H)"
+apply (unfold keysFor_def)
+apply (rule analz_insert_eq_I) 
+apply (erule analz.induct, auto) 
+done
+
+lemma analz_insert_MPair [simp]:
+     "analz (insert {|X,Y|} H) =  
+          insert {|X,Y|} (analz (insert X (insert Y H)))"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule analz.induct, auto)
+apply (erule analz.induct)
+apply (blast intro: analz.Fst analz.Snd)+
+done
+
+text{*Can pull out enCrypted message if the Key is not known*}
+lemma analz_insert_Crypt:
+     "Key (invKey K) \<notin> analz H 
+      ==> analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)"
+apply (rule analz_insert_eq_I) 
+apply (erule analz.induct, auto) 
+
+done
+
+lemma lemma1: "Key (invKey K) \<in> analz H ==>   
+               analz (insert (Crypt K X) H) \<subseteq>  
+               insert (Crypt K X) (analz (insert X H))" 
+apply (rule subsetI)
+apply (erule_tac x = x in analz.induct, auto)
+done
+
+lemma lemma2: "Key (invKey K) \<in> analz H ==>   
+               insert (Crypt K X) (analz (insert X H)) \<subseteq>  
+               analz (insert (Crypt K X) H)"
+apply auto
+apply (erule_tac x = x in analz.induct, auto)
+apply (blast intro: analz_insertI analz.Decrypt)
+done
+
+lemma analz_insert_Decrypt:
+     "Key (invKey K) \<in> analz H ==>   
+               analz (insert (Crypt K X) H) =  
+               insert (Crypt K X) (analz (insert X H))"
+by (intro equalityI lemma1 lemma2)
+
+text{*Case analysis: either the message is secure, or it is not! Effective,
+but can cause subgoals to blow up! Use with @{text "split_if"}; apparently
+@{text "split_tac"} does not cope with patterns such as @{term"analz (insert
+(Crypt K X) H)"} *} 
+lemma analz_Crypt_if [simp]:
+     "analz (insert (Crypt K X) H) =                 
+          (if (Key (invKey K) \<in> analz H)                 
+           then insert (Crypt K X) (analz (insert X H))  
+           else insert (Crypt K X) (analz H))"
+by (simp add: analz_insert_Crypt analz_insert_Decrypt)
+
+
+text{*This rule supposes "for the sake of argument" that we have the key.*}
+lemma analz_insert_Crypt_subset:
+     "analz (insert (Crypt K X) H) \<subseteq>   
+           insert (Crypt K X) (analz (insert X H))"
+apply (rule subsetI)
+apply (erule analz.induct, auto)
+done
+
+
+lemma analz_image_Key [simp]: "analz (Key`N) = Key`N"
+apply auto
+apply (erule analz.induct, auto)
+done
+
+
+subsubsection{*Idempotence and transitivity *}
+
+lemma analz_analzD [dest!]: "X\<in> analz (analz H) ==> X\<in> analz H"
+by (erule analz.induct, blast+)
+
+lemma analz_idem [simp]: "analz (analz H) = analz H"
+by blast
+
+lemma analz_subset_iff [simp]: "(analz G \<subseteq> analz H) = (G \<subseteq> analz H)"
+apply (rule iffI)
+apply (iprover intro: subset_trans analz_increasing)  
+apply (frule analz_mono, simp) 
+done
+
+lemma analz_trans: "[| X\<in> analz G;  G \<subseteq> analz H |] ==> X\<in> analz H"
+by (drule analz_mono, blast)
+
+
+declare [[ atp_problem_prefix = "Message__analz_cut" ]]
+    declare analz_trans[intro]
+lemma analz_cut: "[| Y\<in> analz (insert X H);  X\<in> analz H |] ==> Y\<in> analz H"
+(*TOO SLOW
+by (metis analz_idem analz_increasing analz_mono insert_absorb insert_mono insert_subset) --{*317s*}
+??*)
+by (erule analz_trans, blast)
+
+
+text{*This rewrite rule helps in the simplification of messages that involve
+  the forwarding of unknown components (X).  Without it, removing occurrences
+  of X can be very complicated. *}
+lemma analz_insert_eq: "X\<in> analz H ==> analz (insert X H) = analz H"
+by (blast intro: analz_cut analz_insertI)
+
+
+text{*A congruence rule for "analz" *}
+
+declare [[ atp_problem_prefix = "Message__analz_subset_cong" ]]
+lemma analz_subset_cong:
+     "[| analz G \<subseteq> analz G'; analz H \<subseteq> analz H' |] 
+      ==> analz (G \<union> H) \<subseteq> analz (G' \<union> H')"
+apply simp
+apply (metis Un_absorb2 Un_commute Un_subset_iff Un_upper1 Un_upper2 analz_mono)
+done
+
+
+lemma analz_cong:
+     "[| analz G = analz G'; analz H = analz H'  
+               |] ==> analz (G \<union> H) = analz (G' \<union> H')"
+by (intro equalityI analz_subset_cong, simp_all) 
+
+lemma analz_insert_cong:
+     "analz H = analz H' ==> analz(insert X H) = analz(insert X H')"
+by (force simp only: insert_def intro!: analz_cong)
+
+text{*If there are no pairs or encryptions then analz does nothing*}
+lemma analz_trivial:
+     "[| \<forall>X Y. {|X,Y|} \<notin> H;  \<forall>X K. Crypt K X \<notin> H |] ==> analz H = H"
+apply safe
+apply (erule analz.induct, blast+)
+done
+
+text{*These two are obsolete (with a single Spy) but cost little to prove...*}
+lemma analz_UN_analz_lemma:
+     "X\<in> analz (\<Union>i\<in>A. analz (H i)) ==> X\<in> analz (\<Union>i\<in>A. H i)"
+apply (erule analz.induct)
+apply (blast intro: analz_mono [THEN [2] rev_subsetD])+
+done
+
+lemma analz_UN_analz [simp]: "analz (\<Union>i\<in>A. analz (H i)) = analz (\<Union>i\<in>A. H i)"
+by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD])
+
+
+subsection{*Inductive relation "synth"*}
+
+text{*Inductive definition of "synth" -- what can be built up from a set of
+    messages.  A form of upward closure.  Pairs can be built, messages
+    encrypted with known keys.  Agent names are public domain.
+    Numbers can be guessed, but Nonces cannot be.  *}
+
+inductive_set
+  synth :: "msg set => msg set"
+  for H :: "msg set"
+  where
+    Inj    [intro]:   "X \<in> H ==> X \<in> synth H"
+  | Agent  [intro]:   "Agent agt \<in> synth H"
+  | Number [intro]:   "Number n  \<in> synth H"
+  | Hash   [intro]:   "X \<in> synth H ==> Hash X \<in> synth H"
+  | MPair  [intro]:   "[|X \<in> synth H;  Y \<in> synth H|] ==> {|X,Y|} \<in> synth H"
+  | Crypt  [intro]:   "[|X \<in> synth H;  Key(K) \<in> H|] ==> Crypt K X \<in> synth H"
+
+text{*Monotonicity*}
+lemma synth_mono: "G\<subseteq>H ==> synth(G) \<subseteq> synth(H)"
+  by (auto, erule synth.induct, auto)  
+
+text{*NO @{text Agent_synth}, as any Agent name can be synthesized.  
+  The same holds for @{term Number}*}
+inductive_cases Nonce_synth [elim!]: "Nonce n \<in> synth H"
+inductive_cases Key_synth   [elim!]: "Key K \<in> synth H"
+inductive_cases Hash_synth  [elim!]: "Hash X \<in> synth H"
+inductive_cases MPair_synth [elim!]: "{|X,Y|} \<in> synth H"
+inductive_cases Crypt_synth [elim!]: "Crypt K X \<in> synth H"
+
+
+lemma synth_increasing: "H \<subseteq> synth(H)"
+by blast
+
+subsubsection{*Unions *}
+
+text{*Converse fails: we can synth more from the union than from the 
+  separate parts, building a compound message using elements of each.*}
+lemma synth_Un: "synth(G) \<union> synth(H) \<subseteq> synth(G \<union> H)"
+by (intro Un_least synth_mono Un_upper1 Un_upper2)
+
+
+declare [[ atp_problem_prefix = "Message__synth_insert" ]]
+ 
+lemma synth_insert: "insert X (synth H) \<subseteq> synth(insert X H)"
+by (metis insert_iff insert_subset subset_insertI synth.Inj synth_mono)
+
+subsubsection{*Idempotence and transitivity *}
+
+lemma synth_synthD [dest!]: "X\<in> synth (synth H) ==> X\<in> synth H"
+by (erule synth.induct, blast+)
+
+lemma synth_idem: "synth (synth H) = synth H"
+by blast
+
+lemma synth_subset_iff [simp]: "(synth G \<subseteq> synth H) = (G \<subseteq> synth H)"
+apply (rule iffI)
+apply (iprover intro: subset_trans synth_increasing)  
+apply (frule synth_mono, simp add: synth_idem) 
+done
+
+lemma synth_trans: "[| X\<in> synth G;  G \<subseteq> synth H |] ==> X\<in> synth H"
+by (drule synth_mono, blast)
+
+declare [[ atp_problem_prefix = "Message__synth_cut" ]]
+lemma synth_cut: "[| Y\<in> synth (insert X H);  X\<in> synth H |] ==> Y\<in> synth H"
+(*TOO SLOW
+by (metis insert_absorb insert_mono insert_subset synth_idem synth_increasing synth_mono)
+*)
+by (erule synth_trans, blast)
+
+
+lemma Agent_synth [simp]: "Agent A \<in> synth H"
+by blast
+
+lemma Number_synth [simp]: "Number n \<in> synth H"
+by blast
+
+lemma Nonce_synth_eq [simp]: "(Nonce N \<in> synth H) = (Nonce N \<in> H)"
+by blast
+
+lemma Key_synth_eq [simp]: "(Key K \<in> synth H) = (Key K \<in> H)"
+by blast
+
+lemma Crypt_synth_eq [simp]:
+     "Key K \<notin> H ==> (Crypt K X \<in> synth H) = (Crypt K X \<in> H)"
+by blast
+
+
+lemma keysFor_synth [simp]: 
+    "keysFor (synth H) = keysFor H \<union> invKey`{K. Key K \<in> H}"
+by (unfold keysFor_def, blast)
+
+
+subsubsection{*Combinations of parts, analz and synth *}
+
+declare [[ atp_problem_prefix = "Message__parts_synth" ]]
+lemma parts_synth [simp]: "parts (synth H) = parts H \<union> synth H"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule parts.induct)
+apply (metis UnCI)
+apply (metis MPair_synth UnCI UnE insert_absorb insert_subset parts.Fst parts_increasing)
+apply (metis MPair_synth UnCI UnE insert_absorb insert_subset parts.Snd parts_increasing)
+apply (metis Body Crypt_synth UnCI UnE insert_absorb insert_subset parts_increasing)
+apply (metis Un_subset_iff parts_increasing parts_mono synth_increasing)
+done
+
+
+
+
+declare [[ atp_problem_prefix = "Message__analz_analz_Un" ]]
+lemma analz_analz_Un [simp]: "analz (analz G \<union> H) = analz (G \<union> H)"
+apply (rule equalityI);
+apply (metis analz_idem analz_subset_cong order_eq_refl)
+apply (metis analz_increasing analz_subset_cong order_eq_refl)
+done
+
+declare [[ atp_problem_prefix = "Message__analz_synth_Un" ]]
+    declare analz_mono [intro] analz.Fst [intro] analz.Snd [intro] Un_least [intro]
+lemma analz_synth_Un [simp]: "analz (synth G \<union> H) = analz (G \<union> H) \<union> synth G"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule analz.induct)
+apply (metis UnCI UnE Un_commute analz.Inj)
+apply (metis MPair_synth UnCI UnE Un_commute Un_upper1 analz.Fst analz_increasing analz_mono insert_absorb insert_subset)
+apply (metis MPair_synth UnCI UnE Un_commute Un_upper1 analz.Snd analz_increasing analz_mono insert_absorb insert_subset)
+apply (blast intro: analz.Decrypt)
+apply blast
+done
+
+
+declare [[ atp_problem_prefix = "Message__analz_synth" ]]
+lemma analz_synth [simp]: "analz (synth H) = analz H \<union> synth H"
+proof (neg_clausify)
+assume 0: "analz (synth H) \<noteq> analz H \<union> synth H"
+have 1: "\<And>X1 X3. sup (analz (sup X3 X1)) (synth X3) = analz (sup (synth X3) X1)"
+  by (metis analz_synth_Un)
+have 2: "sup (analz H) (synth H) \<noteq> analz (synth H)"
+  by (metis 0)
+have 3: "\<And>X1 X3. sup (synth X3) (analz (sup X3 X1)) = analz (sup (synth X3) X1)"
+  by (metis 1 Un_commute)
+have 4: "\<And>X3. sup (synth X3) (analz X3) = analz (sup (synth X3) {})"
+  by (metis 3 Un_empty_right)
+have 5: "\<And>X3. sup (synth X3) (analz X3) = analz (synth X3)"
+  by (metis 4 Un_empty_right)
+have 6: "\<And>X3. sup (analz X3) (synth X3) = analz (synth X3)"
+  by (metis 5 Un_commute)
+show "False"
+  by (metis 2 6)
+qed
+
+
+subsubsection{*For reasoning about the Fake rule in traces *}
+
+declare [[ atp_problem_prefix = "Message__parts_insert_subset_Un" ]]
+lemma parts_insert_subset_Un: "X\<in> G ==> parts(insert X H) \<subseteq> parts G \<union> parts H"
+proof (neg_clausify)
+assume 0: "X \<in> G"
+assume 1: "\<not> parts (insert X H) \<subseteq> parts G \<union> parts H"
+have 2: "\<not> parts (insert X H) \<subseteq> parts (G \<union> H)"
+  by (metis 1 parts_Un)
+have 3: "\<not> insert X H \<subseteq> G \<union> H"
+  by (metis 2 parts_mono)
+have 4: "X \<notin> G \<union> H \<or> \<not> H \<subseteq> G \<union> H"
+  by (metis 3 insert_subset)
+have 5: "X \<notin> G \<union> H"
+  by (metis 4 Un_upper2)
+have 6: "X \<notin> G"
+  by (metis 5 UnCI)
+show "False"
+  by (metis 6 0)
+qed
+
+declare [[ atp_problem_prefix = "Message__Fake_parts_insert" ]]
+lemma Fake_parts_insert:
+     "X \<in> synth (analz H) ==>  
+      parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
+proof (neg_clausify)
+assume 0: "X \<in> synth (analz H)"
+assume 1: "\<not> parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
+have 2: "\<And>X3. parts X3 \<union> synth (analz X3) = parts (synth (analz X3))"
+  by (metis parts_synth parts_analz)
+have 3: "\<And>X3. analz X3 \<union> synth (analz X3) = analz (synth (analz X3))"
+  by (metis analz_synth analz_idem)
+have 4: "\<And>X3. analz X3 \<subseteq> analz (synth X3)"
+  by (metis Un_upper1 analz_synth)
+have 5: "\<not> parts (insert X H) \<subseteq> parts H \<union> synth (analz H)"
+  by (metis 1 Un_commute)
+have 6: "\<not> parts (insert X H) \<subseteq> parts (synth (analz H))"
+  by (metis 5 2)
+have 7: "\<not> insert X H \<subseteq> synth (analz H)"
+  by (metis 6 parts_mono)
+have 8: "X \<notin> synth (analz H) \<or> \<not> H \<subseteq> synth (analz H)"
+  by (metis 7 insert_subset)
+have 9: "\<not> H \<subseteq> synth (analz H)"
+  by (metis 8 0)
+have 10: "\<And>X3. X3 \<subseteq> analz (synth X3)"
+  by (metis analz_subset_iff 4)
+have 11: "\<And>X3. X3 \<subseteq> analz (synth (analz X3))"
+  by (metis analz_subset_iff 10)
+have 12: "\<And>X3. analz (synth (analz X3)) = synth (analz X3) \<or>
+     \<not> analz X3 \<subseteq> synth (analz X3)"
+  by (metis Un_absorb1 3)
+have 13: "\<And>X3. analz (synth (analz X3)) = synth (analz X3)"
+  by (metis 12 synth_increasing)
+have 14: "\<And>X3. X3 \<subseteq> synth (analz X3)"
+  by (metis 11 13)
+show "False"
+  by (metis 9 14)
+qed
+
+lemma Fake_parts_insert_in_Un:
+     "[|Z \<in> parts (insert X H);  X: synth (analz H)|] 
+      ==> Z \<in>  synth (analz H) \<union> parts H";
+by (blast dest: Fake_parts_insert  [THEN subsetD, dest])
+
+declare [[ atp_problem_prefix = "Message__Fake_analz_insert" ]]
+    declare analz_mono [intro] synth_mono [intro] 
+lemma Fake_analz_insert:
+     "X\<in> synth (analz G) ==>  
+      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
+by (metis Un_commute Un_insert_left Un_insert_right Un_upper1 analz_analz_Un analz_mono analz_synth_Un equalityE insert_absorb order_le_less xt1(12))
+
+declare [[ atp_problem_prefix = "Message__Fake_analz_insert_simpler" ]]
+(*simpler problems?  BUT METIS CAN'T PROVE
+lemma Fake_analz_insert_simpler:
+     "X\<in> synth (analz G) ==>  
+      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
+apply (rule subsetI)
+apply (subgoal_tac "x \<in> analz (synth (analz G) \<union> H) ")
+apply (metis Un_commute analz_analz_Un analz_synth_Un)
+apply (metis Un_commute Un_upper1 Un_upper2 analz_cut analz_increasing analz_mono insert_absorb insert_mono insert_subset)
+done
+*)
+
+end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/ROOT.ML
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/ROOT.ML	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,8 @@
+(*  Title:      HOL/Metis_Examples/ROOT.ML
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method.
+*)
+
+use_thys ["set", "BigO", "Abstraction", "BT", "Message", "Tarski", "TransClosure"];
+
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/Tarski.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/Tarski.thy	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,1110 @@
+(*  Title:      HOL/MetisTest/Tarski.thy
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method.
+*)
+
+header {* The Full Theorem of Tarski *}
+
+theory Tarski
+imports Main FuncSet
+begin
+
+(*Many of these higher-order problems appear to be impossible using the
+current linkup. They often seem to need either higher-order unification
+or explicit reasoning about connectives such as conjunction. The numerous
+set comprehensions are to blame.*)
+
+
+record 'a potype =
+  pset  :: "'a set"
+  order :: "('a * 'a) set"
+
+constdefs
+  monotone :: "['a => 'a, 'a set, ('a *'a)set] => bool"
+  "monotone f A r == \<forall>x\<in>A. \<forall>y\<in>A. (x, y): r --> ((f x), (f y)) : r"
+
+  least :: "['a => bool, 'a potype] => 'a"
+  "least P po == @ x. x: pset po & P x &
+                       (\<forall>y \<in> pset po. P y --> (x,y): order po)"
+
+  greatest :: "['a => bool, 'a potype] => 'a"
+  "greatest P po == @ x. x: pset po & P x &
+                          (\<forall>y \<in> pset po. P y --> (y,x): order po)"
+
+  lub  :: "['a set, 'a potype] => 'a"
+  "lub S po == least (%x. \<forall>y\<in>S. (y,x): order po) po"
+
+  glb  :: "['a set, 'a potype] => 'a"
+  "glb S po == greatest (%x. \<forall>y\<in>S. (x,y): order po) po"
+
+  isLub :: "['a set, 'a potype, 'a] => bool"
+  "isLub S po == %L. (L: pset po & (\<forall>y\<in>S. (y,L): order po) &
+                   (\<forall>z\<in>pset po. (\<forall>y\<in>S. (y,z): order po) --> (L,z): order po))"
+
+  isGlb :: "['a set, 'a potype, 'a] => bool"
+  "isGlb S po == %G. (G: pset po & (\<forall>y\<in>S. (G,y): order po) &
+                 (\<forall>z \<in> pset po. (\<forall>y\<in>S. (z,y): order po) --> (z,G): order po))"
+
+  "fix"    :: "[('a => 'a), 'a set] => 'a set"
+  "fix f A  == {x. x: A & f x = x}"
+
+  interval :: "[('a*'a) set,'a, 'a ] => 'a set"
+  "interval r a b == {x. (a,x): r & (x,b): r}"
+
+constdefs
+  Bot :: "'a potype => 'a"
+  "Bot po == least (%x. True) po"
+
+  Top :: "'a potype => 'a"
+  "Top po == greatest (%x. True) po"
+
+  PartialOrder :: "('a potype) set"
+  "PartialOrder == {P. refl_on (pset P) (order P) & antisym (order P) &
+                       trans (order P)}"
+
+  CompleteLattice :: "('a potype) set"
+  "CompleteLattice == {cl. cl: PartialOrder &
+                        (\<forall>S. S \<subseteq> pset cl --> (\<exists>L. isLub S cl L)) &
+                        (\<forall>S. S \<subseteq> pset cl --> (\<exists>G. isGlb S cl G))}"
+
+  induced :: "['a set, ('a * 'a) set] => ('a *'a)set"
+  "induced A r == {(a,b). a : A & b: A & (a,b): r}"
+
+constdefs
+  sublattice :: "('a potype * 'a set)set"
+  "sublattice ==
+      SIGMA cl: CompleteLattice.
+          {S. S \<subseteq> pset cl &
+           (| pset = S, order = induced S (order cl) |): CompleteLattice }"
+
+syntax
+  "@SL"  :: "['a set, 'a potype] => bool" ("_ <<= _" [51,50]50)
+
+translations
+  "S <<= cl" == "S : sublattice `` {cl}"
+
+constdefs
+  dual :: "'a potype => 'a potype"
+  "dual po == (| pset = pset po, order = converse (order po) |)"
+
+locale PO =
+  fixes cl :: "'a potype"
+    and A  :: "'a set"
+    and r  :: "('a * 'a) set"
+  assumes cl_po:  "cl : PartialOrder"
+  defines A_def: "A == pset cl"
+     and  r_def: "r == order cl"
+
+locale CL = PO +
+  assumes cl_co:  "cl : CompleteLattice"
+
+definition CLF_set :: "('a potype * ('a => 'a)) set" where
+  "CLF_set = (SIGMA cl: CompleteLattice.
+            {f. f: pset cl -> pset cl & monotone f (pset cl) (order cl)})"
+
+locale CLF = CL +
+  fixes f :: "'a => 'a"
+    and P :: "'a set"
+  assumes f_cl:  "(cl,f) : CLF_set" (*was the equivalent "f : CLF``{cl}"*)
+  defines P_def: "P == fix f A"
+
+
+locale Tarski = CLF +
+  fixes Y     :: "'a set"
+    and intY1 :: "'a set"
+    and v     :: "'a"
+  assumes
+    Y_ss: "Y \<subseteq> P"
+  defines
+    intY1_def: "intY1 == interval r (lub Y cl) (Top cl)"
+    and v_def: "v == glb {x. ((%x: intY1. f x) x, x): induced intY1 r &
+                             x: intY1}
+                      (| pset=intY1, order=induced intY1 r|)"
+
+
+subsection {* Partial Order *}
+
+lemma (in PO) PO_imp_refl_on: "refl_on A r"
+apply (insert cl_po)
+apply (simp add: PartialOrder_def A_def r_def)
+done
+
+lemma (in PO) PO_imp_sym: "antisym r"
+apply (insert cl_po)
+apply (simp add: PartialOrder_def r_def)
+done
+
+lemma (in PO) PO_imp_trans: "trans r"
+apply (insert cl_po)
+apply (simp add: PartialOrder_def r_def)
+done
+
+lemma (in PO) reflE: "x \<in> A ==> (x, x) \<in> r"
+apply (insert cl_po)
+apply (simp add: PartialOrder_def refl_on_def A_def r_def)
+done
+
+lemma (in PO) antisymE: "[| (a, b) \<in> r; (b, a) \<in> r |] ==> a = b"
+apply (insert cl_po)
+apply (simp add: PartialOrder_def antisym_def r_def)
+done
+
+lemma (in PO) transE: "[| (a, b) \<in> r; (b, c) \<in> r|] ==> (a,c) \<in> r"
+apply (insert cl_po)
+apply (simp add: PartialOrder_def r_def)
+apply (unfold trans_def, fast)
+done
+
+lemma (in PO) monotoneE:
+     "[| monotone f A r;  x \<in> A; y \<in> A; (x, y) \<in> r |] ==> (f x, f y) \<in> r"
+by (simp add: monotone_def)
+
+lemma (in PO) po_subset_po:
+     "S \<subseteq> A ==> (| pset = S, order = induced S r |) \<in> PartialOrder"
+apply (simp (no_asm) add: PartialOrder_def)
+apply auto
+-- {* refl *}
+apply (simp add: refl_on_def induced_def)
+apply (blast intro: reflE)
+-- {* antisym *}
+apply (simp add: antisym_def induced_def)
+apply (blast intro: antisymE)
+-- {* trans *}
+apply (simp add: trans_def induced_def)
+apply (blast intro: transE)
+done
+
+lemma (in PO) indE: "[| (x, y) \<in> induced S r; S \<subseteq> A |] ==> (x, y) \<in> r"
+by (simp add: add: induced_def)
+
+lemma (in PO) indI: "[| (x, y) \<in> r; x \<in> S; y \<in> S |] ==> (x, y) \<in> induced S r"
+by (simp add: add: induced_def)
+
+lemma (in CL) CL_imp_ex_isLub: "S \<subseteq> A ==> \<exists>L. isLub S cl L"
+apply (insert cl_co)
+apply (simp add: CompleteLattice_def A_def)
+done
+
+declare (in CL) cl_co [simp]
+
+lemma isLub_lub: "(\<exists>L. isLub S cl L) = isLub S cl (lub S cl)"
+by (simp add: lub_def least_def isLub_def some_eq_ex [symmetric])
+
+lemma isGlb_glb: "(\<exists>G. isGlb S cl G) = isGlb S cl (glb S cl)"
+by (simp add: glb_def greatest_def isGlb_def some_eq_ex [symmetric])
+
+lemma isGlb_dual_isLub: "isGlb S cl = isLub S (dual cl)"
+by (simp add: isLub_def isGlb_def dual_def converse_def)
+
+lemma isLub_dual_isGlb: "isLub S cl = isGlb S (dual cl)"
+by (simp add: isLub_def isGlb_def dual_def converse_def)
+
+lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
+apply (insert cl_po)
+apply (simp add: PartialOrder_def dual_def refl_on_converse
+                 trans_converse antisym_converse)
+done
+
+lemma Rdual:
+     "\<forall>S. (S \<subseteq> A -->( \<exists>L. isLub S (| pset = A, order = r|) L))
+      ==> \<forall>S. (S \<subseteq> A --> (\<exists>G. isGlb S (| pset = A, order = r|) G))"
+apply safe
+apply (rule_tac x = "lub {y. y \<in> A & (\<forall>k \<in> S. (y, k) \<in> r)}
+                      (|pset = A, order = r|) " in exI)
+apply (drule_tac x = "{y. y \<in> A & (\<forall>k \<in> S. (y,k) \<in> r) }" in spec)
+apply (drule mp, fast)
+apply (simp add: isLub_lub isGlb_def)
+apply (simp add: isLub_def, blast)
+done
+
+lemma lub_dual_glb: "lub S cl = glb S (dual cl)"
+by (simp add: lub_def glb_def least_def greatest_def dual_def converse_def)
+
+lemma glb_dual_lub: "glb S cl = lub S (dual cl)"
+by (simp add: lub_def glb_def least_def greatest_def dual_def converse_def)
+
+lemma CL_subset_PO: "CompleteLattice \<subseteq> PartialOrder"
+by (simp add: PartialOrder_def CompleteLattice_def, fast)
+
+lemmas CL_imp_PO = CL_subset_PO [THEN subsetD]
+
+declare PO.PO_imp_refl_on  [OF PO.intro [OF CL_imp_PO], simp]
+declare PO.PO_imp_sym   [OF PO.intro [OF CL_imp_PO], simp]
+declare PO.PO_imp_trans [OF PO.intro [OF CL_imp_PO], simp]
+
+lemma (in CL) CO_refl_on: "refl_on A r"
+by (rule PO_imp_refl_on)
+
+lemma (in CL) CO_antisym: "antisym r"
+by (rule PO_imp_sym)
+
+lemma (in CL) CO_trans: "trans r"
+by (rule PO_imp_trans)
+
+lemma CompleteLatticeI:
+     "[| po \<in> PartialOrder; (\<forall>S. S \<subseteq> pset po --> (\<exists>L. isLub S po L));
+         (\<forall>S. S \<subseteq> pset po --> (\<exists>G. isGlb S po G))|]
+      ==> po \<in> CompleteLattice"
+apply (unfold CompleteLattice_def, blast)
+done
+
+lemma (in CL) CL_dualCL: "dual cl \<in> CompleteLattice"
+apply (insert cl_co)
+apply (simp add: CompleteLattice_def dual_def)
+apply (fold dual_def)
+apply (simp add: isLub_dual_isGlb [symmetric] isGlb_dual_isLub [symmetric]
+                 dualPO)
+done
+
+lemma (in PO) dualA_iff: "pset (dual cl) = pset cl"
+by (simp add: dual_def)
+
+lemma (in PO) dualr_iff: "((x, y) \<in> (order(dual cl))) = ((y, x) \<in> order cl)"
+by (simp add: dual_def)
+
+lemma (in PO) monotone_dual:
+     "monotone f (pset cl) (order cl) 
+     ==> monotone f (pset (dual cl)) (order(dual cl))"
+by (simp add: monotone_def dualA_iff dualr_iff)
+
+lemma (in PO) interval_dual:
+     "[| x \<in> A; y \<in> A|] ==> interval r x y = interval (order(dual cl)) y x"
+apply (simp add: interval_def dualr_iff)
+apply (fold r_def, fast)
+done
+
+lemma (in PO) interval_not_empty:
+     "[| trans r; interval r a b \<noteq> {} |] ==> (a, b) \<in> r"
+apply (simp add: interval_def)
+apply (unfold trans_def, blast)
+done
+
+lemma (in PO) interval_imp_mem: "x \<in> interval r a b ==> (a, x) \<in> r"
+by (simp add: interval_def)
+
+lemma (in PO) left_in_interval:
+     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |] ==> a \<in> interval r a b"
+apply (simp (no_asm_simp) add: interval_def)
+apply (simp add: PO_imp_trans interval_not_empty)
+apply (simp add: reflE)
+done
+
+lemma (in PO) right_in_interval:
+     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |] ==> b \<in> interval r a b"
+apply (simp (no_asm_simp) add: interval_def)
+apply (simp add: PO_imp_trans interval_not_empty)
+apply (simp add: reflE)
+done
+
+
+subsection {* sublattice *}
+
+lemma (in PO) sublattice_imp_CL:
+     "S <<= cl  ==> (| pset = S, order = induced S r |) \<in> CompleteLattice"
+by (simp add: sublattice_def CompleteLattice_def A_def r_def)
+
+lemma (in CL) sublatticeI:
+     "[| S \<subseteq> A; (| pset = S, order = induced S r |) \<in> CompleteLattice |]
+      ==> S <<= cl"
+by (simp add: sublattice_def A_def r_def)
+
+
+subsection {* lub *}
+
+lemma (in CL) lub_unique: "[| S \<subseteq> A; isLub S cl x; isLub S cl L|] ==> x = L"
+apply (rule antisymE)
+apply (auto simp add: isLub_def r_def)
+done
+
+lemma (in CL) lub_upper: "[|S \<subseteq> A; x \<in> S|] ==> (x, lub S cl) \<in> r"
+apply (rule CL_imp_ex_isLub [THEN exE], assumption)
+apply (unfold lub_def least_def)
+apply (rule some_equality [THEN ssubst])
+  apply (simp add: isLub_def)
+ apply (simp add: lub_unique A_def isLub_def)
+apply (simp add: isLub_def r_def)
+done
+
+lemma (in CL) lub_least:
+     "[| S \<subseteq> A; L \<in> A; \<forall>x \<in> S. (x,L) \<in> r |] ==> (lub S cl, L) \<in> r"
+apply (rule CL_imp_ex_isLub [THEN exE], assumption)
+apply (unfold lub_def least_def)
+apply (rule_tac s=x in some_equality [THEN ssubst])
+  apply (simp add: isLub_def)
+ apply (simp add: lub_unique A_def isLub_def)
+apply (simp add: isLub_def r_def A_def)
+done
+
+lemma (in CL) lub_in_lattice: "S \<subseteq> A ==> lub S cl \<in> A"
+apply (rule CL_imp_ex_isLub [THEN exE], assumption)
+apply (unfold lub_def least_def)
+apply (subst some_equality)
+apply (simp add: isLub_def)
+prefer 2 apply (simp add: isLub_def A_def)
+apply (simp add: lub_unique A_def isLub_def)
+done
+
+lemma (in CL) lubI:
+     "[| S \<subseteq> A; L \<in> A; \<forall>x \<in> S. (x,L) \<in> r;
+         \<forall>z \<in> A. (\<forall>y \<in> S. (y,z) \<in> r) --> (L,z) \<in> r |] ==> L = lub S cl"
+apply (rule lub_unique, assumption)
+apply (simp add: isLub_def A_def r_def)
+apply (unfold isLub_def)
+apply (rule conjI)
+apply (fold A_def r_def)
+apply (rule lub_in_lattice, assumption)
+apply (simp add: lub_upper lub_least)
+done
+
+lemma (in CL) lubIa: "[| S \<subseteq> A; isLub S cl L |] ==> L = lub S cl"
+by (simp add: lubI isLub_def A_def r_def)
+
+lemma (in CL) isLub_in_lattice: "isLub S cl L ==> L \<in> A"
+by (simp add: isLub_def  A_def)
+
+lemma (in CL) isLub_upper: "[|isLub S cl L; y \<in> S|] ==> (y, L) \<in> r"
+by (simp add: isLub_def r_def)
+
+lemma (in CL) isLub_least:
+     "[| isLub S cl L; z \<in> A; \<forall>y \<in> S. (y, z) \<in> r|] ==> (L, z) \<in> r"
+by (simp add: isLub_def A_def r_def)
+
+lemma (in CL) isLubI:
+     "[| L \<in> A; \<forall>y \<in> S. (y, L) \<in> r;
+         (\<forall>z \<in> A. (\<forall>y \<in> S. (y, z):r) --> (L, z) \<in> r)|] ==> isLub S cl L"
+by (simp add: isLub_def A_def r_def)
+
+
+
+subsection {* glb *}
+
+lemma (in CL) glb_in_lattice: "S \<subseteq> A ==> glb S cl \<in> A"
+apply (subst glb_dual_lub)
+apply (simp add: A_def)
+apply (rule dualA_iff [THEN subst])
+apply (rule CL.lub_in_lattice)
+apply (rule CL.intro)
+apply (rule PO.intro)
+apply (rule dualPO)
+apply (rule CL_axioms.intro)
+apply (rule CL_dualCL)
+apply (simp add: dualA_iff)
+done
+
+lemma (in CL) glb_lower: "[|S \<subseteq> A; x \<in> S|] ==> (glb S cl, x) \<in> r"
+apply (subst glb_dual_lub)
+apply (simp add: r_def)
+apply (rule dualr_iff [THEN subst])
+apply (rule CL.lub_upper)
+apply (rule CL.intro)
+apply (rule PO.intro)
+apply (rule dualPO)
+apply (rule CL_axioms.intro)
+apply (rule CL_dualCL)
+apply (simp add: dualA_iff A_def, assumption)
+done
+
+text {*
+  Reduce the sublattice property by using substructural properties;
+  abandoned see @{text "Tarski_4.ML"}.
+*}
+
+declare (in CLF) f_cl [simp]
+
+(*never proved, 2007-01-22: Tarski__CLF_unnamed_lemma
+  NOT PROVABLE because of the conjunction used in the definition: we don't
+  allow reasoning with rules like conjE, which is essential here.*)
+declare [[ atp_problem_prefix = "Tarski__CLF_unnamed_lemma" ]]
+lemma (in CLF) [simp]:
+    "f: pset cl -> pset cl & monotone f (pset cl) (order cl)" 
+apply (insert f_cl)
+apply (unfold CLF_set_def)
+apply (erule SigmaE2) 
+apply (erule CollectE) 
+apply assumption
+done
+
+lemma (in CLF) f_in_funcset: "f \<in> A -> A"
+by (simp add: A_def)
+
+lemma (in CLF) monotone_f: "monotone f A r"
+by (simp add: A_def r_def)
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__CLF_CLF_dual" ]]
+declare (in CLF) CLF_set_def [simp] CL_dualCL [simp] monotone_dual [simp] dualA_iff [simp]
+
+lemma (in CLF) CLF_dual: "(dual cl, f) \<in> CLF_set" 
+apply (simp del: dualA_iff)
+apply (simp)
+done
+
+declare (in CLF) CLF_set_def[simp del] CL_dualCL[simp del] monotone_dual[simp del]
+          dualA_iff[simp del]
+
+
+subsection {* fixed points *}
+
+lemma fix_subset: "fix f A \<subseteq> A"
+by (simp add: fix_def, fast)
+
+lemma fix_imp_eq: "x \<in> fix f A ==> f x = x"
+by (simp add: fix_def)
+
+lemma fixf_subset:
+     "[| A \<subseteq> B; x \<in> fix (%y: A. f y) A |] ==> x \<in> fix f B"
+by (simp add: fix_def, auto)
+
+
+subsection {* lemmas for Tarski, lub *}
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__CLF_lubH_le_flubH" ]]
+  declare CL.lub_least[intro] CLF.f_in_funcset[intro] funcset_mem[intro] CL.lub_in_lattice[intro] PO.transE[intro] PO.monotoneE[intro] CLF.monotone_f[intro] CL.lub_upper[intro] 
+lemma (in CLF) lubH_le_flubH:
+     "H = {x. (x, f x) \<in> r & x \<in> A} ==> (lub H cl, f (lub H cl)) \<in> r"
+apply (rule lub_least, fast)
+apply (rule f_in_funcset [THEN funcset_mem])
+apply (rule lub_in_lattice, fast)
+-- {* @{text "\<forall>x:H. (x, f (lub H r)) \<in> r"} *}
+apply (rule ballI)
+(*never proved, 2007-01-22*)
+using [[ atp_problem_prefix = "Tarski__CLF_lubH_le_flubH_simpler" ]]
+apply (rule transE)
+-- {* instantiates @{text "(x, ?z) \<in> order cl to (x, f x)"}, *}
+-- {* because of the def of @{text H} *}
+apply fast
+-- {* so it remains to show @{text "(f x, f (lub H cl)) \<in> r"} *}
+apply (rule_tac f = "f" in monotoneE)
+apply (rule monotone_f, fast)
+apply (rule lub_in_lattice, fast)
+apply (rule lub_upper, fast)
+apply assumption
+done
+  declare CL.lub_least[rule del] CLF.f_in_funcset[rule del] 
+          funcset_mem[rule del] CL.lub_in_lattice[rule del] 
+          PO.transE[rule del] PO.monotoneE[rule del] 
+          CLF.monotone_f[rule del] CL.lub_upper[rule del] 
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__CLF_flubH_le_lubH" ]]
+  declare CLF.f_in_funcset[intro] funcset_mem[intro] CL.lub_in_lattice[intro]
+       PO.monotoneE[intro] CLF.monotone_f[intro] CL.lub_upper[intro] 
+       CLF.lubH_le_flubH[simp]
+lemma (in CLF) flubH_le_lubH:
+     "[|  H = {x. (x, f x) \<in> r & x \<in> A} |] ==> (f (lub H cl), lub H cl) \<in> r"
+apply (rule lub_upper, fast)
+apply (rule_tac t = "H" in ssubst, assumption)
+apply (rule CollectI)
+apply (rule conjI)
+using [[ atp_problem_prefix = "Tarski__CLF_flubH_le_lubH_simpler" ]]
+(*??no longer terminates, with combinators
+apply (metis CO_refl_on lubH_le_flubH monotone_def monotone_f reflD1 reflD2) 
+*)
+apply (metis CO_refl_on lubH_le_flubH monotoneE [OF monotone_f] refl_onD1 refl_onD2)
+apply (metis CO_refl_on lubH_le_flubH refl_onD2)
+done
+  declare CLF.f_in_funcset[rule del] funcset_mem[rule del] 
+          CL.lub_in_lattice[rule del] PO.monotoneE[rule del] 
+          CLF.monotone_f[rule del] CL.lub_upper[rule del] 
+          CLF.lubH_le_flubH[simp del]
+
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__CLF_lubH_is_fixp" ]]
+(*Single-step version fails. The conjecture clauses refer to local abstraction
+functions (Frees), which prevents expand_defs_tac from removing those 
+"definitions" at the end of the proof. *)
+lemma (in CLF) lubH_is_fixp:
+     "H = {x. (x, f x) \<in> r & x \<in> A} ==> lub H cl \<in> fix f A"
+apply (simp add: fix_def)
+apply (rule conjI)
+proof (neg_clausify)
+assume 0: "H =
+Collect
+ (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r)) (COMBC op \<in> A))"
+assume 1: "lub (Collect
+      (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
+        (COMBC op \<in> A)))
+ cl
+\<notin> A"
+have 2: "lub H cl \<notin> A"
+  by (metis 1 0)
+have 3: "(lub H cl, f (lub H cl)) \<in> r"
+  by (metis lubH_le_flubH 0)
+have 4: "(f (lub H cl), lub H cl) \<in> r"
+  by (metis flubH_le_lubH 0)
+have 5: "lub H cl = f (lub H cl) \<or> (lub H cl, f (lub H cl)) \<notin> r"
+  by (metis antisymE 4)
+have 6: "lub H cl = f (lub H cl)"
+  by (metis 5 3)
+have 7: "(lub H cl, lub H cl) \<in> r"
+  by (metis 6 4)
+have 8: "\<And>X1. lub H cl \<in> X1 \<or> \<not> refl_on X1 r"
+  by (metis 7 refl_onD2)
+have 9: "\<not> refl_on A r"
+  by (metis 8 2)
+show "False"
+  by (metis CO_refl_on 9);
+next --{*apparently the way to insert a second structured proof*}
+  show "H = {x. (x, f x) \<in> r \<and> x \<in> A} \<Longrightarrow>
+  f (lub {x. (x, f x) \<in> r \<and> x \<in> A} cl) = lub {x. (x, f x) \<in> r \<and> x \<in> A} cl"
+  proof (neg_clausify)
+  assume 0: "H =
+  Collect
+   (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r)) (COMBC op \<in> A))"
+  assume 1: "f (lub (Collect
+           (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
+             (COMBC op \<in> A)))
+      cl) \<noteq>
+  lub (Collect
+        (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
+          (COMBC op \<in> A)))
+   cl"
+  have 2: "f (lub H cl) \<noteq>
+  lub (Collect
+        (COMBS (COMBB op \<and> (COMBC (COMBB op \<in> (COMBS Pair f)) r))
+          (COMBC op \<in> A)))
+   cl"
+    by (metis 1 0)
+  have 3: "f (lub H cl) \<noteq> lub H cl"
+    by (metis 2 0)
+  have 4: "(lub H cl, f (lub H cl)) \<in> r"
+    by (metis lubH_le_flubH 0)
+  have 5: "(f (lub H cl), lub H cl) \<in> r"
+    by (metis flubH_le_lubH 0)
+  have 6: "lub H cl = f (lub H cl) \<or> (lub H cl, f (lub H cl)) \<notin> r"
+    by (metis antisymE 5)
+  have 7: "lub H cl = f (lub H cl)"
+    by (metis 6 4)
+  show "False"
+    by (metis 3 7)
+  qed
+qed
+
+lemma (in CLF) (*lubH_is_fixp:*)
+     "H = {x. (x, f x) \<in> r & x \<in> A} ==> lub H cl \<in> fix f A"
+apply (simp add: fix_def)
+apply (rule conjI)
+using [[ atp_problem_prefix = "Tarski__CLF_lubH_is_fixp_simpler" ]]
+apply (metis CO_refl_on lubH_le_flubH refl_onD1)
+apply (metis antisymE flubH_le_lubH lubH_le_flubH)
+done
+
+lemma (in CLF) fix_in_H:
+     "[| H = {x. (x, f x) \<in> r & x \<in> A};  x \<in> P |] ==> x \<in> H"
+by (simp add: P_def fix_imp_eq [of _ f A] reflE CO_refl_on
+                    fix_subset [of f A, THEN subsetD])
+
+
+lemma (in CLF) fixf_le_lubH:
+     "H = {x. (x, f x) \<in> r & x \<in> A} ==> \<forall>x \<in> fix f A. (x, lub H cl) \<in> r"
+apply (rule ballI)
+apply (rule lub_upper, fast)
+apply (rule fix_in_H)
+apply (simp_all add: P_def)
+done
+
+declare [[ atp_problem_prefix = "Tarski__CLF_lubH_least_fixf" ]]
+lemma (in CLF) lubH_least_fixf:
+     "H = {x. (x, f x) \<in> r & x \<in> A}
+      ==> \<forall>L. (\<forall>y \<in> fix f A. (y,L) \<in> r) --> (lub H cl, L) \<in> r"
+apply (metis P_def lubH_is_fixp)
+done
+
+subsection {* Tarski fixpoint theorem 1, first part *}
+declare [[ atp_problem_prefix = "Tarski__CLF_T_thm_1_lub" ]]
+  declare CL.lubI[intro] fix_subset[intro] CL.lub_in_lattice[intro] 
+          CLF.fixf_le_lubH[simp] CLF.lubH_least_fixf[simp]
+lemma (in CLF) T_thm_1_lub: "lub P cl = lub {x. (x, f x) \<in> r & x \<in> A} cl"
+(*sledgehammer;*)
+apply (rule sym)
+apply (simp add: P_def)
+apply (rule lubI)
+using [[ atp_problem_prefix = "Tarski__CLF_T_thm_1_lub_simpler" ]]
+apply (metis P_def fix_subset) 
+apply (metis Collect_conj_eq Collect_mem_eq Int_commute Int_lower1 lub_in_lattice vimage_def)
+(*??no longer terminates, with combinators
+apply (metis P_def fix_def fixf_le_lubH)
+apply (metis P_def fix_def lubH_least_fixf)
+*)
+apply (simp add: fixf_le_lubH)
+apply (simp add: lubH_least_fixf)
+done
+  declare CL.lubI[rule del] fix_subset[rule del] CL.lub_in_lattice[rule del] 
+          CLF.fixf_le_lubH[simp del] CLF.lubH_least_fixf[simp del]
+
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__CLF_glbH_is_fixp" ]]
+  declare glb_dual_lub[simp] PO.dualA_iff[intro] CLF.lubH_is_fixp[intro] 
+          PO.dualPO[intro] CL.CL_dualCL[intro] PO.dualr_iff[simp]
+lemma (in CLF) glbH_is_fixp: "H = {x. (f x, x) \<in> r & x \<in> A} ==> glb H cl \<in> P"
+  -- {* Tarski for glb *}
+(*sledgehammer;*)
+apply (simp add: glb_dual_lub P_def A_def r_def)
+apply (rule dualA_iff [THEN subst])
+apply (rule CLF.lubH_is_fixp)
+apply (rule CLF.intro)
+apply (rule CL.intro)
+apply (rule PO.intro)
+apply (rule dualPO)
+apply (rule CL_axioms.intro)
+apply (rule CL_dualCL)
+apply (rule CLF_axioms.intro)
+apply (rule CLF_dual)
+apply (simp add: dualr_iff dualA_iff)
+done
+  declare glb_dual_lub[simp del] PO.dualA_iff[rule del] CLF.lubH_is_fixp[rule del] 
+          PO.dualPO[rule del] CL.CL_dualCL[rule del] PO.dualr_iff[simp del]
+
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__T_thm_1_glb" ]]  (*ALL THEOREMS*)
+lemma (in CLF) T_thm_1_glb: "glb P cl = glb {x. (f x, x) \<in> r & x \<in> A} cl"
+(*sledgehammer;*)
+apply (simp add: glb_dual_lub P_def A_def r_def)
+apply (rule dualA_iff [THEN subst])
+(*never proved, 2007-01-22*)
+using [[ atp_problem_prefix = "Tarski__T_thm_1_glb_simpler" ]]  (*ALL THEOREMS*)
+(*sledgehammer;*)
+apply (simp add: CLF.T_thm_1_lub [of _ f, OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro,
+  OF dualPO CL_dualCL] dualPO CL_dualCL CLF_dual dualr_iff)
+done
+
+subsection {* interval *}
+
+
+declare [[ atp_problem_prefix = "Tarski__rel_imp_elem" ]]
+  declare (in CLF) CO_refl_on[simp] refl_on_def [simp]
+lemma (in CLF) rel_imp_elem: "(x, y) \<in> r ==> x \<in> A"
+by (metis CO_refl_on refl_onD1)
+  declare (in CLF) CO_refl_on[simp del]  refl_on_def [simp del]
+
+declare [[ atp_problem_prefix = "Tarski__interval_subset" ]]
+  declare (in CLF) rel_imp_elem[intro] 
+  declare interval_def [simp]
+lemma (in CLF) interval_subset: "[| a \<in> A; b \<in> A |] ==> interval r a b \<subseteq> A"
+by (metis CO_refl_on interval_imp_mem refl_onD refl_onD2 rel_imp_elem subset_eq)
+  declare (in CLF) rel_imp_elem[rule del] 
+  declare interval_def [simp del]
+
+
+lemma (in CLF) intervalI:
+     "[| (a, x) \<in> r; (x, b) \<in> r |] ==> x \<in> interval r a b"
+by (simp add: interval_def)
+
+lemma (in CLF) interval_lemma1:
+     "[| S \<subseteq> interval r a b; x \<in> S |] ==> (a, x) \<in> r"
+by (unfold interval_def, fast)
+
+lemma (in CLF) interval_lemma2:
+     "[| S \<subseteq> interval r a b; x \<in> S |] ==> (x, b) \<in> r"
+by (unfold interval_def, fast)
+
+lemma (in CLF) a_less_lub:
+     "[| S \<subseteq> A; S \<noteq> {};
+         \<forall>x \<in> S. (a,x) \<in> r; \<forall>y \<in> S. (y, L) \<in> r |] ==> (a,L) \<in> r"
+by (blast intro: transE)
+
+lemma (in CLF) glb_less_b:
+     "[| S \<subseteq> A; S \<noteq> {};
+         \<forall>x \<in> S. (x,b) \<in> r; \<forall>y \<in> S. (G, y) \<in> r |] ==> (G,b) \<in> r"
+by (blast intro: transE)
+
+lemma (in CLF) S_intv_cl:
+     "[| a \<in> A; b \<in> A; S \<subseteq> interval r a b |]==> S \<subseteq> A"
+by (simp add: subset_trans [OF _ interval_subset])
+
+declare [[ atp_problem_prefix = "Tarski__L_in_interval" ]]  (*ALL THEOREMS*)
+lemma (in CLF) L_in_interval:
+     "[| a \<in> A; b \<in> A; S \<subseteq> interval r a b;
+         S \<noteq> {}; isLub S cl L; interval r a b \<noteq> {} |] ==> L \<in> interval r a b" 
+(*WON'T TERMINATE
+apply (metis CO_trans intervalI interval_lemma1 interval_lemma2 isLub_least isLub_upper subset_empty subset_iff trans_def)
+*)
+apply (rule intervalI)
+apply (rule a_less_lub)
+prefer 2 apply assumption
+apply (simp add: S_intv_cl)
+apply (rule ballI)
+apply (simp add: interval_lemma1)
+apply (simp add: isLub_upper)
+-- {* @{text "(L, b) \<in> r"} *}
+apply (simp add: isLub_least interval_lemma2)
+done
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__G_in_interval" ]]  (*ALL THEOREMS*)
+lemma (in CLF) G_in_interval:
+     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {}; S \<subseteq> interval r a b; isGlb S cl G;
+         S \<noteq> {} |] ==> G \<in> interval r a b"
+apply (simp add: interval_dual)
+apply (simp add: CLF.L_in_interval [of _ f, OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro]
+                 dualA_iff A_def dualPO CL_dualCL CLF_dual isGlb_dual_isLub)
+done
+
+declare [[ atp_problem_prefix = "Tarski__intervalPO" ]]  (*ALL THEOREMS*)
+lemma (in CLF) intervalPO:
+     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
+      ==> (| pset = interval r a b, order = induced (interval r a b) r |)
+          \<in> PartialOrder"
+proof (neg_clausify)
+assume 0: "a \<in> A"
+assume 1: "b \<in> A"
+assume 2: "\<lparr>pset = interval r a b, order = induced (interval r a b) r\<rparr> \<notin> PartialOrder"
+have 3: "\<not> interval r a b \<subseteq> A"
+  by (metis 2 po_subset_po)
+have 4: "b \<notin> A \<or> a \<notin> A"
+  by (metis 3 interval_subset)
+have 5: "a \<notin> A"
+  by (metis 4 1)
+show "False"
+  by (metis 5 0)
+qed
+
+lemma (in CLF) intv_CL_lub:
+ "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
+  ==> \<forall>S. S \<subseteq> interval r a b -->
+          (\<exists>L. isLub S (| pset = interval r a b,
+                          order = induced (interval r a b) r |)  L)"
+apply (intro strip)
+apply (frule S_intv_cl [THEN CL_imp_ex_isLub])
+prefer 2 apply assumption
+apply assumption
+apply (erule exE)
+-- {* define the lub for the interval as *}
+apply (rule_tac x = "if S = {} then a else L" in exI)
+apply (simp (no_asm_simp) add: isLub_def split del: split_if)
+apply (intro impI conjI)
+-- {* @{text "(if S = {} then a else L) \<in> interval r a b"} *}
+apply (simp add: CL_imp_PO L_in_interval)
+apply (simp add: left_in_interval)
+-- {* lub prop 1 *}
+apply (case_tac "S = {}")
+-- {* @{text "S = {}, y \<in> S = False => everything"} *}
+apply fast
+-- {* @{text "S \<noteq> {}"} *}
+apply simp
+-- {* @{text "\<forall>y:S. (y, L) \<in> induced (interval r a b) r"} *}
+apply (rule ballI)
+apply (simp add: induced_def  L_in_interval)
+apply (rule conjI)
+apply (rule subsetD)
+apply (simp add: S_intv_cl, assumption)
+apply (simp add: isLub_upper)
+-- {* @{text "\<forall>z:interval r a b. (\<forall>y:S. (y, z) \<in> induced (interval r a b) r \<longrightarrow> (if S = {} then a else L, z) \<in> induced (interval r a b) r"} *}
+apply (rule ballI)
+apply (rule impI)
+apply (case_tac "S = {}")
+-- {* @{text "S = {}"} *}
+apply simp
+apply (simp add: induced_def  interval_def)
+apply (rule conjI)
+apply (rule reflE, assumption)
+apply (rule interval_not_empty)
+apply (rule CO_trans)
+apply (simp add: interval_def)
+-- {* @{text "S \<noteq> {}"} *}
+apply simp
+apply (simp add: induced_def  L_in_interval)
+apply (rule isLub_least, assumption)
+apply (rule subsetD)
+prefer 2 apply assumption
+apply (simp add: S_intv_cl, fast)
+done
+
+lemmas (in CLF) intv_CL_glb = intv_CL_lub [THEN Rdual]
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__interval_is_sublattice" ]]  (*ALL THEOREMS*)
+lemma (in CLF) interval_is_sublattice:
+     "[| a \<in> A; b \<in> A; interval r a b \<noteq> {} |]
+        ==> interval r a b <<= cl"
+(*sledgehammer *)
+apply (rule sublatticeI)
+apply (simp add: interval_subset)
+(*never proved, 2007-01-22*)
+using [[ atp_problem_prefix = "Tarski__interval_is_sublattice_simpler" ]]
+(*sledgehammer *)
+apply (rule CompleteLatticeI)
+apply (simp add: intervalPO)
+ apply (simp add: intv_CL_lub)
+apply (simp add: intv_CL_glb)
+done
+
+lemmas (in CLF) interv_is_compl_latt =
+    interval_is_sublattice [THEN sublattice_imp_CL]
+
+
+subsection {* Top and Bottom *}
+lemma (in CLF) Top_dual_Bot: "Top cl = Bot (dual cl)"
+by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff)
+
+lemma (in CLF) Bot_dual_Top: "Bot cl = Top (dual cl)"
+by (simp add: Top_def Bot_def least_def greatest_def dualA_iff dualr_iff)
+
+declare [[ atp_problem_prefix = "Tarski__Bot_in_lattice" ]]  (*ALL THEOREMS*)
+lemma (in CLF) Bot_in_lattice: "Bot cl \<in> A"
+(*sledgehammer; *)
+apply (simp add: Bot_def least_def)
+apply (rule_tac a="glb A cl" in someI2)
+apply (simp_all add: glb_in_lattice glb_lower 
+                     r_def [symmetric] A_def [symmetric])
+done
+
+(*first proved 2007-01-25 after relaxing relevance*)
+declare [[ atp_problem_prefix = "Tarski__Top_in_lattice" ]]  (*ALL THEOREMS*)
+lemma (in CLF) Top_in_lattice: "Top cl \<in> A"
+(*sledgehammer;*)
+apply (simp add: Top_dual_Bot A_def)
+(*first proved 2007-01-25 after relaxing relevance*)
+using [[ atp_problem_prefix = "Tarski__Top_in_lattice_simpler" ]]  (*ALL THEOREMS*)
+(*sledgehammer*)
+apply (rule dualA_iff [THEN subst])
+apply (blast intro!: CLF.Bot_in_lattice [OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro] dualPO CL_dualCL CLF_dual)
+done
+
+lemma (in CLF) Top_prop: "x \<in> A ==> (x, Top cl) \<in> r"
+apply (simp add: Top_def greatest_def)
+apply (rule_tac a="lub A cl" in someI2)
+apply (rule someI2)
+apply (simp_all add: lub_in_lattice lub_upper 
+                     r_def [symmetric] A_def [symmetric])
+done
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__Bot_prop" ]]  (*ALL THEOREMS*) 
+lemma (in CLF) Bot_prop: "x \<in> A ==> (Bot cl, x) \<in> r"
+(*sledgehammer*) 
+apply (simp add: Bot_dual_Top r_def)
+apply (rule dualr_iff [THEN subst])
+apply (simp add: CLF.Top_prop [of _ f, OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro]
+                 dualA_iff A_def dualPO CL_dualCL CLF_dual)
+done
+
+declare [[ atp_problem_prefix = "Tarski__Bot_in_lattice" ]]  (*ALL THEOREMS*)
+lemma (in CLF) Top_intv_not_empty: "x \<in> A  ==> interval r x (Top cl) \<noteq> {}" 
+apply (metis Top_in_lattice Top_prop empty_iff intervalI reflE)
+done
+
+declare [[ atp_problem_prefix = "Tarski__Bot_intv_not_empty" ]]  (*ALL THEOREMS*)
+lemma (in CLF) Bot_intv_not_empty: "x \<in> A ==> interval r (Bot cl) x \<noteq> {}" 
+apply (metis Bot_prop ex_in_conv intervalI reflE rel_imp_elem)
+done
+
+
+subsection {* fixed points form a partial order *}
+
+lemma (in CLF) fixf_po: "(| pset = P, order = induced P r|) \<in> PartialOrder"
+by (simp add: P_def fix_subset po_subset_po)
+
+(*first proved 2007-01-25 after relaxing relevance*)
+declare [[ atp_problem_prefix = "Tarski__Y_subset_A" ]]
+  declare (in Tarski) P_def[simp] Y_ss [simp]
+  declare fix_subset [intro] subset_trans [intro]
+lemma (in Tarski) Y_subset_A: "Y \<subseteq> A"
+(*sledgehammer*) 
+apply (rule subset_trans [OF _ fix_subset])
+apply (rule Y_ss [simplified P_def])
+done
+  declare (in Tarski) P_def[simp del] Y_ss [simp del]
+  declare fix_subset [rule del] subset_trans [rule del]
+
+
+lemma (in Tarski) lubY_in_A: "lub Y cl \<in> A"
+  by (rule Y_subset_A [THEN lub_in_lattice])
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__lubY_le_flubY" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) lubY_le_flubY: "(lub Y cl, f (lub Y cl)) \<in> r"
+(*sledgehammer*) 
+apply (rule lub_least)
+apply (rule Y_subset_A)
+apply (rule f_in_funcset [THEN funcset_mem])
+apply (rule lubY_in_A)
+-- {* @{text "Y \<subseteq> P ==> f x = x"} *}
+apply (rule ballI)
+using [[ atp_problem_prefix = "Tarski__lubY_le_flubY_simpler" ]]  (*ALL THEOREMS*)
+(*sledgehammer *)
+apply (rule_tac t = "x" in fix_imp_eq [THEN subst])
+apply (erule Y_ss [simplified P_def, THEN subsetD])
+-- {* @{text "reduce (f x, f (lub Y cl)) \<in> r to (x, lub Y cl) \<in> r"} by monotonicity *}
+using [[ atp_problem_prefix = "Tarski__lubY_le_flubY_simplest" ]]  (*ALL THEOREMS*)
+(*sledgehammer*)
+apply (rule_tac f = "f" in monotoneE)
+apply (rule monotone_f)
+apply (simp add: Y_subset_A [THEN subsetD])
+apply (rule lubY_in_A)
+apply (simp add: lub_upper Y_subset_A)
+done
+
+(*first proved 2007-01-25 after relaxing relevance*)
+declare [[ atp_problem_prefix = "Tarski__intY1_subset" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) intY1_subset: "intY1 \<subseteq> A"
+(*sledgehammer*) 
+apply (unfold intY1_def)
+apply (rule interval_subset)
+apply (rule lubY_in_A)
+apply (rule Top_in_lattice)
+done
+
+lemmas (in Tarski) intY1_elem = intY1_subset [THEN subsetD]
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__intY1_f_closed" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) intY1_f_closed: "x \<in> intY1 \<Longrightarrow> f x \<in> intY1"
+(*sledgehammer*) 
+apply (simp add: intY1_def  interval_def)
+apply (rule conjI)
+apply (rule transE)
+apply (rule lubY_le_flubY)
+-- {* @{text "(f (lub Y cl), f x) \<in> r"} *}
+using [[ atp_problem_prefix = "Tarski__intY1_f_closed_simpler" ]]  (*ALL THEOREMS*)
+(*sledgehammer [has been proved before now...]*)
+apply (rule_tac f=f in monotoneE)
+apply (rule monotone_f)
+apply (rule lubY_in_A)
+apply (simp add: intY1_def interval_def  intY1_elem)
+apply (simp add: intY1_def  interval_def)
+-- {* @{text "(f x, Top cl) \<in> r"} *} 
+apply (rule Top_prop)
+apply (rule f_in_funcset [THEN funcset_mem])
+apply (simp add: intY1_def interval_def  intY1_elem)
+done
+
+declare [[ atp_problem_prefix = "Tarski__intY1_func" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) intY1_func: "(%x: intY1. f x) \<in> intY1 -> intY1"
+apply (rule restrict_in_funcset)
+apply (metis intY1_f_closed restrict_in_funcset)
+done
+
+declare [[ atp_problem_prefix = "Tarski__intY1_mono" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) intY1_mono:
+     "monotone (%x: intY1. f x) intY1 (induced intY1 r)"
+(*sledgehammer *)
+apply (auto simp add: monotone_def induced_def intY1_f_closed)
+apply (blast intro: intY1_elem monotone_f [THEN monotoneE])
+done
+
+(*proof requires relaxing relevance: 2007-01-25*)
+declare [[ atp_problem_prefix = "Tarski__intY1_is_cl" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) intY1_is_cl:
+    "(| pset = intY1, order = induced intY1 r |) \<in> CompleteLattice"
+(*sledgehammer*) 
+apply (unfold intY1_def)
+apply (rule interv_is_compl_latt)
+apply (rule lubY_in_A)
+apply (rule Top_in_lattice)
+apply (rule Top_intv_not_empty)
+apply (rule lubY_in_A)
+done
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__v_in_P" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) v_in_P: "v \<in> P"
+(*sledgehammer*) 
+apply (unfold P_def)
+apply (rule_tac A = "intY1" in fixf_subset)
+apply (rule intY1_subset)
+apply (simp add: CLF.glbH_is_fixp [OF CLF.intro, OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro, OF _ intY1_is_cl, simplified]
+                 v_def CL_imp_PO intY1_is_cl CLF_set_def intY1_func intY1_mono)
+done
+
+declare [[ atp_problem_prefix = "Tarski__z_in_interval" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) z_in_interval:
+     "[| z \<in> P; \<forall>y\<in>Y. (y, z) \<in> induced P r |] ==> z \<in> intY1"
+(*sledgehammer *)
+apply (unfold intY1_def P_def)
+apply (rule intervalI)
+prefer 2
+ apply (erule fix_subset [THEN subsetD, THEN Top_prop])
+apply (rule lub_least)
+apply (rule Y_subset_A)
+apply (fast elim!: fix_subset [THEN subsetD])
+apply (simp add: induced_def)
+done
+
+declare [[ atp_problem_prefix = "Tarski__fz_in_int_rel" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) f'z_in_int_rel: "[| z \<in> P; \<forall>y\<in>Y. (y, z) \<in> induced P r |]
+      ==> ((%x: intY1. f x) z, z) \<in> induced intY1 r" 
+apply (metis P_def acc_def fix_imp_eq fix_subset indI reflE restrict_apply subset_eq z_in_interval)
+done
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__tarski_full_lemma" ]]  (*ALL THEOREMS*)
+lemma (in Tarski) tarski_full_lemma:
+     "\<exists>L. isLub Y (| pset = P, order = induced P r |) L"
+apply (rule_tac x = "v" in exI)
+apply (simp add: isLub_def)
+-- {* @{text "v \<in> P"} *}
+apply (simp add: v_in_P)
+apply (rule conjI)
+(*sledgehammer*) 
+-- {* @{text v} is lub *}
+-- {* @{text "1. \<forall>y:Y. (y, v) \<in> induced P r"} *}
+apply (rule ballI)
+apply (simp add: induced_def subsetD v_in_P)
+apply (rule conjI)
+apply (erule Y_ss [THEN subsetD])
+apply (rule_tac b = "lub Y cl" in transE)
+apply (rule lub_upper)
+apply (rule Y_subset_A, assumption)
+apply (rule_tac b = "Top cl" in interval_imp_mem)
+apply (simp add: v_def)
+apply (fold intY1_def)
+apply (rule CL.glb_in_lattice [OF CL.intro, OF PO.intro CL_axioms.intro, OF _ intY1_is_cl, simplified])
+ apply (simp add: CL_imp_PO intY1_is_cl, force)
+-- {* @{text v} is LEAST ub *}
+apply clarify
+apply (rule indI)
+  prefer 3 apply assumption
+ prefer 2 apply (simp add: v_in_P)
+apply (unfold v_def)
+(*never proved, 2007-01-22*)
+using [[ atp_problem_prefix = "Tarski__tarski_full_lemma_simpler" ]]
+(*sledgehammer*) 
+apply (rule indE)
+apply (rule_tac [2] intY1_subset)
+(*never proved, 2007-01-22*)
+using [[ atp_problem_prefix = "Tarski__tarski_full_lemma_simplest" ]]
+(*sledgehammer*) 
+apply (rule CL.glb_lower [OF CL.intro, OF PO.intro CL_axioms.intro, OF _ intY1_is_cl, simplified])
+  apply (simp add: CL_imp_PO intY1_is_cl)
+ apply force
+apply (simp add: induced_def intY1_f_closed z_in_interval)
+apply (simp add: P_def fix_imp_eq [of _ f A] reflE
+                 fix_subset [of f A, THEN subsetD])
+done
+
+lemma CompleteLatticeI_simp:
+     "[| (| pset = A, order = r |) \<in> PartialOrder;
+         \<forall>S. S \<subseteq> A --> (\<exists>L. isLub S (| pset = A, order = r |)  L) |]
+    ==> (| pset = A, order = r |) \<in> CompleteLattice"
+by (simp add: CompleteLatticeI Rdual)
+
+
+(*never proved, 2007-01-22*)
+declare [[ atp_problem_prefix = "Tarski__Tarski_full" ]]
+  declare (in CLF) fixf_po[intro] P_def [simp] A_def [simp] r_def [simp]
+               Tarski.tarski_full_lemma [intro] cl_po [intro] cl_co [intro]
+               CompleteLatticeI_simp [intro]
+theorem (in CLF) Tarski_full:
+     "(| pset = P, order = induced P r|) \<in> CompleteLattice"
+(*sledgehammer*) 
+apply (rule CompleteLatticeI_simp)
+apply (rule fixf_po, clarify)
+(*never proved, 2007-01-22*)
+using [[ atp_problem_prefix = "Tarski__Tarski_full_simpler" ]]
+(*sledgehammer*) 
+apply (simp add: P_def A_def r_def)
+apply (blast intro!: Tarski.tarski_full_lemma [OF Tarski.intro, OF CLF.intro Tarski_axioms.intro,
+  OF CL.intro CLF_axioms.intro, OF PO.intro CL_axioms.intro] cl_po cl_co f_cl)
+done
+  declare (in CLF) fixf_po[rule del] P_def [simp del] A_def [simp del] r_def [simp del]
+         Tarski.tarski_full_lemma [rule del] cl_po [rule del] cl_co [rule del]
+         CompleteLatticeI_simp [rule del]
+
+
+end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/TransClosure.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/TransClosure.thy	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,62 @@
+(*  Title:      HOL/MetisTest/TransClosure.thy
+    ID:         $Id$
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method
+*)
+
+theory TransClosure
+imports Main
+begin
+
+types addr = nat
+
+datatype val
+  = Unit        -- "dummy result value of void expressions"
+  | Null        -- "null reference"
+  | Bool bool   -- "Boolean value"
+  | Intg int    -- "integer value" 
+  | Addr addr   -- "addresses of objects in the heap"
+
+consts R::"(addr \<times> addr) set"
+
+consts f:: "addr \<Rightarrow> val"
+
+declare [[ atp_problem_prefix = "TransClosure__test" ]]
+lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
+   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"  
+by (metis Transitive_Closure.rtrancl_into_rtrancl converse_rtranclE trancl_reflcl)
+
+lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
+   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"
+proof (neg_clausify)
+assume 0: "f c = Intg x"
+assume 1: "(a, b) \<in> R\<^sup>*"
+assume 2: "(b, c) \<in> R\<^sup>*"
+assume 3: "f b \<noteq> Intg x"
+assume 4: "\<And>A. (b, A) \<notin> R \<or> (a, A) \<notin> R\<^sup>*"
+have 5: "b = c \<or> b \<in> Domain R"
+  by (metis Not_Domain_rtrancl 2)
+have 6: "\<And>X1. (a, X1) \<in> R\<^sup>* \<or> (b, X1) \<notin> R"
+  by (metis Transitive_Closure.rtrancl_into_rtrancl 1)
+have 7: "\<And>X1. (b, X1) \<notin> R"
+  by (metis 6 4)
+have 8: "b \<notin> Domain R"
+  by (metis 7 DomainE)
+have 9: "c = b"
+  by (metis 5 8)
+have 10: "f b = Intg x"
+  by (metis 0 9)
+show "False"
+  by (metis 10 3)
+qed
+
+declare [[ atp_problem_prefix = "TransClosure__test_simpler" ]]
+lemma "\<lbrakk> f c = Intg x; \<forall> y. f b = Intg y \<longrightarrow> y \<noteq> x; (a,b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>* \<rbrakk> 
+   \<Longrightarrow> \<exists> c. (b,c) \<in> R \<and> (a,c) \<in> R\<^sup>*"
+apply (erule_tac x="b" in converse_rtranclE)
+apply (metis rel_pow_0_E rel_pow_0_I)
+apply (metis DomainE Domain_iff Transitive_Closure.rtrancl_into_rtrancl)
+done
+
+end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Metis_Examples/set.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Metis_Examples/set.thy	Tue Oct 20 19:52:04 2009 +0200
@@ -0,0 +1,283 @@
+(*  Title:      HOL/Metis_Examples/set.thy
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+
+Testing the metis method.
+*)
+
+theory set
+imports Main
+begin
+
+lemma "EX x X. ALL y. EX z Z. (~P(y,y) | P(x,x) | ~S(z,x)) &
+               (S(x,y) | ~S(y,z) | Q(Z,Z))  &
+               (Q(X,y) | ~Q(y,Z) | S(X,X))" 
+by metis
+(*??But metis can't prove the single-step version...*)
+
+
+
+lemma "P(n::nat) ==> ~P(0) ==> n ~= 0"
+by metis
+
+declare [[sledgehammer_modulus = 1]]
+
+
+(*multiple versions of this example*)
+lemma (*equal_union: *)
+   "(X = Y \<union> Z) =
+    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
+proof (neg_clausify)
+fix x
+assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
+assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
+assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
+have 6: "sup Y Z = X \<or> Y \<subseteq> X"
+  by (metis 0)
+have 7: "sup Y Z = X \<or> Z \<subseteq> X"
+  by (metis 1)
+have 8: "\<And>X3. sup Y Z = X \<or> X \<subseteq> X3 \<or> \<not> Y \<subseteq> X3 \<or> \<not> Z \<subseteq> X3"
+  by (metis 5)
+have 9: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
+  by (metis 2)
+have 10: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
+  by (metis 3)
+have 11: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
+  by (metis 4)
+have 12: "Z \<subseteq> X"
+  by (metis Un_upper2 7)
+have 13: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
+  by (metis 8 Un_upper2)
+have 14: "Y \<subseteq> X"
+  by (metis Un_upper1 6)
+have 15: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis 10 12)
+have 16: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis 9 12)
+have 17: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X"
+  by (metis 11 12)
+have 18: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x"
+  by (metis 17 14)
+have 19: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
+  by (metis 15 14)
+have 20: "Y \<subseteq> x \<or> sup Y Z \<noteq> X"
+  by (metis 16 14)
+have 21: "sup Y Z = X \<or> X \<subseteq> sup Y Z"
+  by (metis 13 Un_upper1)
+have 22: "sup Y Z = X \<or> \<not> sup Y Z \<subseteq> X"
+  by (metis equalityI 21)
+have 23: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis 22 Un_least)
+have 24: "sup Y Z = X \<or> \<not> Y \<subseteq> X"
+  by (metis 23 12)
+have 25: "sup Y Z = X"
+  by (metis 24 14)
+have 26: "\<And>X3. X \<subseteq> X3 \<or> \<not> Z \<subseteq> X3 \<or> \<not> Y \<subseteq> X3"
+  by (metis Un_least 25)
+have 27: "Y \<subseteq> x"
+  by (metis 20 25)
+have 28: "Z \<subseteq> x"
+  by (metis 19 25)
+have 29: "\<not> X \<subseteq> x"
+  by (metis 18 25)
+have 30: "X \<subseteq> x \<or> \<not> Y \<subseteq> x"
+  by (metis 26 28)
+have 31: "X \<subseteq> x"
+  by (metis 30 27)
+show "False"
+  by (metis 31 29)
+qed
+
+declare [[sledgehammer_modulus = 2]]
+
+lemma (*equal_union: *)
+   "(X = Y \<union> Z) =
+    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
+proof (neg_clausify)
+fix x
+assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
+assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
+assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
+have 6: "sup Y Z = X \<or> Y \<subseteq> X"
+  by (metis 0)
+have 7: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
+  by (metis 2)
+have 8: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
+  by (metis 4)
+have 9: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
+  by (metis 5 Un_upper2)
+have 10: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis 3 Un_upper2)
+have 11: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X"
+  by (metis 8 Un_upper2)
+have 12: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
+  by (metis 10 Un_upper1)
+have 13: "sup Y Z = X \<or> X \<subseteq> sup Y Z"
+  by (metis 9 Un_upper1)
+have 14: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis equalityI 13 Un_least)
+have 15: "sup Y Z = X"
+  by (metis 14 1 6)
+have 16: "Y \<subseteq> x"
+  by (metis 7 Un_upper2 Un_upper1 15)
+have 17: "\<not> X \<subseteq> x"
+  by (metis 11 Un_upper1 15)
+have 18: "X \<subseteq> x"
+  by (metis Un_least 15 12 15 16)
+show "False"
+  by (metis 18 17)
+qed
+
+declare [[sledgehammer_modulus = 3]]
+
+lemma (*equal_union: *)
+   "(X = Y \<union> Z) =
+    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
+proof (neg_clausify)
+fix x
+assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
+assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
+assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
+have 6: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
+  by (metis 3)
+have 7: "\<And>X3. sup Y Z = X \<or> X \<subseteq> sup X3 Z \<or> \<not> Y \<subseteq> sup X3 Z"
+  by (metis 5 Un_upper2)
+have 8: "Y \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis 2 Un_upper2)
+have 9: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
+  by (metis 6 Un_upper2 Un_upper1)
+have 10: "sup Y Z = X \<or> \<not> sup Y Z \<subseteq> X"
+  by (metis equalityI 7 Un_upper1)
+have 11: "sup Y Z = X"
+  by (metis 10 Un_least 1 0)
+have 12: "Z \<subseteq> x"
+  by (metis 9 11)
+have 13: "X \<subseteq> x"
+  by (metis Un_least 11 12 8 Un_upper1 11)
+show "False"
+  by (metis 13 4 Un_upper2 Un_upper1 11)
+qed
+
+(*Example included in TPHOLs paper*)
+
+declare [[sledgehammer_modulus = 4]]
+
+lemma (*equal_union: *)
+   "(X = Y \<union> Z) =
+    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
+proof (neg_clausify)
+fix x
+assume 0: "Y \<subseteq> X \<or> X = Y \<union> Z"
+assume 1: "Z \<subseteq> X \<or> X = Y \<union> Z"
+assume 2: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Y \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 3: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> Z \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 4: "(\<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X \<or> \<not> X \<subseteq> x) \<or> X \<noteq> Y \<union> Z"
+assume 5: "\<And>V. ((\<not> Y \<subseteq> V \<or> \<not> Z \<subseteq> V) \<or> X \<subseteq> V) \<or> X = Y \<union> Z"
+have 6: "sup Y Z \<noteq> X \<or> \<not> X \<subseteq> x \<or> \<not> Y \<subseteq> X \<or> \<not> Z \<subseteq> X"
+  by (metis 4)
+have 7: "Z \<subseteq> x \<or> sup Y Z \<noteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis 3 Un_upper2)
+have 8: "Z \<subseteq> x \<or> sup Y Z \<noteq> X"
+  by (metis 7 Un_upper1)
+have 9: "sup Y Z = X \<or> \<not> Z \<subseteq> X \<or> \<not> Y \<subseteq> X"
+  by (metis equalityI 5 Un_upper2 Un_upper1 Un_least)
+have 10: "Y \<subseteq> x"
+  by (metis 2 Un_upper2 1 Un_upper1 0 9 Un_upper2 1 Un_upper1 0)
+have 11: "X \<subseteq> x"
+  by (metis Un_least 9 Un_upper2 1 Un_upper1 0 8 9 Un_upper2 1 Un_upper1 0 10)
+show "False"
+  by (metis 11 6 Un_upper2 1 Un_upper1 0 9 Un_upper2 1 Un_upper1 0)
+qed 
+
+declare [[ atp_problem_prefix = "set__equal_union" ]]
+lemma (*equal_union: *)
+   "(X = Y \<union> Z) =
+    (Y \<subseteq> X \<and> Z \<subseteq> X \<and> (\<forall>V. Y \<subseteq> V \<and> Z \<subseteq> V \<longrightarrow> X \<subseteq> V))" 
+(*One shot proof: hand-reduced. Metis can't do the full proof any more.*)
+by (metis Un_least Un_upper1 Un_upper2 set_eq_subset)
+
+
+declare [[ atp_problem_prefix = "set__equal_inter" ]]
+lemma "(X = Y \<inter> Z) =
+    (X \<subseteq> Y \<and> X \<subseteq> Z \<and> (\<forall>V. V \<subseteq> Y \<and> V \<subseteq> Z \<longrightarrow> V \<subseteq> X))"
+by (metis Int_greatest Int_lower1 Int_lower2 set_eq_subset)
+
+declare [[ atp_problem_prefix = "set__fixedpoint" ]]
+lemma fixedpoint:
+    "\<exists>!x. f (g x) = x \<Longrightarrow> \<exists>!y. g (f y) = y"
+by metis
+
+lemma (*fixedpoint:*)
+    "\<exists>!x. f (g x) = x \<Longrightarrow> \<exists>!y. g (f y) = y"
+proof (neg_clausify)
+fix x xa
+assume 0: "f (g x) = x"
+assume 1: "\<And>y. y = x \<or> f (g y) \<noteq> y"
+assume 2: "\<And>x. g (f (xa x)) = xa x \<or> g (f x) \<noteq> x"
+assume 3: "\<And>x. g (f x) \<noteq> x \<or> xa x \<noteq> x"
+have 4: "\<And>X1. g (f X1) \<noteq> X1 \<or> g x \<noteq> X1"
+  by (metis 3 1 2)
+show "False"
+  by (metis 4 0)
+qed
+
+declare [[ atp_problem_prefix = "set__singleton_example" ]]
+lemma (*singleton_example_2:*)
+     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
+by (metis Set.subsetI Union_upper insertCI set_eq_subset)
+  --{*found by SPASS*}
+
+lemma (*singleton_example_2:*)
+     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
+by (metis Set.subsetI Union_upper insert_iff set_eq_subset)
+
+lemma singleton_example_2:
+     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
+proof (neg_clausify)
+assume 0: "\<And>x. \<not> S \<subseteq> {x}"
+assume 1: "\<And>x. x \<notin> S \<or> \<Union>S \<subseteq> x"
+have 2: "\<And>X3. X3 = \<Union>S \<or> \<not> X3 \<subseteq> \<Union>S \<or> X3 \<notin> S"
+  by (metis set_eq_subset 1)
+have 3: "\<And>X3. S \<subseteq> insert (\<Union>S) X3"
+  by (metis insert_iff Set.subsetI Union_upper 2 Set.subsetI)
+show "False"
+  by (metis 3 0)
+qed
+
+
+
+text {*
+  From W. W. Bledsoe and Guohui Feng, SET-VAR. JAR 11 (3), 1993, pages
+  293-314.
+*}
+
+declare [[ atp_problem_prefix = "set__Bledsoe_Fung" ]]
+(*Notes: 1, the numbering doesn't completely agree with the paper. 
+2, we must rename set variables to avoid type clashes.*)
+lemma "\<exists>B. (\<forall>x \<in> B. x \<le> (0::int))"
+      "D \<in> F \<Longrightarrow> \<exists>G. \<forall>A \<in> G. \<exists>B \<in> F. A \<subseteq> B"
+      "P a \<Longrightarrow> \<exists>A. (\<forall>x \<in> A. P x) \<and> (\<exists>y. y \<in> A)"
+      "a < b \<and> b < (c::int) \<Longrightarrow> \<exists>B. a \<notin> B \<and> b \<in> B \<and> c \<notin> B"
+      "P (f b) \<Longrightarrow> \<exists>s A. (\<forall>x \<in> A. P x) \<and> f s \<in> A"
+      "P (f b) \<Longrightarrow> \<exists>s A. (\<forall>x \<in> A. P x) \<and> f s \<in> A"
+      "\<exists>A. a \<notin> A"
+      "(\<forall>C. (0, 0) \<in> C \<and> (\<forall>x y. (x, y) \<in> C \<longrightarrow> (Suc x, Suc y) \<in> C) \<longrightarrow> (n, m) \<in> C) \<and> Q n \<longrightarrow> Q m" 
+apply (metis atMost_iff)
+apply (metis emptyE)
+apply (metis insert_iff singletonE)
+apply (metis insertCI singletonE zless_le)
+apply (metis Collect_def Collect_mem_eq)
+apply (metis Collect_def Collect_mem_eq)
+apply (metis DiffE)
+apply (metis pair_in_Id_conv) 
+done
+
+end
diff -r 8f35633c4922 -r 9cf389429f6d src/HOL/Tools/res_axioms.ML
--- a/src/HOL/Tools/res_axioms.ML	Tue Oct 20 19:37:09 2009 +0200
+++ b/src/HOL/Tools/res_axioms.ML	Tue Oct 20 19:52:04 2009 +0200
@@ -301,7 +301,7 @@
       then exists (excessive_lambdas_fm Ts) (#2 (strip_comb t))
       else excessive_lambdas (t, max_lambda_nesting);
 
-(*The max apply_depth of any metis call in MetisExamples (on 31-10-2007) was 11.*)
+(*The max apply_depth of any metis call in Metis_Examples (on 31-10-2007) was 11.*)
 val max_apply_depth = 15;
 
 fun apply_depth (f$t) = Int.max (apply_depth f, apply_depth t + 1)