merge
authorblanchet
Tue Dec 20 16:18:56 2016 +0100 (2016-12-20)
changeset 6460820ccca53dd73
parent 64607 20f3dbfe4b24
parent 64606 a871fa7c24fc
child 64620 14f938969779
child 64624 f3f457535fe2
merge
     1.1 --- a/.hgignore	Tue Dec 20 16:17:13 2016 +0100
     1.2 +++ b/.hgignore	Tue Dec 20 16:18:56 2016 +0100
     1.3 @@ -20,5 +20,8 @@
     1.4  ^doc/.*\.pdf
     1.5  ^doc/.*\.ps
     1.6  ^src/Tools/jEdit/dist/
     1.7 +^src/Tools/VSCode/out/
     1.8 +^src/Tools/VSCode/extension/node_modules/
     1.9 +^src/Tools/VSCode/extension/protocol.log
    1.10  ^Admin/jenkins/ci-extras/target/
    1.11  ^stats/
     2.1 --- a/NEWS	Tue Dec 20 16:17:13 2016 +0100
     2.2 +++ b/NEWS	Tue Dec 20 16:18:56 2016 +0100
     2.3 @@ -3,9 +3,35 @@
     2.4  
     2.5  (Note: Isabelle/jEdit shows a tree-view of the NEWS file in Sidekick.)
     2.6  
     2.7 +
     2.8  New in this Isabelle version
     2.9  ----------------------------
    2.10  
    2.11 +*** Prover IDE -- Isabelle/Scala/jEdit ***
    2.12 +
    2.13 +* Command-line invocation "isabelle jedit -R -l LOGIC" opens the ROOT
    2.14 +entry of the specified logic session in the editor, while its parent is
    2.15 +used for formal checking.
    2.16 +
    2.17 +
    2.18 +*** HOL ***
    2.19 +
    2.20 +* Swapped orientation of congruence rules mod_add_left_eq,
    2.21 +mod_add_right_eq, mod_add_eq, mod_mult_left_eq, mod_mult_right_eq,
    2.22 +mod_mult_eq, mod_minus_eq, mod_diff_left_eq, mod_diff_right_eq,
    2.23 +mod_diff_eq.  INCOMPATIBILITY.
    2.24 +
    2.25 +* Generalized some facts:
    2.26 +    zminus_zmod ~> mod_minus_eq
    2.27 +    zdiff_zmod_left ~> mod_diff_left_eq
    2.28 +    zdiff_zmod_right ~> mod_diff_right_eq
    2.29 +    zmod_eq_dvd_iff ~> mod_eq_dvd_iff
    2.30 +INCOMPATIBILITY.
    2.31 +
    2.32 +* Named collection mod_simps covers various congruence rules
    2.33 +concerning mod, replacing former zmod_simps.
    2.34 +INCOMPATIBILITY.
    2.35 +
    2.36  * (Co)datatype package:
    2.37    - The 'size_gen_o_map' lemma is no longer generated for datatypes
    2.38      with type class annotations. As a result, the tactic that derives
    2.39 @@ -13,7 +39,7 @@
    2.40  
    2.41  * The theorem in Permutations has been renamed:
    2.42    bij_swap_ompose_bij ~> bij_swap_compose_bij
    2.43 - 
    2.44 +
    2.45  
    2.46  New in Isabelle2016-1 (December 2016)
    2.47  -------------------------------------
     3.1 --- a/src/Doc/JEdit/JEdit.thy	Tue Dec 20 16:17:13 2016 +0100
     3.2 +++ b/src/Doc/JEdit/JEdit.thy	Tue Dec 20 16:18:56 2016 +0100
     3.3 @@ -233,6 +233,7 @@
     3.4    Options are:
     3.5      -D NAME=X    set JVM system property
     3.6      -J OPTION    add JVM runtime option
     3.7 +    -R           open ROOT entry of logic session and use its parent
     3.8      -b           build only
     3.9      -d DIR       include session directory
    3.10      -f           fresh build
    3.11 @@ -256,6 +257,11 @@
    3.12    The \<^verbatim>\<open>-n\<close> option bypasses the implicit build process for the selected
    3.13    session image.
    3.14  
    3.15 +  Option \<^verbatim>\<open>-R\<close> modifies the meaning of option \<^verbatim>\<open>-l\<close> as follows: the \<^verbatim>\<open>ROOT\<close>
    3.16 +  entry of the specified session is opened in the editor, while its parent
    3.17 +  session is used for formal checking. This facilitates maintenance of a
    3.18 +  broken session, by moving the Prover IDE quickly to relevant source files.
    3.19 +
    3.20    The \<^verbatim>\<open>-m\<close> option specifies additional print modes for the prover process.
    3.21    Note that the system option @{system_option_ref jedit_print_mode} allows to
    3.22    do the same persistently (e.g.\ via the \<^emph>\<open>Plugin Options\<close> dialog of
     4.1 --- a/src/HOL/Algebra/Coset.thy	Tue Dec 20 16:17:13 2016 +0100
     4.2 +++ b/src/HOL/Algebra/Coset.thy	Tue Dec 20 16:18:56 2016 +0100
     4.3 @@ -15,16 +15,16 @@
     4.4    where "H #>\<^bsub>G\<^esub> a = (\<Union>h\<in>H. {h \<otimes>\<^bsub>G\<^esub> a})"
     4.5  
     4.6  definition
     4.7 -  l_coset    :: "[_, 'a, 'a set] \<Rightarrow> 'a set"    (infixl "<#\<index>" 60)
     4.8 -  where "a <#\<^bsub>G\<^esub> H = (\<Union>h\<in>H. {a \<otimes>\<^bsub>G\<^esub> h})"
     4.9 +  l_coset    :: "[_, 'a, 'a set] \<Rightarrow> 'a set"    (infixl "\<subset>#\<index>" 60)
    4.10 +  where "a \<subset>#\<^bsub>G\<^esub> H = (\<Union>h\<in>H. {a \<otimes>\<^bsub>G\<^esub> h})"
    4.11  
    4.12  definition
    4.13    RCOSETS  :: "[_, 'a set] \<Rightarrow> ('a set)set"   ("rcosets\<index> _" [81] 80)
    4.14    where "rcosets\<^bsub>G\<^esub> H = (\<Union>a\<in>carrier G. {H #>\<^bsub>G\<^esub> a})"
    4.15  
    4.16  definition
    4.17 -  set_mult  :: "[_, 'a set ,'a set] \<Rightarrow> 'a set" (infixl "<#>\<index>" 60)
    4.18 -  where "H <#>\<^bsub>G\<^esub> K = (\<Union>h\<in>H. \<Union>k\<in>K. {h \<otimes>\<^bsub>G\<^esub> k})"
    4.19 +  set_mult  :: "[_, 'a set ,'a set] \<Rightarrow> 'a set" (infixl "\<subset>#>\<index>" 60)
    4.20 +  where "H \<subset>#>\<^bsub>G\<^esub> K = (\<Union>h\<in>H. \<Union>k\<in>K. {h \<otimes>\<^bsub>G\<^esub> k})"
    4.21  
    4.22  definition
    4.23    SET_INV :: "[_,'a set] \<Rightarrow> 'a set"  ("set'_inv\<index> _" [81] 80)
    4.24 @@ -32,7 +32,7 @@
    4.25  
    4.26  
    4.27  locale normal = subgroup + group +
    4.28 -  assumes coset_eq: "(\<forall>x \<in> carrier G. H #> x = x <# H)"
    4.29 +  assumes coset_eq: "(\<forall>x \<in> carrier G. H #> x = x \<subset># H)"
    4.30  
    4.31  abbreviation
    4.32    normal_rel :: "['a set, ('a, 'b) monoid_scheme] \<Rightarrow> bool"  (infixl "\<lhd>" 60) where
    4.33 @@ -287,7 +287,7 @@
    4.34  lemma (in monoid) set_mult_closed:
    4.35    assumes Acarr: "A \<subseteq> carrier G"
    4.36        and Bcarr: "B \<subseteq> carrier G"
    4.37 -  shows "A <#> B \<subseteq> carrier G"
    4.38 +  shows "A \<subset>#> B \<subseteq> carrier G"
    4.39  apply rule apply (simp add: set_mult_def, clarsimp)
    4.40  proof -
    4.41    fix a b
    4.42 @@ -306,7 +306,7 @@
    4.43  lemma (in comm_group) mult_subgroups:
    4.44    assumes subH: "subgroup H G"
    4.45        and subK: "subgroup K G"
    4.46 -  shows "subgroup (H <#> K) G"
    4.47 +  shows "subgroup (H \<subset>#> K) G"
    4.48  apply (rule subgroup.intro)
    4.49     apply (intro set_mult_closed subgroup.subset[OF subH] subgroup.subset[OF subK])
    4.50    apply (simp add: set_mult_def) apply clarsimp defer 1
    4.51 @@ -351,7 +351,7 @@
    4.52    assumes "group G"
    4.53    assumes carr: "x \<in> carrier G" "x' \<in> carrier G"
    4.54        and xixH: "(inv x \<otimes> x') \<in> H"
    4.55 -  shows "x' \<in> x <# H"
    4.56 +  shows "x' \<in> x \<subset># H"
    4.57  proof -
    4.58    interpret group G by fact
    4.59    from xixH
    4.60 @@ -375,7 +375,7 @@
    4.61        have "x \<otimes> h = x'" by simp
    4.62  
    4.63    from this[symmetric] and hH
    4.64 -      show "x' \<in> x <# H"
    4.65 +      show "x' \<in> x \<subset># H"
    4.66        unfolding l_coset_def
    4.67        by fast
    4.68  qed
    4.69 @@ -387,7 +387,7 @@
    4.70    by (simp add: normal_def subgroup_def)
    4.71  
    4.72  lemma (in group) normalI: 
    4.73 -  "subgroup H G \<Longrightarrow> (\<forall>x \<in> carrier G. H #> x = x <# H) \<Longrightarrow> H \<lhd> G"
    4.74 +  "subgroup H G \<Longrightarrow> (\<forall>x \<in> carrier G. H #> x = x \<subset># H) \<Longrightarrow> H \<lhd> G"
    4.75    by (simp add: normal_def normal_axioms_def is_group)
    4.76  
    4.77  lemma (in normal) inv_op_closed1:
    4.78 @@ -460,18 +460,18 @@
    4.79  
    4.80  lemma (in group) lcos_m_assoc:
    4.81       "[| M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G |]
    4.82 -      ==> g <# (h <# M) = (g \<otimes> h) <# M"
    4.83 +      ==> g \<subset># (h \<subset># M) = (g \<otimes> h) \<subset># M"
    4.84  by (force simp add: l_coset_def m_assoc)
    4.85  
    4.86 -lemma (in group) lcos_mult_one: "M \<subseteq> carrier G ==> \<one> <# M = M"
    4.87 +lemma (in group) lcos_mult_one: "M \<subseteq> carrier G ==> \<one> \<subset># M = M"
    4.88  by (force simp add: l_coset_def)
    4.89  
    4.90  lemma (in group) l_coset_subset_G:
    4.91 -     "[| H \<subseteq> carrier G; x \<in> carrier G |] ==> x <# H \<subseteq> carrier G"
    4.92 +     "[| H \<subseteq> carrier G; x \<in> carrier G |] ==> x \<subset># H \<subseteq> carrier G"
    4.93  by (auto simp add: l_coset_def subsetD)
    4.94  
    4.95  lemma (in group) l_coset_swap:
    4.96 -     "\<lbrakk>y \<in> x <# H;  x \<in> carrier G;  subgroup H G\<rbrakk> \<Longrightarrow> x \<in> y <# H"
    4.97 +     "\<lbrakk>y \<in> x \<subset># H;  x \<in> carrier G;  subgroup H G\<rbrakk> \<Longrightarrow> x \<in> y \<subset># H"
    4.98  proof (simp add: l_coset_def)
    4.99    assume "\<exists>h\<in>H. y = x \<otimes> h"
   4.100      and x: "x \<in> carrier G"
   4.101 @@ -487,13 +487,13 @@
   4.102  qed
   4.103  
   4.104  lemma (in group) l_coset_carrier:
   4.105 -     "[| y \<in> x <# H;  x \<in> carrier G;  subgroup H G |] ==> y \<in> carrier G"
   4.106 +     "[| y \<in> x \<subset># H;  x \<in> carrier G;  subgroup H G |] ==> y \<in> carrier G"
   4.107  by (auto simp add: l_coset_def m_assoc
   4.108                     subgroup.subset [THEN subsetD] subgroup.m_closed)
   4.109  
   4.110  lemma (in group) l_repr_imp_subset:
   4.111 -  assumes y: "y \<in> x <# H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   4.112 -  shows "y <# H \<subseteq> x <# H"
   4.113 +  assumes y: "y \<in> x \<subset># H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   4.114 +  shows "y \<subset># H \<subseteq> x \<subset># H"
   4.115  proof -
   4.116    from y
   4.117    obtain h' where "h' \<in> H" "x \<otimes> h' = y" by (auto simp add: l_coset_def)
   4.118 @@ -503,20 +503,20 @@
   4.119  qed
   4.120  
   4.121  lemma (in group) l_repr_independence:
   4.122 -  assumes y: "y \<in> x <# H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   4.123 -  shows "x <# H = y <# H"
   4.124 +  assumes y: "y \<in> x \<subset># H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   4.125 +  shows "x \<subset># H = y \<subset># H"
   4.126  proof
   4.127 -  show "x <# H \<subseteq> y <# H"
   4.128 +  show "x \<subset># H \<subseteq> y \<subset># H"
   4.129      by (rule l_repr_imp_subset,
   4.130          (blast intro: l_coset_swap l_coset_carrier y x sb)+)
   4.131 -  show "y <# H \<subseteq> x <# H" by (rule l_repr_imp_subset [OF y x sb])
   4.132 +  show "y \<subset># H \<subseteq> x \<subset># H" by (rule l_repr_imp_subset [OF y x sb])
   4.133  qed
   4.134  
   4.135  lemma (in group) setmult_subset_G:
   4.136 -     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G\<rbrakk> \<Longrightarrow> H <#> K \<subseteq> carrier G"
   4.137 +     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G\<rbrakk> \<Longrightarrow> H \<subset>#> K \<subseteq> carrier G"
   4.138  by (auto simp add: set_mult_def subsetD)
   4.139  
   4.140 -lemma (in group) subgroup_mult_id: "subgroup H G \<Longrightarrow> H <#> H = H"
   4.141 +lemma (in group) subgroup_mult_id: "subgroup H G \<Longrightarrow> H \<subset>#> H = H"
   4.142  apply (auto simp add: subgroup.m_closed set_mult_def Sigma_def)
   4.143  apply (rule_tac x = x in bexI)
   4.144  apply (rule bexI [of _ "\<one>"])
   4.145 @@ -549,41 +549,41 @@
   4.146  qed
   4.147  
   4.148  
   4.149 -subsubsection \<open>Theorems for \<open><#>\<close> with \<open>#>\<close> or \<open><#\<close>.\<close>
   4.150 +subsubsection \<open>Theorems for \<open>\<subset>#>\<close> with \<open>#>\<close> or \<open>\<subset>#\<close>.\<close>
   4.151  
   4.152  lemma (in group) setmult_rcos_assoc:
   4.153       "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk>
   4.154 -      \<Longrightarrow> H <#> (K #> x) = (H <#> K) #> x"
   4.155 +      \<Longrightarrow> H \<subset>#> (K #> x) = (H \<subset>#> K) #> x"
   4.156  by (force simp add: r_coset_def set_mult_def m_assoc)
   4.157  
   4.158  lemma (in group) rcos_assoc_lcos:
   4.159       "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk>
   4.160 -      \<Longrightarrow> (H #> x) <#> K = H <#> (x <# K)"
   4.161 +      \<Longrightarrow> (H #> x) \<subset>#> K = H \<subset>#> (x \<subset># K)"
   4.162  by (force simp add: r_coset_def l_coset_def set_mult_def m_assoc)
   4.163  
   4.164  lemma (in normal) rcos_mult_step1:
   4.165       "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   4.166 -      \<Longrightarrow> (H #> x) <#> (H #> y) = (H <#> (x <# H)) #> y"
   4.167 +      \<Longrightarrow> (H #> x) \<subset>#> (H #> y) = (H \<subset>#> (x \<subset># H)) #> y"
   4.168  by (simp add: setmult_rcos_assoc subset
   4.169                r_coset_subset_G l_coset_subset_G rcos_assoc_lcos)
   4.170  
   4.171  lemma (in normal) rcos_mult_step2:
   4.172       "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   4.173 -      \<Longrightarrow> (H <#> (x <# H)) #> y = (H <#> (H #> x)) #> y"
   4.174 +      \<Longrightarrow> (H \<subset>#> (x \<subset># H)) #> y = (H \<subset>#> (H #> x)) #> y"
   4.175  by (insert coset_eq, simp add: normal_def)
   4.176  
   4.177  lemma (in normal) rcos_mult_step3:
   4.178       "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   4.179 -      \<Longrightarrow> (H <#> (H #> x)) #> y = H #> (x \<otimes> y)"
   4.180 +      \<Longrightarrow> (H \<subset>#> (H #> x)) #> y = H #> (x \<otimes> y)"
   4.181  by (simp add: setmult_rcos_assoc coset_mult_assoc
   4.182                subgroup_mult_id normal.axioms subset normal_axioms)
   4.183  
   4.184  lemma (in normal) rcos_sum:
   4.185       "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   4.186 -      \<Longrightarrow> (H #> x) <#> (H #> y) = H #> (x \<otimes> y)"
   4.187 +      \<Longrightarrow> (H #> x) \<subset>#> (H #> y) = H #> (x \<otimes> y)"
   4.188  by (simp add: rcos_mult_step1 rcos_mult_step2 rcos_mult_step3)
   4.189  
   4.190 -lemma (in normal) rcosets_mult_eq: "M \<in> rcosets H \<Longrightarrow> H <#> M = M"
   4.191 +lemma (in normal) rcosets_mult_eq: "M \<in> rcosets H \<Longrightarrow> H \<subset>#> M = M"
   4.192    \<comment> \<open>generalizes \<open>subgroup_mult_id\<close>\<close>
   4.193    by (auto simp add: RCOSETS_def subset
   4.194          setmult_rcos_assoc subgroup_mult_id normal.axioms normal_axioms)
   4.195 @@ -645,7 +645,7 @@
   4.196  lemma (in subgroup) l_coset_eq_rcong:
   4.197    assumes "group G"
   4.198    assumes a: "a \<in> carrier G"
   4.199 -  shows "a <# H = rcong H `` {a}"
   4.200 +  shows "a \<subset># H = rcong H `` {a}"
   4.201  proof -
   4.202    interpret group G by fact
   4.203    show ?thesis by (force simp add: r_congruent_def l_coset_def m_assoc [symmetric] a ) 
   4.204 @@ -684,7 +684,7 @@
   4.205  text \<open>The relation is a congruence\<close>
   4.206  
   4.207  lemma (in normal) congruent_rcong:
   4.208 -  shows "congruent2 (rcong H) (rcong H) (\<lambda>a b. a \<otimes> b <# H)"
   4.209 +  shows "congruent2 (rcong H) (rcong H) (\<lambda>a b. a \<otimes> b \<subset># H)"
   4.210  proof (intro congruent2I[of "carrier G" _ "carrier G" _] equiv_rcong is_group)
   4.211    fix a b c
   4.212    assume abrcong: "(a, b) \<in> rcong H"
   4.213 @@ -712,10 +712,10 @@
   4.214    ultimately
   4.215        have "(inv (a \<otimes> c)) \<otimes> (b \<otimes> c) \<in> H" by simp
   4.216    from carr and this
   4.217 -     have "(b \<otimes> c) \<in> (a \<otimes> c) <# H"
   4.218 +     have "(b \<otimes> c) \<in> (a \<otimes> c) \<subset># H"
   4.219       by (simp add: lcos_module_rev[OF is_group])
   4.220    from carr and this and is_subgroup
   4.221 -     show "(a \<otimes> c) <# H = (b \<otimes> c) <# H" by (intro l_repr_independence, simp+)
   4.222 +     show "(a \<otimes> c) \<subset># H = (b \<otimes> c) \<subset># H" by (intro l_repr_independence, simp+)
   4.223  next
   4.224    fix a b c
   4.225    assume abrcong: "(a, b) \<in> rcong H"
   4.226 @@ -746,10 +746,10 @@
   4.227        have "inv (c \<otimes> a) \<otimes> (c \<otimes> b) \<in> H" by simp
   4.228  
   4.229    from carr and this
   4.230 -     have "(c \<otimes> b) \<in> (c \<otimes> a) <# H"
   4.231 +     have "(c \<otimes> b) \<in> (c \<otimes> a) \<subset># H"
   4.232       by (simp add: lcos_module_rev[OF is_group])
   4.233    from carr and this and is_subgroup
   4.234 -     show "(c \<otimes> a) <# H = (c \<otimes> b) <# H" by (intro l_repr_independence, simp+)
   4.235 +     show "(c \<otimes> a) \<subset># H = (c \<otimes> b) \<subset># H" by (intro l_repr_independence, simp+)
   4.236  qed
   4.237  
   4.238  
   4.239 @@ -835,7 +835,7 @@
   4.240     where "FactGroup G H = \<lparr>carrier = rcosets\<^bsub>G\<^esub> H, mult = set_mult G, one = H\<rparr>"
   4.241  
   4.242  lemma (in normal) setmult_closed:
   4.243 -     "\<lbrakk>K1 \<in> rcosets H; K2 \<in> rcosets H\<rbrakk> \<Longrightarrow> K1 <#> K2 \<in> rcosets H"
   4.244 +     "\<lbrakk>K1 \<in> rcosets H; K2 \<in> rcosets H\<rbrakk> \<Longrightarrow> K1 \<subset>#> K2 \<in> rcosets H"
   4.245  by (auto simp add: rcos_sum RCOSETS_def)
   4.246  
   4.247  lemma (in normal) setinv_closed:
   4.248 @@ -844,7 +844,7 @@
   4.249  
   4.250  lemma (in normal) rcosets_assoc:
   4.251       "\<lbrakk>M1 \<in> rcosets H; M2 \<in> rcosets H; M3 \<in> rcosets H\<rbrakk>
   4.252 -      \<Longrightarrow> M1 <#> M2 <#> M3 = M1 <#> (M2 <#> M3)"
   4.253 +      \<Longrightarrow> M1 \<subset>#> M2 \<subset>#> M3 = M1 \<subset>#> (M2 \<subset>#> M3)"
   4.254  by (auto simp add: RCOSETS_def rcos_sum m_assoc)
   4.255  
   4.256  lemma (in subgroup) subgroup_in_rcosets:
   4.257 @@ -859,7 +859,7 @@
   4.258  qed
   4.259  
   4.260  lemma (in normal) rcosets_inv_mult_group_eq:
   4.261 -     "M \<in> rcosets H \<Longrightarrow> set_inv M <#> M = H"
   4.262 +     "M \<in> rcosets H \<Longrightarrow> set_inv M \<subset>#> M = H"
   4.263  by (auto simp add: RCOSETS_def rcos_inv rcos_sum subgroup.subset normal.axioms normal_axioms)
   4.264  
   4.265  theorem (in normal) factorgroup_is_group:
   4.266 @@ -874,7 +874,7 @@
   4.267  apply (auto dest: rcosets_inv_mult_group_eq simp add: setinv_closed)
   4.268  done
   4.269  
   4.270 -lemma mult_FactGroup [simp]: "X \<otimes>\<^bsub>(G Mod H)\<^esub> X' = X <#>\<^bsub>G\<^esub> X'"
   4.271 +lemma mult_FactGroup [simp]: "X \<otimes>\<^bsub>(G Mod H)\<^esub> X' = X \<subset>#>\<^bsub>G\<^esub> X'"
   4.272    by (simp add: FactGroup_def) 
   4.273  
   4.274  lemma (in normal) inv_FactGroup:
   4.275 @@ -951,11 +951,11 @@
   4.276    hence all: "\<forall>x\<in>X. h x = h g" "\<forall>x\<in>X'. h x = h g'" 
   4.277      and Xsub: "X \<subseteq> carrier G" and X'sub: "X' \<subseteq> carrier G"
   4.278      by (force simp add: kernel_def r_coset_def image_def)+
   4.279 -  hence "h ` (X <#> X') = {h g \<otimes>\<^bsub>H\<^esub> h g'}" using X X'
   4.280 +  hence "h ` (X \<subset>#> X') = {h g \<otimes>\<^bsub>H\<^esub> h g'}" using X X'
   4.281      by (auto dest!: FactGroup_nonempty intro!: image_eqI
   4.282               simp add: set_mult_def 
   4.283                         subsetD [OF Xsub] subsetD [OF X'sub]) 
   4.284 -  then show "the_elem (h ` (X <#> X')) = the_elem (h ` X) \<otimes>\<^bsub>H\<^esub> the_elem (h ` X')"
   4.285 +  then show "the_elem (h ` (X \<subset>#> X')) = the_elem (h ` X) \<otimes>\<^bsub>H\<^esub> the_elem (h ` X')"
   4.286      by (auto simp add: all FactGroup_nonempty X X' the_elem_image_unique)
   4.287  qed
   4.288  
     5.1 --- a/src/HOL/Algebra/Divisibility.thy	Tue Dec 20 16:17:13 2016 +0100
     5.2 +++ b/src/HOL/Algebra/Divisibility.thy	Tue Dec 20 16:18:56 2016 +0100
     5.3 @@ -1918,7 +1918,7 @@
     5.4      and afs: "wfactors G as a"
     5.5      and bfs: "wfactors G bs b"
     5.6      and carr: "a \<in> carrier G"  "b \<in> carrier G"  "set as \<subseteq> carrier G"  "set bs \<subseteq> carrier G"
     5.7 -  shows "fmset G as \<le># fmset G bs"
     5.8 +  shows "fmset G as \<subseteq># fmset G bs"
     5.9    using ab
    5.10  proof (elim dividesE)
    5.11    fix c
    5.12 @@ -1935,7 +1935,7 @@
    5.13  qed
    5.14  
    5.15  lemma (in comm_monoid_cancel) fmsubset_divides:
    5.16 -  assumes msubset: "fmset G as \<le># fmset G bs"
    5.17 +  assumes msubset: "fmset G as \<subseteq># fmset G bs"
    5.18      and afs: "wfactors G as a"
    5.19      and bfs: "wfactors G bs b"
    5.20      and acarr: "a \<in> carrier G"
    5.21 @@ -1988,7 +1988,7 @@
    5.22      and "b \<in> carrier G"
    5.23      and "set as \<subseteq> carrier G"
    5.24      and "set bs \<subseteq> carrier G"
    5.25 -  shows "a divides b = (fmset G as \<le># fmset G bs)"
    5.26 +  shows "a divides b = (fmset G as \<subseteq># fmset G bs)"
    5.27    using assms
    5.28    by (blast intro: divides_fmsubset fmsubset_divides)
    5.29  
    5.30 @@ -1996,7 +1996,7 @@
    5.31  text \<open>Proper factors on multisets\<close>
    5.32  
    5.33  lemma (in factorial_monoid) fmset_properfactor:
    5.34 -  assumes asubb: "fmset G as \<le># fmset G bs"
    5.35 +  assumes asubb: "fmset G as \<subseteq># fmset G bs"
    5.36      and anb: "fmset G as \<noteq> fmset G bs"
    5.37      and "wfactors G as a"
    5.38      and "wfactors G bs b"
    5.39 @@ -2009,7 +2009,7 @@
    5.40     apply (rule fmsubset_divides[of as bs], fact+)
    5.41  proof
    5.42    assume "b divides a"
    5.43 -  then have "fmset G bs \<le># fmset G as"
    5.44 +  then have "fmset G bs \<subseteq># fmset G as"
    5.45      by (rule divides_fmsubset) fact+
    5.46    with asubb have "fmset G as = fmset G bs"
    5.47      by (rule subset_mset.antisym)
    5.48 @@ -2024,7 +2024,7 @@
    5.49      and "b \<in> carrier G"
    5.50      and "set as \<subseteq> carrier G"
    5.51      and "set bs \<subseteq> carrier G"
    5.52 -  shows "fmset G as \<le># fmset G bs \<and> fmset G as \<noteq> fmset G bs"
    5.53 +  shows "fmset G as \<subseteq># fmset G bs \<and> fmset G as \<noteq> fmset G bs"
    5.54    using pf
    5.55    apply (elim properfactorE)
    5.56    apply rule
    5.57 @@ -2334,11 +2334,11 @@
    5.58    have "c gcdof a b"
    5.59    proof (simp add: isgcd_def, safe)
    5.60      from csmset
    5.61 -    have "fmset G cs \<le># fmset G as"
    5.62 +    have "fmset G cs \<subseteq># fmset G as"
    5.63        by (simp add: multiset_inter_def subset_mset_def)
    5.64      then show "c divides a" by (rule fmsubset_divides) fact+
    5.65    next
    5.66 -    from csmset have "fmset G cs \<le># fmset G bs"
    5.67 +    from csmset have "fmset G cs \<subseteq># fmset G bs"
    5.68        by (simp add: multiset_inter_def subseteq_mset_def, force)
    5.69      then show "c divides b"
    5.70        by (rule fmsubset_divides) fact+
    5.71 @@ -2350,14 +2350,14 @@
    5.72        by blast
    5.73  
    5.74      assume "y divides a"
    5.75 -    then have ya: "fmset G ys \<le># fmset G as"
    5.76 +    then have ya: "fmset G ys \<subseteq># fmset G as"
    5.77        by (rule divides_fmsubset) fact+
    5.78  
    5.79      assume "y divides b"
    5.80 -    then have yb: "fmset G ys \<le># fmset G bs"
    5.81 +    then have yb: "fmset G ys \<subseteq># fmset G bs"
    5.82        by (rule divides_fmsubset) fact+
    5.83  
    5.84 -    from ya yb csmset have "fmset G ys \<le># fmset G cs"
    5.85 +    from ya yb csmset have "fmset G ys \<subseteq># fmset G cs"
    5.86        by (simp add: subset_mset_def)
    5.87      then show "y divides c"
    5.88        by (rule fmsubset_divides) fact+
    5.89 @@ -2420,12 +2420,12 @@
    5.90  
    5.91    have "c lcmof a b"
    5.92    proof (simp add: islcm_def, safe)
    5.93 -    from csmset have "fmset G as \<le># fmset G cs"
    5.94 +    from csmset have "fmset G as \<subseteq># fmset G cs"
    5.95        by (simp add: subseteq_mset_def, force)
    5.96      then show "a divides c"
    5.97        by (rule fmsubset_divides) fact+
    5.98    next
    5.99 -    from csmset have "fmset G bs \<le># fmset G cs"
   5.100 +    from csmset have "fmset G bs \<subseteq># fmset G cs"
   5.101        by (simp add: subset_mset_def)
   5.102      then show "b divides c"
   5.103        by (rule fmsubset_divides) fact+
   5.104 @@ -2437,14 +2437,14 @@
   5.105        by blast
   5.106  
   5.107      assume "a divides y"
   5.108 -    then have ya: "fmset G as \<le># fmset G ys"
   5.109 +    then have ya: "fmset G as \<subseteq># fmset G ys"
   5.110        by (rule divides_fmsubset) fact+
   5.111  
   5.112      assume "b divides y"
   5.113 -    then have yb: "fmset G bs \<le># fmset G ys"
   5.114 +    then have yb: "fmset G bs \<subseteq># fmset G ys"
   5.115        by (rule divides_fmsubset) fact+
   5.116  
   5.117 -    from ya yb csmset have "fmset G cs \<le># fmset G ys"
   5.118 +    from ya yb csmset have "fmset G cs \<subseteq># fmset G ys"
   5.119        apply (simp add: subseteq_mset_def, clarify)
   5.120        apply (case_tac "count (fmset G as) a < count (fmset G bs) a")
   5.121         apply simp
     6.1 --- a/src/HOL/Analysis/Complex_Transcendental.thy	Tue Dec 20 16:17:13 2016 +0100
     6.2 +++ b/src/HOL/Analysis/Complex_Transcendental.thy	Tue Dec 20 16:18:56 2016 +0100
     6.3 @@ -3206,7 +3206,7 @@
     6.4        using of_int_eq_iff apply fastforce
     6.5        by (metis of_int_add of_int_mult of_int_of_nat_eq)
     6.6      also have "... \<longleftrightarrow> int j mod int n = int k mod int n"
     6.7 -      by (auto simp: zmod_eq_dvd_iff dvd_def algebra_simps)
     6.8 +      by (auto simp: mod_eq_dvd_iff dvd_def algebra_simps)
     6.9      also have "... \<longleftrightarrow> j mod n = k mod n"
    6.10        by (metis of_nat_eq_iff zmod_int)
    6.11      finally have "(\<exists>z. \<i> * (of_nat j * (of_real pi * 2)) =
     7.1 --- a/src/HOL/Code_Numeral.thy	Tue Dec 20 16:17:13 2016 +0100
     7.2 +++ b/src/HOL/Code_Numeral.thy	Tue Dec 20 16:18:56 2016 +0100
     7.3 @@ -168,21 +168,9 @@
     7.4    "integer_of_num (Num.Bit0 Num.One) = 2"
     7.5    by (transfer, simp)+
     7.6  
     7.7 -instantiation integer :: "{ring_div, equal, linordered_idom}"
     7.8 +instantiation integer :: "{linordered_idom, equal}"
     7.9  begin
    7.10  
    7.11 -lift_definition divide_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
    7.12 -  is "divide :: int \<Rightarrow> int \<Rightarrow> int"
    7.13 -  .
    7.14 -
    7.15 -declare divide_integer.rep_eq [simp]
    7.16 -
    7.17 -lift_definition modulo_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
    7.18 -  is "modulo :: int \<Rightarrow> int \<Rightarrow> int"
    7.19 -  .
    7.20 -
    7.21 -declare modulo_integer.rep_eq [simp]
    7.22 -
    7.23  lift_definition abs_integer :: "integer \<Rightarrow> integer"
    7.24    is "abs :: int \<Rightarrow> int"
    7.25    .
    7.26 @@ -199,6 +187,7 @@
    7.27    is "less_eq :: int \<Rightarrow> int \<Rightarrow> bool"
    7.28    .
    7.29  
    7.30 +
    7.31  lift_definition less_integer :: "integer \<Rightarrow> integer \<Rightarrow> bool"
    7.32    is "less :: int \<Rightarrow> int \<Rightarrow> bool"
    7.33    .
    7.34 @@ -207,8 +196,8 @@
    7.35    is "HOL.equal :: int \<Rightarrow> int \<Rightarrow> bool"
    7.36    .
    7.37  
    7.38 -instance proof
    7.39 -qed (transfer, simp add: algebra_simps equal less_le_not_le [symmetric] mult_strict_right_mono linear)+
    7.40 +instance
    7.41 +  by standard (transfer, simp add: algebra_simps equal less_le_not_le [symmetric] mult_strict_right_mono linear)+
    7.42  
    7.43  end
    7.44  
    7.45 @@ -236,6 +225,38 @@
    7.46    "of_nat (nat_of_integer k) = max 0 k"
    7.47    by transfer auto
    7.48  
    7.49 +instantiation integer :: "{ring_div, normalization_semidom}"
    7.50 +begin
    7.51 +
    7.52 +lift_definition normalize_integer :: "integer \<Rightarrow> integer"
    7.53 +  is "normalize :: int \<Rightarrow> int"
    7.54 +  .
    7.55 +
    7.56 +declare normalize_integer.rep_eq [simp]
    7.57 +
    7.58 +lift_definition unit_factor_integer :: "integer \<Rightarrow> integer"
    7.59 +  is "unit_factor :: int \<Rightarrow> int"
    7.60 +  .
    7.61 +
    7.62 +declare unit_factor_integer.rep_eq [simp]
    7.63 +
    7.64 +lift_definition divide_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
    7.65 +  is "divide :: int \<Rightarrow> int \<Rightarrow> int"
    7.66 +  .
    7.67 +
    7.68 +declare divide_integer.rep_eq [simp]
    7.69 +
    7.70 +lift_definition modulo_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
    7.71 +  is "modulo :: int \<Rightarrow> int \<Rightarrow> int"
    7.72 +  .
    7.73 +
    7.74 +declare modulo_integer.rep_eq [simp]
    7.75 +
    7.76 +instance
    7.77 +  by standard (transfer, simp add: mult_sgn_abs sgn_mult)+
    7.78 +
    7.79 +end
    7.80 +
    7.81  instantiation integer :: semiring_numeral_div
    7.82  begin
    7.83  
    7.84 @@ -389,6 +410,14 @@
    7.85    "Neg m * Neg n = Pos (m * n)"
    7.86    by simp_all
    7.87  
    7.88 +lemma normalize_integer_code [code]:
    7.89 +  "normalize = (abs :: integer \<Rightarrow> integer)"
    7.90 +  by transfer simp
    7.91 +
    7.92 +lemma unit_factor_integer_code [code]:
    7.93 +  "unit_factor = (sgn :: integer \<Rightarrow> integer)"
    7.94 +  by transfer simp
    7.95 +
    7.96  definition divmod_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer \<times> integer"
    7.97  where
    7.98    "divmod_integer k l = (k div l, k mod l)"
    7.99 @@ -760,21 +789,9 @@
   7.100    "nat_of_natural (numeral k) = numeral k"
   7.101    by transfer rule
   7.102  
   7.103 -instantiation natural :: "{semiring_div, equal, linordered_semiring}"
   7.104 +instantiation natural :: "{linordered_semiring, equal}"
   7.105  begin
   7.106  
   7.107 -lift_definition divide_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.108 -  is "divide :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.109 -  .
   7.110 -
   7.111 -declare divide_natural.rep_eq [simp]
   7.112 -
   7.113 -lift_definition modulo_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.114 -  is "modulo :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.115 -  .
   7.116 -
   7.117 -declare modulo_natural.rep_eq [simp]
   7.118 -
   7.119  lift_definition less_eq_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
   7.120    is "less_eq :: nat \<Rightarrow> nat \<Rightarrow> bool"
   7.121    .
   7.122 @@ -812,6 +829,38 @@
   7.123    "nat_of_natural (max k l) = max (nat_of_natural k) (nat_of_natural l)"
   7.124    by transfer rule
   7.125  
   7.126 +instantiation natural :: "{semiring_div, normalization_semidom}"
   7.127 +begin
   7.128 +
   7.129 +lift_definition normalize_natural :: "natural \<Rightarrow> natural"
   7.130 +  is "normalize :: nat \<Rightarrow> nat"
   7.131 +  .
   7.132 +
   7.133 +declare normalize_natural.rep_eq [simp]
   7.134 +
   7.135 +lift_definition unit_factor_natural :: "natural \<Rightarrow> natural"
   7.136 +  is "unit_factor :: nat \<Rightarrow> nat"
   7.137 +  .
   7.138 +
   7.139 +declare unit_factor_natural.rep_eq [simp]
   7.140 +
   7.141 +lift_definition divide_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.142 +  is "divide :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.143 +  .
   7.144 +
   7.145 +declare divide_natural.rep_eq [simp]
   7.146 +
   7.147 +lift_definition modulo_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.148 +  is "modulo :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.149 +  .
   7.150 +
   7.151 +declare modulo_natural.rep_eq [simp]
   7.152 +
   7.153 +instance
   7.154 +  by standard (transfer, auto simp add: algebra_simps unit_factor_nat_def gr0_conv_Suc)+
   7.155 +
   7.156 +end
   7.157 +
   7.158  lift_definition natural_of_integer :: "integer \<Rightarrow> natural"
   7.159    is "nat :: int \<Rightarrow> nat"
   7.160    .
   7.161 @@ -945,7 +994,32 @@
   7.162  
   7.163  lemma [code abstract]:
   7.164    "integer_of_natural (m * n) = integer_of_natural m * integer_of_natural n"
   7.165 -  by transfer (simp add: of_nat_mult)
   7.166 +  by transfer simp
   7.167 +
   7.168 +lemma [code]:
   7.169 +  "normalize n = n" for n :: natural
   7.170 +  by transfer simp
   7.171 +
   7.172 +lemma [code]:
   7.173 +  "unit_factor n = of_bool (n \<noteq> 0)" for n :: natural
   7.174 +proof (cases "n = 0")
   7.175 +  case True
   7.176 +  then show ?thesis
   7.177 +    by simp
   7.178 +next
   7.179 +  case False
   7.180 +  then have "unit_factor n = 1"
   7.181 +  proof transfer
   7.182 +    fix n :: nat
   7.183 +    assume "n \<noteq> 0"
   7.184 +    then obtain m where "n = Suc m"
   7.185 +      by (cases n) auto
   7.186 +    then show "unit_factor n = 1"
   7.187 +      by simp
   7.188 +  qed
   7.189 +  with False show ?thesis
   7.190 +    by simp
   7.191 +qed
   7.192  
   7.193  lemma [code abstract]:
   7.194    "integer_of_natural (m div n) = integer_of_natural m div integer_of_natural n"
     8.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Tue Dec 20 16:17:13 2016 +0100
     8.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Tue Dec 20 16:18:56 2016 +0100
     8.3 @@ -45,8 +45,8 @@
     8.4      (* Some simpsets for dealing with mod div abs and nat*)
     8.5      val mod_div_simpset =
     8.6        put_simpset HOL_basic_ss ctxt
     8.7 -      addsimps @{thms refl mod_add_eq [symmetric] mod_add_left_eq [symmetric]
     8.8 -          mod_add_right_eq [symmetric]
     8.9 +      addsimps @{thms refl mod_add_eq mod_add_left_eq
    8.10 +          mod_add_right_eq
    8.11            div_add1_eq [symmetric] zdiv_zadd1_eq [symmetric]
    8.12            mod_self
    8.13            div_by_0 mod_by_0 div_0 mod_0
     9.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Tue Dec 20 16:17:13 2016 +0100
     9.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Tue Dec 20 16:18:56 2016 +0100
     9.3 @@ -31,8 +31,6 @@
     9.4               @{thm uminus_add_conv_diff [symmetric]}, @{thm "minus_divide_left"}]
     9.5  val comp_ths = distinct Thm.eq_thm (ths @ comp_arith @ @{thms simp_thms});
     9.6  
     9.7 -val mod_add_eq = @{thm "mod_add_eq"} RS sym;
     9.8 -
     9.9  fun prepare_for_mir q fm = 
    9.10    let
    9.11      val ps = Logic.strip_params fm
    9.12 @@ -71,7 +69,7 @@
    9.13      val (t,np,nh) = prepare_for_mir q g
    9.14      (* Some simpsets for dealing with mod div abs and nat*)
    9.15      val mod_div_simpset = put_simpset HOL_basic_ss ctxt
    9.16 -                        addsimps [refl, mod_add_eq, 
    9.17 +                        addsimps [refl, @{thm mod_add_eq}, 
    9.18                                    @{thm mod_self},
    9.19                                    @{thm div_0}, @{thm mod_0},
    9.20                                    @{thm div_by_1}, @{thm mod_by_1}, @{thm div_by_Suc_0}, @{thm mod_by_Suc_0},
    10.1 --- a/src/HOL/Divides.thy	Tue Dec 20 16:17:13 2016 +0100
    10.2 +++ b/src/HOL/Divides.thy	Tue Dec 20 16:18:56 2016 +0100
    10.3 @@ -3,37 +3,95 @@
    10.4      Copyright   1999  University of Cambridge
    10.5  *)
    10.6  
    10.7 -section \<open>The division operators div and mod\<close>
    10.8 +section \<open>Quotient and remainder\<close>
    10.9  
   10.10  theory Divides
   10.11  imports Parity
   10.12  begin
   10.13  
   10.14 -subsection \<open>Abstract division in commutative semirings.\<close>
   10.15 -
   10.16 -class semiring_div = semidom + semiring_modulo +
   10.17 -  assumes div_by_0: "a div 0 = 0"
   10.18 -    and div_0: "0 div a = 0"
   10.19 -    and div_mult_self1 [simp]: "b \<noteq> 0 \<Longrightarrow> (a + c * b) div b = c + a div b"
   10.20 +subsection \<open>Quotient and remainder in integral domains\<close>
   10.21 +
   10.22 +class semidom_modulo = algebraic_semidom + semiring_modulo
   10.23 +begin
   10.24 +
   10.25 +lemma mod_0 [simp]: "0 mod a = 0"
   10.26 +  using div_mult_mod_eq [of 0 a] by simp
   10.27 +
   10.28 +lemma mod_by_0 [simp]: "a mod 0 = a"
   10.29 +  using div_mult_mod_eq [of a 0] by simp
   10.30 +
   10.31 +lemma mod_by_1 [simp]:
   10.32 +  "a mod 1 = 0"
   10.33 +proof -
   10.34 +  from div_mult_mod_eq [of a one] div_by_1 have "a + a mod 1 = a" by simp
   10.35 +  then have "a + a mod 1 = a + 0" by simp
   10.36 +  then show ?thesis by (rule add_left_imp_eq)
   10.37 +qed
   10.38 +
   10.39 +lemma mod_self [simp]:
   10.40 +  "a mod a = 0"
   10.41 +  using div_mult_mod_eq [of a a] by simp
   10.42 +
   10.43 +lemma dvd_imp_mod_0 [simp]:
   10.44 +  assumes "a dvd b"
   10.45 +  shows "b mod a = 0"
   10.46 +  using assms minus_div_mult_eq_mod [of b a] by simp
   10.47 +
   10.48 +lemma mod_0_imp_dvd: 
   10.49 +  assumes "a mod b = 0"
   10.50 +  shows   "b dvd a"
   10.51 +proof -
   10.52 +  have "b dvd ((a div b) * b)" by simp
   10.53 +  also have "(a div b) * b = a"
   10.54 +    using div_mult_mod_eq [of a b] by (simp add: assms)
   10.55 +  finally show ?thesis .
   10.56 +qed
   10.57 +
   10.58 +lemma mod_eq_0_iff_dvd:
   10.59 +  "a mod b = 0 \<longleftrightarrow> b dvd a"
   10.60 +  by (auto intro: mod_0_imp_dvd)
   10.61 +
   10.62 +lemma dvd_eq_mod_eq_0 [nitpick_unfold, code]:
   10.63 +  "a dvd b \<longleftrightarrow> b mod a = 0"
   10.64 +  by (simp add: mod_eq_0_iff_dvd)
   10.65 +
   10.66 +lemma dvd_mod_iff: 
   10.67 +  assumes "c dvd b"
   10.68 +  shows "c dvd a mod b \<longleftrightarrow> c dvd a"
   10.69 +proof -
   10.70 +  from assms have "(c dvd a mod b) \<longleftrightarrow> (c dvd ((a div b) * b + a mod b))" 
   10.71 +    by (simp add: dvd_add_right_iff)
   10.72 +  also have "(a div b) * b + a mod b = a"
   10.73 +    using div_mult_mod_eq [of a b] by simp
   10.74 +  finally show ?thesis .
   10.75 +qed
   10.76 +
   10.77 +lemma dvd_mod_imp_dvd:
   10.78 +  assumes "c dvd a mod b" and "c dvd b"
   10.79 +  shows "c dvd a"
   10.80 +  using assms dvd_mod_iff [of c b a] by simp
   10.81 +
   10.82 +end
   10.83 +
   10.84 +class idom_modulo = idom + semidom_modulo
   10.85 +begin
   10.86 +
   10.87 +subclass idom_divide ..
   10.88 +
   10.89 +lemma div_diff [simp]:
   10.90 +  "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> (a - b) div c = a div c - b div c"
   10.91 +  using div_add [of _  _ "- b"] by (simp add: dvd_neg_div)
   10.92 +
   10.93 +end
   10.94 +
   10.95 +
   10.96 +subsection \<open>Quotient and remainder in integral domains with additional properties\<close>
   10.97 +
   10.98 +class semiring_div = semidom_modulo +
   10.99 +  assumes div_mult_self1 [simp]: "b \<noteq> 0 \<Longrightarrow> (a + c * b) div b = c + a div b"
  10.100      and div_mult_mult1 [simp]: "c \<noteq> 0 \<Longrightarrow> (c * a) div (c * b) = a div b"
  10.101  begin
  10.102  
  10.103 -subclass algebraic_semidom
  10.104 -proof
  10.105 -  fix b a
  10.106 -  assume "b \<noteq> 0"
  10.107 -  then show "a * b div b = a"
  10.108 -    using div_mult_self1 [of b 0 a] by (simp add: ac_simps div_0)
  10.109 -qed (simp add: div_by_0)
  10.110 -
  10.111 -text \<open>@{const divide} and @{const modulo}\<close>
  10.112 -
  10.113 -lemma mod_by_0 [simp]: "a mod 0 = a"
  10.114 -  using div_mult_mod_eq [of a zero] by simp
  10.115 -
  10.116 -lemma mod_0 [simp]: "0 mod a = 0"
  10.117 -  using div_mult_mod_eq [of zero a] div_0 by simp
  10.118 -
  10.119  lemma div_mult_self2 [simp]:
  10.120    assumes "b \<noteq> 0"
  10.121    shows "(a + b * c) div b = c + a div b"
  10.122 @@ -86,18 +144,6 @@
  10.123    "a * b mod b = 0"
  10.124    using mod_mult_self1 [of 0 a b] by simp
  10.125  
  10.126 -lemma mod_by_1 [simp]:
  10.127 -  "a mod 1 = 0"
  10.128 -proof -
  10.129 -  from div_mult_mod_eq [of a one] div_by_1 have "a + a mod 1 = a" by simp
  10.130 -  then have "a + a mod 1 = a + 0" by simp
  10.131 -  then show ?thesis by (rule add_left_imp_eq)
  10.132 -qed
  10.133 -
  10.134 -lemma mod_self [simp]:
  10.135 -  "a mod a = 0"
  10.136 -  using mod_mult_self2_is_0 [of 1] by simp
  10.137 -
  10.138  lemma div_add_self1:
  10.139    assumes "b \<noteq> 0"
  10.140    shows "(b + a) div b = a div b + 1"
  10.141 @@ -116,31 +162,6 @@
  10.142    "(a + b) mod b = a mod b"
  10.143    using mod_mult_self1 [of a 1 b] by simp
  10.144  
  10.145 -lemma dvd_imp_mod_0 [simp]:
  10.146 -  assumes "a dvd b"
  10.147 -  shows "b mod a = 0"
  10.148 -proof -
  10.149 -  from assms obtain c where "b = a * c" ..
  10.150 -  then have "b mod a = a * c mod a" by simp
  10.151 -  then show "b mod a = 0" by simp
  10.152 -qed
  10.153 -
  10.154 -lemma mod_eq_0_iff_dvd:
  10.155 -  "a mod b = 0 \<longleftrightarrow> b dvd a"
  10.156 -proof
  10.157 -  assume "b dvd a"
  10.158 -  then show "a mod b = 0" by simp
  10.159 -next
  10.160 -  assume "a mod b = 0"
  10.161 -  with div_mult_mod_eq [of a b] have "a div b * b = a" by simp
  10.162 -  then have "a = b * (a div b)" by (simp add: ac_simps)
  10.163 -  then show "b dvd a" ..
  10.164 -qed
  10.165 -
  10.166 -lemma dvd_eq_mod_eq_0 [nitpick_unfold, code]:
  10.167 -  "a dvd b \<longleftrightarrow> b mod a = 0"
  10.168 -  by (simp add: mod_eq_0_iff_dvd)
  10.169 -
  10.170  lemma mod_div_trivial [simp]:
  10.171    "a mod b div b = 0"
  10.172  proof (cases "b = 0")
  10.173 @@ -168,106 +189,6 @@
  10.174    finally show ?thesis .
  10.175  qed
  10.176  
  10.177 -lemma dvd_mod_imp_dvd:
  10.178 -  assumes "k dvd m mod n" and "k dvd n"
  10.179 -  shows "k dvd m"
  10.180 -proof -
  10.181 -  from assms have "k dvd (m div n) * n + m mod n"
  10.182 -    by (simp only: dvd_add dvd_mult)
  10.183 -  then show ?thesis by (simp add: div_mult_mod_eq)
  10.184 -qed
  10.185 -
  10.186 -text \<open>Addition respects modular equivalence.\<close>
  10.187 -
  10.188 -lemma mod_add_left_eq: \<comment> \<open>FIXME reorient\<close>
  10.189 -  "(a + b) mod c = (a mod c + b) mod c"
  10.190 -proof -
  10.191 -  have "(a + b) mod c = (a div c * c + a mod c + b) mod c"
  10.192 -    by (simp only: div_mult_mod_eq)
  10.193 -  also have "\<dots> = (a mod c + b + a div c * c) mod c"
  10.194 -    by (simp only: ac_simps)
  10.195 -  also have "\<dots> = (a mod c + b) mod c"
  10.196 -    by (rule mod_mult_self1)
  10.197 -  finally show ?thesis .
  10.198 -qed
  10.199 -
  10.200 -lemma mod_add_right_eq: \<comment> \<open>FIXME reorient\<close>
  10.201 -  "(a + b) mod c = (a + b mod c) mod c"
  10.202 -proof -
  10.203 -  have "(a + b) mod c = (a + (b div c * c + b mod c)) mod c"
  10.204 -    by (simp only: div_mult_mod_eq)
  10.205 -  also have "\<dots> = (a + b mod c + b div c * c) mod c"
  10.206 -    by (simp only: ac_simps)
  10.207 -  also have "\<dots> = (a + b mod c) mod c"
  10.208 -    by (rule mod_mult_self1)
  10.209 -  finally show ?thesis .
  10.210 -qed
  10.211 -
  10.212 -lemma mod_add_eq: \<comment> \<open>FIXME reorient\<close>
  10.213 -  "(a + b) mod c = (a mod c + b mod c) mod c"
  10.214 -by (rule trans [OF mod_add_left_eq mod_add_right_eq])
  10.215 -
  10.216 -lemma mod_add_cong:
  10.217 -  assumes "a mod c = a' mod c"
  10.218 -  assumes "b mod c = b' mod c"
  10.219 -  shows "(a + b) mod c = (a' + b') mod c"
  10.220 -proof -
  10.221 -  have "(a mod c + b mod c) mod c = (a' mod c + b' mod c) mod c"
  10.222 -    unfolding assms ..
  10.223 -  thus ?thesis
  10.224 -    by (simp only: mod_add_eq [symmetric])
  10.225 -qed
  10.226 -
  10.227 -text \<open>Multiplication respects modular equivalence.\<close>
  10.228 -
  10.229 -lemma mod_mult_left_eq: \<comment> \<open>FIXME reorient\<close>
  10.230 -  "(a * b) mod c = ((a mod c) * b) mod c"
  10.231 -proof -
  10.232 -  have "(a * b) mod c = ((a div c * c + a mod c) * b) mod c"
  10.233 -    by (simp only: div_mult_mod_eq)
  10.234 -  also have "\<dots> = (a mod c * b + a div c * b * c) mod c"
  10.235 -    by (simp only: algebra_simps)
  10.236 -  also have "\<dots> = (a mod c * b) mod c"
  10.237 -    by (rule mod_mult_self1)
  10.238 -  finally show ?thesis .
  10.239 -qed
  10.240 -
  10.241 -lemma mod_mult_right_eq: \<comment> \<open>FIXME reorient\<close>
  10.242 -  "(a * b) mod c = (a * (b mod c)) mod c"
  10.243 -proof -
  10.244 -  have "(a * b) mod c = (a * (b div c * c + b mod c)) mod c"
  10.245 -    by (simp only: div_mult_mod_eq)
  10.246 -  also have "\<dots> = (a * (b mod c) + a * (b div c) * c) mod c"
  10.247 -    by (simp only: algebra_simps)
  10.248 -  also have "\<dots> = (a * (b mod c)) mod c"
  10.249 -    by (rule mod_mult_self1)
  10.250 -  finally show ?thesis .
  10.251 -qed
  10.252 -
  10.253 -lemma mod_mult_eq: \<comment> \<open>FIXME reorient\<close>
  10.254 -  "(a * b) mod c = ((a mod c) * (b mod c)) mod c"
  10.255 -by (rule trans [OF mod_mult_left_eq mod_mult_right_eq])
  10.256 -
  10.257 -lemma mod_mult_cong:
  10.258 -  assumes "a mod c = a' mod c"
  10.259 -  assumes "b mod c = b' mod c"
  10.260 -  shows "(a * b) mod c = (a' * b') mod c"
  10.261 -proof -
  10.262 -  have "(a mod c * (b mod c)) mod c = (a' mod c * (b' mod c)) mod c"
  10.263 -    unfolding assms ..
  10.264 -  thus ?thesis
  10.265 -    by (simp only: mod_mult_eq [symmetric])
  10.266 -qed
  10.267 -
  10.268 -text \<open>Exponentiation respects modular equivalence.\<close>
  10.269 -
  10.270 -lemma power_mod: "(a mod b) ^ n mod b = a ^ n mod b"
  10.271 -apply (induct n, simp_all)
  10.272 -apply (rule mod_mult_right_eq [THEN trans])
  10.273 -apply (simp (no_asm_simp))
  10.274 -apply (rule mod_mult_eq [symmetric])
  10.275 -done
  10.276 -
  10.277  lemma mod_mod_cancel:
  10.278    assumes "c dvd b"
  10.279    shows "a mod b mod c = a mod c"
  10.280 @@ -319,30 +240,120 @@
  10.281  lemma dvd_mod: "k dvd m \<Longrightarrow> k dvd n \<Longrightarrow> k dvd (m mod n)"
  10.282    unfolding dvd_def by (auto simp add: mod_mult_mult1)
  10.283  
  10.284 -lemma dvd_mod_iff: "k dvd n \<Longrightarrow> k dvd (m mod n) \<longleftrightarrow> k dvd m"
  10.285 -by (blast intro: dvd_mod_imp_dvd dvd_mod)
  10.286 -
  10.287 -lemma div_div_eq_right:
  10.288 -  assumes "c dvd b" "b dvd a"
  10.289 -  shows   "a div (b div c) = a div b * c"
  10.290 +named_theorems mod_simps
  10.291 +
  10.292 +text \<open>Addition respects modular equivalence.\<close>
  10.293 +
  10.294 +lemma mod_add_left_eq [mod_simps]:
  10.295 +  "(a mod c + b) mod c = (a + b) mod c"
  10.296 +proof -
  10.297 +  have "(a + b) mod c = (a div c * c + a mod c + b) mod c"
  10.298 +    by (simp only: div_mult_mod_eq)
  10.299 +  also have "\<dots> = (a mod c + b + a div c * c) mod c"
  10.300 +    by (simp only: ac_simps)
  10.301 +  also have "\<dots> = (a mod c + b) mod c"
  10.302 +    by (rule mod_mult_self1)
  10.303 +  finally show ?thesis
  10.304 +    by (rule sym)
  10.305 +qed
  10.306 +
  10.307 +lemma mod_add_right_eq [mod_simps]:
  10.308 +  "(a + b mod c) mod c = (a + b) mod c"
  10.309 +  using mod_add_left_eq [of b c a] by (simp add: ac_simps)
  10.310 +
  10.311 +lemma mod_add_eq:
  10.312 +  "(a mod c + b mod c) mod c = (a + b) mod c"
  10.313 +  by (simp add: mod_add_left_eq mod_add_right_eq)
  10.314 +
  10.315 +lemma mod_sum_eq [mod_simps]:
  10.316 +  "(\<Sum>i\<in>A. f i mod a) mod a = sum f A mod a"
  10.317 +proof (induct A rule: infinite_finite_induct)
  10.318 +  case (insert i A)
  10.319 +  then have "(\<Sum>i\<in>insert i A. f i mod a) mod a
  10.320 +    = (f i mod a + (\<Sum>i\<in>A. f i mod a)) mod a"
  10.321 +    by simp
  10.322 +  also have "\<dots> = (f i + (\<Sum>i\<in>A. f i mod a) mod a) mod a"
  10.323 +    by (simp add: mod_simps)
  10.324 +  also have "\<dots> = (f i + (\<Sum>i\<in>A. f i) mod a) mod a"
  10.325 +    by (simp add: insert.hyps)
  10.326 +  finally show ?case
  10.327 +    by (simp add: insert.hyps mod_simps)
  10.328 +qed simp_all
  10.329 +
  10.330 +lemma mod_add_cong:
  10.331 +  assumes "a mod c = a' mod c"
  10.332 +  assumes "b mod c = b' mod c"
  10.333 +  shows "(a + b) mod c = (a' + b') mod c"
  10.334 +proof -
  10.335 +  have "(a mod c + b mod c) mod c = (a' mod c + b' mod c) mod c"
  10.336 +    unfolding assms ..
  10.337 +  then show ?thesis
  10.338 +    by (simp add: mod_add_eq)
  10.339 +qed
  10.340 +
  10.341 +text \<open>Multiplication respects modular equivalence.\<close>
  10.342 +
  10.343 +lemma mod_mult_left_eq [mod_simps]:
  10.344 +  "((a mod c) * b) mod c = (a * b) mod c"
  10.345  proof -
  10.346 -  from assms have "a div b * c = (a * c) div b"
  10.347 -    by (subst dvd_div_mult) simp_all
  10.348 -  also from assms have "\<dots> = (a * c) div ((b div c) * c)" by simp
  10.349 -  also have "a * c div (b div c * c) = a div (b div c)"
  10.350 -    by (cases "c = 0") simp_all
  10.351 -  finally show ?thesis ..
  10.352 +  have "(a * b) mod c = ((a div c * c + a mod c) * b) mod c"
  10.353 +    by (simp only: div_mult_mod_eq)
  10.354 +  also have "\<dots> = (a mod c * b + a div c * b * c) mod c"
  10.355 +    by (simp only: algebra_simps)
  10.356 +  also have "\<dots> = (a mod c * b) mod c"
  10.357 +    by (rule mod_mult_self1)
  10.358 +  finally show ?thesis
  10.359 +    by (rule sym)
  10.360  qed
  10.361  
  10.362 -lemma div_div_div_same:
  10.363 -  assumes "d dvd a" "d dvd b" "b dvd a"
  10.364 -  shows   "(a div d) div (b div d) = a div b"
  10.365 -  using assms by (subst dvd_div_mult2_eq [symmetric]) simp_all
  10.366 -
  10.367 -lemma cancel_div_mod_rules:
  10.368 -  "((a div b) * b + a mod b) + c = a + c"
  10.369 -  "(b * (a div b) + a mod b) + c = a + c"
  10.370 -  by (simp_all add: div_mult_mod_eq mult_div_mod_eq)
  10.371 +lemma mod_mult_right_eq [mod_simps]:
  10.372 +  "(a * (b mod c)) mod c = (a * b) mod c"
  10.373 +  using mod_mult_left_eq [of b c a] by (simp add: ac_simps)
  10.374 +
  10.375 +lemma mod_mult_eq:
  10.376 +  "((a mod c) * (b mod c)) mod c = (a * b) mod c"
  10.377 +  by (simp add: mod_mult_left_eq mod_mult_right_eq)
  10.378 +
  10.379 +lemma mod_prod_eq [mod_simps]:
  10.380 +  "(\<Prod>i\<in>A. f i mod a) mod a = prod f A mod a"
  10.381 +proof (induct A rule: infinite_finite_induct)
  10.382 +  case (insert i A)
  10.383 +  then have "(\<Prod>i\<in>insert i A. f i mod a) mod a
  10.384 +    = (f i mod a * (\<Prod>i\<in>A. f i mod a)) mod a"
  10.385 +    by simp
  10.386 +  also have "\<dots> = (f i * ((\<Prod>i\<in>A. f i mod a) mod a)) mod a"
  10.387 +    by (simp add: mod_simps)
  10.388 +  also have "\<dots> = (f i * ((\<Prod>i\<in>A. f i) mod a)) mod a"
  10.389 +    by (simp add: insert.hyps)
  10.390 +  finally show ?case
  10.391 +    by (simp add: insert.hyps mod_simps)
  10.392 +qed simp_all
  10.393 +
  10.394 +lemma mod_mult_cong:
  10.395 +  assumes "a mod c = a' mod c"
  10.396 +  assumes "b mod c = b' mod c"
  10.397 +  shows "(a * b) mod c = (a' * b') mod c"
  10.398 +proof -
  10.399 +  have "(a mod c * (b mod c)) mod c = (a' mod c * (b' mod c)) mod c"
  10.400 +    unfolding assms ..
  10.401 +  then show ?thesis
  10.402 +    by (simp add: mod_mult_eq)
  10.403 +qed
  10.404 +
  10.405 +text \<open>Exponentiation respects modular equivalence.\<close>
  10.406 +
  10.407 +lemma power_mod [mod_simps]: 
  10.408 +  "((a mod b) ^ n) mod b = (a ^ n) mod b"
  10.409 +proof (induct n)
  10.410 +  case 0
  10.411 +  then show ?case by simp
  10.412 +next
  10.413 +  case (Suc n)
  10.414 +  have "(a mod b) ^ Suc n mod b = (a mod b) * ((a mod b) ^ n mod b) mod b"
  10.415 +    by (simp add: mod_mult_right_eq)
  10.416 +  with Suc show ?case
  10.417 +    by (simp add: mod_mult_left_eq mod_mult_right_eq)
  10.418 +qed
  10.419  
  10.420  end
  10.421  
  10.422 @@ -351,9 +362,28 @@
  10.423  
  10.424  subclass idom_divide ..
  10.425  
  10.426 +lemma div_minus_minus [simp]: "(- a) div (- b) = a div b"
  10.427 +  using div_mult_mult1 [of "- 1" a b] by simp
  10.428 +
  10.429 +lemma mod_minus_minus [simp]: "(- a) mod (- b) = - (a mod b)"
  10.430 +  using mod_mult_mult1 [of "- 1" a b] by simp
  10.431 +
  10.432 +lemma div_minus_right: "a div (- b) = (- a) div b"
  10.433 +  using div_minus_minus [of "- a" b] by simp
  10.434 +
  10.435 +lemma mod_minus_right: "a mod (- b) = - ((- a) mod b)"
  10.436 +  using mod_minus_minus [of "- a" b] by simp
  10.437 +
  10.438 +lemma div_minus1_right [simp]: "a div (- 1) = - a"
  10.439 +  using div_minus_right [of a 1] by simp
  10.440 +
  10.441 +lemma mod_minus1_right [simp]: "a mod (- 1) = 0"
  10.442 +  using mod_minus_right [of a 1] by simp
  10.443 +
  10.444  text \<open>Negation respects modular equivalence.\<close>
  10.445  
  10.446 -lemma mod_minus_eq: "(- a) mod b = (- (a mod b)) mod b"
  10.447 +lemma mod_minus_eq [mod_simps]:
  10.448 +  "(- (a mod b)) mod b = (- a) mod b"
  10.449  proof -
  10.450    have "(- a) mod b = (- (a div b * b + a mod b)) mod b"
  10.451      by (simp only: div_mult_mod_eq)
  10.452 @@ -361,7 +391,8 @@
  10.453      by (simp add: ac_simps)
  10.454    also have "\<dots> = (- (a mod b)) mod b"
  10.455      by (rule mod_mult_self1)
  10.456 -  finally show ?thesis .
  10.457 +  finally show ?thesis
  10.458 +    by (rule sym)
  10.459  qed
  10.460  
  10.461  lemma mod_minus_cong:
  10.462 @@ -370,73 +401,37 @@
  10.463  proof -
  10.464    have "(- (a mod b)) mod b = (- (a' mod b)) mod b"
  10.465      unfolding assms ..
  10.466 -  thus ?thesis
  10.467 -    by (simp only: mod_minus_eq [symmetric])
  10.468 +  then show ?thesis
  10.469 +    by (simp add: mod_minus_eq)
  10.470  qed
  10.471  
  10.472  text \<open>Subtraction respects modular equivalence.\<close>
  10.473  
  10.474 -lemma mod_diff_left_eq:
  10.475 -  "(a - b) mod c = (a mod c - b) mod c"
  10.476 -  using mod_add_cong [of a c "a mod c" "- b" "- b"] by simp
  10.477 -
  10.478 -lemma mod_diff_right_eq:
  10.479 -  "(a - b) mod c = (a - b mod c) mod c"
  10.480 -  using mod_add_cong [of a c a "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b] by simp
  10.481 +lemma mod_diff_left_eq [mod_simps]:
  10.482 +  "(a mod c - b) mod c = (a - b) mod c"
  10.483 +  using mod_add_cong [of a c "a mod c" "- b" "- b"]
  10.484 +  by simp
  10.485 +
  10.486 +lemma mod_diff_right_eq [mod_simps]:
  10.487 +  "(a - b mod c) mod c = (a - b) mod c"
  10.488 +  using mod_add_cong [of a c a "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b]
  10.489 +  by simp
  10.490  
  10.491  lemma mod_diff_eq:
  10.492 -  "(a - b) mod c = (a mod c - b mod c) mod c"
  10.493 -  using mod_add_cong [of a c "a mod c" "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b] by simp
  10.494 +  "(a mod c - b mod c) mod c = (a - b) mod c"
  10.495 +  using mod_add_cong [of a c "a mod c" "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b]
  10.496 +  by simp
  10.497  
  10.498  lemma mod_diff_cong:
  10.499    assumes "a mod c = a' mod c"
  10.500    assumes "b mod c = b' mod c"
  10.501    shows "(a - b) mod c = (a' - b') mod c"
  10.502 -  using assms mod_add_cong [of a c a' "- b" "- b'"] mod_minus_cong [of b c "b'"] by simp
  10.503 -
  10.504 -lemma dvd_neg_div: "y dvd x \<Longrightarrow> -x div y = - (x div y)"
  10.505 -apply (case_tac "y = 0") apply simp
  10.506 -apply (auto simp add: dvd_def)
  10.507 -apply (subgoal_tac "-(y * k) = y * - k")
  10.508 - apply (simp only:)
  10.509 - apply (erule nonzero_mult_div_cancel_left)
  10.510 -apply simp
  10.511 -done
  10.512 -
  10.513 -lemma dvd_div_neg: "y dvd x \<Longrightarrow> x div -y = - (x div y)"
  10.514 -apply (case_tac "y = 0") apply simp
  10.515 -apply (auto simp add: dvd_def)
  10.516 -apply (subgoal_tac "y * k = -y * -k")
  10.517 - apply (erule ssubst, rule nonzero_mult_div_cancel_left)
  10.518 - apply simp
  10.519 -apply simp
  10.520 -done
  10.521 -
  10.522 -lemma div_diff [simp]:
  10.523 -  "z dvd x \<Longrightarrow> z dvd y \<Longrightarrow> (x - y) div z = x div z - y div z"
  10.524 -  using div_add [of _ _ "- y"] by (simp add: dvd_neg_div)
  10.525 -
  10.526 -lemma div_minus_minus [simp]: "(-a) div (-b) = a div b"
  10.527 -  using div_mult_mult1 [of "- 1" a b]
  10.528 -  unfolding neg_equal_0_iff_equal by simp
  10.529 -
  10.530 -lemma mod_minus_minus [simp]: "(-a) mod (-b) = - (a mod b)"
  10.531 -  using mod_mult_mult1 [of "- 1" a b] by simp
  10.532 -
  10.533 -lemma div_minus_right: "a div (-b) = (-a) div b"
  10.534 -  using div_minus_minus [of "-a" b] by simp
  10.535 -
  10.536 -lemma mod_minus_right: "a mod (-b) = - ((-a) mod b)"
  10.537 -  using mod_minus_minus [of "-a" b] by simp
  10.538 -
  10.539 -lemma div_minus1_right [simp]: "a div (-1) = -a"
  10.540 -  using div_minus_right [of a 1] by simp
  10.541 -
  10.542 -lemma mod_minus1_right [simp]: "a mod (-1) = 0"
  10.543 -  using mod_minus_right [of a 1] by simp
  10.544 +  using assms mod_add_cong [of a c a' "- b" "- b'"] mod_minus_cong [of b c "b'"]
  10.545 +  by simp
  10.546  
  10.547  lemma minus_mod_self2 [simp]:
  10.548    "(a - b) mod b = a mod b"
  10.549 +  using mod_diff_right_eq [of a b b]
  10.550    by (simp add: mod_diff_right_eq)
  10.551  
  10.552  lemma minus_mod_self1 [simp]:
  10.553 @@ -446,7 +441,7 @@
  10.554  end
  10.555  
  10.556  
  10.557 -subsubsection \<open>Parity and division\<close>
  10.558 +subsection \<open>Parity\<close>
  10.559  
  10.560  class semiring_div_parity = semiring_div + comm_semiring_1_cancel + numeral +
  10.561    assumes parity: "a mod 2 = 0 \<or> a mod 2 = 1"
  10.562 @@ -490,18 +485,21 @@
  10.563    assume "a mod 2 = 1"
  10.564    moreover assume "b mod 2 = 1"
  10.565    ultimately show "(a + b) mod 2 = 0"
  10.566 -    using mod_add_eq [of a b 2] by simp
  10.567 +    using mod_add_eq [of a 2 b] by simp
  10.568  next
  10.569    fix a b
  10.570    assume "(a * b) mod 2 = 0"
  10.571 +  then have "(a mod 2) * (b mod 2) mod 2 = 0"
  10.572 +    by (simp add: mod_mult_eq)
  10.573    then have "(a mod 2) * (b mod 2) = 0"
  10.574 -    by (cases "a mod 2 = 0") (simp_all add: mod_mult_eq [of a b 2])
  10.575 +    by (cases "a mod 2 = 0") simp_all
  10.576    then show "a mod 2 = 0 \<or> b mod 2 = 0"
  10.577      by (rule divisors_zero)
  10.578  next
  10.579    fix a
  10.580    assume "a mod 2 = 1"
  10.581 -  then have "a = a div 2 * 2 + 1" using div_mult_mod_eq [of a 2] by simp
  10.582 +  then have "a = a div 2 * 2 + 1"
  10.583 +    using div_mult_mod_eq [of a 2] by simp
  10.584    then show "\<exists>b. a = b + 1" ..
  10.585  qed
  10.586  
  10.587 @@ -532,7 +530,7 @@
  10.588  end
  10.589  
  10.590  
  10.591 -subsection \<open>Generic numeral division with a pragmatic type class\<close>
  10.592 +subsection \<open>Numeral division with a pragmatic type class\<close>
  10.593  
  10.594  text \<open>
  10.595    The following type class contains everything necessary to formulate
  10.596 @@ -826,8 +824,10 @@
  10.597        from m n have "Suc m = q' * n + Suc r'" by simp
  10.598        with True show ?thesis by blast
  10.599      next
  10.600 -      case False then have "n \<le> Suc r'" by auto
  10.601 -      moreover from n have "Suc r' \<le> n" by auto
  10.602 +      case False then have "n \<le> Suc r'"
  10.603 +        by (simp add: not_less)
  10.604 +      moreover from n have "Suc r' \<le> n"
  10.605 +        by (simp add: Suc_le_eq)
  10.606        ultimately have "n = Suc r'" by auto
  10.607        with m have "Suc m = Suc q' * n + 0" by simp
  10.608        with \<open>n \<noteq> 0\<close> show ?thesis by blast
  10.609 @@ -855,7 +855,7 @@
  10.610    apply (auto simp add: add_mult_distrib)
  10.611    done
  10.612    from \<open>n \<noteq> 0\<close> assms have *: "fst qr = fst qr'"
  10.613 -    by (auto simp add: divmod_nat_rel_def intro: order_antisym dest: aux sym)
  10.614 +    by (auto simp add: divmod_nat_rel_def intro: order_antisym dest: aux sym split: if_splits)
  10.615    with assms have "snd qr = snd qr'"
  10.616      by (simp add: divmod_nat_rel_def)
  10.617    with * show ?thesis by (cases qr, cases qr') simp
  10.618 @@ -884,10 +884,10 @@
  10.619    using assms by (auto intro: divmod_nat_rel_unique divmod_nat_rel_divmod_nat)
  10.620  
  10.621  qualified lemma divmod_nat_zero: "divmod_nat m 0 = (0, m)"
  10.622 -  by (simp add: Divides.divmod_nat_unique divmod_nat_rel_def)
  10.623 +  by (simp add: divmod_nat_unique divmod_nat_rel_def)
  10.624  
  10.625  qualified lemma divmod_nat_zero_left: "divmod_nat 0 n = (0, 0)"
  10.626 -  by (simp add: Divides.divmod_nat_unique divmod_nat_rel_def)
  10.627 +  by (simp add: divmod_nat_unique divmod_nat_rel_def)
  10.628  
  10.629  qualified lemma divmod_nat_base: "m < n \<Longrightarrow> divmod_nat m n = (0, m)"
  10.630    by (simp add: divmod_nat_unique divmod_nat_rel_def)
  10.631 @@ -899,19 +899,31 @@
  10.632    have "divmod_nat_rel (m - n) n (divmod_nat (m - n) n)"
  10.633      by (fact divmod_nat_rel_divmod_nat)
  10.634    then show "divmod_nat_rel m n (apfst Suc (divmod_nat (m - n) n))"
  10.635 -    unfolding divmod_nat_rel_def using assms by auto
  10.636 +    unfolding divmod_nat_rel_def using assms
  10.637 +      by (auto split: if_splits simp add: algebra_simps)
  10.638  qed
  10.639  
  10.640  end
  10.641 -  
  10.642 -instantiation nat :: semiring_div
  10.643 +
  10.644 +instantiation nat :: "{semidom_modulo, normalization_semidom}"
  10.645  begin
  10.646  
  10.647 -definition divide_nat where
  10.648 -  div_nat_def: "m div n = fst (Divides.divmod_nat m n)"
  10.649 -
  10.650 -definition modulo_nat where
  10.651 -  mod_nat_def: "m mod n = snd (Divides.divmod_nat m n)"
  10.652 +definition normalize_nat :: "nat \<Rightarrow> nat"
  10.653 +  where [simp]: "normalize = (id :: nat \<Rightarrow> nat)"
  10.654 +
  10.655 +definition unit_factor_nat :: "nat \<Rightarrow> nat"
  10.656 +  where "unit_factor n = (if n = 0 then 0 else 1 :: nat)"
  10.657 +
  10.658 +lemma unit_factor_simps [simp]:
  10.659 +  "unit_factor 0 = (0::nat)"
  10.660 +  "unit_factor (Suc n) = 1"
  10.661 +  by (simp_all add: unit_factor_nat_def)
  10.662 +
  10.663 +definition divide_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat"
  10.664 +  where div_nat_def: "m div n = fst (Divides.divmod_nat m n)"
  10.665 +
  10.666 +definition modulo_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat"
  10.667 +  where mod_nat_def: "m mod n = snd (Divides.divmod_nat m n)"
  10.668  
  10.669  lemma fst_divmod_nat [simp]:
  10.670    "fst (Divides.divmod_nat m n) = m div n"
  10.671 @@ -928,15 +940,18 @@
  10.672  lemma div_nat_unique:
  10.673    assumes "divmod_nat_rel m n (q, r)"
  10.674    shows "m div n = q"
  10.675 -  using assms by (auto dest!: Divides.divmod_nat_unique simp add: prod_eq_iff)
  10.676 +  using assms
  10.677 +  by (auto dest!: Divides.divmod_nat_unique simp add: prod_eq_iff)
  10.678  
  10.679  lemma mod_nat_unique:
  10.680    assumes "divmod_nat_rel m n (q, r)"
  10.681    shows "m mod n = r"
  10.682 -  using assms by (auto dest!: Divides.divmod_nat_unique simp add: prod_eq_iff)
  10.683 +  using assms
  10.684 +  by (auto dest!: Divides.divmod_nat_unique simp add: prod_eq_iff)
  10.685  
  10.686  lemma divmod_nat_rel: "divmod_nat_rel m n (m div n, m mod n)"
  10.687 -  using Divides.divmod_nat_rel_divmod_nat by (simp add: divmod_nat_div_mod)
  10.688 +  using Divides.divmod_nat_rel_divmod_nat
  10.689 +  by (simp add: divmod_nat_div_mod)
  10.690  
  10.691  text \<open>The ''recursion'' equations for @{const divide} and @{const modulo}\<close>
  10.692  
  10.693 @@ -964,11 +979,40 @@
  10.694    shows "m mod n = (m - n) mod n"
  10.695    using assms Divides.divmod_nat_step by (cases "n = 0") (simp_all add: prod_eq_iff)
  10.696  
  10.697 +lemma mod_less_divisor [simp]:
  10.698 +  fixes m n :: nat
  10.699 +  assumes "n > 0"
  10.700 +  shows "m mod n < n"
  10.701 +  using assms divmod_nat_rel [of m n] unfolding divmod_nat_rel_def
  10.702 +  by (auto split: if_splits)
  10.703 +
  10.704 +lemma mod_le_divisor [simp]:
  10.705 +  fixes m n :: nat
  10.706 +  assumes "n > 0"
  10.707 +  shows "m mod n \<le> n"
  10.708 +proof (rule less_imp_le)
  10.709 +  from assms show "m mod n < n"
  10.710 +    by simp
  10.711 +qed
  10.712 +
  10.713  instance proof
  10.714    fix m n :: nat
  10.715    show "m div n * n + m mod n = m"
  10.716      using divmod_nat_rel [of m n] by (simp add: divmod_nat_rel_def)
  10.717  next
  10.718 +  fix n :: nat show "n div 0 = 0"
  10.719 +    by (simp add: div_nat_def Divides.divmod_nat_zero)
  10.720 +next
  10.721 +  fix m n :: nat
  10.722 +  assume "n \<noteq> 0"
  10.723 +  then show "m * n div n = m"
  10.724 +    by (auto simp add: divmod_nat_rel_def intro: div_nat_unique [of _ _ _ 0])
  10.725 +qed (simp_all add: unit_factor_nat_def)
  10.726 +
  10.727 +end
  10.728 +
  10.729 +instance nat :: semiring_div
  10.730 +proof
  10.731    fix m n q :: nat
  10.732    assume "n \<noteq> 0"
  10.733    then show "(q + m * n) div n = m + q div n"
  10.734 @@ -976,48 +1020,33 @@
  10.735  next
  10.736    fix m n q :: nat
  10.737    assume "m \<noteq> 0"
  10.738 -  hence "\<And>a b. divmod_nat_rel n q (a, b) \<Longrightarrow> divmod_nat_rel (m * n) (m * q) (a, m * b)"
  10.739 -    unfolding divmod_nat_rel_def
  10.740 -    by (auto split: if_split_asm, simp_all add: algebra_simps)
  10.741 -  moreover from divmod_nat_rel have "divmod_nat_rel n q (n div q, n mod q)" .
  10.742 -  ultimately have "divmod_nat_rel (m * n) (m * q) (n div q, m * (n mod q))" .
  10.743 -  thus "(m * n) div (m * q) = n div q" by (rule div_nat_unique)
  10.744 -next
  10.745 -  fix n :: nat show "n div 0 = 0"
  10.746 -    by (simp add: div_nat_def Divides.divmod_nat_zero)
  10.747 -next
  10.748 -  fix n :: nat show "0 div n = 0"
  10.749 -    by (simp add: div_nat_def Divides.divmod_nat_zero_left)
  10.750 +  then have "divmod_nat_rel (m * n) (m * q) (n div q, m * (n mod q))"
  10.751 +    using div_mult_mod_eq [of n q]
  10.752 +    by (auto simp add: divmod_nat_rel_def algebra_simps distrib_left [symmetric] simp del: distrib_left)
  10.753 +  then show "(m * n) div (m * q) = n div q"
  10.754 +    by (rule div_nat_unique)
  10.755  qed
  10.756  
  10.757 -end
  10.758 -
  10.759 -instantiation nat :: normalization_semidom
  10.760 -begin
  10.761 -
  10.762 -definition normalize_nat
  10.763 -  where [simp]: "normalize = (id :: nat \<Rightarrow> nat)"
  10.764 -
  10.765 -definition unit_factor_nat
  10.766 -  where "unit_factor n = (if n = 0 then 0 else 1 :: nat)"
  10.767 -
  10.768 -lemma unit_factor_simps [simp]:
  10.769 -  "unit_factor 0 = (0::nat)"
  10.770 -  "unit_factor (Suc n) = 1"
  10.771 -  by (simp_all add: unit_factor_nat_def)
  10.772 -
  10.773 -instance
  10.774 -  by standard (simp_all add: unit_factor_nat_def)
  10.775 -  
  10.776 -end
  10.777 -
  10.778 -lemma divmod_nat_if [code]:
  10.779 -  "Divides.divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else
  10.780 -    let (q, r) = Divides.divmod_nat (m - n) n in (Suc q, r))"
  10.781 -  by (simp add: prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq)
  10.782 +lemma div_by_Suc_0 [simp]:
  10.783 +  "m div Suc 0 = m"
  10.784 +  using div_by_1 [of m] by simp
  10.785 +
  10.786 +lemma mod_by_Suc_0 [simp]:
  10.787 +  "m mod Suc 0 = 0"
  10.788 +  using mod_by_1 [of m] by simp
  10.789 +
  10.790 +lemma mod_greater_zero_iff_not_dvd:
  10.791 +  fixes m n :: nat
  10.792 +  shows "m mod n > 0 \<longleftrightarrow> \<not> n dvd m"
  10.793 +  by (simp add: dvd_eq_mod_eq_0)
  10.794  
  10.795  text \<open>Simproc for cancelling @{const divide} and @{const modulo}\<close>
  10.796  
  10.797 +lemma (in semiring_modulo) cancel_div_mod_rules:
  10.798 +  "((a div b) * b + a mod b) + c = a + c"
  10.799 +  "(b * (a div b) + a mod b) + c = a + c"
  10.800 +  by (simp_all add: div_mult_mod_eq mult_div_mod_eq)
  10.801 +
  10.802  ML_file "~~/src/Provers/Arith/cancel_div_mod.ML"
  10.803  
  10.804  ML \<open>
  10.805 @@ -1048,7 +1077,31 @@
  10.806  )
  10.807  \<close>
  10.808  
  10.809 -simproc_setup cancel_div_mod_nat ("(m::nat) + n") = \<open>K Cancel_Div_Mod_Nat.proc\<close>
  10.810 +simproc_setup cancel_div_mod_nat ("(m::nat) + n") =
  10.811 +  \<open>K Cancel_Div_Mod_Nat.proc\<close>
  10.812 +
  10.813 +lemma divmod_nat_if [code]:
  10.814 +  "Divides.divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else
  10.815 +    let (q, r) = Divides.divmod_nat (m - n) n in (Suc q, r))"
  10.816 +  by (simp add: prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq)
  10.817 +
  10.818 +lemma mod_Suc_eq [mod_simps]:
  10.819 +  "Suc (m mod n) mod n = Suc m mod n"
  10.820 +proof -
  10.821 +  have "(m mod n + 1) mod n = (m + 1) mod n"
  10.822 +    by (simp only: mod_simps)
  10.823 +  then show ?thesis
  10.824 +    by simp
  10.825 +qed
  10.826 +
  10.827 +lemma mod_Suc_Suc_eq [mod_simps]:
  10.828 +  "Suc (Suc (m mod n)) mod n = Suc (Suc m) mod n"
  10.829 +proof -
  10.830 +  have "(m mod n + 2) mod n = (m + 2) mod n"
  10.831 +    by (simp only: mod_simps)
  10.832 +  then show ?thesis
  10.833 +    by simp
  10.834 +qed
  10.835  
  10.836  
  10.837  subsubsection \<open>Quotient\<close>
  10.838 @@ -1077,16 +1130,11 @@
  10.839  qed
  10.840  
  10.841  lemma div_eq_0_iff: "(a div b::nat) = 0 \<longleftrightarrow> a < b \<or> b = 0"
  10.842 -  by (metis div_less div_positive div_by_0 gr0I less_numeral_extra(3) not_less)
  10.843 +  by auto (metis div_positive less_numeral_extra(3) not_less)
  10.844 +
  10.845  
  10.846  subsubsection \<open>Remainder\<close>
  10.847  
  10.848 -lemma mod_less_divisor [simp]:
  10.849 -  fixes m n :: nat
  10.850 -  assumes "n > 0"
  10.851 -  shows "m mod n < (n::nat)"
  10.852 -  using assms divmod_nat_rel [of m n] unfolding divmod_nat_rel_def by auto
  10.853 -
  10.854  lemma mod_Suc_le_divisor [simp]:
  10.855    "m mod Suc n \<le> n"
  10.856    using mod_less_divisor [of "Suc n" m] by arith
  10.857 @@ -1105,13 +1153,6 @@
  10.858  lemma mod_if: "m mod (n::nat) = (if m < n then m else (m - n) mod n)"
  10.859  by (simp add: le_mod_geq)
  10.860  
  10.861 -lemma mod_by_Suc_0 [simp]: "m mod Suc 0 = 0"
  10.862 -by (induct m) (simp_all add: mod_geq)
  10.863 -
  10.864 -lemma mod_le_divisor[simp]: "0 < n \<Longrightarrow> m mod n \<le> (n::nat)"
  10.865 -  apply (drule mod_less_divisor [where m = m])
  10.866 -  apply simp
  10.867 -  done
  10.868  
  10.869  subsubsection \<open>Quotient and Remainder\<close>
  10.870  
  10.871 @@ -1180,25 +1221,16 @@
  10.872  
  10.873  subsubsection \<open>Further Facts about Quotient and Remainder\<close>
  10.874  
  10.875 -lemma div_by_Suc_0 [simp]:
  10.876 -  "m div Suc 0 = m"
  10.877 -  using div_by_1 [of m] by simp
  10.878 -
  10.879 -(* Monotonicity of div in first argument *)
  10.880 -lemma div_le_mono [rule_format (no_asm)]:
  10.881 -    "\<forall>m::nat. m \<le> n --> (m div k) \<le> (n div k)"
  10.882 -apply (case_tac "k=0", simp)
  10.883 -apply (induct "n" rule: nat_less_induct, clarify)
  10.884 -apply (case_tac "n<k")
  10.885 -(* 1  case n<k *)
  10.886 -apply simp
  10.887 -(* 2  case n >= k *)
  10.888 -apply (case_tac "m<k")
  10.889 -(* 2.1  case m<k *)
  10.890 -apply simp
  10.891 -(* 2.2  case m>=k *)
  10.892 -apply (simp add: div_geq diff_le_mono)
  10.893 -done
  10.894 +lemma div_le_mono:
  10.895 +  fixes m n k :: nat
  10.896 +  assumes "m \<le> n"
  10.897 +  shows "m div k \<le> n div k"
  10.898 +proof -
  10.899 +  from assms obtain q where "n = m + q"
  10.900 +    by (auto simp add: le_iff_add)
  10.901 +  then show ?thesis
  10.902 +    by (simp add: div_add1_eq [of m q k])
  10.903 +qed
  10.904  
  10.905  (* Antimonotonicity of div in second argument *)
  10.906  lemma div_le_mono2: "!!m::nat. [| 0<m; m\<le>n |] ==> (k div n) \<le> (k div m)"
  10.907 @@ -1519,11 +1551,6 @@
  10.908  
  10.909  declare Suc_times_mod_eq [of "numeral w", simp] for w
  10.910  
  10.911 -lemma mod_greater_zero_iff_not_dvd:
  10.912 -  fixes m n :: nat
  10.913 -  shows "m mod n > 0 \<longleftrightarrow> \<not> n dvd m"
  10.914 -  by (simp add: dvd_eq_mod_eq_0)
  10.915 -
  10.916  lemma Suc_div_le_mono [simp]: "n div k \<le> (Suc n) div k"
  10.917  by (simp add: div_le_mono)
  10.918  
  10.919 @@ -1643,6 +1670,9 @@
  10.920  
  10.921  subsection \<open>Division on @{typ int}\<close>
  10.922  
  10.923 +context
  10.924 +begin
  10.925 +
  10.926  definition divmod_int_rel :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" \<comment> \<open>definition of quotient and remainder\<close>
  10.927    where "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
  10.928      (if 0 < b then 0 \<le> r \<and> r < b else if b < 0 then b < r \<and> r \<le> 0 else q = 0))"
  10.929 @@ -1678,10 +1708,18 @@
  10.930  apply (blast intro: unique_quotient)
  10.931  done
  10.932  
  10.933 -instantiation int :: modulo
  10.934 +end
  10.935 +
  10.936 +instantiation int :: "{idom_modulo, normalization_semidom}"
  10.937  begin
  10.938  
  10.939 -definition divide_int
  10.940 +definition normalize_int :: "int \<Rightarrow> int"
  10.941 +  where [simp]: "normalize = (abs :: int \<Rightarrow> int)"
  10.942 +
  10.943 +definition unit_factor_int :: "int \<Rightarrow> int"
  10.944 +  where [simp]: "unit_factor = (sgn :: int \<Rightarrow> int)"
  10.945 +
  10.946 +definition divide_int :: "int \<Rightarrow> int \<Rightarrow> int"
  10.947    where "k div l = (if l = 0 \<or> k = 0 then 0
  10.948      else if k > 0 \<and> l > 0 \<or> k < 0 \<and> l < 0
  10.949        then int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)
  10.950 @@ -1689,32 +1727,35 @@
  10.951          if l dvd k then - int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)
  10.952          else - int (Suc (nat \<bar>k\<bar> div nat \<bar>l\<bar>)))"
  10.953  
  10.954 -definition modulo_int
  10.955 +definition modulo_int :: "int \<Rightarrow> int \<Rightarrow> int"
  10.956    where "k mod l = (if l = 0 then k else if l dvd k then 0
  10.957      else if k > 0 \<and> l > 0 \<or> k < 0 \<and> l < 0
  10.958        then sgn l * int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)
  10.959        else sgn l * (\<bar>l\<bar> - int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)))"
  10.960  
  10.961 -instance ..      
  10.962 -
  10.963 -end
  10.964 -
  10.965  lemma divmod_int_rel:
  10.966    "divmod_int_rel k l (k div l, k mod l)"
  10.967 -  unfolding divmod_int_rel_def divide_int_def modulo_int_def
  10.968 -  apply (cases k rule: int_cases3)
  10.969 -  apply (simp add: mod_greater_zero_iff_not_dvd not_le algebra_simps)
  10.970 -  apply (cases l rule: int_cases3)
  10.971 -  apply (simp add: mod_greater_zero_iff_not_dvd not_le algebra_simps)
  10.972 -  apply (simp_all del: of_nat_add of_nat_mult add: mod_greater_zero_iff_not_dvd not_le algebra_simps int_dvd_iff of_nat_add [symmetric] of_nat_mult [symmetric])
  10.973 -  apply (cases l rule: int_cases3)
  10.974 -  apply (simp_all del: of_nat_add of_nat_mult add: not_le algebra_simps int_dvd_iff of_nat_add [symmetric] of_nat_mult [symmetric])
  10.975 -  done
  10.976 -
  10.977 -instantiation int :: ring_div
  10.978 -begin
  10.979 -
  10.980 -subsubsection \<open>Uniqueness and Monotonicity of Quotients and Remainders\<close>
  10.981 +proof (cases k rule: int_cases3)
  10.982 +  case zero
  10.983 +  then show ?thesis
  10.984 +    by (simp add: divmod_int_rel_def divide_int_def modulo_int_def)
  10.985 +next
  10.986 +  case (pos n)
  10.987 +  then show ?thesis
  10.988 +    using div_mult_mod_eq [of n]
  10.989 +    by (cases l rule: int_cases3)
  10.990 +      (auto simp del: of_nat_mult of_nat_add
  10.991 +        simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps
  10.992 +        divmod_int_rel_def divide_int_def modulo_int_def int_dvd_iff)
  10.993 +next
  10.994 +  case (neg n)
  10.995 +  then show ?thesis
  10.996 +    using div_mult_mod_eq [of n]
  10.997 +    by (cases l rule: int_cases3)
  10.998 +      (auto simp del: of_nat_mult of_nat_add
  10.999 +        simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps
 10.1000 +        divmod_int_rel_def divide_int_def modulo_int_def int_dvd_iff)
 10.1001 +qed
 10.1002  
 10.1003  lemma divmod_int_unique:
 10.1004    assumes "divmod_int_rel k l (q, r)"
 10.1005 @@ -1722,42 +1763,21 @@
 10.1006    using assms divmod_int_rel [of k l]
 10.1007    using unique_quotient [of k l] unique_remainder [of k l]
 10.1008    by auto
 10.1009 -  
 10.1010 -instance
 10.1011 -proof
 10.1012 -  fix a b :: int
 10.1013 -  show "a div b * b + a mod b = a"
 10.1014 -    using divmod_int_rel [of a b]
 10.1015 -    unfolding divmod_int_rel_def by (simp add: mult.commute)
 10.1016 -next
 10.1017 -  fix a b c :: int
 10.1018 -  assume "b \<noteq> 0"
 10.1019 -  hence "divmod_int_rel (a + c * b) b (c + a div b, a mod b)"
 10.1020 -    using divmod_int_rel [of a b]
 10.1021 -    unfolding divmod_int_rel_def by (auto simp: algebra_simps)
 10.1022 -  thus "(a + c * b) div b = c + a div b"
 10.1023 -    by (rule div_int_unique)
 10.1024 +
 10.1025 +instance proof
 10.1026 +  fix k l :: int
 10.1027 +  show "k div l * l + k mod l = k"
 10.1028 +    using divmod_int_rel [of k l]
 10.1029 +    unfolding divmod_int_rel_def by (simp add: ac_simps)
 10.1030  next
 10.1031 -  fix a b c :: int
 10.1032 -  assume c: "c \<noteq> 0"
 10.1033 -  have "\<And>q r. divmod_int_rel a b (q, r)
 10.1034 -    \<Longrightarrow> divmod_int_rel (c * a) (c * b) (q, c * r)"
 10.1035 -    unfolding divmod_int_rel_def
 10.1036 -    by (rule linorder_cases [of 0 b])
 10.1037 -      (use c in \<open>auto simp: algebra_simps
 10.1038 -      mult_less_0_iff zero_less_mult_iff mult_strict_right_mono
 10.1039 -      mult_strict_right_mono_neg zero_le_mult_iff mult_le_0_iff\<close>)
 10.1040 -  hence "divmod_int_rel (c * a) (c * b) (a div b, c * (a mod b))"
 10.1041 -    using divmod_int_rel [of a b] .
 10.1042 -  thus "(c * a) div (c * b) = a div b"
 10.1043 -    by (rule div_int_unique)
 10.1044 -next
 10.1045 -  fix a :: int show "a div 0 = 0"
 10.1046 +  fix k :: int show "k div 0 = 0"
 10.1047      by (rule div_int_unique, simp add: divmod_int_rel_def)
 10.1048  next
 10.1049 -  fix a :: int show "0 div a = 0"
 10.1050 -    by (rule div_int_unique, auto simp add: divmod_int_rel_def)
 10.1051 -qed
 10.1052 +  fix k l :: int
 10.1053 +  assume "l \<noteq> 0"
 10.1054 +  then show "k * l div l = k"
 10.1055 +    by (auto simp add: divmod_int_rel_def ac_simps intro: div_int_unique [of _ _ _ 0])
 10.1056 +qed (simp_all add: sgn_mult mult_sgn_abs abs_sgn_eq)
 10.1057  
 10.1058  end
 10.1059  
 10.1060 @@ -1765,36 +1785,30 @@
 10.1061    "is_unit (k::int) \<longleftrightarrow> k = 1 \<or> k = - 1"
 10.1062    by auto
 10.1063  
 10.1064 -instantiation int :: normalization_semidom
 10.1065 -begin
 10.1066 -
 10.1067 -definition normalize_int
 10.1068 -  where [simp]: "normalize = (abs :: int \<Rightarrow> int)"
 10.1069 -
 10.1070 -definition unit_factor_int
 10.1071 -  where [simp]: "unit_factor = (sgn :: int \<Rightarrow> int)"
 10.1072 -
 10.1073 -instance
 10.1074 +instance int :: ring_div
 10.1075  proof
 10.1076 -  fix k :: int
 10.1077 -  assume "k \<noteq> 0"
 10.1078 -  then have "\<bar>sgn k\<bar> = 1"
 10.1079 -    by (cases "0::int" k rule: linorder_cases) simp_all
 10.1080 -  then show "is_unit (unit_factor k)"
 10.1081 -    by simp
 10.1082 -qed (simp_all add: sgn_mult mult_sgn_abs)
 10.1083 -  
 10.1084 -end
 10.1085 -  
 10.1086 -text\<open>Basic laws about division and remainder\<close>
 10.1087 -
 10.1088 -lemma zdiv_int: "int (a div b) = int a div int b"
 10.1089 -  by (simp add: divide_int_def)
 10.1090 -
 10.1091 -lemma zmod_int: "int (a mod b) = int a mod int b"
 10.1092 -  by (simp add: modulo_int_def int_dvd_iff)
 10.1093 -  
 10.1094 -text \<open>Tool setup\<close>
 10.1095 +  fix k l s :: int
 10.1096 +  assume "l \<noteq> 0"
 10.1097 +  then have "divmod_int_rel (k + s * l) l (s + k div l, k mod l)"
 10.1098 +    using divmod_int_rel [of k l]
 10.1099 +    unfolding divmod_int_rel_def by (auto simp: algebra_simps)
 10.1100 +  then show "(k + s * l) div l = s + k div l"
 10.1101 +    by (rule div_int_unique)
 10.1102 +next
 10.1103 +  fix k l s :: int
 10.1104 +  assume "s \<noteq> 0"
 10.1105 +  have "\<And>q r. divmod_int_rel k l (q, r)
 10.1106 +    \<Longrightarrow> divmod_int_rel (s * k) (s * l) (q, s * r)"
 10.1107 +    unfolding divmod_int_rel_def
 10.1108 +    by (rule linorder_cases [of 0 l])
 10.1109 +      (use \<open>s \<noteq> 0\<close> in \<open>auto simp: algebra_simps
 10.1110 +      mult_less_0_iff zero_less_mult_iff mult_strict_right_mono
 10.1111 +      mult_strict_right_mono_neg zero_le_mult_iff mult_le_0_iff\<close>)
 10.1112 +  then have "divmod_int_rel (s * k) (s * l) (k div l, s * (k mod l))"
 10.1113 +    using divmod_int_rel [of k l] .
 10.1114 +  then show "(s * k) div (s * l) = k div l"
 10.1115 +    by (rule div_int_unique)
 10.1116 +qed
 10.1117  
 10.1118  ML \<open>
 10.1119  structure Cancel_Div_Mod_Int = Cancel_Div_Mod
 10.1120 @@ -1807,12 +1821,22 @@
 10.1121  
 10.1122    val div_mod_eqs = map mk_meta_eq @{thms cancel_div_mod_rules};
 10.1123  
 10.1124 -  val prove_eq_sums = Arith_Data.prove_conv2 all_tac
 10.1125 -    (Arith_Data.simp_all_tac @{thms diff_conv_add_uminus add_0_left add_0_right ac_simps})
 10.1126 +  val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac
 10.1127 +    @{thms diff_conv_add_uminus add_0_left add_0_right ac_simps})
 10.1128  )
 10.1129  \<close>
 10.1130  
 10.1131 -simproc_setup cancel_div_mod_int ("(k::int) + l") = \<open>K Cancel_Div_Mod_Int.proc\<close>
 10.1132 +simproc_setup cancel_div_mod_int ("(k::int) + l") =
 10.1133 +  \<open>K Cancel_Div_Mod_Int.proc\<close>
 10.1134 +
 10.1135 +
 10.1136 +text\<open>Basic laws about division and remainder\<close>
 10.1137 +
 10.1138 +lemma zdiv_int: "int (a div b) = int a div int b"
 10.1139 +  by (simp add: divide_int_def)
 10.1140 +
 10.1141 +lemma zmod_int: "int (a mod b) = int a mod int b"
 10.1142 +  by (simp add: modulo_int_def int_dvd_iff)
 10.1143  
 10.1144  lemma pos_mod_conj: "(0::int) < b \<Longrightarrow> 0 \<le> a mod b \<and> a mod b < b"
 10.1145    using divmod_int_rel [of a b]
 10.1146 @@ -1890,7 +1914,12 @@
 10.1147  lemma zmod_zminus1_not_zero:
 10.1148    fixes k l :: int
 10.1149    shows "- k mod l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0"
 10.1150 -  unfolding zmod_zminus1_eq_if by auto
 10.1151 +  by (simp add: mod_eq_0_iff_dvd)
 10.1152 +
 10.1153 +lemma zmod_zminus2_not_zero:
 10.1154 +  fixes k l :: int
 10.1155 +  shows "k mod - l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0"
 10.1156 +  by (simp add: mod_eq_0_iff_dvd)
 10.1157  
 10.1158  lemma zdiv_zminus2_eq_if:
 10.1159       "b \<noteq> (0::int)
 10.1160 @@ -1902,11 +1931,6 @@
 10.1161       "a mod (-b::int) = (if a mod b = 0 then 0 else  (a mod b) - b)"
 10.1162  by (simp add: zmod_zminus1_eq_if mod_minus_right)
 10.1163  
 10.1164 -lemma zmod_zminus2_not_zero:
 10.1165 -  fixes k l :: int
 10.1166 -  shows "k mod - l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0"
 10.1167 -  unfolding zmod_zminus2_eq_if by auto
 10.1168 -
 10.1169  
 10.1170  subsubsection \<open>Monotonicity in the First Argument (Dividend)\<close>
 10.1171  
 10.1172 @@ -2121,7 +2145,7 @@
 10.1173      P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i j)"
 10.1174  apply (rule iffI, clarify)
 10.1175   apply (erule_tac P="P x y" for x y in rev_mp)
 10.1176 - apply (subst mod_add_eq)
 10.1177 + apply (subst mod_add_eq [symmetric])
 10.1178   apply (subst zdiv_zadd1_eq)
 10.1179   apply (simp add: div_pos_pos_trivial mod_pos_pos_trivial)
 10.1180  txt\<open>converse direction\<close>
 10.1181 @@ -2134,7 +2158,7 @@
 10.1182      P(n div k :: int)(n mod k) = (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i j)"
 10.1183  apply (rule iffI, clarify)
 10.1184   apply (erule_tac P="P x y" for x y in rev_mp)
 10.1185 - apply (subst mod_add_eq)
 10.1186 + apply (subst mod_add_eq [symmetric])
 10.1187   apply (subst zdiv_zadd1_eq)
 10.1188   apply (simp add: div_neg_neg_trivial mod_neg_neg_trivial)
 10.1189  txt\<open>converse direction\<close>
 10.1190 @@ -2454,24 +2478,6 @@
 10.1191   apply simp_all
 10.1192  done
 10.1193  
 10.1194 -text \<open>by Brian Huffman\<close>
 10.1195 -lemma zminus_zmod: "- ((x::int) mod m) mod m = - x mod m"
 10.1196 -by (rule mod_minus_eq [symmetric])
 10.1197 -
 10.1198 -lemma zdiff_zmod_left: "(x mod m - y) mod m = (x - y) mod (m::int)"
 10.1199 -by (rule mod_diff_left_eq [symmetric])
 10.1200 -
 10.1201 -lemma zdiff_zmod_right: "(x - y mod m) mod m = (x - y) mod (m::int)"
 10.1202 -by (rule mod_diff_right_eq [symmetric])
 10.1203 -
 10.1204 -lemmas zmod_simps =
 10.1205 -  mod_add_left_eq  [symmetric]
 10.1206 -  mod_add_right_eq [symmetric]
 10.1207 -  mod_mult_right_eq[symmetric]
 10.1208 -  mod_mult_left_eq [symmetric]
 10.1209 -  power_mod
 10.1210 -  zminus_zmod zdiff_zmod_left zdiff_zmod_right
 10.1211 -
 10.1212  text \<open>Distributive laws for function \<open>nat\<close>.\<close>
 10.1213  
 10.1214  lemma nat_div_distrib: "0 \<le> x \<Longrightarrow> nat (x div y) = nat x div nat y"
 10.1215 @@ -2531,28 +2537,29 @@
 10.1216  apply (rule Divides.div_less_dividend, simp_all)
 10.1217  done
 10.1218  
 10.1219 -lemma zmod_eq_dvd_iff: "(x::int) mod n = y mod n \<longleftrightarrow> n dvd x - y"
 10.1220 +lemma (in ring_div) mod_eq_dvd_iff:
 10.1221 +  "a mod c = b mod c \<longleftrightarrow> c dvd a - b" (is "?P \<longleftrightarrow> ?Q")
 10.1222  proof
 10.1223 -  assume H: "x mod n = y mod n"
 10.1224 -  hence "x mod n - y mod n = 0" by simp
 10.1225 -  hence "(x mod n - y mod n) mod n = 0" by simp
 10.1226 -  hence "(x - y) mod n = 0" by (simp add: mod_diff_eq[symmetric])
 10.1227 -  thus "n dvd x - y" by (simp add: dvd_eq_mod_eq_0)
 10.1228 +  assume ?P
 10.1229 +  then have "(a mod c - b mod c) mod c = 0"
 10.1230 +    by simp
 10.1231 +  then show ?Q
 10.1232 +    by (simp add: dvd_eq_mod_eq_0 mod_simps)
 10.1233  next
 10.1234 -  assume H: "n dvd x - y"
 10.1235 -  then obtain k where k: "x-y = n*k" unfolding dvd_def by blast
 10.1236 -  hence "x = n*k + y" by simp
 10.1237 -  hence "x mod n = (n*k + y) mod n" by simp
 10.1238 -  thus "x mod n = y mod n" by (simp add: mod_add_left_eq)
 10.1239 +  assume ?Q
 10.1240 +  then obtain d where d: "a - b = c * d" ..
 10.1241 +  then have "a = c * d + b"
 10.1242 +    by (simp add: algebra_simps)
 10.1243 +  then show ?P by simp
 10.1244  qed
 10.1245  
 10.1246 -lemma nat_mod_eq_lemma: assumes xyn: "(x::nat) mod n = y  mod n" and xy:"y \<le> x"
 10.1247 +lemma nat_mod_eq_lemma: assumes xyn: "(x::nat) mod n = y mod n" and xy:"y \<le> x"
 10.1248    shows "\<exists>q. x = y + n * q"
 10.1249  proof-
 10.1250    from xy have th: "int x - int y = int (x - y)" by simp
 10.1251    from xyn have "int x mod int n = int y mod int n"
 10.1252      by (simp add: zmod_int [symmetric])
 10.1253 -  hence "int n dvd int x - int y" by (simp only: zmod_eq_dvd_iff[symmetric])
 10.1254 +  hence "int n dvd int x - int y" by (simp only: mod_eq_dvd_iff [symmetric])
 10.1255    hence "n dvd x - y" by (simp add: th zdvd_int)
 10.1256    then show ?thesis using xy unfolding dvd_def apply clarsimp apply (rule_tac x="k" in exI) by arith
 10.1257  qed
 10.1258 @@ -2666,6 +2673,4 @@
 10.1259  
 10.1260  declare minus_div_mult_eq_mod [symmetric, nitpick_unfold]
 10.1261  
 10.1262 -hide_fact (open) div_0 div_by_0
 10.1263 -
 10.1264  end
    11.1 --- a/src/HOL/Enum.thy	Tue Dec 20 16:17:13 2016 +0100
    11.2 +++ b/src/HOL/Enum.thy	Tue Dec 20 16:18:56 2016 +0100
    11.3 @@ -683,7 +683,7 @@
    11.4  
    11.5  instance finite_2 :: complete_linorder ..
    11.6  
    11.7 -instantiation finite_2 :: "{field, ring_div, idom_abs_sgn}" begin
    11.8 +instantiation finite_2 :: "{field, idom_abs_sgn}" begin
    11.9  definition [simp]: "0 = a\<^sub>1"
   11.10  definition [simp]: "1 = a\<^sub>2"
   11.11  definition "x + y = (case (x, y) of (a\<^sub>1, a\<^sub>1) \<Rightarrow> a\<^sub>1 | (a\<^sub>2, a\<^sub>2) \<Rightarrow> a\<^sub>1 | _ \<Rightarrow> a\<^sub>2)"
   11.12 @@ -693,19 +693,33 @@
   11.13  definition "inverse = (\<lambda>x :: finite_2. x)"
   11.14  definition "divide = (op * :: finite_2 \<Rightarrow> _)"
   11.15  definition "abs = (\<lambda>x :: finite_2. x)"
   11.16 -definition "x mod y = (case (x, y) of (a\<^sub>2, a\<^sub>1) \<Rightarrow> a\<^sub>2 | _ \<Rightarrow> a\<^sub>1)"
   11.17  definition "sgn = (\<lambda>x :: finite_2. x)"
   11.18  instance
   11.19 -by intro_classes
   11.20 -  (simp_all add: plus_finite_2_def uminus_finite_2_def minus_finite_2_def times_finite_2_def
   11.21 -       inverse_finite_2_def divide_finite_2_def abs_finite_2_def modulo_finite_2_def sgn_finite_2_def
   11.22 -     split: finite_2.splits)
   11.23 +  by standard
   11.24 +    (simp_all add: plus_finite_2_def uminus_finite_2_def minus_finite_2_def times_finite_2_def
   11.25 +      inverse_finite_2_def divide_finite_2_def abs_finite_2_def sgn_finite_2_def
   11.26 +      split: finite_2.splits)
   11.27  end
   11.28  
   11.29  lemma two_finite_2 [simp]:
   11.30    "2 = a\<^sub>1"
   11.31    by (simp add: numeral.simps plus_finite_2_def)
   11.32 -  
   11.33 +
   11.34 +lemma dvd_finite_2_unfold:
   11.35 +  "x dvd y \<longleftrightarrow> x = a\<^sub>2 \<or> y = a\<^sub>1"
   11.36 +  by (auto simp add: dvd_def times_finite_2_def split: finite_2.splits)
   11.37 +
   11.38 +instantiation finite_2 :: "{ring_div, normalization_semidom}" begin
   11.39 +definition [simp]: "normalize = (id :: finite_2 \<Rightarrow> _)"
   11.40 +definition [simp]: "unit_factor = (id :: finite_2 \<Rightarrow> _)"
   11.41 +definition "x mod y = (case (x, y) of (a\<^sub>2, a\<^sub>1) \<Rightarrow> a\<^sub>2 | _ \<Rightarrow> a\<^sub>1)"
   11.42 +instance
   11.43 +  by standard
   11.44 +    (simp_all add: dvd_finite_2_unfold times_finite_2_def
   11.45 +      divide_finite_2_def modulo_finite_2_def split: finite_2.splits)
   11.46 +end
   11.47 +
   11.48 + 
   11.49  hide_const (open) a\<^sub>1 a\<^sub>2
   11.50  
   11.51  datatype (plugins only: code "quickcheck" extraction) finite_3 =
   11.52 @@ -736,6 +750,12 @@
   11.53  
   11.54  end
   11.55  
   11.56 +lemma finite_3_not_eq_unfold:
   11.57 +  "x \<noteq> a\<^sub>1 \<longleftrightarrow> x \<in> {a\<^sub>2, a\<^sub>3}"
   11.58 +  "x \<noteq> a\<^sub>2 \<longleftrightarrow> x \<in> {a\<^sub>1, a\<^sub>3}"
   11.59 +  "x \<noteq> a\<^sub>3 \<longleftrightarrow> x \<in> {a\<^sub>1, a\<^sub>2}"
   11.60 +  by (cases x; simp)+
   11.61 +
   11.62  instantiation finite_3 :: linorder
   11.63  begin
   11.64  
   11.65 @@ -806,7 +826,7 @@
   11.66  
   11.67  instance finite_3 :: complete_linorder ..
   11.68  
   11.69 -instantiation finite_3 :: "{field, ring_div, idom_abs_sgn}" begin
   11.70 +instantiation finite_3 :: "{field, idom_abs_sgn}" begin
   11.71  definition [simp]: "0 = a\<^sub>1"
   11.72  definition [simp]: "1 = a\<^sub>2"
   11.73  definition
   11.74 @@ -820,14 +840,33 @@
   11.75  definition "inverse = (\<lambda>x :: finite_3. x)" 
   11.76  definition "x div y = x * inverse (y :: finite_3)"
   11.77  definition "abs = (\<lambda>x. case x of a\<^sub>3 \<Rightarrow> a\<^sub>2 | _ \<Rightarrow> x)"
   11.78 -definition "x mod y = (case (x, y) of (a\<^sub>2, a\<^sub>1) \<Rightarrow> a\<^sub>2 | (a\<^sub>3, a\<^sub>1) \<Rightarrow> a\<^sub>3 | _ \<Rightarrow> a\<^sub>1)"
   11.79  definition "sgn = (\<lambda>x :: finite_3. x)"
   11.80  instance
   11.81 -by intro_classes
   11.82 -  (simp_all add: plus_finite_3_def uminus_finite_3_def minus_finite_3_def times_finite_3_def
   11.83 -       inverse_finite_3_def divide_finite_3_def abs_finite_3_def modulo_finite_3_def sgn_finite_3_def
   11.84 -       less_finite_3_def
   11.85 -     split: finite_3.splits)
   11.86 +  by standard
   11.87 +    (simp_all add: plus_finite_3_def uminus_finite_3_def minus_finite_3_def times_finite_3_def
   11.88 +      inverse_finite_3_def divide_finite_3_def abs_finite_3_def sgn_finite_3_def
   11.89 +      less_finite_3_def
   11.90 +      split: finite_3.splits)
   11.91 +end
   11.92 +
   11.93 +lemma two_finite_3 [simp]:
   11.94 +  "2 = a\<^sub>3"
   11.95 +  by (simp add: numeral.simps plus_finite_3_def)
   11.96 +
   11.97 +lemma dvd_finite_3_unfold:
   11.98 +  "x dvd y \<longleftrightarrow> x = a\<^sub>2 \<or> x = a\<^sub>3 \<or> y = a\<^sub>1"
   11.99 +  by (cases x) (auto simp add: dvd_def times_finite_3_def split: finite_3.splits)
  11.100 +
  11.101 +instantiation finite_3 :: "{ring_div, normalization_semidom}" begin
  11.102 +definition "normalize x = (case x of a\<^sub>3 \<Rightarrow> a\<^sub>2 | _ \<Rightarrow> x)"
  11.103 +definition [simp]: "unit_factor = (id :: finite_3 \<Rightarrow> _)"
  11.104 +definition "x mod y = (case (x, y) of (a\<^sub>2, a\<^sub>1) \<Rightarrow> a\<^sub>2 | (a\<^sub>3, a\<^sub>1) \<Rightarrow> a\<^sub>3 | _ \<Rightarrow> a\<^sub>1)"
  11.105 +instance
  11.106 +  by standard
  11.107 +    (auto simp add: finite_3_not_eq_unfold plus_finite_3_def
  11.108 +      dvd_finite_3_unfold times_finite_3_def inverse_finite_3_def
  11.109 +      normalize_finite_3_def divide_finite_3_def modulo_finite_3_def
  11.110 +      split: finite_3.splits)
  11.111  end
  11.112  
  11.113  
    12.1 --- a/src/HOL/Fields.thy	Tue Dec 20 16:17:13 2016 +0100
    12.2 +++ b/src/HOL/Fields.thy	Tue Dec 20 16:18:56 2016 +0100
    12.3 @@ -506,6 +506,21 @@
    12.4    "y \<noteq> 0 \<Longrightarrow> z + x / y = (x + z * y) / y"
    12.5    by (simp add: add_divide_distrib add.commute)
    12.6  
    12.7 +lemma dvd_field_iff:
    12.8 +  "a dvd b \<longleftrightarrow> (a = 0 \<longrightarrow> b = 0)"
    12.9 +proof (cases "a = 0")
   12.10 +  case True
   12.11 +  then show ?thesis
   12.12 +    by simp
   12.13 +next
   12.14 +  case False
   12.15 +  then have "b = a * (b / a)"
   12.16 +    by (simp add: field_simps)
   12.17 +  then have "a dvd b" ..
   12.18 +  with False show ?thesis
   12.19 +    by simp
   12.20 +qed
   12.21 +
   12.22  end
   12.23  
   12.24  class field_char_0 = field + ring_char_0
    13.1 --- a/src/HOL/Fun_Def.thy	Tue Dec 20 16:17:13 2016 +0100
    13.2 +++ b/src/HOL/Fun_Def.thy	Tue Dec 20 16:18:56 2016 +0100
    13.3 @@ -278,6 +278,16 @@
    13.4    done
    13.5  
    13.6  
    13.7 +subsection \<open>Yet another induction principle on the natural numbers\<close>
    13.8 +
    13.9 +lemma nat_descend_induct [case_names base descend]:
   13.10 +  fixes P :: "nat \<Rightarrow> bool"
   13.11 +  assumes H1: "\<And>k. k > n \<Longrightarrow> P k"
   13.12 +  assumes H2: "\<And>k. k \<le> n \<Longrightarrow> (\<And>i. i > k \<Longrightarrow> P i) \<Longrightarrow> P k"
   13.13 +  shows "P m"
   13.14 +  using assms by induction_schema (force intro!: wf_measure [of "\<lambda>k. Suc n - k"])+
   13.15 +
   13.16 +
   13.17  subsection \<open>Tool setup\<close>
   13.18  
   13.19  ML_file "Tools/Function/termination.ML"
    14.1 --- a/src/HOL/GCD.thy	Tue Dec 20 16:17:13 2016 +0100
    14.2 +++ b/src/HOL/GCD.thy	Tue Dec 20 16:18:56 2016 +0100
    14.3 @@ -639,7 +639,6 @@
    14.4      using dvd_times_left_cancel_iff [of "gcd a b" _ 1] by simp
    14.5  qed
    14.6  
    14.7 -
    14.8  lemma divides_mult:
    14.9    assumes "a dvd c" and nr: "b dvd c" and "coprime a b"
   14.10    shows "a * b dvd c"
   14.11 @@ -695,6 +694,10 @@
   14.12    using coprime_rmult[of d a b] coprime_lmult[of d a b] coprime_mult[of d a b]
   14.13    by blast
   14.14  
   14.15 +lemma coprime_mul_eq':
   14.16 +  "coprime (a * b) d \<longleftrightarrow> coprime a d \<and> coprime b d"
   14.17 +  using coprime_mul_eq [of d a b] by (simp add: gcd.commute)
   14.18 +
   14.19  lemma gcd_coprime:
   14.20    assumes c: "gcd a b \<noteq> 0"
   14.21      and a: "a = a' * gcd a b"
   14.22 @@ -958,6 +961,24 @@
   14.23    ultimately show ?thesis by (rule that)
   14.24  qed
   14.25  
   14.26 +lemma coprime_crossproduct':
   14.27 +  fixes a b c d
   14.28 +  assumes "b \<noteq> 0"
   14.29 +  assumes unit_factors: "unit_factor b = unit_factor d"
   14.30 +  assumes coprime: "coprime a b" "coprime c d"
   14.31 +  shows "a * d = b * c \<longleftrightarrow> a = c \<and> b = d"
   14.32 +proof safe
   14.33 +  assume eq: "a * d = b * c"
   14.34 +  hence "normalize a * normalize d = normalize c * normalize b"
   14.35 +    by (simp only: normalize_mult [symmetric] mult_ac)
   14.36 +  with coprime have "normalize b = normalize d"
   14.37 +    by (subst (asm) coprime_crossproduct) simp_all
   14.38 +  from this and unit_factors show "b = d"
   14.39 +    by (rule normalize_unit_factor_eqI)
   14.40 +  from eq have "a * d = c * d" by (simp only: \<open>b = d\<close> mult_ac)
   14.41 +  with \<open>b \<noteq> 0\<close> \<open>b = d\<close> show "a = c" by simp
   14.42 +qed (simp_all add: mult_ac)
   14.43 +
   14.44  end
   14.45  
   14.46  class ring_gcd = comm_ring_1 + semiring_gcd
    15.1 --- a/src/HOL/Groebner_Basis.thy	Tue Dec 20 16:17:13 2016 +0100
    15.2 +++ b/src/HOL/Groebner_Basis.thy	Tue Dec 20 16:18:56 2016 +0100
    15.3 @@ -72,7 +72,7 @@
    15.4  declare zmod_eq_0_iff[algebra]
    15.5  declare dvd_0_left_iff[algebra]
    15.6  declare zdvd1_eq[algebra]
    15.7 -declare zmod_eq_dvd_iff[algebra]
    15.8 +declare mod_eq_dvd_iff[algebra]
    15.9  declare nat_mod_eq_iff[algebra]
   15.10  
   15.11  context semiring_parity
    16.1 --- a/src/HOL/Hilbert_Choice.thy	Tue Dec 20 16:17:13 2016 +0100
    16.2 +++ b/src/HOL/Hilbert_Choice.thy	Tue Dec 20 16:18:56 2016 +0100
    16.3 @@ -657,6 +657,12 @@
    16.4    for x :: nat
    16.5    unfolding Greatest_def by (rule GreatestM_nat_le) auto
    16.6  
    16.7 +lemma GreatestI_ex: "\<exists>k::nat. P k \<Longrightarrow> \<forall>y. P y \<longrightarrow> y < b \<Longrightarrow> P (GREATEST x. P x)"
    16.8 +  apply (erule exE)
    16.9 +  apply (rule GreatestI)
   16.10 +   apply assumption+
   16.11 +  done
   16.12 +
   16.13  
   16.14  subsection \<open>An aside: bounded accessible part\<close>
   16.15  
    17.1 --- a/src/HOL/IMP/Abs_Int1_parity.thy	Tue Dec 20 16:17:13 2016 +0100
    17.2 +++ b/src/HOL/IMP/Abs_Int1_parity.thy	Tue Dec 20 16:18:56 2016 +0100
    17.3 @@ -112,7 +112,8 @@
    17.4    case 3 show ?case by auto
    17.5  next
    17.6    case (4 _ a1 _ a2) thus ?case
    17.7 -    by (induction a1 a2 rule: plus_parity.induct) (auto simp add:mod_add_eq)
    17.8 +    by (induction a1 a2 rule: plus_parity.induct)
    17.9 +      (auto simp add: mod_add_eq [symmetric])
   17.10  qed
   17.11  
   17.12  text{* In case 4 we needed to refer to particular variables.
    18.1 --- a/src/HOL/Library/Code_Test.thy	Tue Dec 20 16:17:13 2016 +0100
    18.2 +++ b/src/HOL/Library/Code_Test.thy	Tue Dec 20 16:18:56 2016 +0100
    18.3 @@ -1,7 +1,7 @@
    18.4  (*  Title:      HOL/Library/Code_Test.thy
    18.5 -    Author:     Andreas Lochbihler, ETH Zurich
    18.6 +    Author:     Andreas Lochbihler, ETH Zürich
    18.7  
    18.8 -Test infrastructure for the code generator
    18.9 +Test infrastructure for the code generator.
   18.10  *)
   18.11  
   18.12  theory Code_Test
   18.13 @@ -100,7 +100,7 @@
   18.14    "yxml_string_of_xml_tree (xml.Elem name atts ts) rest =
   18.15     yot_append xml.XY (
   18.16     yot_append (yot_literal name) (
   18.17 -   foldr (\<lambda>(a, x) rest. 
   18.18 +   foldr (\<lambda>(a, x) rest.
   18.19       yot_append xml.Y (
   18.20       yot_append (yot_literal a) (
   18.21       yot_append (yot_literal (STR ''='')) (
    19.1 --- a/src/HOL/Library/DAList_Multiset.thy	Tue Dec 20 16:17:13 2016 +0100
    19.2 +++ b/src/HOL/Library/DAList_Multiset.thy	Tue Dec 20 16:18:56 2016 +0100
    19.3 @@ -228,17 +228,17 @@
    19.4    by (rule multiset_eqI) (simp add: count_of_filter DAList.filter.rep_eq)
    19.5  
    19.6  
    19.7 -lemma mset_eq [code]: "HOL.equal (m1::'a::equal multiset) m2 \<longleftrightarrow> m1 \<le># m2 \<and> m2 \<le># m1"
    19.8 +lemma mset_eq [code]: "HOL.equal (m1::'a::equal multiset) m2 \<longleftrightarrow> m1 \<subseteq># m2 \<and> m2 \<subseteq># m1"
    19.9    by (metis equal_multiset_def subset_mset.eq_iff)
   19.10  
   19.11  text \<open>By default the code for \<open><\<close> is @{prop"xs < ys \<longleftrightarrow> xs \<le> ys \<and> \<not> xs = ys"}.
   19.12  With equality implemented by \<open>\<le>\<close>, this leads to three calls of  \<open>\<le>\<close>.
   19.13  Here is a more efficient version:\<close>
   19.14 -lemma mset_less[code]: "xs <# (ys :: 'a multiset) \<longleftrightarrow> xs \<le># ys \<and> \<not> ys \<le># xs"
   19.15 +lemma mset_less[code]: "xs \<subset># (ys :: 'a multiset) \<longleftrightarrow> xs \<subseteq># ys \<and> \<not> ys \<subseteq># xs"
   19.16    by (rule subset_mset.less_le_not_le)
   19.17  
   19.18  lemma mset_less_eq_Bag0:
   19.19 -  "Bag xs \<le># A \<longleftrightarrow> (\<forall>(x, n) \<in> set (DAList.impl_of xs). count_of (DAList.impl_of xs) x \<le> count A x)"
   19.20 +  "Bag xs \<subseteq># A \<longleftrightarrow> (\<forall>(x, n) \<in> set (DAList.impl_of xs). count_of (DAList.impl_of xs) x \<le> count A x)"
   19.21      (is "?lhs \<longleftrightarrow> ?rhs")
   19.22  proof
   19.23    assume ?lhs
   19.24 @@ -255,7 +255,7 @@
   19.25  qed
   19.26  
   19.27  lemma mset_less_eq_Bag [code]:
   19.28 -  "Bag xs \<le># (A :: 'a multiset) \<longleftrightarrow> (\<forall>(x, n) \<in> set (DAList.impl_of xs). n \<le> count A x)"
   19.29 +  "Bag xs \<subseteq># (A :: 'a multiset) \<longleftrightarrow> (\<forall>(x, n) \<in> set (DAList.impl_of xs). n \<le> count A x)"
   19.30  proof -
   19.31    {
   19.32      fix x n
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/HOL/Library/Field_as_Ring.thy	Tue Dec 20 16:18:56 2016 +0100
    20.3 @@ -0,0 +1,108 @@
    20.4 +(*  Title:      HOL/Library/Field_as_Ring.thy
    20.5 +    Author:     Manuel Eberl
    20.6 +*)
    20.7 +
    20.8 +theory Field_as_Ring
    20.9 +imports 
   20.10 +  Complex_Main
   20.11 +  "~~/src/HOL/Number_Theory/Euclidean_Algorithm"
   20.12 +begin
   20.13 +
   20.14 +context field
   20.15 +begin
   20.16 +
   20.17 +subclass idom_divide ..
   20.18 +
   20.19 +definition normalize_field :: "'a \<Rightarrow> 'a" 
   20.20 +  where [simp]: "normalize_field x = (if x = 0 then 0 else 1)"
   20.21 +definition unit_factor_field :: "'a \<Rightarrow> 'a" 
   20.22 +  where [simp]: "unit_factor_field x = x"
   20.23 +definition euclidean_size_field :: "'a \<Rightarrow> nat" 
   20.24 +  where [simp]: "euclidean_size_field x = (if x = 0 then 0 else 1)"
   20.25 +definition mod_field :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
   20.26 +  where [simp]: "mod_field x y = (if y = 0 then x else 0)"
   20.27 +
   20.28 +end
   20.29 +
   20.30 +instantiation real :: euclidean_ring
   20.31 +begin
   20.32 +
   20.33 +definition [simp]: "normalize_real = (normalize_field :: real \<Rightarrow> _)"
   20.34 +definition [simp]: "unit_factor_real = (unit_factor_field :: real \<Rightarrow> _)"
   20.35 +definition [simp]: "euclidean_size_real = (euclidean_size_field :: real \<Rightarrow> _)"
   20.36 +definition [simp]: "modulo_real = (mod_field :: real \<Rightarrow> _)"
   20.37 +
   20.38 +instance by standard (simp_all add: dvd_field_iff divide_simps)
   20.39 +end
   20.40 +
   20.41 +instantiation real :: euclidean_ring_gcd
   20.42 +begin
   20.43 +
   20.44 +definition gcd_real :: "real \<Rightarrow> real \<Rightarrow> real" where
   20.45 +  "gcd_real = gcd_eucl"
   20.46 +definition lcm_real :: "real \<Rightarrow> real \<Rightarrow> real" where
   20.47 +  "lcm_real = lcm_eucl"
   20.48 +definition Gcd_real :: "real set \<Rightarrow> real" where
   20.49 + "Gcd_real = Gcd_eucl"
   20.50 +definition Lcm_real :: "real set \<Rightarrow> real" where
   20.51 + "Lcm_real = Lcm_eucl"
   20.52 +
   20.53 +instance by standard (simp_all add: gcd_real_def lcm_real_def Gcd_real_def Lcm_real_def)
   20.54 +
   20.55 +end
   20.56 +
   20.57 +instantiation rat :: euclidean_ring
   20.58 +begin
   20.59 +
   20.60 +definition [simp]: "normalize_rat = (normalize_field :: rat \<Rightarrow> _)"
   20.61 +definition [simp]: "unit_factor_rat = (unit_factor_field :: rat \<Rightarrow> _)"
   20.62 +definition [simp]: "euclidean_size_rat = (euclidean_size_field :: rat \<Rightarrow> _)"
   20.63 +definition [simp]: "modulo_rat = (mod_field :: rat \<Rightarrow> _)"
   20.64 +
   20.65 +instance by standard (simp_all add: dvd_field_iff divide_simps)
   20.66 +end
   20.67 +
   20.68 +instantiation rat :: euclidean_ring_gcd
   20.69 +begin
   20.70 +
   20.71 +definition gcd_rat :: "rat \<Rightarrow> rat \<Rightarrow> rat" where
   20.72 +  "gcd_rat = gcd_eucl"
   20.73 +definition lcm_rat :: "rat \<Rightarrow> rat \<Rightarrow> rat" where
   20.74 +  "lcm_rat = lcm_eucl"
   20.75 +definition Gcd_rat :: "rat set \<Rightarrow> rat" where
   20.76 + "Gcd_rat = Gcd_eucl"
   20.77 +definition Lcm_rat :: "rat set \<Rightarrow> rat" where
   20.78 + "Lcm_rat = Lcm_eucl"
   20.79 +
   20.80 +instance by standard (simp_all add: gcd_rat_def lcm_rat_def Gcd_rat_def Lcm_rat_def)
   20.81 +
   20.82 +end
   20.83 +
   20.84 +instantiation complex :: euclidean_ring
   20.85 +begin
   20.86 +
   20.87 +definition [simp]: "normalize_complex = (normalize_field :: complex \<Rightarrow> _)"
   20.88 +definition [simp]: "unit_factor_complex = (unit_factor_field :: complex \<Rightarrow> _)"
   20.89 +definition [simp]: "euclidean_size_complex = (euclidean_size_field :: complex \<Rightarrow> _)"
   20.90 +definition [simp]: "modulo_complex = (mod_field :: complex \<Rightarrow> _)"
   20.91 +
   20.92 +instance by standard (simp_all add: dvd_field_iff divide_simps)
   20.93 +end
   20.94 +
   20.95 +instantiation complex :: euclidean_ring_gcd
   20.96 +begin
   20.97 +
   20.98 +definition gcd_complex :: "complex \<Rightarrow> complex \<Rightarrow> complex" where
   20.99 +  "gcd_complex = gcd_eucl"
  20.100 +definition lcm_complex :: "complex \<Rightarrow> complex \<Rightarrow> complex" where
  20.101 +  "lcm_complex = lcm_eucl"
  20.102 +definition Gcd_complex :: "complex set \<Rightarrow> complex" where
  20.103 + "Gcd_complex = Gcd_eucl"
  20.104 +definition Lcm_complex :: "complex set \<Rightarrow> complex" where
  20.105 + "Lcm_complex = Lcm_eucl"
  20.106 +
  20.107 +instance by standard (simp_all add: gcd_complex_def lcm_complex_def Gcd_complex_def Lcm_complex_def)
  20.108 +
  20.109 +end
  20.110 +
  20.111 +end
    21.1 --- a/src/HOL/Library/Formal_Power_Series.thy	Tue Dec 20 16:17:13 2016 +0100
    21.2 +++ b/src/HOL/Library/Formal_Power_Series.thy	Tue Dec 20 16:18:56 2016 +0100
    21.3 @@ -1157,7 +1157,40 @@
    21.4  lemma fps_unit_dvd [simp]: "(f $ 0 :: 'a :: field) \<noteq> 0 \<Longrightarrow> f dvd g"
    21.5    by (rule dvd_trans, subst fps_is_unit_iff) simp_all
    21.6  
    21.7 -
    21.8 +instantiation fps :: (field) normalization_semidom
    21.9 +begin
   21.10 +
   21.11 +definition fps_unit_factor_def [simp]:
   21.12 +  "unit_factor f = fps_shift (subdegree f) f"
   21.13 +
   21.14 +definition fps_normalize_def [simp]:
   21.15 +  "normalize f = (if f = 0 then 0 else X ^ subdegree f)"
   21.16 +
   21.17 +instance proof
   21.18 +  fix f :: "'a fps"
   21.19 +  show "unit_factor f * normalize f = f"
   21.20 +    by (simp add: fps_shift_times_X_power)
   21.21 +next
   21.22 +  fix f g :: "'a fps"
   21.23 +  show "unit_factor (f * g) = unit_factor f * unit_factor g"
   21.24 +  proof (cases "f = 0 \<or> g = 0")
   21.25 +    assume "\<not>(f = 0 \<or> g = 0)"
   21.26 +    thus "unit_factor (f * g) = unit_factor f * unit_factor g"
   21.27 +    unfolding fps_unit_factor_def
   21.28 +      by (auto simp: fps_shift_fps_shift fps_shift_mult fps_shift_mult_right)
   21.29 +  qed auto
   21.30 +next
   21.31 +  fix f g :: "'a fps"
   21.32 +  assume "g \<noteq> 0"
   21.33 +  then have "f * (fps_shift (subdegree g) g * inverse (fps_shift (subdegree g) g)) = f"
   21.34 +    by (metis add_cancel_right_left fps_shift_nth inverse_mult_eq_1 mult.commute mult_cancel_left2 nth_subdegree_nonzero)
   21.35 +  then have "fps_shift (subdegree g) (g * (f * inverse (fps_shift (subdegree g) g))) = f"
   21.36 +    by (simp add: fps_shift_mult_right mult.commute)
   21.37 +  with \<open>g \<noteq> 0\<close> show "f * g / g = f"
   21.38 +    by (simp add: fps_divide_def Let_def ac_simps)
   21.39 +qed (auto simp add: fps_divide_def Let_def)
   21.40 +
   21.41 +end
   21.42  
   21.43  instantiation fps :: (field) ring_div
   21.44  begin
   21.45 @@ -1291,7 +1324,7 @@
   21.46    also have "fps_shift n (f * inverse h') = f div h"
   21.47      by (simp add: fps_divide_def Let_def dfs)
   21.48    finally show "(f + g * h) div h = g + f div h" by simp
   21.49 -qed (auto simp: fps_divide_def fps_mod_def Let_def)
   21.50 +qed
   21.51  
   21.52  end
   21.53  end
   21.54 @@ -1365,36 +1398,6 @@
   21.55    fps_numeral_divide_divide fps_numeral_mult_divide inverse_fps_numeral neg_numeral_fps_const
   21.56  
   21.57  
   21.58 -
   21.59 -instantiation fps :: (field) normalization_semidom
   21.60 -begin
   21.61 -
   21.62 -definition fps_unit_factor_def [simp]:
   21.63 -  "unit_factor f = fps_shift (subdegree f) f"
   21.64 -
   21.65 -definition fps_normalize_def [simp]:
   21.66 -  "normalize f = (if f = 0 then 0 else X ^ subdegree f)"
   21.67 -
   21.68 -instance proof
   21.69 -  fix f :: "'a fps"
   21.70 -  show "unit_factor f * normalize f = f"
   21.71 -    by (simp add: fps_shift_times_X_power)
   21.72 -next
   21.73 -  fix f g :: "'a fps"
   21.74 -  show "unit_factor (f * g) = unit_factor f * unit_factor g"
   21.75 -  proof (cases "f = 0 \<or> g = 0")
   21.76 -    assume "\<not>(f = 0 \<or> g = 0)"
   21.77 -    thus "unit_factor (f * g) = unit_factor f * unit_factor g"
   21.78 -    unfolding fps_unit_factor_def
   21.79 -      by (auto simp: fps_shift_fps_shift fps_shift_mult fps_shift_mult_right)
   21.80 -  qed auto
   21.81 -qed auto
   21.82 -
   21.83 -end
   21.84 -
   21.85 -instance fps :: (field) algebraic_semidom ..
   21.86 -
   21.87 -
   21.88  subsection \<open>Formal power series form a Euclidean ring\<close>
   21.89  
   21.90  instantiation fps :: (field) euclidean_ring
    22.1 --- a/src/HOL/Library/Library.thy	Tue Dec 20 16:17:13 2016 +0100
    22.2 +++ b/src/HOL/Library/Library.thy	Tue Dec 20 16:18:56 2016 +0100
    22.3 @@ -49,12 +49,14 @@
    22.4    More_List
    22.5    Multiset_Order
    22.6    Multiset_Permutations
    22.7 +  Nonpos_Ints
    22.8    Numeral_Type
    22.9    Omega_Words_Fun
   22.10    OptionalSugar
   22.11    Option_ord
   22.12    Order_Continuity
   22.13    Parallel
   22.14 +  Periodic_Fun
   22.15    Perm
   22.16    Permutation
   22.17    Permutations
   22.18 @@ -72,6 +74,7 @@
   22.19    Quotient_Type
   22.20    Ramsey
   22.21    Reflection
   22.22 +  Rewrite
   22.23    Saturated
   22.24    Set_Algebras
   22.25    State_Monad
    23.1 --- a/src/HOL/Library/Multiset.thy	Tue Dec 20 16:17:13 2016 +0100
    23.2 +++ b/src/HOL/Library/Multiset.thy	Tue Dec 20 16:18:56 2016 +0100
    23.3 @@ -526,9 +526,11 @@
    23.4  
    23.5  interpretation subset_mset: ordered_ab_semigroup_add_imp_le "op +" "op -" "op \<subseteq>#" "op \<subset>#"
    23.6    by standard (auto simp add: subset_mset_def subseteq_mset_def multiset_eq_iff intro: order_trans antisym)
    23.7 -
    23.8 -interpretation subset_mset: ordered_ab_semigroup_monoid_add_imp_le "op +" 0 "op -" "op \<le>#" "op <#"
    23.9 +    \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.10 +
   23.11 +interpretation subset_mset: ordered_ab_semigroup_monoid_add_imp_le "op +" 0 "op -" "op \<subseteq>#" "op \<subset>#"
   23.12    by standard
   23.13 +    \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.14  
   23.15  lemma mset_subset_eqI:
   23.16    "(\<And>a. count A a \<le> count B a) \<Longrightarrow> A \<subseteq># B"
   23.17 @@ -545,8 +547,9 @@
   23.18     apply (auto intro: multiset_eq_iff [THEN iffD2])
   23.19    done
   23.20  
   23.21 -interpretation subset_mset: ordered_cancel_comm_monoid_diff "op +" 0 "op \<le>#" "op <#" "op -"
   23.22 +interpretation subset_mset: ordered_cancel_comm_monoid_diff "op +" 0 "op \<subseteq>#" "op \<subset>#" "op -"
   23.23    by standard (simp, fact mset_subset_eq_exists_conv)
   23.24 +    \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.25  
   23.26  declare subset_mset.add_diff_assoc[simp] subset_mset.add_diff_assoc2[simp]
   23.27  
   23.28 @@ -625,8 +628,8 @@
   23.29  lemma mset_subset_of_empty[simp]: "A \<subset># {#} \<longleftrightarrow> False"
   23.30    by (simp only: subset_mset.not_less_zero)
   23.31  
   23.32 -lemma empty_subset_add_mset[simp]: "{#} <# add_mset x M"
   23.33 -by(auto intro: subset_mset.gr_zeroI)
   23.34 +lemma empty_subset_add_mset[simp]: "{#} \<subset># add_mset x M"
   23.35 +  by (auto intro: subset_mset.gr_zeroI)
   23.36  
   23.37  lemma empty_le: "{#} \<subseteq># A"
   23.38    by (fact subset_mset.zero_le)
   23.39 @@ -684,8 +687,7 @@
   23.40      by arith
   23.41    show "class.semilattice_inf op \<inter># op \<subseteq># op \<subset>#"
   23.42      by standard (auto simp add: multiset_inter_def subseteq_mset_def)
   23.43 -qed
   23.44 -  \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.45 +qed \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.46  
   23.47  definition sup_subset_mset :: "'a multiset \<Rightarrow> 'a multiset \<Rightarrow> 'a multiset"(infixl "\<union>#" 70)
   23.48    where "sup_subset_mset A B = A + (B - A)" \<comment> \<open>FIXME irregular fact name\<close>
   23.49 @@ -696,12 +698,12 @@
   23.50      by arith
   23.51    show "class.semilattice_sup op \<union># op \<subseteq># op \<subset>#"
   23.52      by standard (auto simp add: sup_subset_mset_def subseteq_mset_def)
   23.53 -qed
   23.54 -  \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.55 +qed \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.56  
   23.57  interpretation subset_mset: bounded_lattice_bot "op \<inter>#" "op \<subseteq>#" "op \<subset>#"
   23.58    "op \<union>#" "{#}"
   23.59    by standard auto
   23.60 +    \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.61  
   23.62  
   23.63  subsubsection \<open>Additional intersection facts\<close>
   23.64 @@ -885,11 +887,6 @@
   23.65    by (auto simp: multiset_eq_iff max_def)
   23.66  
   23.67  
   23.68 -subsubsection \<open>Subset is an order\<close>
   23.69 -
   23.70 -interpretation subset_mset: order "op \<subseteq>#" "op \<subset>#" by unfold_locales
   23.71 -
   23.72 -
   23.73  subsection \<open>Replicate and repeat operations\<close>
   23.74  
   23.75  definition replicate_mset :: "nat \<Rightarrow> 'a \<Rightarrow> 'a multiset" where
   23.76 @@ -1161,7 +1158,7 @@
   23.77        by (intro cSup_least) (auto intro: mset_subset_eq_count ge)
   23.78      finally show "count (Sup A) x \<le> count X x" .
   23.79    qed
   23.80 -qed
   23.81 +qed \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.82  
   23.83  lemma set_mset_Inf:
   23.84    assumes "A \<noteq> {}"
   23.85 @@ -1239,7 +1236,7 @@
   23.86    fix A B C :: "'a multiset"
   23.87    show "A \<union># (B \<inter># C) = A \<union># B \<inter># (A \<union># C)"
   23.88      by (intro multiset_eqI) simp_all
   23.89 -qed
   23.90 +qed \<comment> \<open>FIXME: avoid junk stemming from type class interpretation\<close>
   23.91  
   23.92  
   23.93  subsubsection \<open>Filter (with comprehension syntax)\<close>
   23.94 @@ -1741,6 +1738,10 @@
   23.95    "(\<forall>x y. (x, y) \<in># M \<longrightarrow> f x y = g x y) \<Longrightarrow> {#f x y. (x, y) \<in># M#} = {#g x y. (x, y) \<in># M#}"
   23.96    by (metis image_mset_cong split_cong)
   23.97  
   23.98 +lemma image_mset_const_eq:
   23.99 +  "{#c. a \<in># M#} = replicate_mset (size M) c"
  23.100 +  by (induct M) simp_all
  23.101 +
  23.102  
  23.103  subsection \<open>Further conversions\<close>
  23.104  
  23.105 @@ -2313,6 +2314,9 @@
  23.106  translations
  23.107    "\<Prod>i \<in># A. b" \<rightleftharpoons> "CONST prod_mset (CONST image_mset (\<lambda>i. b) A)"
  23.108  
  23.109 +lemma prod_mset_constant [simp]: "(\<Prod>_\<in>#A. c) = c ^ size A"
  23.110 +  by (simp add: image_mset_const_eq)
  23.111 +
  23.112  lemma (in comm_monoid_mult) prod_mset_subset_imp_dvd:
  23.113    assumes "A \<subseteq># B"
  23.114    shows   "prod_mset A dvd prod_mset B"
    24.1 --- a/src/HOL/Library/Multiset_Order.thy	Tue Dec 20 16:17:13 2016 +0100
    24.2 +++ b/src/HOL/Library/Multiset_Order.thy	Tue Dec 20 16:18:56 2016 +0100
    24.3 @@ -49,7 +49,7 @@
    24.4  
    24.5  definition less_multiset\<^sub>D\<^sub>M where
    24.6    "less_multiset\<^sub>D\<^sub>M M N \<longleftrightarrow>
    24.7 -   (\<exists>X Y. X \<noteq> {#} \<and> X \<le># N \<and> M = (N - X) + Y \<and> (\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> k < a)))"
    24.8 +   (\<exists>X Y. X \<noteq> {#} \<and> X \<subseteq># N \<and> M = (N - X) + Y \<and> (\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> k < a)))"
    24.9  
   24.10  
   24.11  text \<open>The Huet--Oppen ordering:\<close>
   24.12 @@ -123,11 +123,11 @@
   24.13  proof -
   24.14    assume "less_multiset\<^sub>D\<^sub>M M N"
   24.15    then obtain X Y where
   24.16 -    "X \<noteq> {#}" and "X \<le># N" and "M = N - X + Y" and "\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> k < a)"
   24.17 +    "X \<noteq> {#}" and "X \<subseteq># N" and "M = N - X + Y" and "\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> k < a)"
   24.18      unfolding less_multiset\<^sub>D\<^sub>M_def by blast
   24.19    then have "(N - X + Y, N - X + X) \<in> mult {(x, y). x < y}"
   24.20      by (intro one_step_implies_mult) (auto simp: Bex_def trans_def)
   24.21 -  with \<open>M = N - X + Y\<close> \<open>X \<le># N\<close> show "(M, N) \<in> mult {(x, y). x < y}"
   24.22 +  with \<open>M = N - X + Y\<close> \<open>X \<subseteq># N\<close> show "(M, N) \<in> mult {(x, y). x < y}"
   24.23      by (metis subset_mset.diff_add)
   24.24  qed
   24.25  
   24.26 @@ -140,7 +140,7 @@
   24.27    define X where "X = N - M"
   24.28    define Y where "Y = M - N"
   24.29    from z show "X \<noteq> {#}" unfolding X_def by (auto simp: multiset_eq_iff not_less_eq_eq Suc_le_eq)
   24.30 -  from z show "X \<le># N" unfolding X_def by auto
   24.31 +  from z show "X \<subseteq># N" unfolding X_def by auto
   24.32    show "M = (N - X) + Y" unfolding X_def Y_def multiset_eq_iff count_union count_diff by force
   24.33    show "\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> k < a)"
   24.34    proof (intro allI impI)
   24.35 @@ -175,7 +175,7 @@
   24.36  lemmas less_multiset\<^sub>H\<^sub>O = mult\<^sub>H\<^sub>O[folded less_multiset_def]
   24.37  
   24.38  lemma subset_eq_imp_le_multiset:
   24.39 -  shows "M \<le># N \<Longrightarrow> M \<le> N"
   24.40 +  shows "M \<subseteq># N \<Longrightarrow> M \<le> N"
   24.41    unfolding less_eq_multiset_def less_multiset\<^sub>H\<^sub>O
   24.42    by (simp add: less_le_not_le subseteq_mset_def)
   24.43  
   24.44 @@ -201,7 +201,7 @@
   24.45  lemma le_multiset_empty_right[simp]: "\<not> M < {#}"
   24.46    using subset_mset.le_zero_eq less_multiset\<^sub>D\<^sub>M by blast
   24.47  
   24.48 -lemma union_le_diff_plus: "P \<le># M \<Longrightarrow> N < P \<Longrightarrow> M - P + N < M"
   24.49 +lemma union_le_diff_plus: "P \<subseteq># M \<Longrightarrow> N < P \<Longrightarrow> M - P + N < M"
   24.50    by (drule subset_mset.diff_add[symmetric]) (metis union_le_mono2)
   24.51  
   24.52  instantiation multiset :: (preorder) ordered_ab_semigroup_monoid_add_imp_le
    25.1 --- a/src/HOL/Library/Normalized_Fraction.thy	Tue Dec 20 16:17:13 2016 +0100
    25.2 +++ b/src/HOL/Library/Normalized_Fraction.thy	Tue Dec 20 16:18:56 2016 +0100
    25.3 @@ -1,3 +1,7 @@
    25.4 +(*  Title:      HOL/Library/Normalized_Fraction.thy
    25.5 +    Author:     Manuel Eberl
    25.6 +*)
    25.7 +
    25.8  theory Normalized_Fraction
    25.9  imports 
   25.10    Main 
   25.11 @@ -5,75 +9,6 @@
   25.12    "~~/src/HOL/Library/Fraction_Field"
   25.13  begin
   25.14  
   25.15 -lemma dvd_neg_div': "y dvd (x :: 'a :: idom_divide) \<Longrightarrow> -x div y = - (x div y)"
   25.16 -apply (case_tac "y = 0") apply simp
   25.17 -apply (auto simp add: dvd_def)
   25.18 -apply (subgoal_tac "-(y * k) = y * - k")
   25.19 -apply (simp only:)
   25.20 -apply (erule nonzero_mult_div_cancel_left)
   25.21 -apply simp
   25.22 -done
   25.23 -
   25.24 -(* TODO Move *)
   25.25 -lemma (in semiring_gcd) coprime_mul_eq': "coprime (a * b) d \<longleftrightarrow> coprime a d \<and> coprime b d"
   25.26 -  using coprime_mul_eq[of d a b] by (simp add: gcd.commute)
   25.27 -
   25.28 -lemma dvd_div_eq_0_iff:
   25.29 -  assumes "b dvd (a :: 'a :: semidom_divide)"
   25.30 -  shows   "a div b = 0 \<longleftrightarrow> a = 0"
   25.31 -  using assms by (elim dvdE, cases "b = 0") simp_all  
   25.32 -
   25.33 -lemma dvd_div_eq_0_iff':
   25.34 -  assumes "b dvd (a :: 'a :: semiring_div)"
   25.35 -  shows   "a div b = 0 \<longleftrightarrow> a = 0"
   25.36 -  using assms by (elim dvdE, cases "b = 0") simp_all
   25.37 -
   25.38 -lemma unit_div_eq_0_iff:
   25.39 -  assumes "is_unit (b :: 'a :: {algebraic_semidom,semidom_divide})"
   25.40 -  shows   "a div b = 0 \<longleftrightarrow> a = 0"
   25.41 -  by (rule dvd_div_eq_0_iff) (insert assms, auto)  
   25.42 -
   25.43 -lemma unit_div_eq_0_iff':
   25.44 -  assumes "is_unit (b :: 'a :: semiring_div)"
   25.45 -  shows   "a div b = 0 \<longleftrightarrow> a = 0"
   25.46 -  by (rule dvd_div_eq_0_iff) (insert assms, auto)
   25.47 -
   25.48 -lemma dvd_div_eq_cancel:
   25.49 -  "a div c = b div c \<Longrightarrow> (c :: 'a :: semiring_div) dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a = b"
   25.50 -  by (elim dvdE, cases "c = 0") simp_all
   25.51 -
   25.52 -lemma dvd_div_eq_iff:
   25.53 -  "(c :: 'a :: semiring_div) dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a div c = b div c \<longleftrightarrow> a = b"
   25.54 -  by (elim dvdE, cases "c = 0") simp_all
   25.55 -
   25.56 -lemma normalize_imp_eq:
   25.57 -  "normalize a = normalize b \<Longrightarrow> unit_factor a = unit_factor b \<Longrightarrow> a = b"
   25.58 -  by (cases "a = 0 \<or> b = 0")
   25.59 -     (auto simp add: div_unit_factor [symmetric] unit_div_cancel simp del: div_unit_factor)
   25.60 -    
   25.61 -lemma coprime_crossproduct':
   25.62 -  fixes a b c d :: "'a :: semiring_gcd"
   25.63 -  assumes nz: "b \<noteq> 0"
   25.64 -  assumes unit_factors: "unit_factor b = unit_factor d"
   25.65 -  assumes coprime: "coprime a b" "coprime c d"
   25.66 -  shows "a * d = b * c \<longleftrightarrow> a = c \<and> b = d"
   25.67 -proof safe
   25.68 -  assume eq: "a * d = b * c"
   25.69 -  hence "normalize a * normalize d = normalize c * normalize b"
   25.70 -    by (simp only: normalize_mult [symmetric] mult_ac)
   25.71 -  with coprime have "normalize b = normalize d"
   25.72 -    by (subst (asm) coprime_crossproduct) simp_all
   25.73 -  from this and unit_factors show "b = d" by (rule normalize_imp_eq)
   25.74 -  from eq have "a * d = c * d" by (simp only: \<open>b = d\<close> mult_ac)
   25.75 -  with nz \<open>b = d\<close> show "a = c" by simp
   25.76 -qed (simp_all add: mult_ac)
   25.77 -  
   25.78 -     
   25.79 -lemma div_mult_unit2: "is_unit c \<Longrightarrow> b dvd a \<Longrightarrow> a div (b * c) = a div b div c"
   25.80 -  by (subst dvd_div_mult2_eq) (simp_all add: mult_unit_dvd_iff)
   25.81 -(* END TODO *)
   25.82 -
   25.83 -
   25.84  definition quot_to_fract :: "'a :: {idom} \<times> 'a \<Rightarrow> 'a fract" where
   25.85    "quot_to_fract = (\<lambda>(a,b). Fraction_Field.Fract a b)"
   25.86  
   25.87 @@ -249,7 +184,7 @@
   25.88  
   25.89  lemma quot_of_fract_uminus:
   25.90    "quot_of_fract (-x) = (let (a,b) = quot_of_fract x in (-a, b))"
   25.91 -  by transfer (auto simp: case_prod_unfold Let_def normalize_quot_def dvd_neg_div' mult_unit_dvd_iff)
   25.92 +  by transfer (auto simp: case_prod_unfold Let_def normalize_quot_def dvd_neg_div mult_unit_dvd_iff)
   25.93  
   25.94  lemma quot_of_fract_diff:
   25.95    "quot_of_fract (x - y) = 
    26.1 --- a/src/HOL/Library/Numeral_Type.thy	Tue Dec 20 16:17:13 2016 +0100
    26.2 +++ b/src/HOL/Library/Numeral_Type.thy	Tue Dec 20 16:18:56 2016 +0100
    26.3 @@ -133,7 +133,7 @@
    26.4  
    26.5  lemma comm_ring_1: "OFCLASS('a, comm_ring_1_class)"
    26.6  apply (intro_classes, unfold definitions)
    26.7 -apply (simp_all add: Rep_simps zmod_simps field_simps)
    26.8 +apply (simp_all add: Rep_simps mod_simps field_simps)
    26.9  done
   26.10  
   26.11  end
   26.12 @@ -147,12 +147,12 @@
   26.13  lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
   26.14  apply (induct k)
   26.15  apply (simp add: zero_def)
   26.16 -apply (simp add: Rep_simps add_def one_def zmod_simps ac_simps)
   26.17 +apply (simp add: Rep_simps add_def one_def mod_simps ac_simps)
   26.18  done
   26.19  
   26.20  lemma of_int_eq: "of_int z = Abs (z mod n)"
   26.21  apply (cases z rule: int_diff_cases)
   26.22 -apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
   26.23 +apply (simp add: Rep_simps of_nat_eq diff_def mod_simps)
   26.24  done
   26.25  
   26.26  lemma Rep_numeral:
    27.1 --- a/src/HOL/Library/Omega_Words_Fun.thy	Tue Dec 20 16:17:13 2016 +0100
    27.2 +++ b/src/HOL/Library/Omega_Words_Fun.thy	Tue Dec 20 16:18:56 2016 +0100
    27.3 @@ -626,7 +626,7 @@
    27.4        by (auto simp add: set_conv_nth)
    27.5      \<comment> "the following bound is terrible, but it simplifies the proof"
    27.6      from nempty k have "\<forall>m. w\<^sup>\<omega> ((Suc m)*(length w) + k) = a"
    27.7 -      by (simp add: mod_add_left_eq)
    27.8 +      by (simp add: mod_add_left_eq [symmetric])
    27.9      moreover
   27.10      \<comment> "why is the following so hard to prove??"
   27.11      have "\<forall>m. m < (Suc m)*(length w) + k"
    28.1 --- a/src/HOL/Library/Permutation.thy	Tue Dec 20 16:17:13 2016 +0100
    28.2 +++ b/src/HOL/Library/Permutation.thy	Tue Dec 20 16:18:56 2016 +0100
    28.3 @@ -134,7 +134,7 @@
    28.4    apply simp
    28.5    done
    28.6  
    28.7 -proposition mset_le_perm_append: "mset xs \<le># mset ys \<longleftrightarrow> (\<exists>zs. xs @ zs <~~> ys)"
    28.8 +proposition mset_le_perm_append: "mset xs \<subseteq># mset ys \<longleftrightarrow> (\<exists>zs. xs @ zs <~~> ys)"
    28.9    apply (auto simp: mset_eq_perm[THEN sym] mset_subset_eq_exists_conv)
   28.10    apply (insert surj_mset)
   28.11    apply (drule surjD)
    29.1 --- a/src/HOL/Library/Polynomial.thy	Tue Dec 20 16:17:13 2016 +0100
    29.2 +++ b/src/HOL/Library/Polynomial.thy	Tue Dec 20 16:18:56 2016 +0100
    29.3 @@ -877,7 +877,7 @@
    29.4    by (induct n, simp add: monom_0, simp add: monom_Suc)
    29.5  
    29.6  lemma smult_Poly: "smult c (Poly xs) = Poly (map (op * c) xs)"
    29.7 -  by (auto simp add: poly_eq_iff coeff_Poly_eq nth_default_def)
    29.8 +  by (auto simp add: poly_eq_iff nth_default_def)
    29.9  
   29.10  lemma degree_smult_eq [simp]:
   29.11    fixes a :: "'a::{comm_semiring_0,semiring_no_zero_divisors}"
   29.12 @@ -1064,6 +1064,111 @@
   29.13      by (rule le_trans[OF degree_mult_le], insert insert, auto)
   29.14  qed simp
   29.15  
   29.16 +
   29.17 +subsection \<open>Mapping polynomials\<close>
   29.18 +
   29.19 +definition map_poly 
   29.20 +     :: "('a :: zero \<Rightarrow> 'b :: zero) \<Rightarrow> 'a poly \<Rightarrow> 'b poly" where
   29.21 +  "map_poly f p = Poly (map f (coeffs p))"
   29.22 +
   29.23 +lemma map_poly_0 [simp]: "map_poly f 0 = 0"
   29.24 +  by (simp add: map_poly_def)
   29.25 +
   29.26 +lemma map_poly_1: "map_poly f 1 = [:f 1:]"
   29.27 +  by (simp add: map_poly_def)
   29.28 +
   29.29 +lemma map_poly_1' [simp]: "f 1 = 1 \<Longrightarrow> map_poly f 1 = 1"
   29.30 +  by (simp add: map_poly_def one_poly_def)
   29.31 +
   29.32 +lemma coeff_map_poly:
   29.33 +  assumes "f 0 = 0"
   29.34 +  shows   "coeff (map_poly f p) n = f (coeff p n)"
   29.35 +  by (auto simp: map_poly_def nth_default_def coeffs_def assms
   29.36 +        not_less Suc_le_eq coeff_eq_0 simp del: upt_Suc)
   29.37 +
   29.38 +lemma coeffs_map_poly [code abstract]: 
   29.39 +    "coeffs (map_poly f p) = strip_while (op = 0) (map f (coeffs p))"
   29.40 +  by (simp add: map_poly_def)
   29.41 +
   29.42 +lemma set_coeffs_map_poly:
   29.43 +  "(\<And>x. f x = 0 \<longleftrightarrow> x = 0) \<Longrightarrow> set (coeffs (map_poly f p)) = f ` set (coeffs p)"
   29.44 +  by (cases "p = 0") (auto simp: coeffs_map_poly last_map last_coeffs_not_0)
   29.45 +
   29.46 +lemma coeffs_map_poly': 
   29.47 +  assumes "(\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0)"
   29.48 +  shows   "coeffs (map_poly f p) = map f (coeffs p)"
   29.49 +  by (cases "p = 0") (auto simp: coeffs_map_poly last_map last_coeffs_not_0 assms 
   29.50 +                           intro!: strip_while_not_last split: if_splits)
   29.51 +
   29.52 +lemma degree_map_poly:
   29.53 +  assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   29.54 +  shows   "degree (map_poly f p) = degree p"
   29.55 +  by (simp add: degree_eq_length_coeffs coeffs_map_poly' assms)
   29.56 +
   29.57 +lemma map_poly_eq_0_iff:
   29.58 +  assumes "f 0 = 0" "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   29.59 +  shows   "map_poly f p = 0 \<longleftrightarrow> p = 0"
   29.60 +proof -
   29.61 +  {
   29.62 +    fix n :: nat
   29.63 +    have "coeff (map_poly f p) n = f (coeff p n)" by (simp add: coeff_map_poly assms)
   29.64 +    also have "\<dots> = 0 \<longleftrightarrow> coeff p n = 0"
   29.65 +    proof (cases "n < length (coeffs p)")
   29.66 +      case True
   29.67 +      hence "coeff p n \<in> set (coeffs p)" by (auto simp: coeffs_def simp del: upt_Suc)
   29.68 +      with assms show "f (coeff p n) = 0 \<longleftrightarrow> coeff p n = 0" by auto
   29.69 +    qed (auto simp: assms length_coeffs nth_default_coeffs_eq [symmetric] nth_default_def)
   29.70 +    finally have "(coeff (map_poly f p) n = 0) = (coeff p n = 0)" .
   29.71 +  }
   29.72 +  thus ?thesis by (auto simp: poly_eq_iff)
   29.73 +qed
   29.74 +
   29.75 +lemma map_poly_smult:
   29.76 +  assumes "f 0 = 0""\<And>c x. f (c * x) = f c * f x"
   29.77 +  shows   "map_poly f (smult c p) = smult (f c) (map_poly f p)"
   29.78 +  by (intro poly_eqI) (simp_all add: assms coeff_map_poly)
   29.79 +
   29.80 +lemma map_poly_pCons:
   29.81 +  assumes "f 0 = 0"
   29.82 +  shows   "map_poly f (pCons c p) = pCons (f c) (map_poly f p)"
   29.83 +  by (intro poly_eqI) (simp_all add: assms coeff_map_poly coeff_pCons split: nat.splits)
   29.84 +
   29.85 +lemma map_poly_map_poly:
   29.86 +  assumes "f 0 = 0" "g 0 = 0"
   29.87 +  shows   "map_poly f (map_poly g p) = map_poly (f \<circ> g) p"
   29.88 +  by (intro poly_eqI) (simp add: coeff_map_poly assms)
   29.89 +
   29.90 +lemma map_poly_id [simp]: "map_poly id p = p"
   29.91 +  by (simp add: map_poly_def)
   29.92 +
   29.93 +lemma map_poly_id' [simp]: "map_poly (\<lambda>x. x) p = p"
   29.94 +  by (simp add: map_poly_def)
   29.95 +
   29.96 +lemma map_poly_cong: 
   29.97 +  assumes "(\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = g x)"
   29.98 +  shows   "map_poly f p = map_poly g p"
   29.99 +proof -
  29.100 +  from assms have "map f (coeffs p) = map g (coeffs p)" by (intro map_cong) simp_all
  29.101 +  thus ?thesis by (simp only: coeffs_eq_iff coeffs_map_poly)
  29.102 +qed
  29.103 +
  29.104 +lemma map_poly_monom: "f 0 = 0 \<Longrightarrow> map_poly f (monom c n) = monom (f c) n"
  29.105 +  by (intro poly_eqI) (simp_all add: coeff_map_poly)
  29.106 +
  29.107 +lemma map_poly_idI:
  29.108 +  assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
  29.109 +  shows   "map_poly f p = p"
  29.110 +  using map_poly_cong[OF assms, of _ id] by simp
  29.111 +
  29.112 +lemma map_poly_idI':
  29.113 +  assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
  29.114 +  shows   "p = map_poly f p"
  29.115 +  using map_poly_cong[OF assms, of _ id] by simp
  29.116 +
  29.117 +lemma smult_conv_map_poly: "smult c p = map_poly (\<lambda>x. c * x) p"
  29.118 +  by (intro poly_eqI) (simp_all add: coeff_map_poly)
  29.119 +
  29.120 +
  29.121  subsection \<open>Conversions from natural numbers\<close>
  29.122  
  29.123  lemma of_nat_poly: "of_nat n = [:of_nat n :: 'a :: comm_semiring_1:]"
  29.124 @@ -1086,6 +1191,7 @@
  29.125  lemma numeral_poly: "numeral n = [:numeral n:]"
  29.126    by (subst of_nat_numeral [symmetric], subst of_nat_poly) simp
  29.127  
  29.128 +
  29.129  subsection \<open>Lemmas about divisibility\<close>
  29.130  
  29.131  lemma dvd_smult: "p dvd q \<Longrightarrow> p dvd smult a q"
  29.132 @@ -1137,6 +1243,11 @@
  29.133  apply (simp add: coeff_mult_degree_sum)
  29.134  done
  29.135  
  29.136 +lemma degree_mult_eq_0:
  29.137 +  fixes p q:: "'a :: {comm_semiring_0,semiring_no_zero_divisors} poly"
  29.138 +  shows "degree (p * q) = 0 \<longleftrightarrow> p = 0 \<or> q = 0 \<or> (p \<noteq> 0 \<and> q \<noteq> 0 \<and> degree p = 0 \<and> degree q = 0)"
  29.139 +  by (auto simp add: degree_mult_eq)
  29.140 +
  29.141  lemma degree_mult_right_le:
  29.142    fixes p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
  29.143    assumes "q \<noteq> 0"
  29.144 @@ -1290,6 +1401,75 @@
  29.145  text \<open>TODO: Simplification rules for comparisons\<close>
  29.146  
  29.147  
  29.148 +subsection \<open>Leading coefficient\<close>
  29.149 +
  29.150 +definition lead_coeff:: "'a::zero poly \<Rightarrow> 'a" where
  29.151 +  "lead_coeff p= coeff p (degree p)"
  29.152 +
  29.153 +lemma lead_coeff_pCons[simp]:
  29.154 +    "p\<noteq>0 \<Longrightarrow>lead_coeff (pCons a p) = lead_coeff p"
  29.155 +    "p=0 \<Longrightarrow> lead_coeff (pCons a p) = a"
  29.156 +unfolding lead_coeff_def by auto
  29.157 +
  29.158 +lemma lead_coeff_0[simp]:"lead_coeff 0 =0" 
  29.159 +  unfolding lead_coeff_def by auto
  29.160 +
  29.161 +lemma coeff_0_prod_list: "coeff (prod_list xs) 0 = prod_list (map (\<lambda>p. coeff p 0) xs)"
  29.162 +  by (induction xs) (simp_all add: coeff_mult)
  29.163 +
  29.164 +lemma coeff_0_power: "coeff (p ^ n) 0 = coeff p 0 ^ n"
  29.165 +  by (induction n) (simp_all add: coeff_mult)
  29.166 +
  29.167 +lemma lead_coeff_mult:
  29.168 +   fixes p q::"'a :: {comm_semiring_0,semiring_no_zero_divisors} poly"
  29.169 +   shows "lead_coeff (p * q) = lead_coeff p * lead_coeff q"
  29.170 +by (unfold lead_coeff_def,cases "p=0 \<or> q=0",auto simp add:coeff_mult_degree_sum degree_mult_eq)
  29.171 +
  29.172 +lemma lead_coeff_add_le:
  29.173 +  assumes "degree p < degree q"
  29.174 +  shows "lead_coeff (p+q) = lead_coeff q" 
  29.175 +using assms unfolding lead_coeff_def
  29.176 +by (metis coeff_add coeff_eq_0 monoid_add_class.add.left_neutral degree_add_eq_right)
  29.177 +
  29.178 +lemma lead_coeff_minus:
  29.179 +  "lead_coeff (-p) = - lead_coeff p"
  29.180 +by (metis coeff_minus degree_minus lead_coeff_def)
  29.181 +
  29.182 +lemma lead_coeff_smult:
  29.183 +  "lead_coeff (smult c p :: 'a :: {comm_semiring_0,semiring_no_zero_divisors} poly) = c * lead_coeff p"
  29.184 +proof -
  29.185 +  have "smult c p = [:c:] * p" by simp
  29.186 +  also have "lead_coeff \<dots> = c * lead_coeff p"
  29.187 +    by (subst lead_coeff_mult) simp_all
  29.188 +  finally show ?thesis .
  29.189 +qed
  29.190 +
  29.191 +lemma lead_coeff_eq_zero_iff [simp]: "lead_coeff p = 0 \<longleftrightarrow> p = 0"
  29.192 +  by (simp add: lead_coeff_def)
  29.193 +
  29.194 +lemma lead_coeff_1 [simp]: "lead_coeff 1 = 1"
  29.195 +  by (simp add: lead_coeff_def)
  29.196 +
  29.197 +lemma lead_coeff_of_nat [simp]:
  29.198 +  "lead_coeff (of_nat n) = (of_nat n :: 'a :: {comm_semiring_1,semiring_char_0})"
  29.199 +  by (induction n) (simp_all add: lead_coeff_def of_nat_poly)
  29.200 +
  29.201 +lemma lead_coeff_numeral [simp]: 
  29.202 +  "lead_coeff (numeral n) = numeral n"
  29.203 +  unfolding lead_coeff_def
  29.204 +  by (subst of_nat_numeral [symmetric], subst of_nat_poly) simp
  29.205 +
  29.206 +lemma lead_coeff_power: 
  29.207 +  "lead_coeff (p ^ n :: 'a :: {comm_semiring_1,semiring_no_zero_divisors} poly) = lead_coeff p ^ n"
  29.208 +  by (induction n) (simp_all add: lead_coeff_mult)
  29.209 +
  29.210 +lemma lead_coeff_nonzero: "p \<noteq> 0 \<Longrightarrow> lead_coeff p \<noteq> 0"
  29.211 +  by (simp add: lead_coeff_def)
  29.212 +
  29.213 +lemma lead_coeff_monom [simp]: "lead_coeff (monom c n) = c"
  29.214 +  by (cases "c = 0") (simp_all add: lead_coeff_def degree_monom_eq)
  29.215 +
  29.216 +
  29.217  subsection \<open>Synthetic division and polynomial roots\<close>
  29.218  
  29.219  text \<open>
  29.220 @@ -1555,7 +1735,7 @@
  29.221  
  29.222  
  29.223  
  29.224 -subsection\<open>Pseudo-Division and Division of Polynomials\<close>
  29.225 +subsection \<open>Pseudo-Division and Division of Polynomials\<close>
  29.226  
  29.227  text\<open>This part is by René Thiemann and Akihisa Yamada.\<close>
  29.228  
  29.229 @@ -1838,15 +2018,172 @@
  29.230  lemma divide_poly_0: "f div 0 = (0 :: 'a poly)"
  29.231    by (simp add: divide_poly_def Let_def divide_poly_main_0)
  29.232  
  29.233 -instance by (standard, auto simp: divide_poly divide_poly_0)
  29.234 +instance
  29.235 +  by standard (auto simp: divide_poly divide_poly_0)
  29.236 +
  29.237  end
  29.238  
  29.239 -
  29.240  instance poly :: (idom_divide) algebraic_semidom ..
  29.241  
  29.242 -
  29.243 -
  29.244 -subsubsection\<open>Division in Field Polynomials\<close>
  29.245 +lemma div_const_poly_conv_map_poly: 
  29.246 +  assumes "[:c:] dvd p"
  29.247 +  shows   "p div [:c:] = map_poly (\<lambda>x. x div c) p"
  29.248 +proof (cases "c = 0")
  29.249 +  case False
  29.250 +  from assms obtain q where p: "p = [:c:] * q" by (erule dvdE)
  29.251 +  moreover {
  29.252 +    have "smult c q = [:c:] * q" by simp
  29.253 +    also have "\<dots> div [:c:] = q" by (rule nonzero_mult_div_cancel_left) (insert False, auto)
  29.254 +    finally have "smult c q div [:c:] = q" .
  29.255 +  }
  29.256 +  ultimately show ?thesis by (intro poly_eqI) (auto simp: coeff_map_poly False)
  29.257 +qed (auto intro!: poly_eqI simp: coeff_map_poly)
  29.258 +
  29.259 +lemma is_unit_monom_0:
  29.260 +  fixes a :: "'a::field"
  29.261 +  assumes "a \<noteq> 0"
  29.262 +  shows "is_unit (monom a 0)"
  29.263 +proof
  29.264 +  from assms show "1 = monom a 0 * monom (inverse a) 0"
  29.265 +    by (simp add: mult_monom)
  29.266 +qed
  29.267 +
  29.268 +lemma is_unit_triv:
  29.269 +  fixes a :: "'a::field"
  29.270 +  assumes "a \<noteq> 0"
  29.271 +  shows "is_unit [:a:]"
  29.272 +  using assms by (simp add: is_unit_monom_0 monom_0 [symmetric])
  29.273 +
  29.274 +lemma is_unit_iff_degree:
  29.275 +  assumes "p \<noteq> (0 :: _ :: field poly)"
  29.276 +  shows "is_unit p \<longleftrightarrow> degree p = 0" (is "?P \<longleftrightarrow> ?Q")
  29.277 +proof
  29.278 +  assume ?Q
  29.279 +  then obtain a where "p = [:a:]" by (rule degree_eq_zeroE)
  29.280 +  with assms show ?P by (simp add: is_unit_triv)
  29.281 +next
  29.282 +  assume ?P
  29.283 +  then obtain q where "q \<noteq> 0" "p * q = 1" ..
  29.284 +  then have "degree (p * q) = degree 1"
  29.285 +    by simp
  29.286 +  with \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> have "degree p + degree q = 0"
  29.287 +    by (simp add: degree_mult_eq)
  29.288 +  then show ?Q by simp
  29.289 +qed
  29.290 +
  29.291 +lemma is_unit_pCons_iff:
  29.292 +  "is_unit (pCons (a::_::field) p) \<longleftrightarrow> p = 0 \<and> a \<noteq> 0"
  29.293 +  by (cases "p = 0") (auto simp add: is_unit_triv is_unit_iff_degree)
  29.294 +
  29.295 +lemma is_unit_monom_trival:
  29.296 +  fixes p :: "'a::field poly"
  29.297 +  assumes "is_unit p"
  29.298 +  shows "monom (coeff p (degree p)) 0 = p"
  29.299 +  using assms by (cases p) (simp_all add: monom_0 is_unit_pCons_iff)
  29.300 +
  29.301 +lemma is_unit_const_poly_iff: 
  29.302 +  "[:c :: 'a :: {comm_semiring_1,semiring_no_zero_divisors}:] dvd 1 \<longleftrightarrow> c dvd 1"
  29.303 +  by (auto simp: one_poly_def)
  29.304 +
  29.305 +lemma is_unit_polyE:
  29.306 +  fixes p :: "'a :: {comm_semiring_1,semiring_no_zero_divisors} poly"
  29.307 +  assumes "p dvd 1" obtains c where "p = [:c:]" "c dvd 1"
  29.308 +proof -
  29.309 +  from assms obtain q where "1 = p * q"
  29.310 +    by (rule dvdE)
  29.311 +  then have "p \<noteq> 0" and "q \<noteq> 0"
  29.312 +    by auto
  29.313 +  from \<open>1 = p * q\<close> have "degree 1 = degree (p * q)"
  29.314 +    by simp
  29.315 +  also from \<open>p \<noteq> 0\<close> and \<open>q \<noteq> 0\<close> have "\<dots> = degree p + degree q"
  29.316 +    by (simp add: degree_mult_eq)
  29.317 +  finally have "degree p = 0" by simp
  29.318 +  with degree_eq_zeroE obtain c where c: "p = [:c:]" .
  29.319 +  moreover with \<open>p dvd 1\<close> have "c dvd 1"
  29.320 +    by (simp add: is_unit_const_poly_iff)
  29.321 +  ultimately show thesis
  29.322 +    by (rule that)
  29.323 +qed
  29.324 +
  29.325 +lemma is_unit_polyE':
  29.326 +  assumes "is_unit (p::_::field poly)"
  29.327 +  obtains a where "p = monom a 0" and "a \<noteq> 0"
  29.328 +proof -
  29.329 +  obtain a q where "p = pCons a q" by (cases p)
  29.330 +  with assms have "p = [:a:]" and "a \<noteq> 0"
  29.331 +    by (simp_all add: is_unit_pCons_iff)
  29.332 +  with that show thesis by (simp add: monom_0)
  29.333 +qed
  29.334 +
  29.335 +lemma is_unit_poly_iff:
  29.336 +  fixes p :: "'a :: {comm_semiring_1,semiring_no_zero_divisors} poly"
  29.337 +  shows "p dvd 1 \<longleftrightarrow> (\<exists>c. p = [:c:] \<and> c dvd 1)"
  29.338 +  by (auto elim: is_unit_polyE simp add: is_unit_const_poly_iff)
  29.339 +
  29.340 +instantiation poly :: ("{normalization_semidom, idom_divide}") normalization_semidom
  29.341 +begin
  29.342 +
  29.343 +definition unit_factor_poly :: "'a poly \<Rightarrow> 'a poly"
  29.344 +  where "unit_factor_poly p = monom (unit_factor (lead_coeff p)) 0"
  29.345 +
  29.346 +definition normalize_poly :: "'a poly \<Rightarrow> 'a poly"
  29.347 +  where "normalize_poly p = map_poly (\<lambda>x. x div unit_factor (lead_coeff p)) p"
  29.348 +
  29.349 +instance proof
  29.350 +  fix p :: "'a poly"
  29.351 +  show "unit_factor p * normalize p = p"
  29.352 +    by (cases "p = 0")
  29.353 +       (simp_all add: unit_factor_poly_def normalize_poly_def monom_0 
  29.354 +          smult_conv_map_poly map_poly_map_poly o_def)
  29.355 +next
  29.356 +  fix p :: "'a poly"
  29.357 +  assume "is_unit p"
  29.358 +  then obtain c where p: "p = [:c:]" "is_unit c"
  29.359 +    by (auto simp: is_unit_poly_iff)
  29.360 +  thus "normalize p = 1"
  29.361 +    by (simp add: normalize_poly_def map_poly_pCons is_unit_normalize one_poly_def)
  29.362 +next
  29.363 +  fix p :: "'a poly" assume "p \<noteq> 0"
  29.364 +  thus "is_unit (unit_factor p)"
  29.365 +    by (simp add: unit_factor_poly_def monom_0 is_unit_poly_iff)
  29.366 +qed (simp_all add: normalize_poly_def unit_factor_poly_def monom_0 lead_coeff_mult unit_factor_mult)
  29.367 +
  29.368 +end
  29.369 +
  29.370 +lemma normalize_poly_eq_div:
  29.371 +  "normalize p = p div [:unit_factor (lead_coeff p):]"
  29.372 +proof (cases "p = 0")
  29.373 +  case False
  29.374 +  thus ?thesis
  29.375 +    by (subst div_const_poly_conv_map_poly)
  29.376 +       (auto simp: normalize_poly_def const_poly_dvd_iff lead_coeff_def )
  29.377 +qed (auto simp: normalize_poly_def)
  29.378 +
  29.379 +lemma unit_factor_pCons:
  29.380 +  "unit_factor (pCons a p) = (if p = 0 then monom (unit_factor a) 0 else unit_factor p)"
  29.381 +  by (simp add: unit_factor_poly_def)
  29.382 +
  29.383 +lemma normalize_monom [simp]:
  29.384 +  "normalize (monom a n) = monom (normalize a) n"
  29.385 +  by (simp add: map_poly_monom normalize_poly_def)
  29.386 +
  29.387 +lemma unit_factor_monom [simp]:
  29.388 +  "unit_factor (monom a n) = monom (unit_factor a) 0"
  29.389 +  by (simp add: unit_factor_poly_def )
  29.390 +
  29.391 +lemma normalize_const_poly: "normalize [:c:] = [:normalize c:]"
  29.392 +  by (simp add: normalize_poly_def map_poly_pCons)
  29.393 +
  29.394 +lemma normalize_smult: "normalize (smult c p) = smult (normalize c) (normalize p)"
  29.395 +proof -
  29.396 +  have "smult c p = [:c:] * p" by simp
  29.397 +  also have "normalize \<dots> = smult (normalize c) (normalize p)"
  29.398 +    by (subst normalize_mult) (simp add: normalize_const_poly)
  29.399 +  finally show ?thesis .
  29.400 +qed
  29.401 +
  29.402 +
  29.403 +subsubsection \<open>Division in Field Polynomials\<close>
  29.404  
  29.405  text\<open>
  29.406   This part connects the above result to the division of field polynomials.
  29.407 @@ -1937,12 +2274,6 @@
  29.408    from pdivmod_rel[of x y,unfolded pdivmod_rel_def]
  29.409    show "x div y * y + x mod y = x" by auto
  29.410  next
  29.411 -  fix x :: "'a poly"
  29.412 -  show "x div 0 = 0" by simp
  29.413 -next
  29.414 -  fix y :: "'a poly"
  29.415 -  show "0 div y = 0" by simp
  29.416 -next
  29.417    fix x y z :: "'a poly"
  29.418    assume "y \<noteq> 0"
  29.419    hence "pdivmod_rel (x + z * y) y (z + x div y) (x mod y)"
  29.420 @@ -1978,58 +2309,6 @@
  29.421  
  29.422  end
  29.423  
  29.424 -lemma is_unit_monom_0:
  29.425 -  fixes a :: "'a::field"
  29.426 -  assumes "a \<noteq> 0"
  29.427 -  shows "is_unit (monom a 0)"
  29.428 -proof
  29.429 -  from assms show "1 = monom a 0 * monom (inverse a) 0"
  29.430 -    by (simp add: mult_monom)
  29.431 -qed
  29.432 -
  29.433 -lemma is_unit_triv:
  29.434 -  fixes a :: "'a::field"
  29.435 -  assumes "a \<noteq> 0"
  29.436 -  shows "is_unit [:a:]"
  29.437 -  using assms by (simp add: is_unit_monom_0 monom_0 [symmetric])
  29.438 -
  29.439 -lemma is_unit_iff_degree:
  29.440 -  assumes "p \<noteq> (0 :: _ :: field poly)"
  29.441 -  shows "is_unit p \<longleftrightarrow> degree p = 0" (is "?P \<longleftrightarrow> ?Q")
  29.442 -proof
  29.443 -  assume ?Q
  29.444 -  then obtain a where "p = [:a:]" by (rule degree_eq_zeroE)
  29.445 -  with assms show ?P by (simp add: is_unit_triv)
  29.446 -next
  29.447 -  assume ?P
  29.448 -  then obtain q where "q \<noteq> 0" "p * q = 1" ..
  29.449 -  then have "degree (p * q) = degree 1"
  29.450 -    by simp
  29.451 -  with \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> have "degree p + degree q = 0"
  29.452 -    by (simp add: degree_mult_eq)
  29.453 -  then show ?Q by simp
  29.454 -qed
  29.455 -
  29.456 -lemma is_unit_pCons_iff:
  29.457 -  "is_unit (pCons (a::_::field) p) \<longleftrightarrow> p = 0 \<and> a \<noteq> 0"
  29.458 -  by (cases "p = 0") (auto simp add: is_unit_triv is_unit_iff_degree)
  29.459 -
  29.460 -lemma is_unit_monom_trival:
  29.461 -  fixes p :: "'a::field poly"
  29.462 -  assumes "is_unit p"
  29.463 -  shows "monom (coeff p (degree p)) 0 = p"
  29.464 -  using assms by (cases p) (simp_all add: monom_0 is_unit_pCons_iff)
  29.465 -
  29.466 -lemma is_unit_polyE:
  29.467 -  assumes "is_unit (p::_::field poly)"
  29.468 -  obtains a where "p = monom a 0" and "a \<noteq> 0"
  29.469 -proof -
  29.470 -  obtain a q where "p = pCons a q" by (cases p)
  29.471 -  with assms have "p = [:a:]" and "a \<noteq> 0"
  29.472 -    by (simp_all add: is_unit_pCons_iff)
  29.473 -  with that show thesis by (simp add: monom_0)
  29.474 -qed
  29.475 -
  29.476  lemma degree_mod_less:
  29.477    "y \<noteq> 0 \<Longrightarrow> x mod y = 0 \<or> degree (x mod y) < degree y"
  29.478    using pdivmod_rel [of x y]
  29.479 @@ -2860,18 +3139,11 @@
  29.480    by (cases "finite A", induction rule: finite_induct)
  29.481       (simp_all add: pcompose_1 pcompose_mult)
  29.482  
  29.483 -
  29.484 -(* The remainder of this section and the next were contributed by Wenda Li *)
  29.485 -
  29.486 -lemma degree_mult_eq_0:
  29.487 -  fixes p q:: "'a :: {comm_semiring_0,semiring_no_zero_divisors} poly"
  29.488 -  shows "degree (p*q) = 0 \<longleftrightarrow> p=0 \<or> q=0 \<or> (p\<noteq>0 \<and> q\<noteq>0 \<and> degree p =0 \<and> degree q =0)"
  29.489 -by (auto simp add:degree_mult_eq)
  29.490 -
  29.491 -lemma pcompose_const[simp]:"pcompose [:a:] q = [:a:]" by (subst pcompose_pCons,simp) 
  29.492 +lemma pcompose_const [simp]: "pcompose [:a:] q = [:a:]"
  29.493 +  by (subst pcompose_pCons) simp
  29.494  
  29.495  lemma pcompose_0': "pcompose p 0 = [:coeff p 0:]"
  29.496 -  by (induct p) (auto simp add:pcompose_pCons)
  29.497 +  by (induct p) (auto simp add: pcompose_pCons)
  29.498  
  29.499  lemma degree_pcompose:
  29.500    fixes p q:: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
  29.501 @@ -2932,53 +3204,6 @@
  29.502    thus ?thesis using \<open>p=[:a:]\<close> by simp
  29.503  qed
  29.504  
  29.505 -
  29.506 -subsection \<open>Leading coefficient\<close>
  29.507 -
  29.508 -definition lead_coeff:: "'a::zero poly \<Rightarrow> 'a" where
  29.509 -  "lead_coeff p= coeff p (degree p)"
  29.510 -
  29.511 -lemma lead_coeff_pCons[simp]:
  29.512 -    "p\<noteq>0 \<Longrightarrow>lead_coeff (pCons a p) = lead_coeff p"
  29.513 -    "p=0 \<Longrightarrow> lead_coeff (pCons a p) = a"
  29.514 -unfolding lead_coeff_def by auto
  29.515 -
  29.516 -lemma lead_coeff_0[simp]:"lead_coeff 0 =0" 
  29.517 -  unfolding lead_coeff_def by auto
  29.518 -
  29.519 -lemma coeff_0_prod_list: "coeff (prod_list xs) 0 = prod_list (map (\<lambda>p. coeff p 0) xs)"
  29.520 -  by (induction xs) (simp_all add: coeff_mult)
  29.521 -
  29.522 -lemma coeff_0_power: "coeff (p ^ n) 0 = coeff p 0 ^ n"
  29.523 -  by (induction n) (simp_all add: coeff_mult)
  29.524 -
  29.525 -lemma lead_coeff_mult:
  29.526 -   fixes p q::"'a :: {comm_semiring_0,semiring_no_zero_divisors} poly"
  29.527 -   shows "lead_coeff (p * q) = lead_coeff p * lead_coeff q"
  29.528 -by (unfold lead_coeff_def,cases "p=0 \<or> q=0",auto simp add:coeff_mult_degree_sum degree_mult_eq)
  29.529 -
  29.530 -lemma lead_coeff_add_le:
  29.531 -  assumes "degree p < degree q"
  29.532 -  shows "lead_coeff (p+q) = lead_coeff q" 
  29.533 -using assms unfolding lead_coeff_def
  29.534 -by (metis coeff_add coeff_eq_0 monoid_add_class.add.left_neutral degree_add_eq_right)
  29.535 -
  29.536 -lemma lead_coeff_minus:
  29.537 -  "lead_coeff (-p) = - lead_coeff p"
  29.538 -by (metis coeff_minus degree_minus lead_coeff_def)
  29.539 -
  29.540 -lemma lead_coeff_smult:
  29.541 -  "lead_coeff (smult c p :: 'a :: {comm_semiring_0,semiring_no_zero_divisors} poly) = c * lead_coeff p"
  29.542 -proof -
  29.543 -  have "smult c p = [:c:] * p" by simp
  29.544 -  also have "lead_coeff \<dots> = c * lead_coeff p"
  29.545 -    by (subst lead_coeff_mult) simp_all
  29.546 -  finally show ?thesis .
  29.547 -qed
  29.548 -
  29.549 -lemma lead_coeff_eq_zero_iff [simp]: "lead_coeff p = 0 \<longleftrightarrow> p = 0"
  29.550 -  by (simp add: lead_coeff_def)
  29.551 -
  29.552  lemma lead_coeff_comp:
  29.553    fixes p q:: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
  29.554    assumes "degree q > 0" 
  29.555 @@ -3009,25 +3234,6 @@
  29.556    ultimately show ?case by blast
  29.557  qed
  29.558  
  29.559 -lemma lead_coeff_1 [simp]: "lead_coeff 1 = 1"
  29.560 -  by (simp add: lead_coeff_def)
  29.561 -
  29.562 -lemma lead_coeff_of_nat [simp]:
  29.563 -  "lead_coeff (of_nat n) = (of_nat n :: 'a :: {comm_semiring_1,semiring_char_0})"
  29.564 -  by (induction n) (simp_all add: lead_coeff_def of_nat_poly)
  29.565 -
  29.566 -lemma lead_coeff_numeral [simp]: 
  29.567 -  "lead_coeff (numeral n) = numeral n"
  29.568 -  unfolding lead_coeff_def
  29.569 -  by (subst of_nat_numeral [symmetric], subst of_nat_poly) simp
  29.570 -
  29.571 -lemma lead_coeff_power: 
  29.572 -  "lead_coeff (p ^ n :: 'a :: {comm_semiring_1,semiring_no_zero_divisors} poly) = lead_coeff p ^ n"
  29.573 -  by (induction n) (simp_all add: lead_coeff_mult)
  29.574 -
  29.575 -lemma lead_coeff_nonzero: "p \<noteq> 0 \<Longrightarrow> lead_coeff p \<noteq> 0"
  29.576 -  by (simp add: lead_coeff_def)
  29.577 -
  29.578  
  29.579  subsection \<open>Shifting polynomials\<close>
  29.580  
    30.1 --- a/src/HOL/Library/Polynomial_Factorial.thy	Tue Dec 20 16:17:13 2016 +0100
    30.2 +++ b/src/HOL/Library/Polynomial_Factorial.thy	Tue Dec 20 16:18:56 2016 +0100
    30.3 @@ -9,144 +9,84 @@
    30.4  theory Polynomial_Factorial
    30.5  imports 
    30.6    Complex_Main
    30.7 -  "~~/src/HOL/Number_Theory/Euclidean_Algorithm"
    30.8    "~~/src/HOL/Library/Polynomial"
    30.9    "~~/src/HOL/Library/Normalized_Fraction"
   30.10 -begin
   30.11 -
   30.12 -subsection \<open>Prelude\<close>
   30.13 -
   30.14 -lemma prod_mset_mult: 
   30.15 -  "prod_mset (image_mset (\<lambda>x. f x * g x) A) = prod_mset (image_mset f A) * prod_mset (image_mset g A)"
   30.16 -  by (induction A) (simp_all add: mult_ac)
   30.17 -  
   30.18 -lemma prod_mset_const: "prod_mset (image_mset (\<lambda>_. c) A) = c ^ size A"
   30.19 -  by (induction A) (simp_all add: mult_ac)
   30.20 -  
   30.21 -lemma dvd_field_iff: "x dvd y \<longleftrightarrow> (x = 0 \<longrightarrow> y = (0::'a::field))"
   30.22 -proof safe
   30.23 -  assume "x \<noteq> 0"
   30.24 -  hence "y = x * (y / x)" by (simp add: field_simps)
   30.25 -  thus "x dvd y" by (rule dvdI)
   30.26 -qed auto
   30.27 -
   30.28 -lemma nat_descend_induct [case_names base descend]:
   30.29 -  assumes "\<And>k::nat. k > n \<Longrightarrow> P k"
   30.30 -  assumes "\<And>k::nat. k \<le> n \<Longrightarrow> (\<And>i. i > k \<Longrightarrow> P i) \<Longrightarrow> P k"
   30.31 -  shows   "P m"
   30.32 -  using assms by induction_schema (force intro!: wf_measure[of "\<lambda>k. Suc n - k"])+
   30.33 -
   30.34 -lemma GreatestI_ex: "\<exists>k::nat. P k \<Longrightarrow> \<forall>y. P y \<longrightarrow> y < b \<Longrightarrow> P (GREATEST x. P x)"
   30.35 -  by (metis GreatestI)
   30.36 -
   30.37 -
   30.38 -context field
   30.39 -begin
   30.40 -
   30.41 -subclass idom_divide ..
   30.42 -
   30.43 -end
   30.44 -
   30.45 -context field
   30.46 -begin
   30.47 -
   30.48 -definition normalize_field :: "'a \<Rightarrow> 'a" 
   30.49 -  where [simp]: "normalize_field x = (if x = 0 then 0 else 1)"
   30.50 -definition unit_factor_field :: "'a \<Rightarrow> 'a" 
   30.51 -  where [simp]: "unit_factor_field x = x"
   30.52 -definition euclidean_size_field :: "'a \<Rightarrow> nat" 
   30.53 -  where [simp]: "euclidean_size_field x = (if x = 0 then 0 else 1)"
   30.54 -definition mod_field :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
   30.55 -  where [simp]: "mod_field x y = (if y = 0 then x else 0)"
   30.56 -
   30.57 -end
   30.58 -
   30.59 -instantiation real :: euclidean_ring
   30.60 -begin
   30.61 -
   30.62 -definition [simp]: "normalize_real = (normalize_field :: real \<Rightarrow> _)"
   30.63 -definition [simp]: "unit_factor_real = (unit_factor_field :: real \<Rightarrow> _)"
   30.64 -definition [simp]: "euclidean_size_real = (euclidean_size_field :: real \<Rightarrow> _)"
   30.65 -definition [simp]: "modulo_real = (mod_field :: real \<Rightarrow> _)"
   30.66 -
   30.67 -instance by standard (simp_all add: dvd_field_iff divide_simps)
   30.68 -end
   30.69 -
   30.70 -instantiation real :: euclidean_ring_gcd
   30.71 +  "~~/src/HOL/Library/Field_as_Ring"
   30.72  begin
   30.73  
   30.74 -definition gcd_real :: "real \<Rightarrow> real \<Rightarrow> real" where
   30.75 -  "gcd_real = gcd_eucl"
   30.76 -definition lcm_real :: "real \<Rightarrow> real \<Rightarrow> real" where
   30.77 -  "lcm_real = lcm_eucl"
   30.78 -definition Gcd_real :: "real set \<Rightarrow> real" where
   30.79 - "Gcd_real = Gcd_eucl"
   30.80 -definition Lcm_real :: "real set \<Rightarrow> real" where
   30.81 - "Lcm_real = Lcm_eucl"
   30.82 +subsection \<open>Various facts about polynomials\<close>
   30.83  
   30.84 -instance by standard (simp_all add: gcd_real_def lcm_real_def Gcd_real_def Lcm_real_def)
   30.85 -
   30.86 -end
   30.87 +lemma prod_mset_const_poly: "prod_mset (image_mset (\<lambda>x. [:f x:]) A) = [:prod_mset (image_mset f A):]"
   30.88 +  by (induction A) (simp_all add: one_poly_def mult_ac)
   30.89  
   30.90 -instantiation rat :: euclidean_ring
   30.91 -begin
   30.92 -
   30.93 -definition [simp]: "normalize_rat = (normalize_field :: rat \<Rightarrow> _)"
   30.94 -definition [simp]: "unit_factor_rat = (unit_factor_field :: rat \<Rightarrow> _)"
   30.95 -definition [simp]: "euclidean_size_rat = (euclidean_size_field :: rat \<Rightarrow> _)"
   30.96 -definition [simp]: "modulo_rat = (mod_field :: rat \<Rightarrow> _)"
   30.97 -
   30.98 -instance by standard (simp_all add: dvd_field_iff divide_simps)
   30.99 -end
  30.100 -
  30.101 -instantiation rat :: euclidean_ring_gcd
  30.102 -begin
  30.103 +lemma is_unit_smult_iff: "smult c p dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
  30.104 +proof -
  30.105 +  have "smult c p = [:c:] * p" by simp
  30.106 +  also have "\<dots> dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
  30.107 +  proof safe
  30.108 +    assume A: "[:c:] * p dvd 1"
  30.109 +    thus "p dvd 1" by (rule dvd_mult_right)
  30.110 +    from A obtain q where B: "1 = [:c:] * p * q" by (erule dvdE)
  30.111 +    have "c dvd c * (coeff p 0 * coeff q 0)" by simp
  30.112 +    also have "\<dots> = coeff ([:c:] * p * q) 0" by (simp add: mult.assoc coeff_mult)
  30.113 +    also note B [symmetric]
  30.114 +    finally show "c dvd 1" by simp
  30.115 +  next
  30.116 +    assume "c dvd 1" "p dvd 1"
  30.117 +    from \<open>c dvd 1\<close> obtain d where "1 = c * d" by (erule dvdE)
  30.118 +    hence "1 = [:c:] * [:d:]" by (simp add: one_poly_def mult_ac)
  30.119 +    hence "[:c:] dvd 1" by (rule dvdI)
  30.120 +    from mult_dvd_mono[OF this \<open>p dvd 1\<close>] show "[:c:] * p dvd 1" by simp
  30.121 +  qed
  30.122 +  finally show ?thesis .
  30.123 +qed
  30.124  
  30.125 -definition gcd_rat :: "rat \<Rightarrow> rat \<Rightarrow> rat" where
  30.126 -  "gcd_rat = gcd_eucl"
  30.127 -definition lcm_rat :: "rat \<Rightarrow> rat \<Rightarrow> rat" where
  30.128 -  "lcm_rat = lcm_eucl"
  30.129 -definition Gcd_rat :: "rat set \<Rightarrow> rat" where
  30.130 - "Gcd_rat = Gcd_eucl"
  30.131 -definition Lcm_rat :: "rat set \<Rightarrow> rat" where
  30.132 - "Lcm_rat = Lcm_eucl"
  30.133 -
  30.134 -instance by standard (simp_all add: gcd_rat_def lcm_rat_def Gcd_rat_def Lcm_rat_def)
  30.135 -
  30.136 -end
  30.137 -
  30.138 -instantiation complex :: euclidean_ring
  30.139 -begin
  30.140 +lemma degree_mod_less': "b \<noteq> 0 \<Longrightarrow> a mod b \<noteq> 0 \<Longrightarrow> degree (a mod b) < degree b"
  30.141 +  using degree_mod_less[of b a] by auto
  30.142 +  
  30.143 +lemma smult_eq_iff:
  30.144 +  assumes "(b :: 'a :: field) \<noteq> 0"
  30.145 +  shows   "smult a p = smult b q \<longleftrightarrow> smult (a / b) p = q"
  30.146 +proof
  30.147 +  assume "smult a p = smult b q"
  30.148 +  also from assms have "smult (inverse b) \<dots> = q" by simp
  30.149 +  finally show "smult (a / b) p = q" by (simp add: field_simps)
  30.150 +qed (insert assms, auto)
  30.151  
  30.152 -definition [simp]: "normalize_complex = (normalize_field :: complex \<Rightarrow> _)"
  30.153 -definition [simp]: "unit_factor_complex = (unit_factor_field :: complex \<Rightarrow> _)"
  30.154 -definition [simp]: "euclidean_size_complex = (euclidean_size_field :: complex \<Rightarrow> _)"
  30.155 -definition [simp]: "modulo_complex = (mod_field :: complex \<Rightarrow> _)"
  30.156 -
  30.157 -instance by standard (simp_all add: dvd_field_iff divide_simps)
  30.158 -end
  30.159 -
  30.160 -instantiation complex :: euclidean_ring_gcd
  30.161 -begin
  30.162 -
  30.163 -definition gcd_complex :: "complex \<Rightarrow> complex \<Rightarrow> complex" where
  30.164 -  "gcd_complex = gcd_eucl"
  30.165 -definition lcm_complex :: "complex \<Rightarrow> complex \<Rightarrow> complex" where
  30.166 -  "lcm_complex = lcm_eucl"
  30.167 -definition Gcd_complex :: "complex set \<Rightarrow> complex" where
  30.168 - "Gcd_complex = Gcd_eucl"
  30.169 -definition Lcm_complex :: "complex set \<Rightarrow> complex" where
  30.170 - "Lcm_complex = Lcm_eucl"
  30.171 -
  30.172 -instance by standard (simp_all add: gcd_complex_def lcm_complex_def Gcd_complex_def Lcm_complex_def)
  30.173 -
  30.174 -end
  30.175 -
  30.176 +lemma irreducible_const_poly_iff:
  30.177 +  fixes c :: "'a :: {comm_semiring_1,semiring_no_zero_divisors}"
  30.178 +  shows "irreducible [:c:] \<longleftrightarrow> irreducible c"
  30.179 +proof
  30.180 +  assume A: "irreducible c"
  30.181 +  show "irreducible [:c:]"
  30.182 +  proof (rule irreducibleI)
  30.183 +    fix a b assume ab: "[:c:] = a * b"
  30.184 +    hence "degree [:c:] = degree (a * b)" by (simp only: )
  30.185 +    also from A ab have "a \<noteq> 0" "b \<noteq> 0" by auto
  30.186 +    hence "degree (a * b) = degree a + degree b" by (simp add: degree_mult_eq)
  30.187 +    finally have "degree a = 0" "degree b = 0" by auto
  30.188 +    then obtain a' b' where ab': "a = [:a':]" "b = [:b':]" by (auto elim!: degree_eq_zeroE)
  30.189 +    from ab have "coeff [:c:] 0 = coeff (a * b) 0" by (simp only: )
  30.190 +    hence "c = a' * b'" by (simp add: ab' mult_ac)
  30.191 +    from A and this have "a' dvd 1 \<or> b' dvd 1" by (rule irreducibleD)
  30.192 +    with ab' show "a dvd 1 \<or> b dvd 1" by (auto simp: one_poly_def)
  30.193 +  qed (insert A, auto simp: irreducible_def is_unit_poly_iff)
  30.194 +next
  30.195 +  assume A: "irreducible [:c:]"
  30.196 +  show "irreducible c"
  30.197 +  proof (rule irreducibleI)
  30.198 +    fix a b assume ab: "c = a * b"
  30.199 +    hence "[:c:] = [:a:] * [:b:]" by (simp add: mult_ac)
  30.200 +    from A and this have "[:a:] dvd 1 \<or> [:b:] dvd 1" by (rule irreducibleD)
  30.201 +    thus "a dvd 1 \<or> b dvd 1" by (simp add: one_poly_def)
  30.202 +  qed (insert A, auto simp: irreducible_def one_poly_def)
  30.203 +qed
  30.204  
  30.205  
  30.206  subsection \<open>Lifting elements into the field of fractions\<close>
  30.207  
  30.208  definition to_fract :: "'a :: idom \<Rightarrow> 'a fract" where "to_fract x = Fract x 1"
  30.209 +  -- \<open>FIXME: name \<open>of_idom\<close>, abbreviation\<close>
  30.210  
  30.211  lemma to_fract_0 [simp]: "to_fract 0 = 0"
  30.212    by (simp add: to_fract_def eq_fract Zero_fract_def)
  30.213 @@ -219,285 +159,6 @@
  30.214  lemma normalize_snd_quot_of_fract: "normalize (snd (quot_of_fract x)) = snd (quot_of_fract x)"
  30.215    by (intro unit_factor_1_imp_normalized unit_factor_snd_quot_of_fract)
  30.216  
  30.217 -  
  30.218 -subsection \<open>Mapping polynomials\<close>
  30.219 -
  30.220 -definition map_poly 
  30.221 -     :: "('a :: zero \<Rightarrow> 'b :: zero) \<Rightarrow> 'a poly \<Rightarrow> 'b poly" where
  30.222 -  "map_poly f p = Poly (map f (coeffs p))"
  30.223 -
  30.224 -lemma map_poly_0 [simp]: "map_poly f 0 = 0"
  30.225 -  by (simp add: map_poly_def)
  30.226 -
  30.227 -lemma map_poly_1: "map_poly f 1 = [:f 1:]"
  30.228 -  by (simp add: map_poly_def)
  30.229 -
  30.230 -lemma map_poly_1' [simp]: "f 1 = 1 \<Longrightarrow> map_poly f 1 = 1"
  30.231 -  by (simp add: map_poly_def one_poly_def)
  30.232 -
  30.233 -lemma coeff_map_poly:
  30.234 -  assumes "f 0 = 0"
  30.235 -  shows   "coeff (map_poly f p) n = f (coeff p n)"
  30.236 -  by (auto simp: map_poly_def nth_default_def coeffs_def assms
  30.237 -        not_less Suc_le_eq coeff_eq_0 simp del: upt_Suc)
  30.238 -
  30.239 -lemma coeffs_map_poly [code abstract]: 
  30.240 -    "coeffs (map_poly f p) = strip_while (op = 0) (map f (coeffs p))"
  30.241 -  by (simp add: map_poly_def)
  30.242 -
  30.243 -lemma set_coeffs_map_poly:
  30.244 -  "(\<And>x. f x = 0 \<longleftrightarrow> x = 0) \<Longrightarrow> set (coeffs (map_poly f p)) = f ` set (coeffs p)"
  30.245 -  by (cases "p = 0") (auto simp: coeffs_map_poly last_map last_coeffs_not_0)
  30.246 -
  30.247 -lemma coeffs_map_poly': 
  30.248 -  assumes "(\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0)"
  30.249 -  shows   "coeffs (map_poly f p) = map f (coeffs p)"
  30.250 -  by (cases "p = 0") (auto simp: coeffs_map_poly last_map last_coeffs_not_0 assms 
  30.251 -                           intro!: strip_while_not_last split: if_splits)
  30.252 -
  30.253 -lemma degree_map_poly:
  30.254 -  assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
  30.255 -  shows   "degree (map_poly f p) = degree p"
  30.256 -  by (simp add: degree_eq_length_coeffs coeffs_map_poly' assms)
  30.257 -
  30.258 -lemma map_poly_eq_0_iff:
  30.259 -  assumes "f 0 = 0" "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
  30.260 -  shows   "map_poly f p = 0 \<longleftrightarrow> p = 0"
  30.261 -proof -
  30.262 -  {
  30.263 -    fix n :: nat
  30.264 -    have "coeff (map_poly f p) n = f (coeff p n)" by (simp add: coeff_map_poly assms)
  30.265 -    also have "\<dots> = 0 \<longleftrightarrow> coeff p n = 0"
  30.266 -    proof (cases "n < length (coeffs p)")
  30.267 -      case True
  30.268 -      hence "coeff p n \<in> set (coeffs p)" by (auto simp: coeffs_def simp del: upt_Suc)
  30.269 -      with assms show "f (coeff p n) = 0 \<longleftrightarrow> coeff p n = 0" by auto
  30.270 -    qed (auto simp: assms length_coeffs nth_default_coeffs_eq [symmetric] nth_default_def)
  30.271 -    finally have "(coeff (map_poly f p) n = 0) = (coeff p n = 0)" .
  30.272 -  }
  30.273 -  thus ?thesis by (auto simp: poly_eq_iff)
  30.274 -qed
  30.275 -
  30.276 -lemma map_poly_smult:
  30.277 -  assumes "f 0 = 0""\<And>c x. f (c * x) = f c * f x"
  30.278 -  shows   "map_poly f (smult c p) = smult (f c) (map_poly f p)"
  30.279 -  by (intro poly_eqI) (simp_all add: assms coeff_map_poly)
  30.280 -
  30.281 -lemma map_poly_pCons:
  30.282 -  assumes "f 0 = 0"
  30.283 -  shows   "map_poly f (pCons c p) = pCons (f c) (map_poly f p)"
  30.284 -  by (intro poly_eqI) (simp_all add: assms coeff_map_poly coeff_pCons split: nat.splits)
  30.285 -
  30.286 -lemma map_poly_map_poly:
  30.287 -  assumes "f 0 = 0" "g 0 = 0"
  30.288 -  shows   "map_poly f (map_poly g p) = map_poly (f \<circ> g) p"
  30.289 -  by (intro poly_eqI) (simp add: coeff_map_poly assms)
  30.290 -
  30.291 -lemma map_poly_id [simp]: "map_poly id p = p"
  30.292 -  by (simp add: map_poly_def)
  30.293 -
  30.294 -lemma map_poly_id' [simp]: "map_poly (\<lambda>x. x) p = p"
  30.295 -  by (simp add: map_poly_def)
  30.296 -
  30.297 -lemma map_poly_cong: 
  30.298 -  assumes "(\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = g x)"
  30.299 -  shows   "map_poly f p = map_poly g p"
  30.300 -proof -
  30.301 -  from assms have "map f (coeffs p) = map g (coeffs p)" by (intro map_cong) simp_all
  30.302 -  thus ?thesis by (simp only: coeffs_eq_iff coeffs_map_poly)
  30.303 -qed
  30.304 -
  30.305 -lemma map_poly_monom: "f 0 = 0 \<Longrightarrow> map_poly f (monom c n) = monom (f c) n"
  30.306 -  by (intro poly_eqI) (simp_all add: coeff_map_poly)
  30.307 -
  30.308 -lemma map_poly_idI:
  30.309 -  assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
  30.310 -  shows   "map_poly f p = p"
  30.311 -  using map_poly_cong[OF assms, of _ id] by simp
  30.312 -
  30.313 -lemma map_poly_idI':
  30.314 -  assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
  30.315 -  shows   "p = map_poly f p"
  30.316 -  using map_poly_cong[OF assms, of _ id] by simp
  30.317 -
  30.318 -lemma smult_conv_map_poly: "smult c p = map_poly (\<lambda>x. c * x) p"
  30.319 -  by (intro poly_eqI) (simp_all add: coeff_map_poly)
  30.320 -
  30.321 -lemma div_const_poly_conv_map_poly: 
  30.322 -  assumes "[:c:] dvd p"
  30.323 -  shows   "p div [:c:] = map_poly (\<lambda>x. x div c) p"
  30.324 -proof (cases "c = 0")
  30.325 -  case False
  30.326 -  from assms obtain q where p: "p = [:c:] * q" by (erule dvdE)
  30.327 -  moreover {
  30.328 -    have "smult c q = [:c:] * q" by simp
  30.329 -    also have "\<dots> div [:c:] = q" by (rule nonzero_mult_div_cancel_left) (insert False, auto)
  30.330 -    finally have "smult c q div [:c:] = q" .
  30.331 -  }
  30.332 -  ultimately show ?thesis by (intro poly_eqI) (auto simp: coeff_map_poly False)
  30.333 -qed (auto intro!: poly_eqI simp: coeff_map_poly)
  30.334 -
  30.335 -
  30.336 -
  30.337 -subsection \<open>Various facts about polynomials\<close>
  30.338 -
  30.339 -lemma prod_mset_const_poly: "prod_mset (image_mset (\<lambda>x. [:f x:]) A) = [:prod_mset (image_mset f A):]"
  30.340 -  by (induction A) (simp_all add: one_poly_def mult_ac)
  30.341 -
  30.342 -lemma degree_mod_less': "b \<noteq> 0 \<Longrightarrow> a mod b \<noteq> 0 \<Longrightarrow> degree (a mod b) < degree b"
  30.343 -  using degree_mod_less[of b a] by auto
  30.344 -  
  30.345 -lemma is_unit_const_poly_iff: 
  30.346 -    "[:c :: 'a :: {comm_semiring_1,semiring_no_zero_divisors}:] dvd 1 \<longleftrightarrow> c dvd 1"
  30.347 -  by (auto simp: one_poly_def)
  30.348 -
  30.349 -lemma is_unit_poly_iff:
  30.350 -  fixes p :: "'a :: {comm_semiring_1,semiring_no_zero_divisors} poly"
  30.351 -  shows "p dvd 1 \<longleftrightarrow> (\<exists>c. p = [:c:] \<and> c dvd 1)"
  30.352 -proof safe
  30.353 -  assume "p dvd 1"
  30.354 -  then obtain q where pq: "1 = p * q" by (erule dvdE)
  30.355 -  hence "degree 1 = degree (p * q)" by simp
  30.356 -  also from pq have "\<dots> = degree p + degree q" by (intro degree_mult_eq) auto
  30.357 -  finally have "degree p = 0" by simp
  30.358 -  from degree_eq_zeroE[OF this] obtain c where c: "p = [:c:]" .
  30.359 -  with \<open>p dvd 1\<close> show "\<exists>c. p = [:c:] \<and> c dvd 1"
  30.360 -    by (auto simp: is_unit_const_poly_iff)
  30.361 -qed (auto simp: is_unit_const_poly_iff)
  30.362 -
  30.363 -lemma is_unit_polyE:
  30.364 -  fixes p :: "'a :: {comm_semiring_1,semiring_no_zero_divisors} poly"
  30.365 -  assumes "p dvd 1" obtains c where "p = [:c:]" "c dvd 1"
  30.366 -  using assms by (subst (asm) is_unit_poly_iff) blast
  30.367 -
  30.368 -lemma smult_eq_iff:
  30.369 -  assumes "(b :: 'a :: field) \<noteq> 0"
  30.370 -  shows   "smult a p = smult b q \<longleftrightarrow> smult (a / b) p = q"
  30.371 -proof
  30.372 -  assume "smult a p = smult b q"
  30.373 -  also from assms have "smult (inverse b) \<dots> = q" by simp
  30.374 -  finally show "smult (a / b) p = q" by (simp add: field_simps)
  30.375 -qed (insert assms, auto)
  30.376 -
  30.377 -lemma irreducible_const_poly_iff:
  30.378 -  fixes c :: "'a :: {comm_semiring_1,semiring_no_zero_divisors}"
  30.379 -  shows "irreducible [:c:] \<longleftrightarrow> irreducible c"
  30.380 -proof
  30.381 -  assume A: "irreducible c"
  30.382 -  show "irreducible [:c:]"
  30.383 -  proof (rule irreducibleI)
  30.384 -    fix a b assume ab: "[:c:] = a * b"
  30.385 -    hence "degree [:c:] = degree (a * b)" by (simp only: )
  30.386 -    also from A ab have "a \<noteq> 0" "b \<noteq> 0" by auto
  30.387 -    hence "degree (a * b) = degree a + degree b" by (simp add: degree_mult_eq)
  30.388 -    finally have "degree a = 0" "degree b = 0" by auto
  30.389 -    then obtain a' b' where ab': "a = [:a':]" "b = [:b':]" by (auto elim!: degree_eq_zeroE)
  30.390 -    from ab have "coeff [:c:] 0 = coeff (a * b) 0" by (simp only: )
  30.391 -    hence "c = a' * b'" by (simp add: ab' mult_ac)
  30.392 -    from A and this have "a' dvd 1 \<or> b' dvd 1" by (rule irreducibleD)
  30.393 -    with ab' show "a dvd 1 \<or> b dvd 1" by (auto simp: one_poly_def)
  30.394 -  qed (insert A, auto simp: irreducible_def is_unit_poly_iff)
  30.395 -next
  30.396 -  assume A: "irreducible [:c:]"
  30.397 -  show "irreducible c"
  30.398 -  proof (rule irreducibleI)
  30.399 -    fix a b assume ab: "c = a * b"
  30.400 -    hence "[:c:] = [:a:] * [:b:]" by (simp add: mult_ac)
  30.401 -    from A and this have "[:a:] dvd 1 \<or> [:b:] dvd 1" by (rule irreducibleD)
  30.402 -    thus "a dvd 1 \<or> b dvd 1" by (simp add: one_poly_def)
  30.403 -  qed (insert A, auto simp: irreducible_def one_poly_def)
  30.404 -qed
  30.405 -
  30.406 -lemma lead_coeff_monom [simp]: "lead_coeff (monom c n) = c"
  30.407 -  by (cases "c = 0") (simp_all add: lead_coeff_def degree_monom_eq)
  30.408 -
  30.409 -  
  30.410 -subsection \<open>Normalisation of polynomials\<close>
  30.411 -
  30.412 -instantiation poly :: ("{normalization_semidom,idom_divide}") normalization_semidom
  30.413 -begin
  30.414 -
  30.415 -definition unit_factor_poly :: "'a poly \<Rightarrow> 'a poly"
  30.416 -  where "unit_factor_poly p = monom (unit_factor (lead_coeff p)) 0"
  30.417 -
  30.418 -definition normalize_poly :: "'a poly \<Rightarrow> 'a poly"
  30.419 -  where "normalize_poly p = map_poly (\<lambda>x. x div unit_factor (lead_coeff p)) p"
  30.420 -
  30.421 -lemma normalize_poly_altdef:
  30.422 -  "normalize p = p div [:unit_factor (lead_coeff p):]"
  30.423 -proof (cases "p = 0")
  30.424 -  case False
  30.425 -  thus ?thesis
  30.426 -    by (subst div_const_poly_conv_map_poly)
  30.427 -       (auto simp: normalize_poly_def const_poly_dvd_iff lead_coeff_def )
  30.428 -qed (auto simp: normalize_poly_def)
  30.429 -
  30.430 -instance
  30.431 -proof
  30.432 -  fix p :: "'a poly"
  30.433 -  show "unit_factor p * normalize p = p"
  30.434 -    by (cases "p = 0")
  30.435 -       (simp_all add: unit_factor_poly_def normalize_poly_def monom_0 
  30.436 -          smult_conv_map_poly map_poly_map_poly o_def)
  30.437 -next
  30.438 -  fix p :: "'a poly"
  30.439 -  assume "is_unit p"
  30.440 -  then obtain c where p: "p = [:c:]" "is_unit c" by (auto simp: is_unit_poly_iff)
  30.441 -  thus "normalize p = 1"
  30.442 -    by (simp add: normalize_poly_def map_poly_pCons is_unit_normalize one_poly_def)
  30.443 -next
  30.444 -  fix p :: "'a poly" assume "p \<noteq> 0"
  30.445 -  thus "is_unit (unit_factor p)"
  30.446 -    by (simp add: unit_factor_poly_def monom_0 is_unit_poly_iff)
  30.447 -qed (simp_all add: normalize_poly_def unit_factor_poly_def monom_0 lead_coeff_mult unit_factor_mult)
  30.448 -
  30.449 -end
  30.450 -
  30.451 -lemma unit_factor_pCons:
  30.452 -  "unit_factor (pCons a p) = (if p = 0 then monom (unit_factor a) 0 else unit_factor p)"
  30.453 -  by (simp add: unit_factor_poly_def)
  30.454 -
  30.455 -lemma normalize_monom [simp]:
  30.456 -  "normalize (monom a n) = monom (normalize a) n"
  30.457 -  by (simp add: map_poly_monom normalize_poly_def)
  30.458 -
  30.459 -lemma unit_factor_monom [simp]:
  30.460 -  "unit_factor (monom a n) = monom (unit_factor a) 0"
  30.461 -  by (simp add: unit_factor_poly_def )
  30.462 -
  30.463 -lemma normalize_const_poly: "normalize [:c:] = [:normalize c:]"
  30.464 -  by (simp add: normalize_poly_def map_poly_pCons)
  30.465 -
  30.466 -lemma normalize_smult: "normalize (smult c p) = smult (normalize c) (normalize p)"
  30.467 -proof -
  30.468 -  have "smult c p = [:c:] * p" by simp
  30.469 -  also have "normalize \<dots> = smult (normalize c) (normalize p)"
  30.470 -    by (subst normalize_mult) (simp add: normalize_const_poly)
  30.471 -  finally show ?thesis .
  30.472 -qed
  30.473 -
  30.474 -lemma is_unit_smult_iff: "smult c p dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
  30.475 -proof -
  30.476 -  have "smult c p = [:c:] * p" by simp
  30.477 -  also have "\<dots> dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
  30.478 -  proof safe
  30.479 -    assume A: "[:c:] * p dvd 1"
  30.480 -    thus "p dvd 1" by (rule dvd_mult_right)
  30.481 -    from A obtain q where B: "1 = [:c:] * p * q" by (erule dvdE)
  30.482 -    have "c dvd c * (coeff p 0 * coeff q 0)" by simp
  30.483 -    also have "\<dots> = coeff ([:c:] * p * q) 0" by (simp add: mult.assoc coeff_mult)
  30.484 -    also note B [symmetric]
  30.485 -    finally show "c dvd 1" by simp
  30.486 -  next
  30.487 -    assume "c dvd 1" "p dvd 1"
  30.488 -    from \<open>c dvd 1\<close> obtain d where "1 = c * d" by (erule dvdE)
  30.489 -    hence "1 = [:c:] * [:d:]" by (simp add: one_poly_def mult_ac)
  30.490 -    hence "[:c:] dvd 1" by (rule dvdI)
  30.491 -    from mult_dvd_mono[OF this \<open>p dvd 1\<close>] show "[:c:] * p dvd 1" by simp
  30.492 -  qed
  30.493 -  finally show ?thesis .
  30.494 -qed
  30.495 -
  30.496  
  30.497  subsection \<open>Content and primitive part of a polynomial\<close>
  30.498  
  30.499 @@ -1243,7 +904,7 @@
  30.500  
  30.501  end
  30.502  
  30.503 -  
  30.504 + 
  30.505  subsection \<open>Prime factorisation of polynomials\<close>   
  30.506  
  30.507  context
  30.508 @@ -1264,7 +925,8 @@
  30.509      by (simp add: e_def content_prod_mset multiset.map_comp o_def)
  30.510    also have "image_mset (\<lambda>x. content (primitive_part_fract x)) ?P = image_mset (\<lambda>_. 1) ?P"
  30.511      by (intro image_mset_cong content_primitive_part_fract) auto
  30.512 -  finally have content_e: "content e = 1" by (simp add: prod_mset_const)    
  30.513 +  finally have content_e: "content e = 1"
  30.514 +    by simp    
  30.515    
  30.516    have "fract_poly p = unit_factor_field_poly (fract_poly p) * 
  30.517            normalize_field_poly (fract_poly p)" by simp
  30.518 @@ -1277,7 +939,7 @@
  30.519                 image_mset (\<lambda>x. [:fract_content x:] * fract_poly (primitive_part_fract x)) ?P"
  30.520      by (intro image_mset_cong) (auto simp: content_times_primitive_part_fract)
  30.521    also have "prod_mset \<dots> = smult c (fract_poly e)"
  30.522 -    by (subst prod_mset_mult) (simp_all add: prod_mset_fract_poly prod_mset_const_poly c_def e_def)
  30.523 +    by (subst prod_mset.distrib) (simp_all add: prod_mset_fract_poly prod_mset_const_poly c_def e_def)
  30.524    also have "[:to_fract (lead_coeff p):] * \<dots> = smult c' (fract_poly e)"
  30.525      by (simp add: c'_def)
  30.526    finally have eq: "fract_poly p = smult c' (fract_poly e)" .
  30.527 @@ -1466,20 +1128,22 @@
  30.528                smult (gcd (content p) (content q)) 
  30.529                  (gcd_poly_code_aux (primitive_part p) (primitive_part q)))"
  30.530  
  30.531 +lemma gcd_poly_code [code]: "gcd p q = gcd_poly_code p q"
  30.532 +  by (simp add: gcd_poly_code_def gcd_poly_code_aux_correct gcd_poly_decompose [symmetric])
  30.533 +
  30.534  lemma lcm_poly_code [code]: 
  30.535    fixes p q :: "'a :: factorial_ring_gcd poly"
  30.536    shows "lcm p q = normalize (p * q) div gcd p q"
  30.537 -  by (rule lcm_gcd)
  30.538 -
  30.539 -lemma gcd_poly_code [code]: "gcd p q = gcd_poly_code p q"
  30.540 -  by (simp add: gcd_poly_code_def gcd_poly_code_aux_correct gcd_poly_decompose [symmetric])
  30.541 +  by (fact lcm_gcd)
  30.542  
  30.543  declare Gcd_set
  30.544    [where ?'a = "'a :: factorial_ring_gcd poly", code]
  30.545  
  30.546  declare Lcm_set
  30.547    [where ?'a = "'a :: factorial_ring_gcd poly", code]
  30.548 +
  30.549 +text \<open>Example:
  30.550 +  @{lemma "Lcm {[:1, 2, 3:], [:2, 3, 4:]} = [:[:2:], [:7:], [:16:], [:17:], [:12 :: int:]:]" by eval}
  30.551 +\<close>
  30.552    
  30.553 -value [code] "Lcm {[:1,2,3:], [:2,3,4::int poly:]}"
  30.554 -
  30.555  end
    31.1 --- a/src/HOL/Library/code_test.ML	Tue Dec 20 16:17:13 2016 +0100
    31.2 +++ b/src/HOL/Library/code_test.ML	Tue Dec 20 16:18:56 2016 +0100
    31.3 @@ -1,59 +1,44 @@
    31.4  (*  Title:      HOL/Library/code_test.ML
    31.5 -    Author:     Andreas Lochbihler, ETH Zurich
    31.6 +    Author:     Andreas Lochbihler, ETH Zürich
    31.7  
    31.8 -Test infrastructure for the code generator
    31.9 +Test infrastructure for the code generator.
   31.10  *)
   31.11  
   31.12 -signature CODE_TEST = sig
   31.13 -  val add_driver : string * ((Proof.context -> (string * string) list * string -> Path.T -> string) * string) -> theory -> theory
   31.14 -  val get_driver : theory -> string -> ((Proof.context -> (string * string) list * string -> Path.T -> string) * string) option
   31.15 -  val overlord : bool Config.T
   31.16 -  val successN : string
   31.17 -  val failureN : string
   31.18 -  val start_markerN : string
   31.19 -  val end_markerN : string
   31.20 -  val test_terms : Proof.context -> term list -> string -> unit
   31.21 -  val test_targets : Proof.context -> term list -> string list -> unit list
   31.22 -  val test_code_cmd : string list -> string list -> Toplevel.state -> unit
   31.23 -
   31.24 -  val eval_term : string -> Proof.context -> term -> term
   31.25 -
   31.26 -  val gen_driver :
   31.27 +signature CODE_TEST =
   31.28 +sig
   31.29 +  val add_driver:
   31.30 +    string * ((Proof.context -> (string * string) list * string -> Path.T -> string) * string) ->
   31.31 +    theory -> theory
   31.32 +  val overlord: bool Config.T
   31.33 +  val successN: string
   31.34 +  val failureN: string
   31.35 +  val start_markerN: string
   31.36 +  val end_markerN: string
   31.37 +  val test_terms: Proof.context -> term list -> string -> unit
   31.38 +  val test_targets: Proof.context -> term list -> string list -> unit
   31.39 +  val test_code_cmd: string list -> string list -> Proof.context -> unit
   31.40 +  val eval_term: string -> Proof.context -> term -> term
   31.41 +  val evaluate:
   31.42     (theory -> Path.T -> string list -> string ->
   31.43 -    {files : (Path.T * string) list,
   31.44 -     compile_cmd : string option, run_cmd : string, mk_code_file : string -> Path.T})
   31.45 -   -> string -> string -> string
   31.46 -   -> theory -> (string * string) list * string -> Path.T -> string
   31.47 -
   31.48 -  val ISABELLE_POLYML : string
   31.49 -  val polymlN : string
   31.50 -  val evaluate_in_polyml : Proof.context -> (string * string) list * string -> Path.T -> string
   31.51 -
   31.52 -  val mltonN : string
   31.53 -  val ISABELLE_MLTON : string
   31.54 -  val evaluate_in_mlton : Proof.context -> (string * string) list * string -> Path.T -> string
   31.55 -
   31.56 -  val smlnjN : string
   31.57 -  val ISABELLE_SMLNJ : string
   31.58 -  val evaluate_in_smlnj : Proof.context -> (string * string) list * string -> Path.T -> string
   31.59 -
   31.60 -  val ocamlN : string
   31.61 -  val ISABELLE_OCAMLC : string
   31.62 -  val evaluate_in_ocaml : Proof.context -> (string * string) list * string -> Path.T -> string
   31.63 -
   31.64 -  val ghcN : string
   31.65 -  val ISABELLE_GHC : string
   31.66 -  val ghc_options : string Config.T
   31.67 -  val evaluate_in_ghc : Proof.context -> (string * string) list * string -> Path.T -> string
   31.68 -
   31.69 -  val scalaN : string
   31.70 -  val ISABELLE_SCALA : string
   31.71 -  val evaluate_in_scala : Proof.context -> (string * string) list * string -> Path.T -> string
   31.72 +     {files: (Path.T * string) list,
   31.73 +       compile_cmd: string option,
   31.74 +       run_cmd: string,
   31.75 +       mk_code_file: string -> Path.T}) -> (string * string) option -> string -> theory ->
   31.76 +     (string * string) list * string -> Path.T -> string
   31.77 +  val evaluate_in_polyml: Proof.context -> (string * string) list * string -> Path.T -> string
   31.78 +  val evaluate_in_mlton: Proof.context -> (string * string) list * string -> Path.T -> string
   31.79 +  val evaluate_in_smlnj: Proof.context -> (string * string) list * string -> Path.T -> string
   31.80 +  val evaluate_in_ocaml: Proof.context -> (string * string) list * string -> Path.T -> string
   31.81 +  val ghc_options: string Config.T
   31.82 +  val evaluate_in_ghc: Proof.context -> (string * string) list * string -> Path.T -> string
   31.83 +  val evaluate_in_scala: Proof.context -> (string * string) list * string -> Path.T -> string
   31.84  end
   31.85  
   31.86 -structure Code_Test : CODE_TEST = struct
   31.87 +structure Code_Test: CODE_TEST =
   31.88 +struct
   31.89  
   31.90  (* convert a list of terms into nested tuples and back *)
   31.91 +
   31.92  fun mk_tuples [] = @{term "()"}
   31.93    | mk_tuples [t] = t
   31.94    | mk_tuples (t :: ts) = HOLogic.mk_prod (t, mk_tuples ts)
   31.95 @@ -62,47 +47,46 @@
   31.96    | dest_tuples t = [t]
   31.97  
   31.98  
   31.99 -fun map_option _ NONE = NONE
  31.100 -  | map_option f (SOME x) = SOME (f x)
  31.101 -
  31.102  fun last_field sep str =
  31.103    let
  31.104 -    val n = size sep;
  31.105 -    val len = size str;
  31.106 +    val n = size sep
  31.107 +    val len = size str
  31.108      fun find i =
  31.109        if i < 0 then NONE
  31.110        else if String.substring (str, i, n) = sep then SOME i
  31.111 -      else find (i - 1);
  31.112 +      else find (i - 1)
  31.113    in
  31.114      (case find (len - n) of
  31.115        NONE => NONE
  31.116      | SOME i => SOME (String.substring (str, 0, i), String.extract (str, i + n, NONE)))
  31.117 -  end;
  31.118 +  end
  31.119  
  31.120  fun split_first_last start stop s =
  31.121 -  case first_field start s
  31.122 -   of NONE => NONE
  31.123 -    | SOME (initial, rest) =>
  31.124 -      case last_field stop rest
  31.125 -       of NONE => NONE
  31.126 -        | SOME (middle, tail) => SOME (initial, middle, tail);
  31.127 +  (case first_field start s of
  31.128 +    NONE => NONE
  31.129 +  | SOME (initial, rest) =>
  31.130 +      (case last_field stop rest of
  31.131 +        NONE => NONE
  31.132 +      | SOME (middle, tail) => SOME (initial, middle, tail)))
  31.133  
  31.134 -(* Data slot for drivers *)
  31.135 +
  31.136 +(* data slot for drivers *)
  31.137  
  31.138  structure Drivers = Theory_Data
  31.139  (
  31.140 -  type T = (string * ((Proof.context -> (string * string) list * string -> Path.T -> string) * string)) list;
  31.141 -  val empty = [];
  31.142 -  val extend = I;
  31.143 -  fun merge data : T = AList.merge (op =) (K true) data;
  31.144 +  type T =
  31.145 +    (string * ((Proof.context -> (string * string) list * string -> Path.T -> string) * string)) list
  31.146 +  val empty = []
  31.147 +  val extend = I
  31.148 +  fun merge data : T = AList.merge (op =) (K true) data
  31.149  )
  31.150  
  31.151 -val add_driver = Drivers.map o AList.update (op =);
  31.152 -val get_driver = AList.lookup (op =) o Drivers.get;
  31.153 +val add_driver = Drivers.map o AList.update (op =)
  31.154 +val get_driver = AList.lookup (op =) o Drivers.get
  31.155  
  31.156  (*
  31.157    Test drivers must produce output of the following format:
  31.158 -  
  31.159 +
  31.160    The start of the relevant data is marked with start_markerN,
  31.161    its end with end_markerN.
  31.162  
  31.163 @@ -112,7 +96,8 @@
  31.164    There must not be any additional whitespace in between.
  31.165  *)
  31.166  
  31.167 -(* Parsing of results *)
  31.168 +
  31.169 +(* parsing of results *)
  31.170  
  31.171  val successN = "True"
  31.172  val failureN = "False"
  31.173 @@ -121,7 +106,7 @@
  31.174  
  31.175  fun parse_line line =
  31.176    if String.isPrefix successN line then (true, NONE)
  31.177 -  else if String.isPrefix failureN line then (false, 
  31.178 +  else if String.isPrefix failureN line then (false,
  31.179      if size line > size failureN then
  31.180        String.extract (line, size failureN, NONE)
  31.181        |> YXML.parse_body
  31.182 @@ -132,20 +117,21 @@
  31.183    else raise Fail ("Cannot parse result of evaluation:\n" ^ line)
  31.184  
  31.185  fun parse_result target out =
  31.186 -  case split_first_last start_markerN end_markerN out
  31.187 -    of NONE => error ("Evaluation failed for " ^ target ^ "!\nBash output:\n" ^ out)
  31.188 -     | SOME (_, middle, _) => middle |> trim_line |> split_lines |> map parse_line
  31.189 +  (case split_first_last start_markerN end_markerN out of
  31.190 +    NONE => error ("Evaluation failed for " ^ target ^ "!\nBash output:\n" ^ out)
  31.191 +  | SOME (_, middle, _) => middle |> trim_line |> split_lines |> map parse_line)
  31.192  
  31.193 -(* Pretty printing of test results *)
  31.194 +
  31.195 +(* pretty printing of test results *)
  31.196  
  31.197  fun pretty_eval _ NONE _ = []
  31.198 -  | pretty_eval ctxt (SOME evals) ts = 
  31.199 -    [Pretty.fbrk,
  31.200 -     Pretty.big_list "Evaluated terms"
  31.201 -       (map (fn (t, eval) => Pretty.block 
  31.202 -         [Syntax.pretty_term ctxt t, Pretty.brk 1, Pretty.str "=", Pretty.brk 1,
  31.203 -          Syntax.pretty_term ctxt eval])
  31.204 -       (ts ~~ evals))]
  31.205 +  | pretty_eval ctxt (SOME evals) ts =
  31.206 +      [Pretty.fbrk,
  31.207 +       Pretty.big_list "Evaluated terms"
  31.208 +         (map (fn (t, eval) => Pretty.block
  31.209 +           [Syntax.pretty_term ctxt t, Pretty.brk 1, Pretty.str "=", Pretty.brk 1,
  31.210 +            Syntax.pretty_term ctxt eval])
  31.211 +         (ts ~~ evals))]
  31.212  
  31.213  fun pretty_failure ctxt target (((_, evals), query), eval_ts) =
  31.214    Pretty.block (Pretty.text ("Test in " ^ target ^ " failed for")
  31.215 @@ -155,60 +141,61 @@
  31.216  fun pretty_failures ctxt target failures =
  31.217    Pretty.blk (0, Pretty.fbreaks (map (pretty_failure ctxt target) failures))
  31.218  
  31.219 -(* Driver invocation *)
  31.220  
  31.221 -val overlord = Attrib.setup_config_bool @{binding "code_test_overlord"} (K false);
  31.222 +(* driver invocation *)
  31.223 +
  31.224 +val overlord = Attrib.setup_config_bool @{binding "code_test_overlord"} (K false)
  31.225  
  31.226  fun with_overlord_dir name f =
  31.227    let
  31.228 -    val path = Path.append (Path.explode "$ISABELLE_HOME_USER") (Path.basic (name ^ serial_string ()))
  31.229 -    val _ = Isabelle_System.mkdirs path;
  31.230 -  in
  31.231 -    Exn.release (Exn.capture f path)
  31.232 -  end;
  31.233 +    val path =
  31.234 +      Path.append (Path.explode "$ISABELLE_HOME_USER") (Path.basic (name ^ serial_string ()))
  31.235 +    val _ = Isabelle_System.mkdirs path
  31.236 +  in Exn.release (Exn.capture f path) end
  31.237  
  31.238  fun dynamic_value_strict ctxt t compiler =
  31.239    let
  31.240      val thy = Proof_Context.theory_of ctxt
  31.241 -    val (driver, target) = case get_driver thy compiler
  31.242 -     of NONE => error ("No driver for target " ^ compiler)
  31.243 -      | SOME f => f;
  31.244 +    val (driver, target) =
  31.245 +      (case get_driver thy compiler of
  31.246 +        NONE => error ("No driver for target " ^ compiler)
  31.247 +      | SOME f => f)
  31.248      val debug = Config.get (Proof_Context.init_global thy) overlord
  31.249      val with_dir = if debug then with_overlord_dir else Isabelle_System.with_tmp_dir
  31.250      fun evaluate f = with_dir "Code_Test" (driver ctxt f) |> parse_result compiler
  31.251      fun evaluator program _ vs_ty deps =
  31.252 -      Exn.interruptible_capture evaluate (Code_Target.computation_text ctxt target program deps true vs_ty);
  31.253 -    fun postproc f = map (apsnd (map_option (map f)))
  31.254 -  in
  31.255 -    Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_res o postproc) evaluator t)
  31.256 -  end;
  31.257 +      Exn.interruptible_capture evaluate
  31.258 +        (Code_Target.computation_text ctxt target program deps true vs_ty)
  31.259 +    fun postproc f = map (apsnd (Option.map (map f)))
  31.260 +  in Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_res o postproc) evaluator t) end
  31.261  
  31.262 -(* Term preprocessing *)
  31.263 +
  31.264 +(* term preprocessing *)
  31.265  
  31.266  fun add_eval (Const (@{const_name Trueprop}, _) $ t) = add_eval t
  31.267    | add_eval (Const (@{const_name "HOL.eq"}, _) $ lhs $ rhs) = (fn acc =>
  31.268 -    acc
  31.269 -    |> add_eval rhs
  31.270 -    |> add_eval lhs
  31.271 -    |> cons rhs
  31.272 -    |> cons lhs)
  31.273 +      acc
  31.274 +      |> add_eval rhs
  31.275 +      |> add_eval lhs
  31.276 +      |> cons rhs
  31.277 +      |> cons lhs)
  31.278    | add_eval (Const (@{const_name "Not"}, _) $ t) = add_eval t
  31.279    | add_eval (Const (@{const_name "Orderings.ord_class.less_eq"}, _) $ lhs $ rhs) = (fn acc =>
  31.280 -    lhs :: rhs :: acc)
  31.281 +      lhs :: rhs :: acc)
  31.282    | add_eval (Const (@{const_name "Orderings.ord_class.less"}, _) $ lhs $ rhs) = (fn acc =>
  31.283 -    lhs :: rhs :: acc)
  31.284 +      lhs :: rhs :: acc)
  31.285    | add_eval _ = I
  31.286  
  31.287  fun mk_term_of [] = @{term "None :: (unit \<Rightarrow> yxml_of_term) option"}
  31.288    | mk_term_of ts =
  31.289 -  let
  31.290 -    val tuple = mk_tuples ts
  31.291 -    val T = fastype_of tuple
  31.292 -  in
  31.293 -    @{term "Some :: (unit \<Rightarrow> yxml_of_term) \<Rightarrow> (unit \<Rightarrow> yxml_of_term) option"} $
  31.294 -      (absdummy @{typ unit} (@{const yxml_string_of_term} $
  31.295 -        (Const (@{const_name Code_Evaluation.term_of}, T --> @{typ term}) $ tuple)))
  31.296 -  end
  31.297 +      let
  31.298 +        val tuple = mk_tuples ts
  31.299 +        val T = fastype_of tuple
  31.300 +      in
  31.301 +        @{term "Some :: (unit \<Rightarrow> yxml_of_term) \<Rightarrow> (unit \<Rightarrow> yxml_of_term) option"} $
  31.302 +          (absdummy @{typ unit} (@{const yxml_string_of_term} $
  31.303 +            (Const (@{const_name Code_Evaluation.term_of}, T --> @{typ term}) $ tuple)))
  31.304 +      end
  31.305  
  31.306  fun test_terms ctxt ts target =
  31.307    let
  31.308 @@ -216,109 +203,121 @@
  31.309  
  31.310      fun term_of t = Sign.of_sort thy (fastype_of t, @{sort term_of})
  31.311  
  31.312 -    fun ensure_bool t = case fastype_of t of @{typ bool} => ()
  31.313 -      | _ => error ("Test case not of type bool: " ^ Pretty.string_of (Syntax.pretty_term ctxt t))
  31.314 +    fun ensure_bool t =
  31.315 +      (case fastype_of t of
  31.316 +        @{typ bool} => ()
  31.317 +      | _ =>
  31.318 +        error (Pretty.string_of
  31.319 +          (Pretty.block [Pretty.str "Test case not of type bool:", Pretty.brk 1,
  31.320 +            Syntax.pretty_term ctxt t])))
  31.321  
  31.322 -    val _ = map ensure_bool ts
  31.323 +    val _ = List.app ensure_bool ts
  31.324  
  31.325      val evals = map (fn t => filter term_of (add_eval t [])) ts
  31.326      val eval = map mk_term_of evals
  31.327  
  31.328 -    val T = HOLogic.mk_prodT (@{typ bool}, Type (@{type_name option}, [@{typ unit} --> @{typ yxml_of_term}]))
  31.329 -    val t = HOLogic.mk_list T (map HOLogic.mk_prod (ts ~~ eval))
  31.330 +    val t =
  31.331 +      HOLogic.mk_list @{typ "bool \<times> (unit \<Rightarrow> yxml_of_term) option"}
  31.332 +        (map HOLogic.mk_prod (ts ~~ eval))
  31.333  
  31.334 -    val result = dynamic_value_strict ctxt t target;
  31.335 +    val result = dynamic_value_strict ctxt t target
  31.336  
  31.337      val failed =
  31.338        filter_out (fst o fst o fst) (result ~~ ts ~~ evals)
  31.339 -      handle ListPair.UnequalLengths => 
  31.340 +      handle ListPair.UnequalLengths =>
  31.341          error ("Evaluation failed!\nWrong number of test results: " ^ Int.toString (length result))
  31.342 -    val _ = case failed of [] => () 
  31.343 -      | _ => error (Pretty.string_of (pretty_failures ctxt target failed))
  31.344    in
  31.345 -    ()
  31.346 +    (case failed of [] =>
  31.347 +      ()
  31.348 +    | _ => error (Pretty.string_of (pretty_failures ctxt target failed)))
  31.349    end
  31.350  
  31.351 -fun test_targets ctxt = map o test_terms ctxt
  31.352 +fun test_targets ctxt = List.app o test_terms ctxt
  31.353  
  31.354 -fun test_code_cmd raw_ts targets state =
  31.355 +fun pretty_free ctxt = Syntax.pretty_term ctxt o Free
  31.356 +
  31.357 +fun test_code_cmd raw_ts targets ctxt =
  31.358    let
  31.359 -    val ctxt = Toplevel.context_of state;
  31.360 -    val ts = Syntax.read_terms ctxt raw_ts;
  31.361 -    val frees = fold Term.add_free_names ts []
  31.362 -    val _ = if frees = [] then () else
  31.363 -      error ("Terms contain free variables: " ^
  31.364 -      Pretty.string_of (Pretty.block (Pretty.commas (map Pretty.str frees))))
  31.365 -  in
  31.366 -    test_targets ctxt ts targets; ()
  31.367 -  end
  31.368 +    val ts = Syntax.read_terms ctxt raw_ts
  31.369 +    val frees = fold Term.add_frees ts []
  31.370 +    val _ =
  31.371 +      if null frees then ()
  31.372 +      else error (Pretty.string_of
  31.373 +        (Pretty.block (Pretty.str "Terms contain free variables:" :: Pretty.brk 1 ::
  31.374 +          Pretty.commas (map (pretty_free ctxt) frees))))
  31.375 +  in test_targets ctxt ts targets end
  31.376  
  31.377  fun eval_term target ctxt t =
  31.378    let
  31.379 -    val frees = Term.add_free_names t []
  31.380 -    val _ = if frees = [] then () else
  31.381 -      error ("Term contains free variables: " ^
  31.382 -      Pretty.string_of (Pretty.block (Pretty.commas (map Pretty.str frees))))
  31.383 +    val frees = Term.add_frees t []
  31.384 +    val _ =
  31.385 +      if null frees then ()
  31.386 +      else
  31.387 +        error (Pretty.string_of
  31.388 +          (Pretty.block (Pretty.str "Term contains free variables:" :: Pretty.brk 1 ::
  31.389 +            Pretty.commas (map (pretty_free ctxt) frees))))
  31.390  
  31.391 -    val thy = Proof_Context.theory_of ctxt
  31.392 +    val T = fastype_of t
  31.393 +    val _ =
  31.394 +      if Sign.of_sort (Proof_Context.theory_of ctxt) (T, @{sort term_of}) then ()
  31.395 +      else error ("Type " ^ Syntax.string_of_typ ctxt T ^
  31.396 +       " of term not of sort " ^ Syntax.string_of_sort ctxt @{sort term_of})
  31.397  
  31.398 -    val T_t = fastype_of t
  31.399 -    val _ = if Sign.of_sort thy (T_t, @{sort term_of}) then () else error 
  31.400 -      ("Type " ^ Pretty.string_of (Syntax.pretty_typ ctxt T_t) ^ 
  31.401 -       " of term not of sort " ^ Pretty.string_of (Syntax.pretty_sort ctxt @{sort term_of}))
  31.402 +    val t' =
  31.403 +      HOLogic.mk_list @{typ "bool \<times> (unit \<Rightarrow> yxml_of_term) option"}
  31.404 +        [HOLogic.mk_prod (@{term "False"}, mk_term_of [t])]
  31.405  
  31.406 -    val T = HOLogic.mk_prodT (@{typ bool}, Type (@{type_name option}, [@{typ unit} --> @{typ yxml_of_term}]))
  31.407 -    val t' = HOLogic.mk_list T [HOLogic.mk_prod (@{term "False"}, mk_term_of [t])]
  31.408 +    val result = dynamic_value_strict ctxt t' target
  31.409 +  in (case result of [(_, SOME [t])] => t | _ => error "Evaluation failed") end
  31.410  
  31.411 -    val result = dynamic_value_strict ctxt t' target;
  31.412 -  in
  31.413 -    case result of [(_, SOME [t])] => t | _ => error "Evaluation failed"
  31.414 -  end
  31.415 +
  31.416 +(* generic driver *)
  31.417  
  31.418 -(* Generic driver *)
  31.419 -
  31.420 -fun gen_driver mk_driver env_var env_var_dest compilerN ctxt (code_files, value_name) =
  31.421 +fun evaluate mk_driver opt_env_var compilerN ctxt (code_files, value_name) =
  31.422    let
  31.423 -    val compiler = getenv env_var
  31.424 -    val _ = if compiler <> "" then () else error (Pretty.string_of (Pretty.para 
  31.425 -         ("Environment variable " ^ env_var ^ " is not set. To test code generation with " ^
  31.426 -         compilerN ^ ", set this variable to your " ^ env_var_dest ^ " in the settings file.")))
  31.427 +    val _ =
  31.428 +      (case opt_env_var of
  31.429 +        NONE => ()
  31.430 +      | SOME (env_var, env_var_dest) =>
  31.431 +          (case getenv env_var of
  31.432 +            "" =>
  31.433 +              error (Pretty.string_of (Pretty.para
  31.434 +                ("Environment variable " ^ env_var ^ " is not set. To test code generation with " ^
  31.435 +                  compilerN ^ ", set this variable to your " ^ env_var_dest ^
  31.436 +                  " in the $ISABELLE_HOME_USER/etc/settings file.")))
  31.437 +          | _ => ()))
  31.438  
  31.439      fun compile NONE = ()
  31.440        | compile (SOME cmd) =
  31.441 -        let
  31.442 -          val (out, ret) = Isabelle_System.bash_output cmd
  31.443 -        in
  31.444 -          if ret = 0 then () else error
  31.445 -            ("Compilation with " ^ compilerN ^ " failed:\n" ^ cmd ^ "\n" ^ out)
  31.446 -        end
  31.447 +          let
  31.448 +            val (out, ret) = Isabelle_System.bash_output cmd
  31.449 +          in
  31.450 +            if ret = 0 then ()
  31.451 +            else error ("Compilation with " ^ compilerN ^ " failed:\n" ^ cmd ^ "\n" ^ out)
  31.452 +          end
  31.453  
  31.454 -    fun run (path : Path.T)= 
  31.455 +    fun run path =
  31.456        let
  31.457          val modules = map fst code_files
  31.458 -        val {files, compile_cmd, run_cmd, mk_code_file}
  31.459 -          =  mk_driver ctxt path modules value_name
  31.460 +        val {files, compile_cmd, run_cmd, mk_code_file} = mk_driver ctxt path modules value_name
  31.461  
  31.462 -        val _ = map (fn (name, code) => File.write (mk_code_file name) code) code_files
  31.463 -        val _ = map (fn (name, content) => File.write name content) files
  31.464 +        val _ = List.app (fn (name, code) => File.write (mk_code_file name) code) code_files
  31.465 +        val _ = List.app (fn (name, content) => File.write name content) files
  31.466  
  31.467          val _ = compile compile_cmd
  31.468  
  31.469          val (out, res) = Isabelle_System.bash_output run_cmd
  31.470 -        val _ = if res = 0 then () else error
  31.471 -          ("Evaluation for " ^ compilerN ^ " terminated with error code " ^ Int.toString res ^
  31.472 -           "\nBash output:\n" ^ out)
  31.473 -      in
  31.474 -        out
  31.475 -      end
  31.476 -  in
  31.477 -    run
  31.478 -  end
  31.479 +        val _ =
  31.480 +          if res = 0 then ()
  31.481 +          else error ("Evaluation for " ^ compilerN ^ " terminated with error code " ^
  31.482 +            Int.toString res ^ "\nBash output:\n" ^ out)
  31.483 +      in out end
  31.484 +  in run end
  31.485  
  31.486 -(* Driver for PolyML *)
  31.487  
  31.488 -val ISABELLE_POLYML = "ISABELLE_POLYML"
  31.489 -val polymlN = "PolyML";
  31.490 +(* driver for PolyML *)
  31.491 +
  31.492 +val polymlN = "PolyML"
  31.493  
  31.494  fun mk_driver_polyml _ path _ value_name =
  31.495    let
  31.496 @@ -327,10 +326,10 @@
  31.497  
  31.498      val code_path = Path.append path (Path.basic generatedN)
  31.499      val driver_path = Path.append path (Path.basic driverN)
  31.500 -    val driver = 
  31.501 +    val driver =
  31.502        "fun main prog_name = \n" ^
  31.503        "  let\n" ^
  31.504 -      "    fun format_term NONE = \"\"\n" ^ 
  31.505 +      "    fun format_term NONE = \"\"\n" ^
  31.506        "      | format_term (SOME t) = t ();\n" ^
  31.507        "    fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
  31.508        "      | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
  31.509 @@ -342,17 +341,16 @@
  31.510        "    ()\n" ^
  31.511        "  end;\n"
  31.512      val cmd =
  31.513 -      "echo \"use \\\"" ^ Path.implode code_path ^ "\\\"; use \\\"" ^ 
  31.514 -      Path.implode driver_path ^ "\\\"; main ();\" | " ^ 
  31.515 -      Path.implode (Path.variable ISABELLE_POLYML)
  31.516 +      "echo \"use \\\"" ^ Path.implode code_path ^ "\\\"; use \\\"" ^
  31.517 +      Path.implode driver_path ^ "\\\"; main ();\" | \"$ML_HOME/poly\""
  31.518    in
  31.519      {files = [(driver_path, driver)], compile_cmd = NONE, run_cmd = cmd, mk_code_file = K code_path}
  31.520    end
  31.521  
  31.522 -fun evaluate_in_polyml ctxt =
  31.523 -  gen_driver mk_driver_polyml ISABELLE_POLYML "PolyML executable" polymlN ctxt
  31.524 +fun evaluate_in_polyml ctxt = evaluate mk_driver_polyml NONE polymlN ctxt
  31.525  
  31.526 -(* Driver for mlton *)
  31.527 +
  31.528 +(* driver for mlton *)
  31.529  
  31.530  val mltonN = "MLton"
  31.531  val ISABELLE_MLTON = "ISABELLE_MLTON"
  31.532 @@ -367,8 +365,8 @@
  31.533      val code_path = Path.append path (Path.basic generatedN)
  31.534      val driver_path = Path.append path (Path.basic driverN)
  31.535      val ml_basis_path = Path.append path (Path.basic ml_basisN)
  31.536 -    val driver = 
  31.537 -      "fun format_term NONE = \"\"\n" ^ 
  31.538 +    val driver =
  31.539 +      "fun format_term NONE = \"\"\n" ^
  31.540        "  | format_term (SOME t) = t ();\n" ^
  31.541        "fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
  31.542        "  | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
  31.543 @@ -391,9 +389,10 @@
  31.544    end
  31.545  
  31.546  fun evaluate_in_mlton ctxt =
  31.547 -  gen_driver mk_driver_mlton ISABELLE_MLTON "MLton executable" mltonN ctxt
  31.548 +  evaluate mk_driver_mlton (SOME (ISABELLE_MLTON, "MLton executable")) mltonN ctxt
  31.549  
  31.550 -(* Driver for SML/NJ *)
  31.551 +
  31.552 +(* driver for SML/NJ *)
  31.553  
  31.554  val smlnjN = "SMLNJ"
  31.555  val ISABELLE_SMLNJ = "ISABELLE_SMLNJ"
  31.556 @@ -405,11 +404,11 @@
  31.557  
  31.558      val code_path = Path.append path (Path.basic generatedN)
  31.559      val driver_path = Path.append path (Path.basic driverN)
  31.560 -    val driver = 
  31.561 +    val driver =
  31.562        "structure Test = struct\n" ^
  31.563        "fun main prog_name =\n" ^
  31.564        "  let\n" ^
  31.565 -      "    fun format_term NONE = \"\"\n" ^ 
  31.566 +      "    fun format_term NONE = \"\"\n" ^
  31.567        "      | format_term (SOME t) = t ();\n" ^
  31.568        "    fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
  31.569        "      | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
  31.570 @@ -430,9 +429,10 @@
  31.571    end
  31.572  
  31.573  fun evaluate_in_smlnj ctxt =
  31.574 -  gen_driver mk_driver_smlnj ISABELLE_SMLNJ "SMLNJ executable" smlnjN ctxt
  31.575 +  evaluate mk_driver_smlnj (SOME (ISABELLE_SMLNJ, "SMLNJ executable")) smlnjN ctxt
  31.576  
  31.577 -(* Driver for OCaml *)
  31.578 +
  31.579 +(* driver for OCaml *)
  31.580  
  31.581  val ocamlN = "OCaml"
  31.582  val ISABELLE_OCAMLC = "ISABELLE_OCAMLC"
  31.583 @@ -444,9 +444,9 @@
  31.584  
  31.585      val code_path = Path.append path (Path.basic generatedN)
  31.586      val driver_path = Path.append path (Path.basic driverN)
  31.587 -    val driver = 
  31.588 +    val driver =
  31.589        "let format_term = function\n" ^
  31.590 -      "  | None -> \"\"\n" ^ 
  31.591 +      "  | None -> \"\"\n" ^
  31.592        "  | Some t -> t ();;\n" ^
  31.593        "let format = function\n" ^
  31.594        "  | (true, _) -> \"" ^ successN ^ "\\n\"\n" ^
  31.595 @@ -471,9 +471,10 @@
  31.596    end
  31.597  
  31.598  fun evaluate_in_ocaml ctxt =
  31.599 -  gen_driver mk_driver_ocaml ISABELLE_OCAMLC "ocamlc executable" ocamlN ctxt
  31.600 +  evaluate mk_driver_ocaml (SOME (ISABELLE_OCAMLC, "ocamlc executable")) ocamlN ctxt
  31.601  
  31.602 -(* Driver for GHC *)
  31.603 +
  31.604 +(* driver for GHC *)
  31.605  
  31.606  val ghcN = "GHC"
  31.607  val ISABELLE_GHC = "ISABELLE_GHC"
  31.608 @@ -486,12 +487,12 @@
  31.609  
  31.610      fun mk_code_file name = Path.append path (Path.basic (name ^ ".hs"))
  31.611      val driver_path = Path.append path (Path.basic driverN)
  31.612 -    val driver = 
  31.613 +    val driver =
  31.614        "module Main where {\n" ^
  31.615        String.concat (map (fn module => "import qualified " ^ module ^ ";\n") modules) ^
  31.616        "main = do {\n" ^
  31.617        "    let {\n" ^
  31.618 -      "      format_term Nothing = \"\";\n" ^ 
  31.619 +      "      format_term Nothing = \"\";\n" ^
  31.620        "      format_term (Just t) = t ();\n" ^
  31.621        "      format (True, _) = \"" ^ successN ^ "\\n\";\n" ^
  31.622        "      format (False, to) = \"" ^ failureN ^ "\" ++ format_term to ++ \"\\n\";\n" ^
  31.623 @@ -516,12 +517,12 @@
  31.624    end
  31.625  
  31.626  fun evaluate_in_ghc ctxt =
  31.627 -  gen_driver mk_driver_ghc ISABELLE_GHC "GHC executable" ghcN ctxt
  31.628 +  evaluate mk_driver_ghc (SOME (ISABELLE_GHC, "GHC executable")) ghcN ctxt
  31.629  
  31.630 -(* Driver for Scala *)
  31.631 +
  31.632 +(* driver for Scala *)
  31.633  
  31.634  val scalaN = "Scala"
  31.635 -val ISABELLE_SCALA = "ISABELLE_SCALA"
  31.636  
  31.637  fun mk_driver_scala _ path _ value_name =
  31.638    let
  31.639 @@ -530,7 +531,7 @@
  31.640  
  31.641      val code_path = Path.append path (Path.basic (generatedN ^ ".scala"))
  31.642      val driver_path = Path.append path (Path.basic driverN)
  31.643 -    val driver = 
  31.644 +    val driver =
  31.645        "import " ^ generatedN ^ "._\n" ^
  31.646        "object Test {\n" ^
  31.647        "  def format_term(x : Option[Unit => String]) : String = x match {\n" ^
  31.648 @@ -550,37 +551,36 @@
  31.649        "}\n"
  31.650  
  31.651      val compile_cmd =
  31.652 -      Path.implode (Path.append (Path.variable ISABELLE_SCALA) (Path.basic "scalac")) ^
  31.653 -      " -d " ^ File.bash_path path ^ " -classpath " ^ File.bash_path path ^ " " ^
  31.654 +      "\"$SCALA_HOME/bin/scalac\" -d " ^ File.bash_path path ^
  31.655 +      " -classpath " ^ File.bash_path path ^ " " ^
  31.656        File.bash_path code_path ^ " " ^ File.bash_path driver_path
  31.657  
  31.658 -    val run_cmd =
  31.659 -      Path.implode (Path.append (Path.variable ISABELLE_SCALA) (Path.basic "scala")) ^
  31.660 -      " -cp " ^ File.bash_path path ^ " Test"
  31.661 +    val run_cmd = "\"$SCALA_HOME/bin/scala\" -cp " ^ File.bash_path path ^ " Test"
  31.662    in
  31.663      {files = [(driver_path, driver)],
  31.664       compile_cmd = SOME compile_cmd, run_cmd = run_cmd, mk_code_file = K code_path}
  31.665    end
  31.666  
  31.667 -fun evaluate_in_scala ctxt =
  31.668 -  gen_driver mk_driver_scala ISABELLE_SCALA "Scala directory" scalaN ctxt
  31.669 +fun evaluate_in_scala ctxt = evaluate mk_driver_scala NONE scalaN ctxt
  31.670 +
  31.671  
  31.672 -val test_codeP = Scan.repeat1 Parse.prop -- (@{keyword "in"} |-- Scan.repeat1 Parse.name)
  31.673 +(* command setup *)
  31.674  
  31.675 -val _ = 
  31.676 +val _ =
  31.677    Outer_Syntax.command @{command_keyword test_code}
  31.678      "compile test cases to target languages, execute them and report results"
  31.679 -      (test_codeP >> (fn (raw_ts, targets) => Toplevel.keep (test_code_cmd raw_ts targets)))
  31.680 +      (Scan.repeat1 Parse.prop -- (@{keyword "in"} |-- Scan.repeat1 Parse.name)
  31.681 +        >> (fn (ts, targets) => Toplevel.keep (test_code_cmd ts targets o Toplevel.context_of)))
  31.682  
  31.683 -val _ = Theory.setup (fold add_driver
  31.684 -  [(polymlN, (evaluate_in_polyml, Code_ML.target_SML)),
  31.685 -   (mltonN, (evaluate_in_mlton, Code_ML.target_SML)),
  31.686 -   (smlnjN, (evaluate_in_smlnj, Code_ML.target_SML)),
  31.687 -   (ocamlN, (evaluate_in_ocaml, Code_ML.target_OCaml)),
  31.688 -   (ghcN, (evaluate_in_ghc, Code_Haskell.target)),
  31.689 -   (scalaN, (evaluate_in_scala, Code_Scala.target))]
  31.690 +val _ =
  31.691 +  Theory.setup (fold add_driver
  31.692 +    [(polymlN, (evaluate_in_polyml, Code_ML.target_SML)),
  31.693 +     (mltonN, (evaluate_in_mlton, Code_ML.target_SML)),
  31.694 +     (smlnjN, (evaluate_in_smlnj, Code_ML.target_SML)),
  31.695 +     (ocamlN, (evaluate_in_ocaml, Code_ML.target_OCaml)),
  31.696 +     (ghcN, (evaluate_in_ghc, Code_Haskell.target)),
  31.697 +     (scalaN, (evaluate_in_scala, Code_Scala.target))]
  31.698    #> fold (fn target => Value_Command.add_evaluator (target, eval_term target))
  31.699 -    [polymlN, mltonN, smlnjN, ocamlN, ghcN, scalaN]);
  31.700 +      [polymlN, mltonN, smlnjN, ocamlN, ghcN, scalaN])
  31.701  
  31.702  end
  31.703 -
    32.1 --- a/src/HOL/Nonstandard_Analysis/CLim.thy	Tue Dec 20 16:17:13 2016 +0100
    32.2 +++ b/src/HOL/Nonstandard_Analysis/CLim.thy	Tue Dec 20 16:18:56 2016 +0100
    32.3 @@ -4,198 +4,178 @@
    32.4      Conversion to Isar and new proofs by Lawrence C Paulson, 2004
    32.5  *)
    32.6  
    32.7 -section\<open>Limits, Continuity and Differentiation for Complex Functions\<close>
    32.8 +section \<open>Limits, Continuity and Differentiation for Complex Functions\<close>
    32.9  
   32.10  theory CLim
   32.11 -imports CStar
   32.12 +  imports CStar
   32.13  begin
   32.14  
   32.15  (*not in simpset?*)
   32.16  declare hypreal_epsilon_not_zero [simp]
   32.17  
   32.18  (*??generalize*)
   32.19 -lemma lemma_complex_mult_inverse_squared [simp]:
   32.20 -     "x \<noteq> (0::complex) \<Longrightarrow> x * (inverse x)\<^sup>2 = inverse x"
   32.21 -by (simp add: numeral_2_eq_2)
   32.22 +lemma lemma_complex_mult_inverse_squared [simp]: "x \<noteq> 0 \<Longrightarrow> x * (inverse x)\<^sup>2 = inverse x"
   32.23 +  for x :: complex
   32.24 +  by (simp add: numeral_2_eq_2)
   32.25 +
   32.26 +text \<open>Changing the quantified variable. Install earlier?\<close>
   32.27 +lemma all_shift: "(\<forall>x::'a::comm_ring_1. P x) \<longleftrightarrow> (\<forall>x. P (x - a))"
   32.28 +  apply auto
   32.29 +  apply (drule_tac x = "x + a" in spec)
   32.30 +  apply (simp add: add.assoc)
   32.31 +  done
   32.32  
   32.33 -text\<open>Changing the quantified variable. Install earlier?\<close>
   32.34 -lemma all_shift: "(\<forall>x::'a::comm_ring_1. P x) = (\<forall>x. P (x-a))"
   32.35 -apply auto 
   32.36 -apply (drule_tac x="x+a" in spec) 
   32.37 -apply (simp add: add.assoc) 
   32.38 -done
   32.39 +lemma complex_add_minus_iff [simp]: "x + - a = 0 \<longleftrightarrow> x = a"
   32.40 +  for x a :: complex
   32.41 +  by (simp add: diff_eq_eq)
   32.42  
   32.43 -lemma complex_add_minus_iff [simp]: "(x + - a = (0::complex)) = (x=a)"
   32.44 -by (simp add: diff_eq_eq)
   32.45 -
   32.46 -lemma complex_add_eq_0_iff [iff]: "(x+y = (0::complex)) = (y = -x)"
   32.47 -apply auto
   32.48 -apply (drule sym [THEN diff_eq_eq [THEN iffD2]], auto)
   32.49 -done
   32.50 +lemma complex_add_eq_0_iff [iff]: "x + y = 0 \<longleftrightarrow> y = - x"
   32.51 +  for x y :: complex
   32.52 +  apply auto
   32.53 +  apply (drule sym [THEN diff_eq_eq [THEN iffD2]])
   32.54 +  apply auto
   32.55 +  done
   32.56  
   32.57  
   32.58 -subsection\<open>Limit of Complex to Complex Function\<close>
   32.59 +subsection \<open>Limit of Complex to Complex Function\<close>
   32.60 +
   32.61 +lemma NSLIM_Re: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L \<Longrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Re L"
   32.62 +  by (simp add: NSLIM_def starfunC_approx_Re_Im_iff hRe_hcomplex_of_complex)
   32.63  
   32.64 -lemma NSLIM_Re: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L ==> (%x. Re(f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Re(L)"
   32.65 -by (simp add: NSLIM_def starfunC_approx_Re_Im_iff 
   32.66 -              hRe_hcomplex_of_complex)
   32.67 +lemma NSLIM_Im: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L \<Longrightarrow> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Im L"
   32.68 +  by (simp add: NSLIM_def starfunC_approx_Re_Im_iff hIm_hcomplex_of_complex)
   32.69  
   32.70 -lemma NSLIM_Im: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L ==> (%x. Im(f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Im(L)"
   32.71 -by (simp add: NSLIM_def starfunC_approx_Re_Im_iff 
   32.72 -              hIm_hcomplex_of_complex)
   32.73 +lemma LIM_Re: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow> Re L"
   32.74 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
   32.75 +  by (simp add: LIM_NSLIM_iff NSLIM_Re)
   32.76  
   32.77 -(** get this result easily now **)
   32.78 -lemma LIM_Re:
   32.79 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   32.80 -  shows "f \<midarrow>a\<rightarrow> L ==> (%x. Re(f x)) \<midarrow>a\<rightarrow> Re(L)"
   32.81 -by (simp add: LIM_NSLIM_iff NSLIM_Re)
   32.82 +lemma LIM_Im: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow> Im L"
   32.83 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
   32.84 +  by (simp add: LIM_NSLIM_iff NSLIM_Im)
   32.85  
   32.86 -lemma LIM_Im:
   32.87 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   32.88 -  shows "f \<midarrow>a\<rightarrow> L ==> (%x. Im(f x)) \<midarrow>a\<rightarrow> Im(L)"
   32.89 -by (simp add: LIM_NSLIM_iff NSLIM_Im)
   32.90 +lemma LIM_cnj: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. cnj (f x)) \<midarrow>a\<rightarrow> cnj L"
   32.91 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
   32.92 +  by (simp add: LIM_eq complex_cnj_diff [symmetric] del: complex_cnj_diff)
   32.93  
   32.94 -lemma LIM_cnj:
   32.95 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   32.96 -  shows "f \<midarrow>a\<rightarrow> L ==> (%x. cnj (f x)) \<midarrow>a\<rightarrow> cnj L"
   32.97 -by (simp add: LIM_eq complex_cnj_diff [symmetric] del: complex_cnj_diff)
   32.98 -
   32.99 -lemma LIM_cnj_iff:
  32.100 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.101 -  shows "((%x. cnj (f x)) \<midarrow>a\<rightarrow> cnj L) = (f \<midarrow>a\<rightarrow> L)"
  32.102 -by (simp add: LIM_eq complex_cnj_diff [symmetric] del: complex_cnj_diff)
  32.103 +lemma LIM_cnj_iff: "((\<lambda>x. cnj (f x)) \<midarrow>a\<rightarrow> cnj L) \<longleftrightarrow> f \<midarrow>a\<rightarrow> L"
  32.104 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.105 +  by (simp add: LIM_eq complex_cnj_diff [symmetric] del: complex_cnj_diff)
  32.106  
  32.107  lemma starfun_norm: "( *f* (\<lambda>x. norm (f x))) = (\<lambda>x. hnorm (( *f* f) x))"
  32.108 -by transfer (rule refl)
  32.109 +  by transfer (rule refl)
  32.110  
  32.111  lemma star_of_Re [simp]: "star_of (Re x) = hRe (star_of x)"
  32.112 -by transfer (rule refl)
  32.113 +  by transfer (rule refl)
  32.114  
  32.115  lemma star_of_Im [simp]: "star_of (Im x) = hIm (star_of x)"
  32.116 -by transfer (rule refl)
  32.117 +  by transfer (rule refl)
  32.118  
  32.119 -text""
  32.120 -(** another equivalence result **)
  32.121 -lemma NSCLIM_NSCRLIM_iff:
  32.122 -   "(f \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S L) = ((%y. cmod(f y - L)) \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S 0)"
  32.123 -by (simp add: NSLIM_def starfun_norm
  32.124 -    approx_approx_zero_iff [symmetric] approx_minus_iff [symmetric])
  32.125 +text \<open>Another equivalence result.\<close>
  32.126 +lemma NSCLIM_NSCRLIM_iff: "f \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S L \<longleftrightarrow> (\<lambda>y. cmod (f y - L)) \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S 0"
  32.127 +  by (simp add: NSLIM_def starfun_norm
  32.128 +      approx_approx_zero_iff [symmetric] approx_minus_iff [symmetric])
  32.129  
  32.130 -(** much, much easier standard proof **)
  32.131 -lemma CLIM_CRLIM_iff:
  32.132 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.133 -  shows "(f \<midarrow>x\<rightarrow> L) = ((%y. cmod(f y - L)) \<midarrow>x\<rightarrow> 0)"
  32.134 -by (simp add: LIM_eq)
  32.135 +text \<open>Much, much easier standard proof.\<close>
  32.136 +lemma CLIM_CRLIM_iff: "f \<midarrow>x\<rightarrow> L \<longleftrightarrow> (\<lambda>y. cmod (f y - L)) \<midarrow>x\<rightarrow> 0"
  32.137 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.138 +  by (simp add: LIM_eq)
  32.139  
  32.140 -(* so this is nicer nonstandard proof *)
  32.141 -lemma NSCLIM_NSCRLIM_iff2:
  32.142 -     "(f \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S L) = ((%y. cmod(f y - L)) \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S 0)"
  32.143 -by (simp add: LIM_NSLIM_iff [symmetric] CLIM_CRLIM_iff)
  32.144 +text \<open>So this is nicer nonstandard proof.\<close>
  32.145 +lemma NSCLIM_NSCRLIM_iff2: "f \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S L \<longleftrightarrow> (\<lambda>y. cmod (f y - L)) \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S 0"
  32.146 +  by (simp add: LIM_NSLIM_iff [symmetric] CLIM_CRLIM_iff)
  32.147  
  32.148  lemma NSLIM_NSCRLIM_Re_Im_iff:
  32.149 -     "(f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L) = ((%x. Re(f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Re(L) &
  32.150 -                            (%x. Im(f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Im(L))"
  32.151 -apply (auto intro: NSLIM_Re NSLIM_Im)
  32.152 -apply (auto simp add: NSLIM_def starfun_Re starfun_Im)
  32.153 -apply (auto dest!: spec)
  32.154 -apply (simp add: hcomplex_approx_iff)
  32.155 -done
  32.156 +  "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L \<longleftrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Re L \<and> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Im L"
  32.157 +  apply (auto intro: NSLIM_Re NSLIM_Im)
  32.158 +  apply (auto simp add: NSLIM_def starfun_Re starfun_Im)
  32.159 +  apply (auto dest!: spec)
  32.160 +  apply (simp add: hcomplex_approx_iff)
  32.161 +  done
  32.162 +
  32.163 +lemma LIM_CRLIM_Re_Im_iff: "f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow> Re L \<and> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow> Im L"
  32.164 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.165 +  by (simp add: LIM_NSLIM_iff NSLIM_NSCRLIM_Re_Im_iff)
  32.166 +
  32.167 +
  32.168 +subsection \<open>Continuity\<close>
  32.169 +
  32.170 +lemma NSLIM_isContc_iff: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S f a \<longleftrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow>\<^sub>N\<^sub>S f a"
  32.171 +  by (rule NSLIM_h_iff)
  32.172  
  32.173 -lemma LIM_CRLIM_Re_Im_iff:
  32.174 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.175 -  shows "(f \<midarrow>a\<rightarrow> L) = ((%x. Re(f x)) \<midarrow>a\<rightarrow> Re(L) &
  32.176 -                         (%x. Im(f x)) \<midarrow>a\<rightarrow> Im(L))"
  32.177 -by (simp add: LIM_NSLIM_iff NSLIM_NSCRLIM_Re_Im_iff)
  32.178 +
  32.179 +subsection \<open>Functions from Complex to Reals\<close>
  32.180 +
  32.181 +lemma isNSContCR_cmod [simp]: "isNSCont cmod a"
  32.182 +  by (auto intro: approx_hnorm
  32.183 +      simp: starfunCR_cmod hcmod_hcomplex_of_complex [symmetric] isNSCont_def)
  32.184 +
  32.185 +lemma isContCR_cmod [simp]: "isCont cmod a"
  32.186 +  by (simp add: isNSCont_isCont_iff [symmetric])
  32.187 +
  32.188 +lemma isCont_Re: "isCont f a \<Longrightarrow> isCont (\<lambda>x. Re (f x)) a"
  32.189 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.190 +  by (simp add: isCont_def LIM_Re)
  32.191 +
  32.192 +lemma isCont_Im: "isCont f a \<Longrightarrow> isCont (\<lambda>x. Im (f x)) a"
  32.193 +  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.194 +  by (simp add: isCont_def LIM_Im)
  32.195  
  32.196  
  32.197 -subsection\<open>Continuity\<close>
  32.198 -
  32.199 -lemma NSLIM_isContc_iff:
  32.200 -     "(f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S f a) = ((%h. f(a + h)) \<midarrow>0\<rightarrow>\<^sub>N\<^sub>S f a)"
  32.201 -by (rule NSLIM_h_iff)
  32.202 -
  32.203 -subsection\<open>Functions from Complex to Reals\<close>
  32.204 -
  32.205 -lemma isNSContCR_cmod [simp]: "isNSCont cmod (a)"
  32.206 -by (auto intro: approx_hnorm
  32.207 -         simp add: starfunCR_cmod hcmod_hcomplex_of_complex [symmetric] 
  32.208 -                    isNSCont_def)
  32.209 +subsection \<open>Differentiation of Natural Number Powers\<close>
  32.210  
  32.211 -lemma isContCR_cmod [simp]: "isCont cmod (a)"
  32.212 -by (simp add: isNSCont_isCont_iff [symmetric])
  32.213 -
  32.214 -lemma isCont_Re:
  32.215 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.216 -  shows "isCont f a ==> isCont (%x. Re (f x)) a"
  32.217 -by (simp add: isCont_def LIM_Re)
  32.218 -
  32.219 -lemma isCont_Im:
  32.220 -  fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
  32.221 -  shows "isCont f a ==> isCont (%x. Im (f x)) a"
  32.222 -by (simp add: isCont_def LIM_Im)
  32.223 +lemma CDERIV_pow [simp]: "DERIV (\<lambda>x. x ^ n) x :> complex_of_real (real n) * (x ^ (n - Suc 0))"
  32.224 +  apply (induct n)
  32.225 +   apply (drule_tac [2] DERIV_ident [THEN DERIV_mult])
  32.226 +   apply (auto simp add: distrib_right of_nat_Suc)
  32.227 +  apply (case_tac "n")
  32.228 +   apply (auto simp add: ac_simps)
  32.229 +  done
  32.230  
  32.231 -subsection\<open>Differentiation of Natural Number Powers\<close>
  32.232 -
  32.233 -lemma CDERIV_pow [simp]:
  32.234 -     "DERIV (%x. x ^ n) x :> (complex_of_real (real n)) * (x ^ (n - Suc 0))"
  32.235 -apply (induct n)
  32.236 -apply (drule_tac [2] DERIV_ident [THEN DERIV_mult])
  32.237 -apply (auto simp add: distrib_right of_nat_Suc)
  32.238 -apply (case_tac "n")
  32.239 -apply (auto simp add: ac_simps)
  32.240 -done
  32.241 +text \<open>Nonstandard version.\<close>
  32.242 +lemma NSCDERIV_pow: "NSDERIV (\<lambda>x. x ^ n) x :> complex_of_real (real n) * (x ^ (n - 1))"
  32.243 +  by (metis CDERIV_pow NSDERIV_DERIV_iff One_nat_def)
  32.244  
  32.245 -text\<open>Nonstandard version\<close>
  32.246 -lemma NSCDERIV_pow: "NSDERIV (%x. x ^ n) x :> complex_of_real (real n) * (x ^ (n - 1))"
  32.247 -    by (metis CDERIV_pow NSDERIV_DERIV_iff One_nat_def)
  32.248 +text \<open>Can't relax the premise @{term "x \<noteq> 0"}: it isn't continuous at zero.\<close>
  32.249 +lemma NSCDERIV_inverse: "x \<noteq> 0 \<Longrightarrow> NSDERIV (\<lambda>x. inverse x) x :> - (inverse x)\<^sup>2"
  32.250 +  for x :: complex
  32.251 +  unfolding numeral_2_eq_2 by (rule NSDERIV_inverse)
  32.252  
  32.253 -text\<open>Can't relax the premise @{term "x \<noteq> 0"}: it isn't continuous at zero\<close>
  32.254 -lemma NSCDERIV_inverse:
  32.255 -     "(x::complex) \<noteq> 0 ==> NSDERIV (%x. inverse(x)) x :> (- ((inverse x)\<^sup>2))"
  32.256 -unfolding numeral_2_eq_2
  32.257 -by (rule NSDERIV_inverse)
  32.258 -
  32.259 -lemma CDERIV_inverse:
  32.260 -     "(x::complex) \<noteq> 0 ==> DERIV (%x. inverse(x)) x :> (- ((inverse x)\<^sup>2))"
  32.261 -unfolding numeral_2_eq_2
  32.262 -by (rule DERIV_inverse)
  32.263 +lemma CDERIV_inverse: "x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse x) x :> - (inverse x)\<^sup>2"
  32.264 +  for x :: complex
  32.265 +  unfolding numeral_2_eq_2 by (rule DERIV_inverse)
  32.266  
  32.267  
  32.268 -subsection\<open>Derivative of Reciprocals (Function @{term inverse})\<close>
  32.269 +subsection \<open>Derivative of Reciprocals (Function @{term inverse})\<close>
  32.270  
  32.271  lemma CDERIV_inverse_fun:
  32.272 -     "[| DERIV f x :> d; f(x) \<noteq> (0::complex) |]
  32.273 -      ==> DERIV (%x. inverse(f x)) x :> (- (d * inverse ((f x)\<^sup>2)))"
  32.274 -unfolding numeral_2_eq_2
  32.275 -by (rule DERIV_inverse_fun)
  32.276 +  "DERIV f x :> d \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse (f x)) x :> - (d * inverse ((f x)\<^sup>2))"
  32.277 +  for x :: complex
  32.278 +  unfolding numeral_2_eq_2 by (rule DERIV_inverse_fun)
  32.279  
  32.280  lemma NSCDERIV_inverse_fun:
  32.281 -     "[| NSDERIV f x :> d; f(x) \<noteq> (0::complex) |]
  32.282 -      ==> NSDERIV (%x. inverse(f x)) x :> (- (d * inverse ((f x)\<^sup>2)))"
  32.283 -unfolding numeral_2_eq_2
  32.284 -by (rule NSDERIV_inverse_fun)
  32.285 +  "NSDERIV f x :> d \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> NSDERIV (\<lambda>x. inverse (f x)) x :> - (d * inverse ((f x)\<^sup>2))"
  32.286 +  for x :: complex
  32.287 +  unfolding numeral_2_eq_2 by (rule NSDERIV_inverse_fun)
  32.288  
  32.289  
  32.290 -subsection\<open>Derivative of Quotient\<close>
  32.291 +subsection \<open>Derivative of Quotient\<close>
  32.292  
  32.293  lemma CDERIV_quotient:
  32.294 -     "[| DERIV f x :> d; DERIV g x :> e; g(x) \<noteq> (0::complex) |]
  32.295 -       ==> DERIV (%y. f(y) / (g y)) x :> (d*g(x) - (e*f(x))) / ((g x)\<^sup>2)"
  32.296 -unfolding numeral_2_eq_2
  32.297 -by (rule DERIV_quotient)
  32.298 +  "DERIV f x :> d \<Longrightarrow> DERIV g x :> e \<Longrightarrow> g(x) \<noteq> 0 \<Longrightarrow>
  32.299 +    DERIV (\<lambda>y. f y / g y) x :> (d * g x - (e * f x)) / (g x)\<^sup>2"
  32.300 +  for x :: complex
  32.301 +  unfolding numeral_2_eq_2 by (rule DERIV_quotient)
  32.302  
  32.303  lemma NSCDERIV_quotient:
  32.304 -     "[| NSDERIV f x :> d; NSDERIV g x :> e; g(x) \<noteq> (0::complex) |]
  32.305 -       ==> NSDERIV (%y. f(y) / (g y)) x :> (d*g(x) - (e*f(x))) / ((g x)\<^sup>2)"
  32.306 -unfolding numeral_2_eq_2
  32.307 -by (rule NSDERIV_quotient)
  32.308 +  "NSDERIV f x :> d \<Longrightarrow> NSDERIV g x :> e \<Longrightarrow> g x \<noteq> (0::complex) \<Longrightarrow>
  32.309 +    NSDERIV (\<lambda>y. f y / g y) x :> (d * g x - (e * f x)) / (g x)\<^sup>2"
  32.310 +  unfolding numeral_2_eq_2 by (rule NSDERIV_quotient)
  32.311  
  32.312  
  32.313 -subsection\<open>Caratheodory Formulation of Derivative at a Point: Standard Proof\<close>
  32.314 +subsection \<open>Caratheodory Formulation of Derivative at a Point: Standard Proof\<close>
  32.315  
  32.316  lemma CARAT_CDERIVD:
  32.317 -     "(\<forall>z. f z - f x = g z * (z - x)) & isNSCont g x & g x = l
  32.318 -      ==> NSDERIV f x :> l"
  32.319 -by clarify (rule CARAT_DERIVD)
  32.320 +  "(\<forall>z. f z - f x = g z * (z - x)) \<and> isNSCont g x \<and> g x = l \<Longrightarrow> NSDERIV f x :> l"
  32.321 +  by clarify (rule CARAT_DERIVD)
  32.322  
  32.323  end
    33.1 --- a/src/HOL/Nonstandard_Analysis/CStar.thy	Tue Dec 20 16:17:13 2016 +0100
    33.2 +++ b/src/HOL/Nonstandard_Analysis/CStar.thy	Tue Dec 20 16:18:56 2016 +0100
    33.3 @@ -3,37 +3,36 @@
    33.4      Copyright:  2001 University of Edinburgh
    33.5  *)
    33.6  
    33.7 -section\<open>Star-transforms in NSA, Extending Sets of Complex Numbers
    33.8 -      and Complex Functions\<close>
    33.9 +section \<open>Star-transforms in NSA, Extending Sets of Complex Numbers and Complex Functions\<close>
   33.10  
   33.11  theory CStar
   33.12 -imports NSCA
   33.13 +  imports NSCA
   33.14  begin
   33.15  
   33.16 -subsection\<open>Properties of the *-Transform Applied to Sets of Reals\<close>
   33.17 +subsection \<open>Properties of the \<open>*\<close>-Transform Applied to Sets of Reals\<close>
   33.18  
   33.19 -lemma STARC_hcomplex_of_complex_Int:
   33.20 -     "*s* X Int SComplex = hcomplex_of_complex ` X"
   33.21 -by (auto simp add: Standard_def)
   33.22 +lemma STARC_hcomplex_of_complex_Int: "*s* X \<inter> SComplex = hcomplex_of_complex ` X"
   33.23 +  by (auto simp: Standard_def)
   33.24  
   33.25 -lemma lemma_not_hcomplexA:
   33.26 -     "x \<notin> hcomplex_of_complex ` A ==> \<forall>y \<in> A. x \<noteq> hcomplex_of_complex y"
   33.27 -by auto
   33.28 +lemma lemma_not_hcomplexA: "x \<notin> hcomplex_of_complex ` A \<Longrightarrow> \<forall>y \<in> A. x \<noteq> hcomplex_of_complex y"
   33.29 +  by auto
   33.30 +
   33.31  
   33.32 -subsection\<open>Theorems about Nonstandard Extensions of Functions\<close>
   33.33 +subsection \<open>Theorems about Nonstandard Extensions of Functions\<close>
   33.34  
   33.35 -lemma starfunC_hcpow: "!!Z. ( *f* (%z. z ^ n)) Z = Z pow hypnat_of_nat n"
   33.36 -by transfer (rule refl)
   33.37 +lemma starfunC_hcpow: "\<And>Z. ( *f* (\<lambda>z. z ^ n)) Z = Z pow hypnat_of_nat n"
   33.38 +  by transfer (rule refl)
   33.39  
   33.40  lemma starfunCR_cmod: "*f* cmod = hcmod"
   33.41 -by transfer (rule refl)
   33.42 +  by transfer (rule refl)
   33.43  
   33.44 -subsection\<open>Internal Functions - Some Redundancy With *f* Now\<close>
   33.45 +
   33.46 +subsection \<open>Internal Functions - Some Redundancy With \<open>*f*\<close> Now\<close>
   33.47  
   33.48  (** subtraction: ( *fn) - ( *gn) = *(fn - gn) **)
   33.49  (*
   33.50  lemma starfun_n_diff:
   33.51 -   "( *fn* f) z - ( *fn* g) z = ( *fn* (%i x. f i x - g i x)) z"
   33.52 +   "( *fn* f) z - ( *fn* g) z = ( *fn* (\<lambda>i x. f i x - g i x)) z"
   33.53  apply (cases z)
   33.54  apply (simp add: starfun_n star_n_diff)
   33.55  done
   33.56 @@ -41,19 +40,17 @@
   33.57  (** composition: ( *fn) o ( *gn) = *(fn o gn) **)
   33.58  
   33.59  lemma starfun_Re: "( *f* (\<lambda>x. Re (f x))) = (\<lambda>x. hRe (( *f* f) x))"
   33.60 -by transfer (rule refl)
   33.61 +  by transfer (rule refl)
   33.62  
   33.63  lemma starfun_Im: "( *f* (\<lambda>x. Im (f x))) = (\<lambda>x. hIm (( *f* f) x))"
   33.64 -by transfer (rule refl)
   33.65 +  by transfer (rule refl)
   33.66  
   33.67  lemma starfunC_eq_Re_Im_iff:
   33.68 -    "(( *f* f) x = z) = ((( *f* (%x. Re(f x))) x = hRe (z)) &
   33.69 -                          (( *f* (%x. Im(f x))) x = hIm (z)))"
   33.70 -by (simp add: hcomplex_hRe_hIm_cancel_iff starfun_Re starfun_Im)
   33.71 +  "( *f* f) x = z \<longleftrightarrow> ( *f* (\<lambda>x. Re (f x))) x = hRe z \<and> ( *f* (\<lambda>x. Im (f x))) x = hIm z"
   33.72 +  by (simp add: hcomplex_hRe_hIm_cancel_iff starfun_Re starfun_Im)
   33.73  
   33.74  lemma starfunC_approx_Re_Im_iff:
   33.75 -    "(( *f* f) x \<approx> z) = ((( *f* (%x. Re(f x))) x \<approx> hRe (z)) &
   33.76 -                            (( *f* (%x. Im(f x))) x \<approx> hIm (z)))"
   33.77 -by (simp add: hcomplex_approx_iff starfun_Re starfun_Im)
   33.78 +  "( *f* f) x \<approx> z \<longleftrightarrow> ( *f* (\<lambda>x. Re (f x))) x \<approx> hRe z \<and> ( *f* (\<lambda>x. Im (f x))) x \<approx> hIm z"
   33.79 +  by (simp add: hcomplex_approx_iff starfun_Re starfun_Im)
   33.80  
   33.81  end
    34.1 --- a/src/HOL/Nonstandard_Analysis/Examples/NSPrimes.thy	Tue Dec 20 16:17:13 2016 +0100
    34.2 +++ b/src/HOL/Nonstandard_Analysis/Examples/NSPrimes.thy	Tue Dec 20 16:18:56 2016 +0100
    34.3 @@ -4,280 +4,287 @@
    34.4      Conversion to Isar and new proofs by Lawrence C Paulson, 2004
    34.5  *)
    34.6  
    34.7 -section\<open>The Nonstandard Primes as an Extension of the Prime Numbers\<close>
    34.8 +section \<open>The Nonstandard Primes as an Extension of the Prime Numbers\<close>
    34.9  
   34.10  theory NSPrimes
   34.11 -imports "~~/src/HOL/Number_Theory/Primes" "../Hyperreal"
   34.12 +  imports "~~/src/HOL/Number_Theory/Primes" "../Hyperreal"
   34.13  begin
   34.14  
   34.15 -text\<open>These can be used to derive an alternative proof of the infinitude of
   34.16 +text \<open>These can be used to derive an alternative proof of the infinitude of
   34.17  primes by considering a property of nonstandard sets.\<close>
   34.18  
   34.19 -definition
   34.20 -  starprime :: "hypnat set" where
   34.21 -  [transfer_unfold]: "starprime = ( *s* {p. prime p})"
   34.22 +definition starprime :: "hypnat set"
   34.23 +  where [transfer_unfold]: "starprime = *s* {p. prime p}"
   34.24  
   34.25 -definition
   34.26 -  choicefun :: "'a set => 'a" where
   34.27 -  "choicefun E = (@x. \<exists>X \<in> Pow(E) -{{}}. x : X)"
   34.28 +definition choicefun :: "'a set \<Rightarrow> 'a"
   34.29 +  where "choicefun E = (SOME x. \<exists>X \<in> Pow E - {{}}. x \<in> X)"
   34.30  
   34.31 -primrec injf_max :: "nat => ('a::{order} set) => 'a"
   34.32 +primrec injf_max :: "nat \<Rightarrow> 'a::order set \<Rightarrow> 'a"
   34.33  where
   34.34    injf_max_zero: "injf_max 0 E = choicefun E"
   34.35 -| injf_max_Suc:  "injf_max (Suc n) E = choicefun({e. e:E & injf_max n E < e})"
   34.36 -
   34.37 +| injf_max_Suc: "injf_max (Suc n) E = choicefun ({e. e \<in> E \<and> injf_max n E < e})"
   34.38  
   34.39 -lemma dvd_by_all2:
   34.40 -  fixes M :: nat
   34.41 -  shows "\<exists>N>0. \<forall>m. 0 < m \<and> m \<le> M \<longrightarrow> m dvd N"
   34.42 -apply (induct M)
   34.43 -apply auto
   34.44 -apply (rule_tac x = "N * (Suc M) " in exI)
   34.45 -apply auto
   34.46 -apply (metis dvdI dvd_add_times_triv_left_iff dvd_add_triv_right_iff dvd_refl dvd_trans le_Suc_eq mult_Suc_right)
   34.47 -done
   34.48 +lemma dvd_by_all2: "\<exists>N>0. \<forall>m. 0 < m \<and> m \<le> M \<longrightarrow> m dvd N"
   34.49 +  for M :: nat
   34.50 +  apply (induct M)
   34.51 +   apply auto
   34.52 +  apply (rule_tac x = "N * Suc M" in exI)
   34.53 +  apply auto
   34.54 +  apply (metis dvdI dvd_add_times_triv_left_iff dvd_add_triv_right_iff dvd_refl dvd_trans le_Suc_eq mult_Suc_right)
   34.55 +  done
   34.56  
   34.57 -lemma dvd_by_all:
   34.58 -  "\<forall>M::nat. \<exists>N>0. \<forall>m. 0 < m \<and> m \<le> M \<longrightarrow> m dvd N"
   34.59 +lemma dvd_by_all: "\<forall>M::nat. \<exists>N>0. \<forall>m. 0 < m \<and> m \<le> M \<longrightarrow> m dvd N"
   34.60    using dvd_by_all2 by blast
   34.61  
   34.62 -lemma hypnat_of_nat_le_zero_iff [simp]: "(hypnat_of_nat n <= 0) = (n = 0)"
   34.63 -by (transfer, simp)
   34.64 +lemma hypnat_of_nat_le_zero_iff [simp]: "hypnat_of_nat n \<le> 0 \<longleftrightarrow> n = 0"
   34.65 +  by transfer simp
   34.66  
   34.67 -(* Goldblatt: Exercise 5.11(2) - p. 57 *)
   34.68 -lemma hdvd_by_all: "\<forall>M. \<exists>N. 0 < N & (\<forall>m. 0 < m & (m::hypnat) <= M --> m dvd N)"
   34.69 -by (transfer, rule dvd_by_all)
   34.70 +text \<open>Goldblatt: Exercise 5.11(2) -- p. 57.\<close>
   34.71 +lemma hdvd_by_all: "\<forall>M. \<exists>N. 0 < N \<and> (\<forall>m::hypnat. 0 < m \<and> m \<le> M \<longrightarrow> m dvd N)"
   34.72 +  by transfer (rule dvd_by_all)
   34.73  
   34.74  lemmas hdvd_by_all2 = hdvd_by_all [THEN spec]
   34.75  
   34.76 -(* Goldblatt: Exercise 5.11(2) - p. 57 *)
   34.77 +text \<open>Goldblatt: Exercise 5.11(2) -- p. 57.\<close>
   34.78  lemma hypnat_dvd_all_hypnat_of_nat:
   34.79 -     "\<exists>(N::hypnat). 0 < N & (\<forall>n \<in> -{0::nat}. hypnat_of_nat(n) dvd N)"
   34.80 -apply (cut_tac hdvd_by_all)
   34.81 -apply (drule_tac x = whn in spec, auto)
   34.82 -apply (rule exI, auto)
   34.83 -apply (drule_tac x = "hypnat_of_nat n" in spec)
   34.84 -apply (auto simp add: linorder_not_less)
   34.85 -done
   34.86 +  "\<exists>N::hypnat. 0 < N \<and> (\<forall>n \<in> - {0::nat}. hypnat_of_nat n dvd N)"
   34.87 +  apply (cut_tac hdvd_by_all)
   34.88 +  apply (drule_tac x = whn in spec)
   34.89 +  apply auto
   34.90 +  apply (rule exI)
   34.91 +  apply auto
   34.92 +  apply (drule_tac x = "hypnat_of_nat n" in spec)
   34.93 +  apply (auto simp add: linorder_not_less)
   34.94 +  done
   34.95  
   34.96  
   34.97 -text\<open>The nonstandard extension of the set prime numbers consists of precisely
   34.98 -those hypernaturals exceeding 1 that have no nontrivial factors\<close>
   34.99 +text \<open>The nonstandard extension of the set prime numbers consists of precisely
  34.100 +  those hypernaturals exceeding 1 that have no nontrivial factors.\<close>
  34.101  
  34.102 -(* Goldblatt: Exercise 5.11(3a) - p 57  *)
  34.103 -lemma starprime:
  34.104 -  "starprime = {p. 1 < p & (\<forall>m. m dvd p --> m = 1 | m = p)}"
  34.105 -by (transfer, auto simp add: prime_nat_iff)
  34.106 +text \<open>Goldblatt: Exercise 5.11(3a) -- p 57.\<close>
  34.107 +lemma starprime: "starprime = {p. 1 < p \<and> (\<forall>m. m dvd p \<longrightarrow> m = 1 \<or> m = p)}"
  34.108 +  by transfer (auto simp add: prime_nat_iff)
  34.109  
  34.110 -(* Goldblatt Exercise 5.11(3b) - p 57  *)
  34.111 -lemma hyperprime_factor_exists [rule_format]:
  34.112 -  "!!n. 1 < n ==> (\<exists>k \<in> starprime. k dvd n)"
  34.113 -by (transfer, simp add: prime_factor_nat)
  34.114 +text \<open>Goldblatt Exercise 5.11(3b) -- p 57.\<close>
  34.115 +lemma hyperprime_factor_exists: "\<And>n. 1 < n \<Longrightarrow> \<exists>k \<in> starprime. k dvd n"
  34.116 +  by transfer (simp add: prime_factor_nat)
  34.117  
  34.118 -(* Goldblatt Exercise 3.10(1) - p. 29 *)
  34.119 -lemma NatStar_hypnat_of_nat: "finite A ==> *s* A = hypnat_of_nat ` A"
  34.120 -by (rule starset_finite)
  34.121 +text \<open>Goldblatt Exercise 3.10(1) -- p. 29.\<close>
  34.122 +lemma NatStar_hypnat_of_nat: "finite A \<Longrightarrow> *s* A = hypnat_of_nat ` A"
  34.123 +  by (rule starset_finite)
  34.124  
  34.125  
  34.126 -subsection\<open>Another characterization of infinite set of natural numbers\<close>
  34.127 +subsection \<open>Another characterization of infinite set of natural numbers\<close>
  34.128  
  34.129 -lemma finite_nat_set_bounded: "finite N ==> \<exists>n. (\<forall>i \<in> N. i<(n::nat))"
  34.130 -apply (erule_tac F = N in finite_induct, auto)
  34.131 -apply (rule_tac x = "Suc n + x" in exI, auto)
  34.132 -done
  34.133 +lemma finite_nat_set_bounded: "finite N \<Longrightarrow> \<exists>n::nat. \<forall>i \<in> N. i < n"
  34.134 +  apply (erule_tac F = N in finite_induct)
  34.135 +   apply auto
  34.136 +  apply (rule_tac x = "Suc n + x" in exI)
  34.137 +  apply auto
  34.138 +  done
  34.139  
  34.140 -lemma finite_nat_set_bounded_iff: "finite N = (\<exists>n. (\<forall>i \<in> N. i<(n::nat)))"
  34.141 -by (blast intro: finite_nat_set_bounded bounded_nat_set_is_finite)
  34.142 +lemma finite_nat_set_bounded_iff: "finite N \<longleftrightarrow> (\<exists>n::nat. \<forall>i \<in> N. i < n)"
  34.143 +  by (blast intro: finite_nat_set_bounded bounded_nat_set_is_finite)
  34.144  
  34.145 -lemma not_finite_nat_set_iff: "(~ finite N) = (\<forall>n. \<exists>i \<in> N. n <= (i::nat))"
  34.146 -by (auto simp add: finite_nat_set_bounded_iff not_less)
  34.147 +lemma not_finite_nat_set_iff: "\<not> finite N \<longleftrightarrow> (\<forall>n::nat. \<exists>i \<in> N. n \<le> i)"
  34.148 +  by (auto simp add: finite_nat_set_bounded_iff not_less)
  34.149  
  34.150 -lemma bounded_nat_set_is_finite2: "(\<forall>i \<in> N. i<=(n::nat)) ==> finite N"
  34.151 -apply (rule finite_subset)
  34.152 - apply (rule_tac [2] finite_atMost, auto)
  34.153 -done
  34.154 +lemma bounded_nat_set_is_finite2: "\<forall>i::nat \<in> N. i \<le> n \<Longrightarrow> finite N"
  34.155 +  apply (rule finite_subset)
  34.156 +   apply (rule_tac [2] finite_atMost)
  34.157 +  apply auto
  34.158 +  done
  34.159  
  34.160 -lemma finite_nat_set_bounded2: "finite N ==> \<exists>n. (\<forall>i \<in> N. i<=(n::nat))"
  34.161 -apply (erule_tac F = N in finite_induct, auto)
  34.162 -apply (rule_tac x = "n + x" in exI, auto)
  34.163 -done
  34.164 +lemma finite_nat_set_bounded2: "finite N \<Longrightarrow> \<exists>n::nat. \<forall>i \<in> N. i \<le> n"
  34.165 +  apply (erule_tac F = N in finite_induct)
  34.166 +   apply auto
  34.167 +  apply (rule_tac x = "n + x" in exI)
  34.168 +  apply auto
  34.169 +  done
  34.170  
  34.171 -lemma finite_nat_set_bounded_iff2: "finite N = (\<exists>n. (\<forall>i \<in> N. i<=(n::nat)))"
  34.172 -by (blast intro: finite_nat_set_bounded2 bounded_nat_set_is_finite2)
  34.173 +lemma finite_nat_set_bounded_iff2: "finite N \<longleftrightarrow> (\<exists>n::nat. \<forall>i \<in> N. i \<le> n)"
  34.174 +  by (blast intro: finite_nat_set_bounded2 bounded_nat_set_is_finite2)
  34.175  
  34.176 -lemma not_finite_nat_set_iff2: "(~ finite N) = (\<forall>n. \<exists>i \<in> N. n < (i::nat))"
  34.177 -by (auto simp add: finite_nat_set_bounded_iff2 not_le)
  34.178 +lemma not_finite_nat_set_iff2: "\<not> finite N \<longleftrightarrow> (\<forall>n::nat. \<exists>i \<in> N. n < i)"
  34.179 +  by (auto simp add: finite_nat_set_bounded_iff2 not_le)
  34.180  
  34.181  
  34.182 -subsection\<open>An injective function cannot define an embedded natural number\<close>
  34.183 +subsection \<open>An injective function cannot define an embedded natural number\<close>
  34.184  
  34.185 -lemma lemma_infinite_set_singleton: "\<forall>m n. m \<noteq> n --> f n \<noteq> f m
  34.186 -      ==>  {n. f n = N} = {} |  (\<exists>m. {n. f n = N} = {m})"
  34.187 -apply auto
  34.188 -apply (drule_tac x = x in spec, auto)
  34.189 -apply (subgoal_tac "\<forall>n. (f n = f x) = (x = n) ")
  34.190 -apply auto
  34.191 -done
  34.192 +lemma lemma_infinite_set_singleton:
  34.193 +  "\<forall>m n. m \<noteq> n \<longrightarrow> f n \<noteq> f m \<Longrightarrow> {n. f n = N} = {} \<or> (\<exists>m. {n. f n = N} = {m})"
  34.194 +  apply auto
  34.195 +  apply (drule_tac x = x in spec, auto)
  34.196 +  apply (subgoal_tac "\<forall>n. f n = f x \<longleftrightarrow> x = n")
  34.197 +   apply auto
  34.198 +  done
  34.199  
  34.200  lemma inj_fun_not_hypnat_in_SHNat:
  34.201 -  assumes inj_f: "inj (f::nat=>nat)"
  34.202 +  fixes f :: "nat \<Rightarrow> nat"
  34.203 +  assumes inj_f: "inj f"
  34.204    shows "starfun f whn \<notin> Nats"
  34.205  proof
  34.206    from inj_f have inj_f': "inj (starfun f)"
  34.207      by (transfer inj_on_def Ball_def UNIV_def)
  34.208    assume "starfun f whn \<in> Nats"
  34.209    then obtain N where N: "starfun f whn = hypnat_of_nat N"
  34.210 -    by (auto simp add: Nats_def)
  34.211 -  hence "\<exists>n. starfun f n = hypnat_of_nat N" ..
  34.212 -  hence "\<exists>n. f n = N" by transfer
  34.213 -  then obtain n where n: "f n = N" ..
  34.214 -  hence "starfun f (hypnat_of_nat n) = hypnat_of_nat N"
  34.215 +    by (auto simp: Nats_def)
  34.216 +  then have "\<exists>n. starfun f n = hypnat_of_nat N" ..
  34.217 +  then have "\<exists>n. f n = N" by transfer
  34.218 +  then obtain n where "f n = N" ..
  34.219 +  then have "starfun f (hypnat_of_nat n) = hypnat_of_nat N"
  34.220      by transfer
  34.221    with N have "starfun f whn = starfun f (hypnat_of_nat n)"
  34.222      by simp
  34.223    with inj_f' have "whn = hypnat_of_nat n"
  34.224      by (rule injD)
  34.225 -  thus "False"
  34.226 +  then show False
  34.227      by (simp add: whn_neq_hypnat_of_nat)
  34.228  qed
  34.229  
  34.230 -lemma range_subset_mem_starsetNat:
  34.231 -   "range f <= A ==> starfun f whn \<in> *s* A"
  34.232 -apply (rule_tac x="whn" in spec)
  34.233 -apply (transfer, auto)
  34.234 -done
  34.235 +lemma range_subset_mem_starsetNat: "range f \<subseteq> A \<Longrightarrow> starfun f whn \<in> *s* A"
  34.236 +  apply (rule_tac x="whn" in spec)
  34.237 +  apply transfer
  34.238 +  apply auto
  34.239 +  done
  34.240 +
  34.241 +text \<open>
  34.242 +  Gleason Proposition 11-5.5. pg 149, pg 155 (ex. 3) and pg. 360.
  34.243  
  34.244 -(*--------------------------------------------------------------------------------*)
  34.245 -(* Gleason Proposition 11-5.5. pg 149, pg 155 (ex. 3) and pg. 360                 *)
  34.246 -(* Let E be a nonvoid ordered set with no maximal elements (note: effectively an  *)
  34.247 -(* infinite set if we take E = N (Nats)). Then there exists an order-preserving   *)
  34.248 -(* injection from N to E. Of course, (as some doofus will undoubtedly point out!  *)
  34.249 -(* :-)) can use notion of least element in proof (i.e. no need for choice) if     *)
  34.250 -(* dealing with nats as we have well-ordering property                            *)
  34.251 -(*--------------------------------------------------------------------------------*)
  34.252 +  Let \<open>E\<close> be a nonvoid ordered set with no maximal elements (note: effectively an
  34.253 +  infinite set if we take \<open>E = N\<close> (Nats)). Then there exists an order-preserving
  34.254 +  injection from \<open>N\<close> to \<open>E\<close>. Of course, (as some doofus will undoubtedly point out!
  34.255 +  :-)) can use notion of least element in proof (i.e. no need for choice) if
  34.256 +  dealing with nats as we have well-ordering property.
  34.257 +\<close>
  34.258  
  34.259 -lemma lemmaPow3: "E \<noteq> {} ==> \<exists>x. \<exists>X \<in> (Pow E - {{}}). x: X"
  34.260 -by auto
  34.261 +lemma lemmaPow3: "E \<noteq> {} \<Longrightarrow> \<exists>x. \<exists>X \<in> Pow E - {{}}. x \<in> X"
  34.262 +  by auto
  34.263  
  34.264 -lemma choicefun_mem_set [simp]: "E \<noteq> {} ==> choicefun E \<in> E"
  34.265 -apply (unfold choicefun_def)
  34.266 -apply (rule lemmaPow3 [THEN someI2_ex], auto)
  34.267 -done
  34.268 +lemma choicefun_mem_set [simp]: "E \<noteq> {} \<Longrightarrow> choicefun E \<in> E"
  34.269 +  apply (unfold choicefun_def)
  34.270 +  apply (rule lemmaPow3 [THEN someI2_ex], auto)
  34.271 +  done
  34.272  
  34.273 -lemma injf_max_mem_set: "[| E \<noteq>{}; \<forall>x. \<exists>y \<in> E. x < y |] ==> injf_max n E \<in> E"
  34.274 -apply (induct_tac "n", force)
  34.275 -apply (simp (no_asm) add: choicefun_def)
  34.276 -apply (rule lemmaPow3 [THEN someI2_ex], auto)
  34.277 -done
  34.278 +lemma injf_max_mem_set: "E \<noteq>{} \<Longrightarrow> \<forall>x. \<exists>y \<in> E. x < y \<Longrightarrow> injf_max n E \<in> E"
  34.279 +  apply (induct n)
  34.280 +   apply force
  34.281 +  apply (simp add: choicefun_def)
  34.282 +  apply (rule lemmaPow3 [THEN someI2_ex], auto)
  34.283 +  done
  34.284  
  34.285 -lemma injf_max_order_preserving: "\<forall>x. \<exists>y \<in> E. x < y ==> injf_max n E < injf_max (Suc n) E"
  34.286 -apply (simp (no_asm) add: choicefun_def)
  34.287 -apply (rule lemmaPow3 [THEN someI2_ex], auto)
  34.288 -done
  34.289 +lemma injf_max_order_preserving: "\<forall>x. \<exists>y \<in> E. x < y \<Longrightarrow> injf_max n E < injf_max (Suc n) E"
  34.290 +  apply (simp add: choicefun_def)
  34.291 +  apply (rule lemmaPow3 [THEN someI2_ex])
  34.292 +   apply auto
  34.293 +  done
  34.294  
  34.295 -lemma injf_max_order_preserving2: "\<forall>x. \<exists>y \<in> E. x < y
  34.296 -      ==> \<forall>n m. m < n --> injf_max m E < injf_max n E"
  34.297 -apply (rule allI)
  34.298 -apply (induct_tac "n", auto)
  34.299 -apply (simp (no_asm) add: choicefun_def)
  34.300 -apply (rule lemmaPow3 [THEN someI2_ex])
  34.301 -apply (auto simp add: less_Suc_eq)
  34.302 -apply (drule_tac x = m in spec)
  34.303 -apply (drule subsetD, auto)
  34.304 -apply (drule_tac x = "injf_max m E" in order_less_trans, auto)
  34.305 -done
  34.306 +lemma injf_max_order_preserving2: "\<forall>x. \<exists>y \<in> E. x < y \<Longrightarrow> \<forall>n m. m < n \<longrightarrow> injf_max m E < injf_max n E"
  34.307 +  apply (rule allI)
  34.308 +  apply (induct_tac n)
  34.309 +   apply auto
  34.310 +  apply (simp add: choicefun_def)
  34.311 +  apply (rule lemmaPow3 [THEN someI2_ex])
  34.312 +   apply (auto simp add: less_Suc_eq)
  34.313 +  apply (drule_tac x = m in spec)
  34.314 +  apply (drule subsetD)
  34.315 +   apply auto
  34.316 +  apply (drule_tac x = "injf_max m E" in order_less_trans)
  34.317 +   apply auto
  34.318 +  done
  34.319  
  34.320 -lemma inj_injf_max: "\<forall>x. \<exists>y \<in> E. x < y ==> inj (%n. injf_max n E)"
  34.321 -apply (rule inj_onI)
  34.322 -apply (rule ccontr, auto)
  34.323 -apply (drule injf_max_order_preserving2)
  34.324 -apply (metis linorder_antisym_conv3 order_less_le)
  34.325 -done
  34.326 +lemma inj_injf_max: "\<forall>x. \<exists>y \<in> E. x < y \<Longrightarrow> inj (\<lambda>n. injf_max n E)"
  34.327 +  apply (rule inj_onI)
  34.328 +  apply (rule ccontr)
  34.329 +  apply auto
  34.330 +  apply (drule injf_max_order_preserving2)
  34.331 +  apply (metis linorder_antisym_conv3 order_less_le)
  34.332 +  done
  34.333  
  34.334  lemma infinite_set_has_order_preserving_inj:
  34.335 -     "[| (E::('a::{order} set)) \<noteq> {}; \<forall>x. \<exists>y \<in> E. x < y |]
  34.336 -      ==> \<exists>f. range f <= E & inj (f::nat => 'a) & (\<forall>m. f m < f(Suc m))"
  34.337 -apply (rule_tac x = "%n. injf_max n E" in exI, safe)
  34.338 -apply (rule injf_max_mem_set)
  34.339 -apply (rule_tac [3] inj_injf_max)
  34.340 -apply (rule_tac [4] injf_max_order_preserving, auto)
  34.341 -done
  34.342 +  "E \<noteq> {} \<Longrightarrow> \<forall>x. \<exists>y \<in> E. x < y \<Longrightarrow> \<exists>f. range f \<subseteq> E \<and> inj f \<and> (\<forall>m. f m < f (Suc m))"
  34.343 +  for E :: "'a::order set" and f :: "nat \<Rightarrow> 'a"
  34.344 +  apply (rule_tac x = "\<lambda>n. injf_max n E" in exI)
  34.345 +  apply safe
  34.346 +    apply (rule injf_max_mem_set)
  34.347 +     apply (rule_tac [3] inj_injf_max)
  34.348 +     apply (rule_tac [4] injf_max_order_preserving)
  34.349 +     apply auto
  34.350 +  done
  34.351  
  34.352 -text\<open>Only need the existence of an injective function from N to A for proof\<close>
  34.353  
  34.354 -lemma hypnat_infinite_has_nonstandard:
  34.355 -     "~ finite A ==> hypnat_of_nat ` A < ( *s* A)"
  34.356 -apply auto
  34.357 -apply (subgoal_tac "A \<noteq> {}")
  34.358 -prefer 2 apply force
  34.359 -apply (drule infinite_set_has_order_preserving_inj)
  34.360 -apply (erule not_finite_nat_set_iff2 [THEN iffD1], auto)
  34.361 -apply (drule inj_fun_not_hypnat_in_SHNat)
  34.362 -apply (drule range_subset_mem_starsetNat)
  34.363 -apply (auto simp add: SHNat_eq)
  34.364 -done
  34.365 +text \<open>Only need the existence of an injective function from \<open>N\<close> to \<open>A\<close> for proof.\<close>
  34.366  
  34.367 -lemma starsetNat_eq_hypnat_of_nat_image_finite: "*s* A =  hypnat_of_nat ` A ==> finite A"
  34.368 -by (metis hypnat_infinite_has_nonstandard less_irrefl)
  34.369 +lemma hypnat_infinite_has_nonstandard: "\<not> finite A \<Longrightarrow> hypnat_of_nat ` A < ( *s* A)"
  34.370 +  apply auto
  34.371 +  apply (subgoal_tac "A \<noteq> {}")
  34.372 +   prefer 2 apply force
  34.373 +  apply (drule infinite_set_has_order_preserving_inj)
  34.374 +   apply (erule not_finite_nat_set_iff2 [THEN iffD1])
  34.375 +  apply auto
  34.376 +  apply (drule inj_fun_not_hypnat_in_SHNat)
  34.377 +  apply (drule range_subset_mem_starsetNat)
  34.378 +  apply (auto simp add: SHNat_eq)
  34.379 +  done
  34.380  
  34.381 -lemma finite_starsetNat_iff: "( *s* A = hypnat_of_nat ` A) = (finite A)"
  34.382 -by (blast intro!: starsetNat_eq_hypnat_of_nat_image_finite NatStar_hypnat_of_nat)
  34.383 +lemma starsetNat_eq_hypnat_of_nat_image_finite: "*s* A =  hypnat_of_nat ` A \<Longrightarrow> finite A"
  34.384 +  by (metis hypnat_infinite_has_nonstandard less_irrefl)
  34.385 +
  34.386 +lemma finite_starsetNat_iff: "*s* A = hypnat_of_nat ` A \<longleftrightarrow> finite A"
  34.387 +  by (blast intro!: starsetNat_eq_hypnat_of_nat_image_finite NatStar_hypnat_of_nat)
  34.388  
  34.389 -lemma hypnat_infinite_has_nonstandard_iff: "(~ finite A) = (hypnat_of_nat ` A < *s* A)"
  34.390 -apply (rule iffI)
  34.391 -apply (blast intro!: hypnat_infinite_has_nonstandard)
  34.392 -apply (auto simp add: finite_starsetNat_iff [symmetric])
  34.393 -done
  34.394 +lemma hypnat_infinite_has_nonstandard_iff: "\<not> finite A \<longleftrightarrow> hypnat_of_nat ` A < *s* A"
  34.395 +  apply (rule iffI)
  34.396 +   apply (blast intro!: hypnat_infinite_has_nonstandard)
  34.397 +  apply (auto simp add: finite_starsetNat_iff [symmetric])
  34.398 +  done
  34.399  
  34.400 -subsection\<open>Existence of Infinitely Many Primes: a Nonstandard Proof\<close>
  34.401  
  34.402 -lemma lemma_not_dvd_hypnat_one [simp]: "~ (\<forall>n \<in> - {0}. hypnat_of_nat n dvd 1)"
  34.403 -apply auto
  34.404 -apply (rule_tac x = 2 in bexI)
  34.405 -apply (transfer, auto)
  34.406 -done
  34.407 +subsection \<open>Existence of Infinitely Many Primes: a Nonstandard Proof\<close>
  34.408  
  34.409 -lemma lemma_not_dvd_hypnat_one2 [simp]: "\<exists>n \<in> - {0}. ~ hypnat_of_nat n dvd 1"
  34.410 -apply (cut_tac lemma_not_dvd_hypnat_one)
  34.411 -apply (auto simp del: lemma_not_dvd_hypnat_one)
  34.412 -done
  34.413 +lemma lemma_not_dvd_hypnat_one [simp]: "\<not> (\<forall>n \<in> - {0}. hypnat_of_nat n dvd 1)"
  34.414 +  apply auto
  34.415 +  apply (rule_tac x = 2 in bexI)
  34.416 +   apply transfer
  34.417 +   apply auto
  34.418 +  done
  34.419  
  34.420 -lemma hypnat_add_one_gt_one:
  34.421 -    "!!N. 0 < N ==> 1 < (N::hypnat) + 1"
  34.422 -by (transfer, simp)
  34.423 +lemma lemma_not_dvd_hypnat_one2 [simp]: "\<exists>n \<in> - {0}. \<not> hypnat_of_nat n dvd 1"
  34.424 +  using lemma_not_dvd_hypnat_one by (auto simp del: lemma_not_dvd_hypnat_one)
  34.425 +
  34.426 +lemma hypnat_add_one_gt_one: "\<And>N::hypnat. 0 < N \<Longrightarrow> 1 < N + 1"
  34.427 +  by transfer simp
  34.428  
  34.429  lemma hypnat_of_nat_zero_not_prime [simp]: "hypnat_of_nat 0 \<notin> starprime"
  34.430 -by (transfer, simp)
  34.431 +  by transfer simp
  34.432  
  34.433 -lemma hypnat_zero_not_prime [simp]:
  34.434 -   "0 \<notin> starprime"
  34.435 -by (cut_tac hypnat_of_nat_zero_not_prime, simp)
  34.436 +lemma hypnat_zero_not_prime [simp]: "0 \<notin> starprime"
  34.437 +  using hypnat_of_nat_zero_not_prime by simp
  34.438  
  34.439  lemma hypnat_of_nat_one_not_prime [simp]: "hypnat_of_nat 1 \<notin> starprime"
  34.440 -by (transfer, simp)
  34.441 +  by transfer simp
  34.442  
  34.443  lemma hypnat_one_not_prime [simp]: "1 \<notin> starprime"
  34.444 -by (cut_tac hypnat_of_nat_one_not_prime, simp)
  34.445 +  using hypnat_of_nat_one_not_prime by simp
  34.446  
  34.447 -lemma hdvd_diff: "!!k m n :: hypnat. [| k dvd m; k dvd n |] ==> k dvd (m - n)"
  34.448 -by (transfer, rule dvd_diff_nat)
  34.449 +lemma hdvd_diff: "\<And>k m n :: hypnat. k dvd m \<Longrightarrow> k dvd n \<Longrightarrow> k dvd (m - n)"
  34.450 +  by transfer (rule dvd_diff_nat)
  34.451  
  34.452 -lemma hdvd_one_eq_one:
  34.453 -  "\<And>x::hypnat. is_unit x \<Longrightarrow> x = 1"
  34.454 +lemma hdvd_one_eq_one: "\<And>x::hypnat. is_unit x \<Longrightarrow> x = 1"
  34.455    by transfer simp
  34.456  
  34.457 -text\<open>Already proved as \<open>primes_infinite\<close>, but now using non-standard naturals.\<close>
  34.458 -theorem not_finite_prime: "~ finite {p::nat. prime p}"
  34.459 -apply (rule hypnat_infinite_has_nonstandard_iff [THEN iffD2])
  34.460 -using hypnat_dvd_all_hypnat_of_nat
  34.461 -apply clarify
  34.462 -apply (drule hypnat_add_one_gt_one)
  34.463 -apply (drule hyperprime_factor_exists)
  34.464 -apply clarify
  34.465 -apply (subgoal_tac "k \<notin> hypnat_of_nat ` {p. prime p}")
  34.466 -apply (force simp add: starprime_def)
  34.467 -  apply (metis Compl_iff add.commute dvd_add_left_iff empty_iff hdvd_one_eq_one hypnat_one_not_prime 
  34.468 -           imageE insert_iff mem_Collect_eq not_prime_0)
  34.469 -done
  34.470 +text \<open>Already proved as \<open>primes_infinite\<close>, but now using non-standard naturals.\<close>
  34.471 +theorem not_finite_prime: "\<not> finite {p::nat. prime p}"
  34.472 +  apply (rule hypnat_infinite_has_nonstandard_iff [THEN iffD2])
  34.473 +  using hypnat_dvd_all_hypnat_of_nat
  34.474 +  apply clarify
  34.475 +  apply (drule hypnat_add_one_gt_one)
  34.476 +  apply (drule hyperprime_factor_exists)
  34.477 +  apply clarify
  34.478 +  apply (subgoal_tac "k \<notin> hypnat_of_nat ` {p. prime p}")
  34.479 +   apply (force simp: starprime_def)
  34.480 +  apply (metis Compl_iff add.commute dvd_add_left_iff empty_iff hdvd_one_eq_one hypnat_one_not_prime
  34.481 +      imageE insert_iff mem_Collect_eq not_prime_0)
  34.482 +  done
  34.483  
  34.484  end
    35.1 --- a/src/HOL/Nonstandard_Analysis/HDeriv.thy	Tue Dec 20 16:17:13 2016 +0100
    35.2 +++ b/src/HOL/Nonstandard_Analysis/HDeriv.thy	Tue Dec 20 16:18:56 2016 +0100
    35.3 @@ -53,7 +53,7 @@
    35.4     apply (drule (1) bspec)+
    35.5     apply (drule (1) approx_trans3)
    35.6     apply simp
    35.7 -  apply (simp add: Infinitesimal_of_hypreal Infinitesimal_epsilon)
    35.8 +  apply (simp add: Infinitesimal_of_hypreal)
    35.9    apply (simp add: of_hypreal_eq_0_iff hypreal_epsilon_not_zero)
   35.10    done
   35.11  
   35.12 @@ -75,7 +75,7 @@
   35.13  text \<open>While we're at it!\<close>
   35.14  lemma NSDERIV_iff2:
   35.15    "(NSDERIV f x :> D) \<longleftrightarrow>
   35.16 -    (\<forall>w. w \<noteq> star_of x & w \<approx> star_of x \<longrightarrow> ( *f* (%z. (f z - f x) / (z-x))) w \<approx> star_of D)"
   35.17 +    (\<forall>w. w \<noteq> star_of x \<and> w \<approx> star_of x \<longrightarrow> ( *f* (\<lambda>z. (f z - f x) / (z - x))) w \<approx> star_of D)"
   35.18    by (simp add: NSDERIV_NSLIM_iff2 NSLIM_def)
   35.19  
   35.20  (* FIXME delete *)
   35.21 @@ -91,7 +91,7 @@
   35.22    apply (drule_tac x = u in spec, auto)
   35.23    apply (drule_tac c = "u - hypreal_of_real x" and b = "hypreal_of_real D" in approx_mult1)
   35.24     apply (drule_tac [!] hypreal_not_eq_minus_iff [THEN iffD1])
   35.25 -   apply (subgoal_tac [2] "( *f* (%z. z-x)) u \<noteq> (0::hypreal) ")
   35.26 +   apply (subgoal_tac [2] "( *f* (\<lambda>z. z - x)) u \<noteq> (0::hypreal) ")
   35.27      apply (auto simp: approx_minus_iff [THEN iffD1, THEN mem_infmal_iff [THEN iffD2]]
   35.28        Infinitesimal_subset_HFinite [THEN subsetD])
   35.29    done
   35.30 @@ -290,7 +290,8 @@
   35.31    apply (case_tac "( *f* g) (star_of (x) + xa) = star_of (g x) ")
   35.32     apply (drule_tac g = g in NSDERIV_zero)
   35.33        apply (auto simp add: divide_inverse)
   35.34 -  apply (rule_tac z1 = "( *f* g) (star_of (x) + xa) - star_of (g x) " and y1 = "inverse xa" in lemma_chain [THEN ssubst])
   35.35 +  apply (rule_tac z1 = "( *f* g) (star_of (x) + xa) - star_of (g x) " and y1 = "inverse xa"
   35.36 +      in lemma_chain [THEN ssubst])
   35.37     apply (erule hypreal_not_eq_minus_iff [THEN iffD1])
   35.38    apply (rule approx_mult_star_of)
   35.39     apply (simp_all add: divide_inverse [symmetric])
    36.1 --- a/src/HOL/Nonstandard_Analysis/HLim.thy	Tue Dec 20 16:17:13 2016 +0100
    36.2 +++ b/src/HOL/Nonstandard_Analysis/HLim.thy	Tue Dec 20 16:18:56 2016 +0100
    36.3 @@ -77,7 +77,7 @@
    36.4  qed
    36.5  
    36.6  lemma NSLIM_zero_cancel: "(\<lambda>x. f x - l) \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S 0 \<Longrightarrow> f \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S l"
    36.7 -  apply (drule_tac g = "%x. l" and m = l in NSLIM_add)
    36.8 +  apply (drule_tac g = "\<lambda>x. l" and m = l in NSLIM_add)
    36.9     apply (auto simp add: add.assoc)
   36.10    done
   36.11  
   36.12 @@ -205,8 +205,8 @@
   36.13  lemma isCont_isNSCont: "isCont f a \<Longrightarrow> isNSCont f a"
   36.14    by (erule isNSCont_isCont_iff [THEN iffD2])
   36.15  
   36.16 -text \<open>NS continuity \<open>==>\<close> Standard continuity.\<close>
   36.17 -lemma isNSCont_isCont: "isNSCont f a ==> isCont f a"
   36.18 +text \<open>NS continuity \<open>\<Longrightarrow>\<close> Standard continuity.\<close>
   36.19 +lemma isNSCont_isCont: "isNSCont f a \<Longrightarrow> isCont f a"
   36.20    by (erule isNSCont_isCont_iff [THEN iffD1])
   36.21  
   36.22  
    37.1 --- a/src/HOL/Nonstandard_Analysis/HLog.thy	Tue Dec 20 16:17:13 2016 +0100
    37.2 +++ b/src/HOL/Nonstandard_Analysis/HLog.thy	Tue Dec 20 16:18:56 2016 +0100
    37.3 @@ -3,154 +3,134 @@
    37.4      Copyright:  2000, 2001 University of Edinburgh
    37.5  *)
    37.6  
    37.7 -section\<open>Logarithms: Non-Standard Version\<close>
    37.8 +section \<open>Logarithms: Non-Standard Version\<close>
    37.9  
   37.10  theory HLog
   37.11 -imports HTranscendental
   37.12 +  imports HTranscendental
   37.13  begin
   37.14  
   37.15  
   37.16  (* should be in NSA.ML *)
   37.17  lemma epsilon_ge_zero [simp]: "0 \<le> \<epsilon>"
   37.18 -by (simp add: epsilon_def star_n_zero_num star_n_le)
   37.19 +  by (simp add: epsilon_def star_n_zero_num star_n_le)
   37.20  
   37.21 -lemma hpfinite_witness: "\<epsilon> : {x. 0 \<le> x & x : HFinite}"
   37.22 -by auto
   37.23 +lemma hpfinite_witness: "\<epsilon> \<in> {x. 0 \<le> x \<and> x \<in> HFinite}"
   37.24 +  by auto
   37.25  
   37.26  
   37.27 -definition
   37.28 -  powhr  :: "[hypreal,hypreal] => hypreal"     (infixr "powhr" 80) where
   37.29 -  [transfer_unfold]: "x powhr a = starfun2 (op powr) x a"
   37.30 -  
   37.31 -definition
   37.32 -  hlog :: "[hypreal,hypreal] => hypreal" where
   37.33 -  [transfer_unfold]: "hlog a x = starfun2 log a x"
   37.34 +definition powhr :: "hypreal \<Rightarrow> hypreal \<Rightarrow> hypreal"  (infixr "powhr" 80)
   37.35 +  where [transfer_unfold]: "x powhr a = starfun2 (op powr) x a"
   37.36 +
   37.37 +definition hlog :: "hypreal \<Rightarrow> hypreal \<Rightarrow> hypreal"
   37.38 +  where [transfer_unfold]: "hlog a x = starfun2 log a x"
   37.39 +
   37.40 +lemma powhr: "(star_n X) powhr (star_n Y) = star_n (\<lambda>n. (X n) powr (Y n))"
   37.41 +  by (simp add: powhr_def starfun2_star_n)
   37.42  
   37.43 -lemma powhr: "(star_n X) powhr (star_n Y) = star_n (%n. (X n) powr (Y n))"
   37.44 -by (simp add: powhr_def starfun2_star_n)
   37.45 -
   37.46 -lemma powhr_one_eq_one [simp]: "!!a. 1 powhr a = 1"
   37.47 -by (transfer, simp)
   37.48 +lemma powhr_one_eq_one [simp]: "\<And>a. 1 powhr a = 1"
   37.49 +  by transfer simp
   37.50  
   37.51 -lemma powhr_mult:
   37.52 -  "!!a x y. [| 0 < x; 0 < y |] ==> (x * y) powhr a = (x powhr a) * (y powhr a)"
   37.53 -by (transfer, simp add: powr_mult)
   37.54 +lemma powhr_mult: "\<And>a x y. 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x * y) powhr a = (x powhr a) * (y powhr a)"
   37.55 +  by transfer (simp add: powr_mult)
   37.56  
   37.57 -lemma powhr_gt_zero [simp]: "!!a x. 0 < x powhr a \<longleftrightarrow> x \<noteq> 0"
   37.58 -by (transfer, simp)
   37.59 +lemma powhr_gt_zero [simp]: "\<And>a x. 0 < x powhr a \<longleftrightarrow> x \<noteq> 0"
   37.60 +  by transfer simp
   37.61  
   37.62  lemma powhr_not_zero [simp]: "\<And>a x. x powhr a \<noteq> 0 \<longleftrightarrow> x \<noteq> 0"
   37.63 -by transfer simp
   37.64 -
   37.65 -lemma powhr_divide:
   37.66 -  "!!a x y. [| 0 < x; 0 < y |] ==> (x / y) powhr a = (x powhr a)/(y powhr a)"
   37.67 -by (transfer, rule powr_divide)
   37.68 +  by transfer simp
   37.69  
   37.70 -lemma powhr_add: "!!a b x. x powhr (a + b) = (x powhr a) * (x powhr b)"
   37.71 -by (transfer, rule powr_add)
   37.72 +lemma powhr_divide: "\<And>a x y. 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x / y) powhr a = (x powhr a) / (y powhr a)"
   37.73 +  by transfer (rule powr_divide)
   37.74  
   37.75 -lemma powhr_powhr: "!!a b x. (x powhr a) powhr b = x powhr (a * b)"
   37.76 -by (transfer, rule powr_powr)
   37.77 +lemma powhr_add: "\<And>a b x. x powhr (a + b) = (x powhr a) * (x powhr b)"
   37.78 +  by transfer (rule powr_add)
   37.79  
   37.80 -lemma powhr_powhr_swap: "!!a b x. (x powhr a) powhr b = (x powhr b) powhr a"
   37.81 -by (transfer, rule powr_powr_swap)
   37.82 +lemma powhr_powhr: "\<And>a b x. (x powhr a) powhr b = x powhr (a * b)"
   37.83 +  by transfer (rule powr_powr)
   37.84  
   37.85 -lemma powhr_minus: "!!a x. x powhr (-a) = inverse (x powhr a)"
   37.86 -by (transfer, rule powr_minus)
   37.87 +lemma powhr_powhr_swap: "\<And>a b x. (x powhr a) powhr b = (x powhr b) powhr a"
   37.88 +  by transfer (rule powr_powr_swap)
   37.89  
   37.90 -lemma powhr_minus_divide: "x powhr (-a) = 1/(x powhr a)"
   37.91 -by (simp add: divide_inverse powhr_minus)
   37.92 +lemma powhr_minus: "\<And>a x. x powhr (- a) = inverse (x powhr a)"
   37.93 +  by transfer (rule powr_minus)
   37.94  
   37.95 -lemma powhr_less_mono: "!!a b x. [| a < b; 1 < x |] ==> x powhr a < x powhr b"
   37.96 -by (transfer, simp)
   37.97 +lemma powhr_minus_divide: "x powhr (- a) = 1 / (x powhr a)"
   37.98 +  by (simp add: divide_inverse powhr_minus)
   37.99  
  37.100 -lemma powhr_less_cancel: "!!a b x. [| x powhr a < x powhr b; 1 < x |] ==> a < b"
  37.101 -by (transfer, simp)
  37.102 +lemma powhr_less_mono: "\<And>a b x. a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powhr a < x powhr b"
  37.103 +  by transfer simp
  37.104 +
  37.105 +lemma powhr_less_cancel: "\<And>a b x. x powhr a < x powhr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
  37.106 +  by transfer simp
  37.107  
  37.108 -lemma powhr_less_cancel_iff [simp]:
  37.109 -     "1 < x ==> (x powhr a < x powhr b) = (a < b)"
  37.110 -by (blast intro: powhr_less_cancel powhr_less_mono)
  37.111 +lemma powhr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> x powhr a < x powhr b \<longleftrightarrow> a < b"
  37.112 +  by (blast intro: powhr_less_cancel powhr_less_mono)
  37.113  
  37.114 -lemma powhr_le_cancel_iff [simp]:
  37.115 -     "1 < x ==> (x powhr a \<le> x powhr b) = (a \<le> b)"
  37.116 -by (simp add: linorder_not_less [symmetric])
  37.117 +lemma powhr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> x powhr a \<le> x powhr b \<longleftrightarrow> a \<le> b"
  37.118 +  by (simp add: linorder_not_less [symmetric])
  37.119  
  37.120 -lemma hlog:
  37.121 -     "hlog (star_n X) (star_n Y) =  
  37.122 -      star_n (%n. log (X n) (Y n))"
  37.123 -by (simp add: hlog_def starfun2_star_n)
  37.124 +lemma hlog: "hlog (star_n X) (star_n Y) = star_n (\<lambda>n. log (X n) (Y n))"
  37.125 +  by (simp add: hlog_def starfun2_star_n)
  37.126  
  37.127 -lemma hlog_starfun_ln: "!!x. ( *f* ln) x = hlog (( *f* exp) 1) x"
  37.128 -by (transfer, rule log_ln)
  37.129 +lemma hlog_starfun_ln: "\<And>x. ( *f* ln) x = hlog (( *f* exp) 1) x"
  37.130 +  by transfer (rule log_ln)
  37.131  
  37.132 -lemma powhr_hlog_cancel [simp]:
  37.133 -     "!!a x. [| 0 < a; a \<noteq> 1; 0 < x |] ==> a powhr (hlog a x) = x"
  37.134 -by (transfer, simp)
  37.135 +lemma powhr_hlog_cancel [simp]: "\<And>a x. 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powhr (hlog a x) = x"
  37.136 +  by transfer simp
  37.137  
  37.138 -lemma hlog_powhr_cancel [simp]:
  37.139 -     "!!a y. [| 0 < a; a \<noteq> 1 |] ==> hlog a (a powhr y) = y"
  37.140 -by (transfer, simp)
  37.141 +lemma hlog_powhr_cancel [simp]: "\<And>a y. 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> hlog a (a powhr y) = y"
  37.142 +  by transfer simp
  37.143  
  37.144  lemma hlog_mult:
  37.145 -     "!!a x y. [| 0 < a; a \<noteq> 1; 0 < x; 0 < y  |]  
  37.146 -      ==> hlog a (x * y) = hlog a x + hlog a y"
  37.147 -by (transfer, rule log_mult)
  37.148 +  "\<And>a x y. 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> hlog a (x * y) = hlog a x + hlog a y"
  37.149 +  by transfer (rule log_mult)
  37.150  
  37.151 -lemma hlog_as_starfun:
  37.152 -     "!!a x. [| 0 < a; a \<noteq> 1 |] ==> hlog a x = ( *f* ln) x / ( *f* ln) a"
  37.153 -by (transfer, simp add: log_def)
  37.154 +lemma hlog_as_starfun: "\<And>a x. 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> hlog a x = ( *f* ln) x / ( *f* ln) a"
  37.155 +  by transfer (simp add: log_def)
  37.156  
  37.157  lemma hlog_eq_div_starfun_ln_mult_hlog:
  37.158 -     "!!a b x. [| 0 < a; a \<noteq> 1; 0 < b; b \<noteq> 1; 0 < x |]  
  37.159 -      ==> hlog a x = (( *f* ln) b/( *f*ln) a) * hlog b x"
  37.160 -by (transfer, rule log_eq_div_ln_mult_log)
  37.161 +  "\<And>a b x. 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
  37.162 +    hlog a x = (( *f* ln) b / ( *f* ln) a) * hlog b x"
  37.163 +  by transfer (rule log_eq_div_ln_mult_log)
  37.164  
  37.165 -lemma powhr_as_starfun: "!!a x. x powhr a = (if x=0 then 0 else ( *f* exp) (a * ( *f* real_ln) x))"
  37.166 -  by (transfer, simp add: powr_def)
  37.167 +lemma powhr_as_starfun: "\<And>a x. x powhr a = (if x = 0 then 0 else ( *f* exp) (a * ( *f* real_ln) x))"
  37.168 +  by transfer (simp add: powr_def)
  37.169  
  37.170  lemma HInfinite_powhr:
  37.171 -     "[| x : HInfinite; 0 < x; a : HFinite - Infinitesimal;  
  37.172 -         0 < a |] ==> x powhr a : HInfinite"
  37.173 -apply (auto intro!: starfun_ln_ge_zero starfun_ln_HInfinite HInfinite_HFinite_not_Infinitesimal_mult2 starfun_exp_HInfinite 
  37.174 -       simp add: order_less_imp_le HInfinite_gt_zero_gt_one powhr_as_starfun zero_le_mult_iff)
  37.175 -done
  37.176 +  "x \<in> HInfinite \<Longrightarrow> 0 < x \<Longrightarrow> a \<in> HFinite - Infinitesimal \<Longrightarrow> 0 < a \<Longrightarrow> x powhr a \<in> HInfinite"
  37.177 +  by (auto intro!: starfun_ln_ge_zero starfun_ln_HInfinite
  37.178 +        HInfinite_HFinite_not_Infinitesimal_mult2 starfun_exp_HInfinite
  37.179 +      simp add: order_less_imp_le HInfinite_gt_zero_gt_one powhr_as_starfun zero_le_mult_iff)
  37.180  
  37.181  lemma hlog_hrabs_HInfinite_Infinitesimal:
  37.182 -     "[| x : HFinite - Infinitesimal; a : HInfinite; 0 < a |]  
  37.183 -      ==> hlog a \<bar>x\<bar> : Infinitesimal"
  37.184 -apply (frule HInfinite_gt_zero_gt_one)
  37.185 -apply (auto intro!: starfun_ln_HFinite_not_Infinitesimal
  37.186 -            HInfinite_inverse_Infinitesimal Infinitesimal_HFinite_mult2 
  37.187 -        simp add: starfun_ln_HInfinite not_Infinitesimal_not_zero 
  37.188 -          hlog_as_starfun divide_inverse)
  37.189 -done
  37.190 +  "x \<in> HFinite - Infinitesimal \<Longrightarrow> a \<in> HInfinite \<Longrightarrow> 0 < a \<Longrightarrow> hlog a \<bar>x\<bar> \<in> Infinitesimal"
  37.191 +  apply (frule HInfinite_gt_zero_gt_one)
  37.192 +   apply (auto intro!: starfun_ln_HFinite_not_Infinitesimal
  37.193 +      HInfinite_inverse_Infinitesimal Infinitesimal_HFinite_mult2
  37.194 +      simp add: starfun_ln_HInfinite not_Infinitesimal_not_zero
  37.195 +      hlog_as_starfun divide_inverse)
  37.196 +  done
  37.197  
  37.198 -lemma hlog_HInfinite_as_starfun:
  37.199 -     "[| a : HInfinite; 0 < a |] ==> hlog a x = ( *f* ln) x / ( *f* ln) a"
  37.200 -by (rule hlog_as_starfun, auto)
  37.201 +lemma hlog_HInfinite_as_starfun: "a \<in> HInfinite \<Longrightarrow> 0 < a \<Longrightarrow> hlog a x = ( *f* ln) x / ( *f* ln) a"
  37.202 +  by (rule hlog_as_starfun) auto
  37.203  
  37.204 -lemma hlog_one [simp]: "!!a. hlog a 1 = 0"
  37.205 -by (transfer, simp)
  37.206 +lemma hlog_one [simp]: "\<And>a. hlog a 1 = 0"
  37.207 +  by transfer simp
  37.208  
  37.209 -lemma hlog_eq_one [simp]: "!!a. [| 0 < a; a \<noteq> 1 |] ==> hlog a a = 1"
  37.210 -by (transfer, rule log_eq_one)
  37.211 +lemma hlog_eq_one [simp]: "\<And>a. 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> hlog a a = 1"
  37.212 +  by transfer (rule log_eq_one)
  37.213  
  37.214 -lemma hlog_inverse:
  37.215 -     "[| 0 < a; a \<noteq> 1; 0 < x |] ==> hlog a (inverse x) = - hlog a x"
  37.216 -apply (rule add_left_cancel [of "hlog a x", THEN iffD1])
  37.217 -apply (simp add: hlog_mult [symmetric])
  37.218 -done
  37.219 +lemma hlog_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> hlog a (inverse x) = - hlog a x"
  37.220 +  by (rule add_left_cancel [of "hlog a x", THEN iffD1]) (simp add: hlog_mult [symmetric])
  37.221  
  37.222 -lemma hlog_divide:
  37.223 -     "[| 0 < a; a \<noteq> 1; 0 < x; 0 < y|] ==> hlog a (x/y) = hlog a x - hlog a y"
  37.224 -by (simp add: hlog_mult hlog_inverse divide_inverse)
  37.225 +lemma hlog_divide: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> hlog a (x / y) = hlog a x - hlog a y"
  37.226 +  by (simp add: hlog_mult hlog_inverse divide_inverse)
  37.227  
  37.228  lemma hlog_less_cancel_iff [simp]:
  37.229 -     "!!a x y. [| 1 < a; 0 < x; 0 < y |] ==> (hlog a x < hlog a y) = (x < y)"
  37.230 -by (transfer, simp)
  37.231 +  "\<And>a x y. 1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> hlog a x < hlog a y \<longleftrightarrow> x < y"
  37.232 +  by transfer simp
  37.233  
  37.234 -lemma hlog_le_cancel_iff [simp]:
  37.235 -     "[| 1 < a; 0 < x; 0 < y |] ==> (hlog a x \<le> hlog a y) = (x \<le> y)"
  37.236 -by (simp add: linorder_not_less [symmetric])
  37.237 +lemma hlog_le_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> hlog a x \<le> hlog a y \<longleftrightarrow> x \<le> y"
  37.238 +  by (simp add: linorder_not_less [symmetric])
  37.239  
  37.240  end
    38.1 --- a/src/HOL/Nonstandard_Analysis/HSEQ.thy	Tue Dec 20 16:17:13 2016 +0100
    38.2 +++ b/src/HOL/Nonstandard_Analysis/HSEQ.thy	Tue Dec 20 16:18:56 2016 +0100
    38.3 @@ -15,434 +15,431 @@
    38.4    abbrevs "--->" = "\<longlonglongrightarrow>\<^sub>N\<^sub>S"
    38.5  begin
    38.6  
    38.7 -definition
    38.8 -  NSLIMSEQ :: "[nat => 'a::real_normed_vector, 'a] => bool"
    38.9 +definition NSLIMSEQ :: "(nat \<Rightarrow> 'a::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> bool"
   38.10      ("((_)/ \<longlonglongrightarrow>\<^sub>N\<^sub>S (_))" [60, 60] 60) where
   38.11      \<comment>\<open>Nonstandard definition of convergence of sequence\<close>
   38.12 -  "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L = (\<forall>N \<in> HNatInfinite. ( *f* X) N \<approx> star_of L)"
   38.13 +  "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L \<longleftrightarrow> (\<forall>N \<in> HNatInfinite. ( *f* X) N \<approx> star_of L)"
   38.14  
   38.15 -definition
   38.16 -  nslim :: "(nat => 'a::real_normed_vector) => 'a" where
   38.17 -    \<comment>\<open>Nonstandard definition of limit using choice operator\<close>
   38.18 -  "nslim X = (THE L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
   38.19 +definition nslim :: "(nat \<Rightarrow> 'a::real_normed_vector) \<Rightarrow> 'a"
   38.20 +  where "nslim X = (THE L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
   38.21 +  \<comment> \<open>Nonstandard definition of limit using choice operator\<close>
   38.22 +
   38.23  
   38.24 -definition
   38.25 -  NSconvergent :: "(nat => 'a::real_normed_vector) => bool" where
   38.26 -    \<comment>\<open>Nonstandard definition of convergence\<close>
   38.27 -  "NSconvergent X = (\<exists>L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
   38.28 +definition NSconvergent :: "(nat \<Rightarrow> 'a::real_normed_vector) \<Rightarrow> bool"
   38.29 +  where "NSconvergent X \<longleftrightarrow> (\<exists>L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
   38.30 +  \<comment> \<open>Nonstandard definition of convergence\<close>
   38.31  
   38.32 -definition
   38.33 -  NSBseq :: "(nat => 'a::real_normed_vector) => bool" where
   38.34 -    \<comment>\<open>Nonstandard definition for bounded sequence\<close>
   38.35 -  "NSBseq X = (\<forall>N \<in> HNatInfinite. ( *f* X) N : HFinite)"
   38.36 +definition NSBseq :: "(nat \<Rightarrow> 'a::real_normed_vector) \<Rightarrow> bool"
   38.37 +  where "NSBseq X \<longleftrightarrow> (\<forall>N \<in> HNatInfinite. ( *f* X) N \<in> HFinite)"
   38.38 +  \<comment> \<open>Nonstandard definition for bounded sequence\<close>
   38.39 +
   38.40  
   38.41 -definition
   38.42 -  NSCauchy :: "(nat => 'a::real_normed_vector) => bool" where
   38.43 -    \<comment>\<open>Nonstandard definition\<close>
   38.44 -  "NSCauchy X = (\<forall>M \<in> HNatInfinite. \<forall>N \<in> HNatInfinite. ( *f* X) M \<approx> ( *f* X) N)"
   38.45 +definition NSCauchy :: "(nat \<Rightarrow> 'a::real_normed_vector) \<Rightarrow> bool"
   38.46 +  where "NSCauchy X \<longleftrightarrow> (\<forall>M \<in> HNatInfinite. \<forall>N \<in> HNatInfinite. ( *f* X) M \<approx> ( *f* X) N)"
   38.47 +  \<comment> \<open>Nonstandard definition\<close>
   38.48 +
   38.49  
   38.50  subsection \<open>Limits of Sequences\<close>
   38.51  
   38.52 -lemma NSLIMSEQ_iff:
   38.53 -    "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S L) = (\<forall>N \<in> HNatInfinite. ( *f* X) N \<approx> star_of L)"
   38.54 -by (simp add: NSLIMSEQ_def)
   38.55 +lemma NSLIMSEQ_iff: "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S L) \<longleftrightarrow> (\<forall>N \<in> HNatInfinite. ( *f* X) N \<approx> star_of L)"
   38.56 +  by (simp add: NSLIMSEQ_def)
   38.57 +
   38.58 +lemma NSLIMSEQ_I: "(\<And>N. N \<in> HNatInfinite \<Longrightarrow> starfun X N \<approx> star_of L) \<Longrightarrow> X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
   38.59 +  by (simp add: NSLIMSEQ_def)
   38.60  
   38.61 -lemma NSLIMSEQ_I:
   38.62 -  "(\<And>N. N \<in> HNatInfinite \<Longrightarrow> starfun X N \<approx> star_of L) \<Longrightarrow> X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
   38.63 -by (simp add: NSLIMSEQ_def)
   38.64 +lemma NSLIMSEQ_D: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L \<Longrightarrow> N \<in> HNatInfinite \<Longrightarrow> starfun X N \<approx> star_of L"
   38.65 +  by (simp add: NSLIMSEQ_def)
   38.66  
   38.67 -lemma NSLIMSEQ_D:
   38.68 -  "\<lbrakk>X \<longlonglongrightarrow>\<^sub>N\<^sub>S L; N \<in> HNatInfinite\<rbrakk> \<Longrightarrow> starfun X N \<approx> star_of L"
   38.69 -by (simp add: NSLIMSEQ_def)
   38.70 +lemma NSLIMSEQ_const: "(\<lambda>n. k) \<longlonglongrightarrow>\<^sub>N\<^sub>S k"
   38.71 +  by (simp add: NSLIMSEQ_def)
   38.72  
   38.73 -lemma NSLIMSEQ_const: "(%n. k) \<longlonglongrightarrow>\<^sub>N\<^sub>S k"
   38.74 -by (simp add: NSLIMSEQ_def)
   38.75 +lemma NSLIMSEQ_add: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b \<Longrightarrow> (\<lambda>n. X n + Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + b"
   38.76 +  by (auto intro: approx_add simp add: NSLIMSEQ_def)
   38.77  
   38.78 -lemma NSLIMSEQ_add:
   38.79 -      "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n + Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + b"
   38.80 -by (auto intro: approx_add simp add: NSLIMSEQ_def starfun_add [symmetric])
   38.81 +lemma NSLIMSEQ_add_const: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> (\<lambda>n. f n + b) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + b"
   38.82 +  by (simp only: NSLIMSEQ_add NSLIMSEQ_const)
   38.83  
   38.84 -lemma NSLIMSEQ_add_const: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S a ==> (%n.(f n + b)) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + b"
   38.85 -by (simp only: NSLIMSEQ_add NSLIMSEQ_const)
   38.86 +lemma NSLIMSEQ_mult: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b \<Longrightarrow> (\<lambda>n. X n * Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a * b"
   38.87 +  for a b :: "'a::real_normed_algebra"
   38.88 +  by (auto intro!: approx_mult_HFinite simp add: NSLIMSEQ_def)
   38.89  
   38.90 -lemma NSLIMSEQ_mult:
   38.91 -  fixes a b :: "'a::real_normed_algebra"
   38.92 -  shows "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n * Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a * b"
   38.93 -by (auto intro!: approx_mult_HFinite simp add: NSLIMSEQ_def)
   38.94 +lemma NSLIMSEQ_minus: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> (\<lambda>n. - X n) \<longlonglongrightarrow>\<^sub>N\<^sub>S - a"
   38.95 +  by (auto simp add: NSLIMSEQ_def)
   38.96  
   38.97 -lemma NSLIMSEQ_minus: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a ==> (%n. -(X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S -a"
   38.98 -by (auto simp add: NSLIMSEQ_def)
   38.99 +lemma NSLIMSEQ_minus_cancel: "(\<lambda>n. - X n) \<longlonglongrightarrow>\<^sub>N\<^sub>S -a \<Longrightarrow> X \<longlonglongrightarrow>\<^sub>N\<^sub>S a"
  38.100 +  by (drule NSLIMSEQ_minus) simp
  38.101  
  38.102 -lemma NSLIMSEQ_minus_cancel: "(%n. -(X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S -a ==> X \<longlonglongrightarrow>\<^sub>N\<^sub>S a"
  38.103 -by (drule NSLIMSEQ_minus, simp)
  38.104 -
  38.105 -lemma NSLIMSEQ_diff:
  38.106 -     "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n - Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a - b"
  38.107 +lemma NSLIMSEQ_diff: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b \<Longrightarrow> (\<lambda>n. X n - Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a - b"
  38.108    using NSLIMSEQ_add [of X a "- Y" "- b"] by (simp add: NSLIMSEQ_minus fun_Compl_def)
  38.109  
  38.110  (* FIXME: delete *)
  38.111 -lemma NSLIMSEQ_add_minus:
  38.112 -     "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n + -Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + -b"
  38.113 +lemma NSLIMSEQ_add_minus: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b \<Longrightarrow> (\<lambda>n. X n + - Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + - b"
  38.114    by (simp add: NSLIMSEQ_diff)
  38.115  
  38.116 -lemma NSLIMSEQ_diff_const: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S a ==> (%n.(f n - b)) \<longlonglongrightarrow>\<^sub>N\<^sub>S a - b"
  38.117 -by (simp add: NSLIMSEQ_diff NSLIMSEQ_const)
  38.118 +lemma NSLIMSEQ_diff_const: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> (\<lambda>n. f n - b) \<longlonglongrightarrow>\<^sub>N\<^sub>S a - b"
  38.119 +  by (simp add: NSLIMSEQ_diff NSLIMSEQ_const)
  38.120  
  38.121 -lemma NSLIMSEQ_inverse:
  38.122 -  fixes a :: "'a::real_normed_div_algebra"
  38.123 -  shows "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a;  a ~= 0 |] ==> (%n. inverse(X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S inverse(a)"
  38.124 -by (simp add: NSLIMSEQ_def star_of_approx_inverse)
  38.125 +lemma NSLIMSEQ_inverse: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (\<lambda>n. inverse (X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S inverse a"
  38.126 +  for a :: "'a::real_normed_div_algebra"
  38.127 +  by (simp add: NSLIMSEQ_def star_of_approx_inverse)
  38.128  
  38.129 -lemma NSLIMSEQ_mult_inverse:
  38.130 -  fixes a b :: "'a::real_normed_field"
  38.131 -  shows
  38.132 -     "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a;  Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b;  b ~= 0 |] ==> (%n. X n / Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a/b"
  38.133 -by (simp add: NSLIMSEQ_mult NSLIMSEQ_inverse divide_inverse)
  38.134 +lemma NSLIMSEQ_mult_inverse: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> (\<lambda>n. X n / Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a / b"
  38.135 +  for a b :: "'a::real_normed_field"
  38.136 +  by (simp add: NSLIMSEQ_mult NSLIMSEQ_inverse divide_inverse)
  38.137  
  38.138  lemma starfun_hnorm: "\<And>x. hnorm (( *f* f) x) = ( *f* (\<lambda>x. norm (f x))) x"
  38.139 -by transfer simp
  38.140 +  by transfer simp
  38.141  
  38.142  lemma NSLIMSEQ_norm: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> (\<lambda>n. norm (X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S norm a"
  38.143 -by (simp add: NSLIMSEQ_def starfun_hnorm [symmetric] approx_hnorm)
  38.144 -
  38.145 -text\<open>Uniqueness of limit\<close>
  38.146 -lemma NSLIMSEQ_unique: "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; X \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> a = b"
  38.147 -apply (simp add: NSLIMSEQ_def)
  38.148 -apply (drule HNatInfinite_whn [THEN [2] bspec])+
  38.149 -apply (auto dest: approx_trans3)
  38.150 -done
  38.151 +  by (simp add: NSLIMSEQ_def starfun_hnorm [symmetric] approx_hnorm)
  38.152  
  38.153 -lemma NSLIMSEQ_pow [rule_format]:
  38.154 -  fixes a :: "'a::{real_normed_algebra,power}"
  38.155 -  shows "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S a) --> ((%n. (X n) ^ m) \<longlonglongrightarrow>\<^sub>N\<^sub>S a ^ m)"
  38.156 -apply (induct "m")
  38.157 -apply (auto simp add: power_Suc intro: NSLIMSEQ_mult NSLIMSEQ_const)
  38.158 -done
  38.159 +text \<open>Uniqueness of limit.\<close>
  38.160 +lemma NSLIMSEQ_unique: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> X \<longlonglongrightarrow>\<^sub>N\<^sub>S b \<Longrightarrow> a = b"
  38.161 +  apply (simp add: NSLIMSEQ_def)
  38.162 +  apply (drule HNatInfinite_whn [THEN [2] bspec])+
  38.163 +  apply (auto dest: approx_trans3)
  38.164 +  done
  38.165  
  38.166 -text\<open>We can now try and derive a few properties of sequences,
  38.167 -     starting with the limit comparison property for sequences.\<close>
  38.168 +lemma NSLIMSEQ_pow [rule_format]: "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S a) \<longrightarrow> ((\<lambda>n. (X n) ^ m) \<longlonglongrightarrow>\<^sub>N\<^sub>S a ^ m)"
  38.169 +  for a :: "'a::{real_normed_algebra,power}"
  38.170 +  by (induct m) (auto intro: NSLIMSEQ_mult NSLIMSEQ_const)
  38.171 +
  38.172 +text \<open>We can now try and derive a few properties of sequences,
  38.173 +  starting with the limit comparison property for sequences.\<close>
  38.174  
  38.175 -lemma NSLIMSEQ_le:
  38.176 -       "[| f \<longlonglongrightarrow>\<^sub>N\<^sub>S l; g \<longlonglongrightarrow>\<^sub>N\<^sub>S m;
  38.177 -           \<exists>N. \<forall>n \<ge> N. f(n) \<le> g(n)
  38.178 -        |] ==> l \<le> (m::real)"
  38.179 -apply (simp add: NSLIMSEQ_def, safe)
  38.180 -apply (drule starfun_le_mono)
  38.181 -apply (drule HNatInfinite_whn [THEN [2] bspec])+
  38.182 -apply (drule_tac x = whn in spec)
  38.183 -apply (drule bex_Infinitesimal_iff2 [THEN iffD2])+
  38.184 -apply clarify
  38.185 -apply (auto intro: hypreal_of_real_le_add_Infininitesimal_cancel2)
  38.186 -done
  38.187 +lemma NSLIMSEQ_le: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S l \<Longrightarrow> g \<longlonglongrightarrow>\<^sub>N\<^sub>S m \<Longrightarrow> \<exists>N. \<forall>n \<ge> N. f n \<le> g n \<Longrightarrow> l \<le> m"
  38.188 +  for l m :: real
  38.189 +  apply (simp add: NSLIMSEQ_def, safe)
  38.190 +  apply (drule starfun_le_mono)
  38.191 +  apply (drule HNatInfinite_whn [THEN [2] bspec])+
  38.192 +  apply (drule_tac x = whn in spec)
  38.193 +  apply (drule bex_Infinitesimal_iff2 [THEN iffD2])+
  38.194 +  apply clarify
  38.195 +  apply (auto intro: hypreal_of_real_le_add_Infininitesimal_cancel2)
  38.196 +  done
  38.197  
  38.198 -lemma NSLIMSEQ_le_const: "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S (r::real); \<forall>n. a \<le> X n |] ==> a \<le> r"
  38.199 -by (erule NSLIMSEQ_le [OF NSLIMSEQ_const], auto)
  38.200 +lemma NSLIMSEQ_le_const: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S r \<Longrightarrow> \<forall>n. a \<le> X n \<Longrightarrow> a \<le> r"
  38.201 +  for a r :: real
  38.202 +  by (erule NSLIMSEQ_le [OF NSLIMSEQ_const]) auto
  38.203  
  38.204 -lemma NSLIMSEQ_le_const2: "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S (r::real); \<forall>n. X n \<le> a |] ==> r \<le> a"
  38.205 -by (erule NSLIMSEQ_le [OF _ NSLIMSEQ_const], auto)
  38.206 +lemma NSLIMSEQ_le_const2: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S r \<Longrightarrow> \<forall>n. X n \<le> a \<Longrightarrow> r \<le> a"
  38.207 +  for a r :: real
  38.208 +  by (erule NSLIMSEQ_le [OF _ NSLIMSEQ_const]) auto
  38.209  
  38.210 -text\<open>Shift a convergent series by 1:
  38.211 +text \<open>Shift a convergent series by 1:
  38.212    By the equivalence between Cauchiness and convergence and because
  38.213    the successor of an infinite hypernatural is also infinite.\<close>
  38.214  
  38.215 -lemma NSLIMSEQ_Suc: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S l ==> (%n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l"
  38.216 -apply (unfold NSLIMSEQ_def, safe)
  38.217 -apply (drule_tac x="N + 1" in bspec)
  38.218 -apply (erule HNatInfinite_add)
  38.219 -apply (simp add: starfun_shift_one)
  38.220 -done
  38.221 +lemma NSLIMSEQ_Suc: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S l \<Longrightarrow> (\<lambda>n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l"
  38.222 +  apply (unfold NSLIMSEQ_def)
  38.223 +  apply safe
  38.224 +  apply (drule_tac x="N + 1" in bspec)
  38.225 +   apply (erule HNatInfinite_add)
  38.226 +  apply (simp add: starfun_shift_one)
  38.227 +  done
  38.228  
  38.229 -lemma NSLIMSEQ_imp_Suc: "(%n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l ==> f \<longlonglongrightarrow>\<^sub>N\<^sub>S l"
  38.230 -apply (unfold NSLIMSEQ_def, safe)
  38.231 -apply (drule_tac x="N - 1" in bspec) 
  38.232 -apply (erule Nats_1 [THEN [2] HNatInfinite_diff])
  38.233 -apply (simp add: starfun_shift_one one_le_HNatInfinite)
  38.234 -done
  38.235 +lemma NSLIMSEQ_imp_Suc: "(\<lambda>n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l \<Longrightarrow> f \<longlonglongrightarrow>\<^sub>N\<^sub>S l"
  38.236 +  apply (unfold NSLIMSEQ_def)
  38.237 +  apply safe
  38.238 +  apply (drule_tac x="N - 1" in bspec)
  38.239 +   apply (erule Nats_1 [THEN [2] HNatInfinite_diff])
  38.240 +  apply (simp add: starfun_shift_one one_le_HNatInfinite)
  38.241 +  done
  38.242  
  38.243 -lemma NSLIMSEQ_Suc_iff: "((%n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l) = (f \<longlonglongrightarrow>\<^sub>N\<^sub>S l)"
  38.244 -by (blast intro: NSLIMSEQ_imp_Suc NSLIMSEQ_Suc)
  38.245 +lemma NSLIMSEQ_Suc_iff: "(\<lambda>n. f (Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l \<longleftrightarrow> f \<longlonglongrightarrow>\<^sub>N\<^sub>S l"
  38.246 +  by (blast intro: NSLIMSEQ_imp_Suc NSLIMSEQ_Suc)
  38.247 +
  38.248  
  38.249  subsubsection \<open>Equivalence of @{term LIMSEQ} and @{term NSLIMSEQ}\<close>
  38.250  
  38.251  lemma LIMSEQ_NSLIMSEQ:
  38.252 -  assumes X: "X \<longlonglongrightarrow> L" shows "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
  38.253 +  assumes X: "X \<longlonglongrightarrow> L"
  38.254 +  shows "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
  38.255  proof (rule NSLIMSEQ_I)
  38.256 -  fix N assume N: "N \<in> HNatInfinite"
  38.257 +  fix N
  38.258 +  assume N: "N \<in> HNatInfinite"
  38.259    have "starfun X N - star_of L \<in> Infinitesimal"
  38.260    proof (rule InfinitesimalI2)
  38.261 -    fix r::real assume r: "0 < r"
  38.262 -    from LIMSEQ_D [OF X r]
  38.263 -    obtain no where "\<forall>n\<ge>no. norm (X n - L) < r" ..
  38.264 -    hence "\<forall>n\<ge>star_of no. hnorm (starfun X n - star_of L) < star_of r"
  38.265 +    fix r :: real
  38.266 +    assume r: "0 < r"
  38.267 +    from LIMSEQ_D [OF X r] obtain no where "\<forall>n\<ge>no. norm (X n - L) < r" ..
  38.268 +    then have "\<forall>n\<ge>star_of no. hnorm (starfun X n - star_of L) < star_of r"
  38.269        by transfer
  38.270 -    thus "hnorm (starfun X N - star_of L) < star_of r"
  38.271 +    then show "hnorm (starfun X N - star_of L) < star_of r"
  38.272        using N by (simp add: star_of_le_HNatInfinite)
  38.273    qed
  38.274 -  thus "starfun X N \<approx> star_of L"
  38.275 -    by (unfold approx_def)
  38.276 +  then show "starfun X N \<approx> star_of L"
  38.277 +    by (simp only: approx_def)
  38.278  qed
  38.279  
  38.280  lemma NSLIMSEQ_LIMSEQ:
  38.281 -  assumes X: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L" shows "X \<longlonglongrightarrow> L"
  38.282 +  assumes X: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
  38.283 +  shows "X \<longlonglongrightarrow> L"
  38.284  proof (rule LIMSEQ_I)
  38.285 -  fix r::real assume r: "0 < r"
  38.286 +  fix r :: real
  38.287 +  assume r: "0 < r"
  38.288    have "\<exists>no. \<forall>n\<ge>no. hnorm (starfun X n - star_of L) < star_of r"
  38.289    proof (intro exI allI impI)
  38.290 -    fix n assume "whn \<le> n"
  38.291 +    fix n
  38.292 +    assume "whn \<le> n"
  38.293      with HNatInfinite_whn have "n \<in> HNatInfinite"
  38.294        by (rule HNatInfinite_upward_closed)
  38.295      with X have "starfun X n \<approx> star_of L"
  38.296        by (rule NSLIMSEQ_D)
  38.297 -    hence "starfun X n - star_of L \<in> Infinitesimal"
  38.298 -      by (unfold approx_def)
  38.299 -    thus "hnorm (starfun X n - star_of L) < star_of r"
  38.300 +    then have "starfun X n - star_of L \<in> Infinitesimal"
  38.301 +      by (simp only: approx_def)
  38.302 +    then show "hnorm (starfun X n - star_of L) < star_of r"
  38.303        using r by (rule InfinitesimalD2)
  38.304    qed
  38.305 -  thus "\<exists>no. \<forall>n\<ge>no. norm (X n - L) < r"
  38.306 +  then show "\<exists>no. \<forall>n\<ge>no. norm (X n - L) < r"
  38.307      by transfer
  38.308  qed
  38.309  
  38.310 -theorem LIMSEQ_NSLIMSEQ_iff: "(f \<longlonglongrightarrow> L) = (f \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
  38.311 -by (blast intro: LIMSEQ_NSLIMSEQ NSLIMSEQ_LIMSEQ)
  38.312 +theorem LIMSEQ_NSLIMSEQ_iff: "f \<longlonglongrightarrow> L \<longleftrightarrow> f \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
  38.313 +  by (blast intro: LIMSEQ_NSLIMSEQ NSLIMSEQ_LIMSEQ)
  38.314 +
  38.315  
  38.316  subsubsection \<open>Derived theorems about @{term NSLIMSEQ}\<close>
  38.317  
  38.318 -text\<open>We prove the NS version from the standard one, since the NS proof
  38.319 -   seems more complicated than the standard one above!\<close>
  38.320 -lemma NSLIMSEQ_norm_zero: "((\<lambda>n. norm (X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0) = (X \<longlonglongrightarrow>\<^sub>N\<^sub>S 0)"
  38.321 -by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] tendsto_norm_zero_iff)
  38.322 +text \<open>We prove the NS version from the standard one, since the NS proof
  38.323 +  seems more complicated than the standard one above!\<close>
  38.324 +lemma NSLIMSEQ_norm_zero: "(\<lambda>n. norm (X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0 \<longleftrightarrow> X \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.325 +  by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] tendsto_norm_zero_iff)
  38.326  
  38.327 -lemma NSLIMSEQ_rabs_zero: "((%n. \<bar>f n\<bar>) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0) = (f \<longlonglongrightarrow>\<^sub>N\<^sub>S (0::real))"
  38.328 -by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] tendsto_rabs_zero_iff)
  38.329 -
  38.330 -text\<open>Generalization to other limits\<close>
  38.331 -lemma NSLIMSEQ_imp_rabs: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S (l::real) ==> (%n. \<bar>f n\<bar>) \<longlonglongrightarrow>\<^sub>N\<^sub>S \<bar>l\<bar>"
  38.332 -apply (simp add: NSLIMSEQ_def)
  38.333 -apply (auto intro: approx_hrabs 
  38.334 -            simp add: starfun_abs)
  38.335 -done
  38.336 +lemma NSLIMSEQ_rabs_zero: "(\<lambda>n. \<bar>f n\<bar>) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0 \<longleftrightarrow> f \<longlonglongrightarrow>\<^sub>N\<^sub>S (0::real)"
  38.337 +  by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] tendsto_rabs_zero_iff)
  38.338  
  38.339 -lemma NSLIMSEQ_inverse_zero:
  38.340 -     "\<forall>y::real. \<exists>N. \<forall>n \<ge> N. y < f(n)
  38.341 -      ==> (%n. inverse(f n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.342 -by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_zero)
  38.343 +text \<open>Generalization to other limits.\<close>
  38.344 +lemma NSLIMSEQ_imp_rabs: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S l \<Longrightarrow> (\<lambda>n. \<bar>f n\<bar>) \<longlonglongrightarrow>\<^sub>N\<^sub>S \<bar>l\<bar>"
  38.345 +  for l :: real
  38.346 +  by (simp add: NSLIMSEQ_def) (auto intro: approx_hrabs simp add: starfun_abs)
  38.347 +
  38.348 +lemma NSLIMSEQ_inverse_zero: "\<forall>y::real. \<exists>N. \<forall>n \<ge> N. y < f n \<Longrightarrow> (\<lambda>n. inverse (f n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.349 +  by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_zero)
  38.350  
  38.351 -lemma NSLIMSEQ_inverse_real_of_nat: "(%n. inverse(real(Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.352 -by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_real_of_nat del: of_nat_Suc)
  38.353 +lemma NSLIMSEQ_inverse_real_of_nat: "(\<lambda>n. inverse (real (Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.354 +  by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_real_of_nat del: of_nat_Suc)
  38.355  
  38.356 -lemma NSLIMSEQ_inverse_real_of_nat_add:
  38.357 -     "(%n. r + inverse(real(Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  38.358 -by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_real_of_nat_add del: of_nat_Suc)
  38.359 +lemma NSLIMSEQ_inverse_real_of_nat_add: "(\<lambda>n. r + inverse (real (Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  38.360 +  by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_real_of_nat_add del: of_nat_Suc)
  38.361  
  38.362 -lemma NSLIMSEQ_inverse_real_of_nat_add_minus:
  38.363 -     "(%n. r + -inverse(real(Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  38.364 +lemma NSLIMSEQ_inverse_real_of_nat_add_minus: "(\<lambda>n. r + - inverse (real (Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  38.365    using LIMSEQ_inverse_real_of_nat_add_minus by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric])
  38.366  
  38.367  lemma NSLIMSEQ_inverse_real_of_nat_add_minus_mult:
  38.368 -     "(%n. r*( 1 + -inverse(real(Suc n)))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  38.369 -  using LIMSEQ_inverse_real_of_nat_add_minus_mult by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric])
  38.370 +  "(\<lambda>n. r * (1 + - inverse (real (Suc n)))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  38.371 +  using LIMSEQ_inverse_real_of_nat_add_minus_mult
  38.372 +  by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric])
  38.373  
  38.374  
  38.375  subsection \<open>Convergence\<close>
  38.376  
  38.377 -lemma nslimI: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L ==> nslim X = L"
  38.378 -apply (simp add: nslim_def)
  38.379 -apply (blast intro: NSLIMSEQ_unique)
  38.380 -done
  38.381 +lemma nslimI: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L \<Longrightarrow> nslim X = L"
  38.382 +  by (simp add: nslim_def) (blast intro: NSLIMSEQ_unique)
  38.383  
  38.384  lemma lim_nslim_iff: "lim X = nslim X"
  38.385 -by (simp add: lim_def nslim_def LIMSEQ_NSLIMSEQ_iff)
  38.386 +  by (simp add: lim_def nslim_def LIMSEQ_NSLIMSEQ_iff)
  38.387  
  38.388 -lemma NSconvergentD: "NSconvergent X ==> \<exists>L. (X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
  38.389 -by (simp add: NSconvergent_def)
  38.390 +lemma NSconvergentD: "NSconvergent X \<Longrightarrow> \<exists>L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
  38.391 +  by (simp add: NSconvergent_def)
  38.392  
  38.393 -lemma NSconvergentI: "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S L) ==> NSconvergent X"
  38.394 -by (auto simp add: NSconvergent_def)
  38.395 +lemma NSconvergentI: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L \<Longrightarrow> NSconvergent X"
  38.396 +  by (auto simp add: NSconvergent_def)
  38.397  
  38.398  lemma convergent_NSconvergent_iff: "convergent X = NSconvergent X"
  38.399 -by (simp add: convergent_def NSconvergent_def LIMSEQ_NSLIMSEQ_iff)
  38.400 +  by (simp add: convergent_def NSconvergent_def LIMSEQ_NSLIMSEQ_iff)
  38.401  
  38.402 -lemma NSconvergent_NSLIMSEQ_iff: "NSconvergent X = (X \<longlonglongrightarrow>\<^sub>N\<^sub>S nslim X)"
  38.403 -by (auto intro: theI NSLIMSEQ_unique simp add: NSconvergent_def nslim_def)
  38.404 +lemma NSconvergent_NSLIMSEQ_iff: "NSconvergent X \<longleftrightarrow> X \<longlonglongrightarrow>\<^sub>N\<^sub>S nslim X"
  38.405 +  by (auto intro: theI NSLIMSEQ_unique simp add: NSconvergent_def nslim_def)
  38.406  
  38.407  
  38.408  subsection \<open>Bounded Monotonic Sequences\<close>
  38.409  
  38.410 -lemma NSBseqD: "[| NSBseq X;  N: HNatInfinite |] ==> ( *f* X) N : HFinite"
  38.411 -by (simp add: NSBseq_def)
  38.412 +lemma NSBseqD: "NSBseq X \<Longrightarrow> N \<in> HNatInfinite \<Longrightarrow> ( *f* X) N \<in> HFinite"
  38.413 +  by (simp add: NSBseq_def)
  38.414  
  38.415  lemma Standard_subset_HFinite: "Standard \<subseteq> HFinite"
  38.416 -unfolding Standard_def by auto
  38.417 +  by (auto simp: Standard_def)
  38.418  
  38.419  lemma NSBseqD2: "NSBseq X \<Longrightarrow> ( *f* X) N \<in> HFinite"
  38.420 -apply (cases "N \<in> HNatInfinite")
  38.421 -apply (erule (1) NSBseqD)
  38.422 -apply (rule subsetD [OF Standard_subset_HFinite])
  38.423 -apply (simp add: HNatInfinite_def Nats_eq_Standard)
  38.424 -done
  38.425 +  apply (cases "N \<in> HNatInfinite")
  38.426 +   apply (erule (1) NSBseqD)
  38.427 +  apply (rule subsetD [OF Standard_subset_HFinite])
  38.428 +  apply (simp add: HNatInfinite_def Nats_eq_Standard)
  38.429 +  done
  38.430  
  38.431 -lemma NSBseqI: "\<forall>N \<in> HNatInfinite. ( *f* X) N : HFinite ==> NSBseq X"
  38.432 -by (simp add: NSBseq_def)
  38.433 -
  38.434 -text\<open>The standard definition implies the nonstandard definition\<close>
  38.435 +lemma NSBseqI: "\<forall>N \<in> HNatInfinite. ( *f* X) N \<in> HFinite \<Longrightarrow> NSBseq X"
  38.436 +  by (simp add: NSBseq_def)
  38.437  
  38.438 -lemma Bseq_NSBseq: "Bseq X ==> NSBseq X"
  38.439 -proof (unfold NSBseq_def, safe)
  38.440 +text \<open>The standard definition implies the nonstandard definition.\<close>
  38.441 +lemma Bseq_NSBseq: "Bseq X \<Longrightarrow> NSBseq X"
  38.442 +  unfolding NSBseq_def
  38.443 +proof safe
  38.444    assume X: "Bseq X"
  38.445 -  fix N assume N: "N \<in> HNatInfinite"
  38.446 -  from BseqD [OF X] obtain K where "\<forall>n. norm (X n) \<le> K" by fast
  38.447 -  hence "\<forall>N. hnorm (starfun X N) \<le> star_of K" by transfer
  38.448 -  hence "hnorm (starfun X N) \<le> star_of K" by simp
  38.449 -  also have "star_of K < star_of (K + 1)" by simp
  38.450 -  finally have "\<exists>x\<in>Reals. hnorm (starfun X N) < x" by (rule bexI, simp)
  38.451 -  thus "starfun X N \<in> HFinite" by (simp add: HFinite_def)
  38.452 +  fix N
  38.453 +  assume N: "N \<in> HNatInfinite"
  38.454 +  from BseqD [OF X] obtain K where "\<forall>n. norm (X n) \<le> K"
  38.455 +    by fast
  38.456 +  then have "\<forall>N. hnorm (starfun X N) \<le> star_of K"
  38.457 +    by transfer
  38.458 +  then have "hnorm (starfun X N) \<le> star_of K"
  38.459 +    by simp
  38.460 +  also have "star_of K < star_of (K + 1)"
  38.461 +    by simp
  38.462 +  finally have "\<exists>x\<in>Reals. hnorm (starfun X N) < x"
  38.463 +    by (rule bexI) simp
  38.464 +  then show "starfun X N \<in> HFinite"
  38.465 +    by (simp add: HFinite_def)
  38.466  qed
  38.467  
  38.468 -text\<open>The nonstandard definition implies the standard definition\<close>
  38.469 -
  38.470 +text \<open>The nonstandard definition implies the standard definition.\<close>
  38.471  lemma SReal_less_omega: "r \<in> \<real> \<Longrightarrow> r < \<omega>"
  38.472 -apply (insert HInfinite_omega)
  38.473 -apply (simp add: HInfinite_def)
  38.474 -apply (simp add: order_less_imp_le)
  38.475 -done
  38.476 +  using HInfinite_omega
  38.477 +  by (simp add: HInfinite_def) (simp add: order_less_imp_le)
  38.478  
  38.479  lemma NSBseq_Bseq: "NSBseq X \<Longrightarrow> Bseq X"
  38.480  proof (rule ccontr)
  38.481    let ?n = "\<lambda>K. LEAST n. K < norm (X n)"
  38.482    assume "NSBseq X"
  38.483 -  hence finite: "( *f* X) (( *f* ?n) \<omega>) \<in> HFinite"
  38.484 +  then have finite: "( *f* X) (( *f* ?n) \<omega>) \<in> HFinite"
  38.485      by (rule NSBseqD2)
  38.486    assume "\<not> Bseq X"
  38.487 -  hence "\<forall>K>0. \<exists>n. K < norm (X n)"
  38.488 +  then have "\<forall>K>0. \<exists>n. K < norm (X n)"
  38.489      by (simp add: Bseq_def linorder_not_le)
  38.490 -  hence "\<forall>K>0. K < norm (X (?n K))"
  38.491 +  then have "\<forall>K>0. K < norm (X (?n K))"
  38.492      by (auto intro: LeastI_ex)
  38.493 -  hence "\<forall>K>0. K < hnorm (( *f* X) (( *f* ?n) K))"
  38.494 +  then have "\<forall>K>0. K < hnorm (( *f* X) (( *f* ?n) K))"
  38.495      by transfer
  38.496 -  hence "\<omega> < hnorm (( *f* X) (( *f* ?n) \<omega>))"
  38.497 +  then have "\<omega> < hnorm (( *f* X) (( *f* ?n) \<omega>))"
  38.498      by simp
  38.499 -  hence "\<forall>r\<in>\<real>. r < hnorm (( *f* X) (( *f* ?n) \<omega>))"
  38.500 +  then have "\<forall>r\<in>\<real>. r < hnorm (( *f* X) (( *f* ?n) \<omega>))"
  38.501      by (simp add: order_less_trans [OF SReal_less_omega])
  38.502 -  hence "( *f* X) (( *f* ?n) \<omega>) \<in> HInfinite"
  38.503 +  then have "( *f* X) (( *f* ?n) \<omega>) \<in> HInfinite"
  38.504      by (simp add: HInfinite_def)
  38.505    with finite show "False"
  38.506      by (simp add: HFinite_HInfinite_iff)
  38.507  qed
  38.508  
  38.509 -text\<open>Equivalence of nonstandard and standard definitions
  38.510 -  for a bounded sequence\<close>
  38.511 -lemma Bseq_NSBseq_iff: "(Bseq X) = (NSBseq X)"
  38.512 -by (blast intro!: NSBseq_Bseq Bseq_NSBseq)
  38.513 +text \<open>Equivalence of nonstandard and standard definitions for a bounded sequence.\<close>
  38.514 +lemma Bseq_NSBseq_iff: "Bseq X = NSBseq X"
  38.515 +  by (blast intro!: NSBseq_Bseq Bseq_NSBseq)
  38.516  
  38.517 -text\<open>A convergent sequence is bounded: 
  38.518 - Boundedness as a necessary condition for convergence. 
  38.519 - The nonstandard version has no existential, as usual\<close>
  38.520 +text \<open>A convergent sequence is bounded:
  38.521 +  Boundedness as a necessary condition for convergence.
  38.522 +  The nonstandard version has no existential, as usual.\<close>
  38.523 +lemma NSconvergent_NSBseq: "NSconvergent X \<Longrightarrow> NSBseq X"
  38.524 +  by (simp add: NSconvergent_def NSBseq_def NSLIMSEQ_def)
  38.525 +    (blast intro: HFinite_star_of approx_sym approx_HFinite)
  38.526  
  38.527 -lemma NSconvergent_NSBseq: "NSconvergent X ==> NSBseq X"
  38.528 -apply (simp add: NSconvergent_def NSBseq_def NSLIMSEQ_def)
  38.529 -apply (blast intro: HFinite_star_of approx_sym approx_HFinite)
  38.530 -done
  38.531 +text \<open>Standard Version: easily now proved using equivalence of NS and
  38.532 + standard definitions.\<close>
  38.533  
  38.534 -text\<open>Standard Version: easily now proved using equivalence of NS and
  38.535 - standard definitions\<close>
  38.536 +lemma convergent_Bseq: "convergent X \<Longrightarrow> Bseq X"
  38.537 +  for X :: "nat \<Rightarrow> 'b::real_normed_vector"
  38.538 +  by (simp add: NSconvergent_NSBseq convergent_NSconvergent_iff Bseq_NSBseq_iff)
  38.539  
  38.540 -lemma convergent_Bseq: "convergent X ==> Bseq (X::nat \<Rightarrow> _::real_normed_vector)"
  38.541 -by (simp add: NSconvergent_NSBseq convergent_NSconvergent_iff Bseq_NSBseq_iff)
  38.542  
  38.543 -subsubsection\<open>Upper Bounds and Lubs of Bounded Sequences\<close>
  38.544 +subsubsection \<open>Upper Bounds and Lubs of Bounded Sequences\<close>
  38.545  
  38.546 -lemma NSBseq_isUb: "NSBseq X ==> \<exists>U::real. isUb UNIV {x. \<exists>n. X n = x} U"
  38.547 -by (simp add: Bseq_NSBseq_iff [symmetric] Bseq_isUb)
  38.548 +lemma NSBseq_isUb: "NSBseq X \<Longrightarrow> \<exists>U::real. isUb UNIV {x. \<exists>n. X n = x} U"
  38.549 +  by (simp add: Bseq_NSBseq_iff [symmetric] Bseq_isUb)
  38.550  
  38.551 -lemma NSBseq_isLub: "NSBseq X ==> \<exists>U::real. isLub UNIV {x. \<exists>n. X n = x} U"
  38.552 -by (simp add: Bseq_NSBseq_iff [symmetric] Bseq_isLub)
  38.553 +lemma NSBseq_isLub: "NSBseq X \<Longrightarrow> \<exists>U::real. isLub UNIV {x. \<exists>n. X n = x} U"
  38.554 +  by (simp add: Bseq_NSBseq_iff [symmetric] Bseq_isLub)
  38.555 +
  38.556  
  38.557 -subsubsection\<open>A Bounded and Monotonic Sequence Converges\<close>
  38.558 +subsubsection \<open>A Bounded and Monotonic Sequence Converges\<close>
  38.559  
  38.560 -text\<open>The best of both worlds: Easier to prove this result as a standard
  38.561 +text \<open>The best of both worlds: Easier to prove this result as a standard
  38.562     theorem and then use equivalence to "transfer" it into the
  38.563     equivalent nonstandard form if needed!\<close>
  38.564  
  38.565 -lemma Bmonoseq_NSLIMSEQ: "\<forall>n \<ge> m. X n = X m ==> \<exists>L. (X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
  38.566 -by (auto dest!: Bmonoseq_LIMSEQ simp add: LIMSEQ_NSLIMSEQ_iff)
  38.567 +lemma Bmonoseq_NSLIMSEQ: "\<forall>n \<ge> m. X n = X m \<Longrightarrow> \<exists>L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
  38.568 +  by (auto dest!: Bmonoseq_LIMSEQ simp add: LIMSEQ_NSLIMSEQ_iff)
  38.569  
  38.570 -lemma NSBseq_mono_NSconvergent:
  38.571 -     "[| NSBseq X; \<forall>m. \<forall>n \<ge> m. X m \<le> X n |] ==> NSconvergent (X::nat=>real)"
  38.572 -by (auto intro: Bseq_mono_convergent 
  38.573 -         simp add: convergent_NSconvergent_iff [symmetric] 
  38.574 -                   Bseq_NSBseq_iff [symmetric])
  38.575 +lemma NSBseq_mono_NSconvergent: "NSBseq X \<Longrightarrow> \<forall>m. \<forall>n \<ge> m. X m \<le> X n \<Longrightarrow> NSconvergent X"
  38.576 +  for X :: "nat \<Rightarrow> real"
  38.577 +  by (auto intro: Bseq_mono_convergent
  38.578 +      simp: convergent_NSconvergent_iff [symmetric] Bseq_NSBseq_iff [symmetric])
  38.579  
  38.580  
  38.581  subsection \<open>Cauchy Sequences\<close>
  38.582  
  38.583  lemma NSCauchyI:
  38.584 -  "(\<And>M N. \<lbrakk>M \<in> HNatInfinite; N \<in> HNatInfinite\<rbrakk> \<Longrightarrow> starfun X M \<approx> starfun X N)
  38.585 -   \<Longrightarrow> NSCauchy X"
  38.586 -by (simp add: NSCauchy_def)
  38.587 +  "(\<And>M N. M \<in> HNatInfinite \<Longrightarrow> N \<in> HNatInfinite \<Longrightarrow> starfun X M \<approx> starfun X N) \<Longrightarrow> NSCauchy X"
  38.588 +  by (simp add: NSCauchy_def)
  38.589  
  38.590  lemma NSCauchyD:
  38.591 -  "\<lbrakk>NSCauchy X; M \<in> HNatInfinite; N \<in> HNatInfinite\<rbrakk>
  38.592 -   \<Longrightarrow> starfun X M \<approx> starfun X N"
  38.593 -by (simp add: NSCauchy_def)
  38.594 +  "NSCauchy X \<Longrightarrow> M \<in> HNatInfinite \<Longrightarrow> N \<in> HNatInfinite \<Longrightarrow> starfun X M \<approx> starfun X N"
  38.595 +  by (simp add: NSCauchy_def)
  38.596  
  38.597 -subsubsection\<open>Equivalence Between NS and Standard\<close>
  38.598 +
  38.599 +subsubsection \<open>Equivalence Between NS and Standard\<close>
  38.600  
  38.601  lemma Cauchy_NSCauchy:
  38.602 -  assumes X: "Cauchy X" shows "NSCauchy X"
  38.603 +  assumes X: "Cauchy X"
  38.604 +  shows "NSCauchy X"
  38.605  proof (rule NSCauchyI)
  38.606 -  fix M assume M: "M \<in> HNatInfinite"
  38.607 -  fix N assume N: "N \<in> HNatInfinite"
  38.608 +  fix M
  38.609 +  assume M: "M \<in> HNatInfinite"
  38.610 +  fix N
  38.611 +  assume N: "N \<in> HNatInfinite"
  38.612    have "starfun X M - starfun X N \<in> Infinitesimal"
  38.613    proof (rule InfinitesimalI2)
  38.614 -    fix r :: real assume r: "0 < r"
  38.615 -    from CauchyD [OF X r]
  38.616 -    obtain k where "\<forall>m\<ge>k. \<forall>n\<ge>k. norm (X m - X n) < r" ..
  38.617 -    hence "\<forall>m\<ge>star_of k. \<forall>n\<ge>star_of k.
  38.618 -           hnorm (starfun X m - starfun X n) < star_of r"
  38.619 +    fix r :: real
  38.620 +    assume r: "0 < r"
  38.621 +    from CauchyD [OF X r] obtain k where "\<forall>m\<ge>k. \<forall>n\<ge>k. norm (X m - X n) < r" ..
  38.622 +    then have "\<forall>m\<ge>star_of k. \<forall>n\<ge>star_of k. hnorm (starfun X m - starfun X n) < star_of r"
  38.623        by transfer
  38.624 -    thus "hnorm (starfun X M - starfun X N) < star_of r"
  38.625 +    then show "hnorm (starfun X M - starfun X N) < star_of r"
  38.626        using M N by (simp add: star_of_le_HNatInfinite)
  38.627    qed
  38.628 -  thus "starfun X M \<approx> starfun X N"
  38.629 -    by (unfold approx_def)
  38.630 +  then show "starfun X M \<approx> starfun X N"
  38.631 +    by (simp only: approx_def)
  38.632  qed
  38.633  
  38.634  lemma NSCauchy_Cauchy:
  38.635 -  assumes X: "NSCauchy X" shows "Cauchy X"
  38.636 +  assumes X: "NSCauchy X"
  38.637 +  shows "Cauchy X"
  38.638  proof (rule CauchyI)
  38.639 -  fix r::real assume r: "0 < r"
  38.640 +  fix r :: real
  38.641 +  assume r: "0 < r"
  38.642    have "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. hnorm (starfun X m - starfun X n) < star_of r"
  38.643    proof (intro exI allI impI)
  38.644 -    fix M assume "whn \<le> M"
  38.645 +    fix M
  38.646 +    assume "whn \<le> M"
  38.647      with HNatInfinite_whn have M: "M \<in> HNatInfinite"
  38.648        by (rule HNatInfinite_upward_closed)
  38.649 -    fix N assume "whn \<le> N"
  38.650 +    fix N
  38.651 +    assume "whn \<le> N"
  38.652      with HNatInfinite_whn have N: "N \<in> HNatInfinite"
  38.653        by (rule HNatInfinite_upward_closed)
  38.654      from X M N have "starfun X M \<approx> starfun X N"
  38.655        by (rule NSCauchyD)
  38.656 -    hence "starfun X M - starfun X N \<in> Infinitesimal"
  38.657 -      by (unfold approx_def)
  38.658 -    thus "hnorm (starfun X M - starfun X N) < star_of r"
  38.659 +    then have "starfun X M - starfun X N \<in> Infinitesimal"
  38.660 +      by (simp only: approx_def)
  38.661 +    then show "hnorm (starfun X M - starfun X N) < star_of r"
  38.662        using r by (rule InfinitesimalD2)
  38.663    qed
  38.664 -  thus "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. norm (X m - X n) < r"
  38.665 +  then show "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. norm (X m - X n) < r"
  38.666      by transfer
  38.667  qed
  38.668  
  38.669  theorem NSCauchy_Cauchy_iff: "NSCauchy X = Cauchy X"
  38.670 -by (blast intro!: NSCauchy_Cauchy Cauchy_NSCauchy)
  38.671 +  by (blast intro!: NSCauchy_Cauchy Cauchy_NSCauchy)
  38.672 +
  38.673  
  38.674  subsubsection \<open>Cauchy Sequences are Bounded\<close>
  38.675  
  38.676 -text\<open>A Cauchy sequence is bounded -- nonstandard version\<close>
  38.677 +text \<open>A Cauchy sequence is bounded -- nonstandard version.\<close>
  38.678  
  38.679 -lemma NSCauchy_NSBseq: "NSCauchy X ==> NSBseq X"
  38.680 -by (simp add: Cauchy_Bseq Bseq_NSBseq_iff [symmetric] NSCauchy_Cauchy_iff)
  38.681 +lemma NSCauchy_NSBseq: "NSCauchy X \<Longrightarrow> NSBseq X"
  38.682 +  by (simp add: Cauchy_Bseq Bseq_NSBseq_iff [symmetric] NSCauchy_Cauchy_iff)
  38.683 +
  38.684  
  38.685  subsubsection \<open>Cauchy Sequences are Convergent\<close>
  38.686  
  38.687 -text\<open>Equivalence of Cauchy criterion and convergence:
  38.688 +text \<open>Equivalence of Cauchy criterion and convergence:
  38.689    We will prove this using our NS formulation which provides a
  38.690    much easier proof than using the standard definition. We do not
  38.691    need to use properties of subsequences such as boundedness,
  38.692 @@ -453,64 +450,60 @@
  38.693    since the NS formulations do not involve existential quantifiers.\<close>
  38.694  
  38.695  lemma NSconvergent_NSCauchy: "NSconvergent X \<Longrightarrow> NSCauchy X"
  38.696 -apply (simp add: NSconvergent_def NSLIMSEQ_def NSCauchy_def, safe)
  38.697 -apply (auto intro: approx_trans2)
  38.698 -done
  38.699 +  by (simp add: NSconvergent_def NSLIMSEQ_def NSCauchy_def) (auto intro: approx_trans2)
  38.700  
  38.701 -lemma real_NSCauchy_NSconvergent:
  38.702 -  fixes X :: "nat \<Rightarrow> real"
  38.703 -  shows "NSCauchy X \<Longrightarrow> NSconvergent X"
  38.704 -apply (simp add: NSconvergent_def NSLIMSEQ_def)
  38.705 -apply (frule NSCauchy_NSBseq)
  38.706 -apply (simp add: NSBseq_def NSCauchy_def)
  38.707 -apply (drule HNatInfinite_whn [THEN [2] bspec])
  38.708 -apply (drule HNatInfinite_whn [THEN [2] bspec])
  38.709 -apply (auto dest!: st_part_Ex simp add: SReal_iff)
  38.710 -apply (blast intro: approx_trans3)
  38.711 -done
  38.712 +lemma real_NSCauchy_NSconvergent: "NSCauchy X \<Longrightarrow> NSconvergent X"
  38.713 +  for X :: "nat \<Rightarrow> real"
  38.714 +  apply (simp add: NSconvergent_def NSLIMSEQ_def)
  38.715 +  apply (frule NSCauchy_NSBseq)
  38.716 +  apply (simp add: NSBseq_def NSCauchy_def)
  38.717 +  apply (drule HNatInfinite_whn [THEN [2] bspec])
  38.718 +  apply (drule HNatInfinite_whn [THEN [2] bspec])
  38.719 +  apply (auto dest!: st_part_Ex simp add: SReal_iff)
  38.720 +  apply (blast intro: approx_trans3)
  38.721 +  done
  38.722  
  38.723 -lemma NSCauchy_NSconvergent:
  38.724 -  fixes X :: "nat \<Rightarrow> 'a::banach"
  38.725 -  shows "NSCauchy X \<Longrightarrow> NSconvergent X"
  38.726 -apply (drule NSCauchy_Cauchy [THEN Cauchy_convergent])
  38.727 -apply (erule convergent_NSconvergent_iff [THEN iffD1])
  38.728 -done
  38.729 +lemma NSCauchy_NSconvergent: "NSCauchy X \<Longrightarrow> NSconvergent X"
  38.730 +  for X :: "nat \<Rightarrow> 'a::banach"
  38.731 +  apply (drule NSCauchy_Cauchy [THEN Cauchy_convergent])
  38.732 +  apply (erule convergent_NSconvergent_iff [THEN iffD1])
  38.733 +  done
  38.734  
  38.735 -lemma NSCauchy_NSconvergent_iff:
  38.736 -  fixes X :: "nat \<Rightarrow> 'a::banach"
  38.737 -  shows "NSCauchy X = NSconvergent X"
  38.738 -by (fast intro: NSCauchy_NSconvergent NSconvergent_NSCauchy)
  38.739 +lemma NSCauchy_NSconvergent_iff: "NSCauchy X = NSconvergent X"
  38.740 +  for X :: "nat \<Rightarrow> 'a::banach"
  38.741 +  by (fast intro: NSCauchy_NSconvergent NSconvergent_NSCauchy)
  38.742  
  38.743  
  38.744  subsection \<open>Power Sequences\<close>
  38.745  
  38.746 -text\<open>The sequence @{term "x^n"} tends to 0 if @{term "0\<le>x"} and @{term
  38.747 -"x<1"}.  Proof will use (NS) Cauchy equivalence for convergence and
  38.748 +text \<open>The sequence @{term "x^n"} tends to 0 if @{term "0\<le>x"} and @{term
  38.749 +  "x<1"}.  Proof will use (NS) Cauchy equivalence for convergence and
  38.750    also fact that bounded and monotonic sequence converges.\<close>
  38.751  
  38.752 -text\<open>We now use NS criterion to bring proof of theorem through\<close>
  38.753 +text \<open>We now use NS criterion to bring proof of theorem through.\<close>
  38.754 +lemma NSLIMSEQ_realpow_zero: "0 \<le> x \<Longrightarrow> x < 1 \<Longrightarrow> (\<lambda>n. x ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.755 +  for x :: real
  38.756 +  apply (simp add: NSLIMSEQ_def)
  38.757 +  apply (auto dest!: convergent_realpow simp add: convergent_NSconvergent_iff)
  38.758 +  apply (frule NSconvergentD)
  38.759 +  apply (auto simp add: NSLIMSEQ_def NSCauchy_NSconvergent_iff [symmetric] NSCauchy_def starfun_pow)
  38.760 +  apply (frule HNatInfinite_add_one)
  38.761 +  apply (drule bspec, assumption)
  38.762 +  apply (drule bspec, assumption)
  38.763 +  apply (drule_tac x = "N + 1" in bspec, assumption)
  38.764 +  apply (simp add: hyperpow_add)
  38.765 +  apply (drule approx_mult_subst_star_of, assumption)
  38.766 +  apply (drule approx_trans3, assumption)
  38.767 +  apply (auto simp del: star_of_mult simp add: star_of_mult [symmetric])
  38.768 +  done
  38.769  
  38.770 -lemma NSLIMSEQ_realpow_zero:
  38.771 -  "[| 0 \<le> (x::real); x < 1 |] ==> (%n. x ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.772 -apply (simp add: NSLIMSEQ_def)
  38.773 -apply (auto dest!: convergent_realpow simp add: convergent_NSconvergent_iff)
  38.774 -apply (frule NSconvergentD)
  38.775 -apply (auto simp add: NSLIMSEQ_def NSCauchy_NSconvergent_iff [symmetric] NSCauchy_def starfun_pow)
  38.776 -apply (frule HNatInfinite_add_one)
  38.777 -apply (drule bspec, assumption)
  38.778 -apply (drule bspec, assumption)
  38.779 -apply (drule_tac x = "N + (1::hypnat) " in bspec, assumption)
  38.780 -apply (simp add: hyperpow_add)
  38.781 -apply (drule approx_mult_subst_star_of, assumption)
  38.782 -apply (drule approx_trans3, assumption)
  38.783 -apply (auto simp del: star_of_mult simp add: star_of_mult [symmetric])
  38.784 -done
  38.785 +lemma NSLIMSEQ_rabs_realpow_zero: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. \<bar>c\<bar> ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.786 +  for c :: real
  38.787 +  by (simp add: LIMSEQ_rabs_realpow_zero LIMSEQ_NSLIMSEQ_iff [symmetric])
  38.788  
  38.789 -lemma NSLIMSEQ_rabs_realpow_zero: "\<bar>c\<bar> < (1::real) ==> (%n. \<bar>c\<bar> ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.790 -by (simp add: LIMSEQ_rabs_realpow_zero LIMSEQ_NSLIMSEQ_iff [symmetric])
  38.791 -
  38.792 -lemma NSLIMSEQ_rabs_realpow_zero2: "\<bar>c\<bar> < (1::real) ==> (%n. c ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.793 -by (simp add: LIMSEQ_rabs_realpow_zero2 LIMSEQ_NSLIMSEQ_iff [symmetric])
  38.794 +lemma NSLIMSEQ_rabs_realpow_zero2: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. c ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  38.795 +  for c :: real
  38.796 +  by (simp add: LIMSEQ_rabs_realpow_zero2 LIMSEQ_NSLIMSEQ_iff [symmetric])
  38.797  
  38.798  (***---------------------------------------------------------------
  38.799      Theorems proved by Harrison in HOL that we do not need
    39.1 --- a/src/HOL/Nonstandard_Analysis/HSeries.thy	Tue Dec 20 16:17:13 2016 +0100
    39.2 +++ b/src/HOL/Nonstandard_Analysis/HSeries.thy	Tue Dec 20 16:18:56 2016 +0100
    39.3 @@ -5,200 +5,177 @@
    39.4  Converted to Isar and polished by lcp
    39.5  *)
    39.6  
    39.7 -section\<open>Finite Summation and Infinite Series for Hyperreals\<close>
    39.8 +section \<open>Finite Summation and Infinite Series for Hyperreals\<close>
    39.9  
   39.10  theory HSeries
   39.11 -imports HSEQ
   39.12 +  imports HSEQ
   39.13  begin
   39.14  
   39.15 -definition
   39.16 -  sumhr :: "(hypnat * hypnat * (nat=>real)) => hypreal" where
   39.17 -  "sumhr =
   39.18 -      (%(M,N,f). starfun2 (%m n. sum f {m..<n}) M N)"
   39.19 +definition sumhr :: "hypnat \<times> hypnat \<times> (nat \<Rightarrow> real) \<Rightarrow> hypreal"
   39.20 +  where "sumhr = (\<lambda>(M,N,f). starfun2 (\<lambda>m n. sum f {m..<n}) M N)"
   39.21 +
   39.22 +definition NSsums :: "(nat \<Rightarrow> real) \<Rightarrow> real \<Rightarrow> bool"  (infixr "NSsums" 80)
   39.23 +  where "f NSsums s = (\<lambda>n. sum f {..<n}) \<longlonglongrightarrow>\<^sub>N\<^sub>S s"
   39.24  
   39.25 -definition
   39.26 -  NSsums  :: "[nat=>real,real] => bool"     (infixr "NSsums" 80) where
   39.27 -  "f NSsums s = (%n. sum f {..<n}) \<longlonglongrightarrow>\<^sub>N\<^sub>S s"
   39.28 +definition NSsummable :: "(nat \<Rightarrow> real) \<Rightarrow> bool"
   39.29 +  where "NSsummable f \<longleftrightarrow> (\<exists>s. f NSsums s)"
   39.30  
   39.31 -definition
   39.32 -  NSsummable :: "(nat=>real) => bool" where
   39.33 -  "NSsummable f = (\<exists>s. f NSsums s)"
   39.34 +definition NSsuminf :: "(nat \<Rightarrow> real) \<Rightarrow> real"
   39.35 +  where "NSsuminf f = (THE s. f NSsums s)"
   39.36  
   39.37 -definition
   39.38 -  NSsuminf   :: "(nat=>real) => real" where
   39.39 -  "NSsuminf f = (THE s. f NSsums s)"
   39.40 +lemma sumhr_app: "sumhr (M, N, f) = ( *f2* (\<lambda>m n. sum f {m..<n})) M N"
   39.41 +  by (simp add: sumhr_def)
   39.42  
   39.43 -lemma sumhr_app: "sumhr(M,N,f) = ( *f2* (\<lambda>m n. sum f {m..<n})) M N"
   39.44 -by (simp add: sumhr_def)
   39.45 +text \<open>Base case in definition of @{term sumr}.\<close>
   39.46 +lemma sumhr_zero [simp]: "\<And>m. sumhr (m, 0, f) = 0"
   39.47 +  unfolding sumhr_app by transfer simp
   39.48  
   39.49 -text\<open>Base case in definition of @{term sumr}\<close>
   39.50 -lemma sumhr_zero [simp]: "!!m. sumhr (m,0,f) = 0"
   39.51 -unfolding sumhr_app by transfer simp
   39.52 -
   39.53 -text\<open>Recursive case in definition of @{term sumr}\<close>
   39.54 +text \<open>Recursive case in definition of @{term sumr}.\<close>
   39.55  lemma sumhr_if:
   39.56 -     "!!m n. sumhr(m,n+1,f) =
   39.57 -      (if n + 1 \<le> m then 0 else sumhr(m,n,f) + ( *f* f) n)"
   39.58 -unfolding sumhr_app by transfer simp
   39.59 +  "\<And>m n. sumhr (m, n + 1, f) = (if n + 1 \<le> m then 0 else sumhr (m, n, f) + ( *f* f) n)"
   39.60 +  unfolding sumhr_app by transfer simp
   39.61 +
   39.62 +lemma sumhr_Suc_zero [simp]: "\<And>n. sumhr (n + 1, n, f) = 0"
   39.63 +  unfolding sumhr_app by transfer simp
   39.64  
   39.65 -lemma sumhr_Suc_zero [simp]: "!!n. sumhr (n + 1, n, f) = 0"
   39.66 -unfolding sumhr_app by transfer simp
   39.67 +lemma sumhr_eq_bounds [simp]: "\<And>n. sumhr (n, n, f) = 0"
   39.68 +  unfolding sumhr_app by transfer simp
   39.69  
   39.70 -lemma sumhr_eq_bounds [simp]: "!!n. sumhr (n,n,f) = 0"
   39.71 -unfolding sumhr_app by transfer simp
   39.72 +lemma sumhr_Suc [simp]: "\<And>m. sumhr (m, m + 1, f) = ( *f* f) m"
   39.73 +  unfolding sumhr_app by transfer simp
   39.74  
   39.75 -lemma sumhr_Suc [simp]: "!!m. sumhr (m,m + 1,f) = ( *f* f) m"
   39.76 -unfolding sumhr_app by transfer simp
   39.77 +lemma sumhr_add_lbound_zero [simp]: "\<And>k m. sumhr (m + k, k, f) = 0"
   39.78 +  unfolding sumhr_app by transfer simp
   39.79  
   39.80 -lemma sumhr_add_lbound_zero [simp]: "!!k m. sumhr(m+k,k,f) = 0"
   39.81 -unfolding sumhr_app by transfer simp
   39.82 +lemma sumhr_add: "\<And>m n. sumhr (m, n, f) + sumhr (m, n, g) = sumhr (m, n, \<lambda>i. f i + g i)"
   39.83 +  unfolding sumhr_app by transfer (rule sum.distrib [symmetric])
   39.84  
   39.85 -lemma sumhr_add:
   39.86 -  "!!m n. sumhr (m,n,f) + sumhr(m,n,g) = sumhr(m,n,%i. f i + g i)"
   39.87 -unfolding sumhr_app by transfer (rule sum.distrib [symmetric])
   39.88 +lemma sumhr_mult: "\<And>m n. hypreal_of_real r * sumhr (m, n, f) = sumhr (m, n, \<lambda>n. r * f n)"
   39.89 +  unfolding sumhr_app by transfer (rule sum_distrib_left)
   39.90  
   39.91 -lemma sumhr_mult:
   39.92 -  "!!m n. hypreal_of_real r * sumhr(m,n,f) = sumhr(m,n,%n. r * f n)"
   39.93 -unfolding sumhr_app by transfer (rule sum_distrib_left)
   39.94 +lemma sumhr_split_add: "\<And>n p. n < p \<Longrightarrow> sumhr (0, n, f) + sumhr (n, p, f) = sumhr (0, p, f)"
   39.95 +  unfolding sumhr_app by transfer (simp add: sum_add_nat_ivl)
   39.96  
   39.97 -lemma sumhr_split_add:
   39.98 -  "!!n p. n < p ==> sumhr(0,n,f) + sumhr(n,p,f) = sumhr(0,p,f)"
   39.99 -unfolding sumhr_app by transfer (simp add: sum_add_nat_ivl)
  39.100 +lemma sumhr_split_diff: "n < p \<Longrightarrow> sumhr (0, p, f) - sumhr (0, n, f) = sumhr (n, p, f)"
  39.101 +  by (drule sumhr_split_add [symmetric, where f = f]) simp
  39.102  
  39.103 -lemma sumhr_split_diff: "n<p ==> sumhr(0,p,f) - sumhr(0,n,f) = sumhr(n,p,f)"
  39.104 -by (drule_tac f = f in sumhr_split_add [symmetric], simp)
  39.105 +lemma sumhr_hrabs: "\<And>m n. \<bar>sumhr (m, n, f)\<bar> \<le> sumhr (m, n, \<lambda>i. \<bar>f i\<bar>)"
  39.106 +  unfolding sumhr_app by transfer (rule sum_abs)
  39.107  
  39.108 -lemma sumhr_hrabs: "!!m n. \<bar>sumhr(m,n,f)\<bar> \<le> sumhr(m,n,%i. \<bar>f i\<bar>)"
  39.109 -unfolding sumhr_app by transfer (rule sum_abs)
  39.110 -
  39.111 -text\<open>other general version also needed\<close>
  39.112 +text \<open>Other general version also needed.\<close>
  39.113  lemma sumhr_fun_hypnat_eq:
  39.114 -   "(\<forall>r. m \<le> r & r < n --> f r = g r) -->
  39.115 -      sumhr(hypnat_of_nat m, hypnat_of_nat n, f) =
  39.116 -      sumhr(hypnat_of_nat m, hypnat_of_nat n, g)"
  39.117 -unfolding sumhr_app by transfer simp
  39.118 +  "(\<forall>r. m \<le> r \<and> r < n \<longrightarrow> f r = g r) \<longrightarrow>
  39.119 +    sumhr (hypnat_of_nat m, hypnat_of_nat n, f) =
  39.120 +    sumhr (hypnat_of_nat m, hypnat_of_nat n, g)"
  39.121 +  unfolding sumhr_app by transfer simp
  39.122  
  39.123 -lemma sumhr_const:
  39.124 -     "!!n. sumhr(0, n, %i. r) = hypreal_of_hypnat n * hypreal_of_real r"
  39.125 -unfolding sumhr_app by transfer simp
  39.126 +lemma sumhr_const: "\<And>n. sumhr (0, n, \<lambda>i. r) = hypreal_of_hypnat n * hypreal_of_real r"
  39.127 +  unfolding sumhr_app by transfer simp
  39.128  
  39.129 -lemma sumhr_less_bounds_zero [simp]: "!!m n. n < m ==> sumhr(m,n,f) = 0"
  39.130 -unfolding sumhr_app by transfer simp
  39.131 +lemma sumhr_less_bounds_zero [simp]: "\<And>m n. n < m \<Longrightarrow> sumhr (m, n, f) = 0"
  39.132 +  unfolding sumhr_app by transfer simp
  39.133  
  39.134 -lemma sumhr_minus: "!!m n. sumhr(m, n, %i. - f i) = - sumhr(m, n, f)"
  39.135 -unfolding sumhr_app by transfer (rule sum_negf)
  39.136 +lemma sumhr_minus: "\<And>m n. sumhr (m, n, \<lambda>i. - f i) = - sumhr (m, n, f)"
  39.137 +  unfolding sumhr_app by transfer (rule sum_negf)
  39.138  
  39.139  lemma sumhr_shift_bounds:
  39.140 -  "!!m n. sumhr(m+hypnat_of_nat k,n+hypnat_of_nat k,f) =
  39.141 -          sumhr(m,n,%i. f(i + k))"
  39.142 -unfolding sumhr_app by transfer (rule sum_shift_bounds_nat_ivl)
  39.143 +  "\<And>m n. sumhr (m + hypnat_of_nat k, n + hypnat_of_nat k, f) =
  39.144 +    sumhr (m, n, \<lambda>i. f (i + k))"
  39.145 +  unfolding sumhr_app by transfer (rule sum_shift_bounds_nat_ivl)
  39.146  
  39.147  
  39.148 -subsection\<open>Nonstandard Sums\<close>
  39.149 +subsection \<open>Nonstandard Sums\<close>
  39.150  
  39.151 -text\<open>Infinite sums are obtained by summing to some infinite hypernatural
  39.152 - (such as @{term whn})\<close>
  39.153 -lemma sumhr_hypreal_of_hypnat_omega:
  39.154 -      "sumhr(0,whn,%i. 1) = hypreal_of_hypnat whn"
  39.155 -by (simp add: sumhr_const)
  39.156 +text \<open>Infinite sums are obtained by summing to some infinite hypernatural
  39.157 +  (such as @{term whn}).\<close>
  39.158 +lemma sumhr_hypreal_of_hypnat_omega: "sumhr (0, whn, \<lambda>i. 1) = hypreal_of_hypnat whn"
  39.159 +  by (simp add: sumhr_const)
  39.160  
  39.161 -lemma sumhr_hypreal_omega_minus_one: "sumhr(0, whn, %i. 1) = \<omega> - 1"
  39.162 -apply (simp add: sumhr_const)
  39.163 -(* FIXME: need lemma: hypreal_of_hypnat whn = \<omega> - 1 *)
  39.164 -(* maybe define \<omega> = hypreal_of_hypnat whn + 1 *)
  39.165 -apply (unfold star_class_defs omega_def hypnat_omega_def
  39.166 -              of_hypnat_def star_of_def)
  39.167 -apply (simp add: starfun_star_n starfun2_star_n)
  39.168 -done
  39.169 +lemma sumhr_hypreal_omega_minus_one: "sumhr(0, whn, \<lambda>i. 1) = \<omega> - 1"
  39.170 +  apply (simp add: sumhr_const)
  39.171 +    (* FIXME: need lemma: hypreal_of_hypnat whn = \<omega> - 1 *)
  39.172 +    (* maybe define \<omega> = hypreal_of_hypnat whn + 1 *)
  39.173 +  apply (unfold star_class_defs omega_def hypnat_omega_def of_hypnat_def star_of_def)
  39.174 +  apply (simp add: starfun_star_n starfun2_star_n)
  39.175 +  done
  39.176  
  39.177 -lemma sumhr_minus_one_realpow_zero [simp]:
  39.178 -     "!!N. sumhr(0, N + N, %i. (-1) ^ (i+1)) = 0"
  39.179 -unfolding sumhr_app
  39.180 -apply transfer
  39.181 -apply (simp del: power_Suc add: mult_2 [symmetric])
  39.182 -apply (induct_tac N)
  39.183 -apply simp_all
  39.184 -done
  39.185 +lemma sumhr_minus_one_realpow_zero [simp]: "\<And>N. sumhr (0, N + N, \<lambda>i. (-1) ^ (i + 1)) = 0"
  39.186 +  unfolding sumhr_app
  39.187 +  apply transfer
  39.188 +  apply (simp del: power_Suc add: mult_2 [symmetric])
  39.189 +  apply (induct_tac N)
  39.190 +   apply simp_all
  39.191 +  done
  39.192  
  39.193  lemma sumhr_interval_const:
  39.194 -     "(\<forall>n. m \<le> Suc n --> f n = r) & m \<le> na
  39.195 -      ==> sumhr(hypnat_of_nat m,hypnat_of_nat na,f) =
  39.196 -          (hypreal_of_nat (na - m) * hypreal_of_real r)"
  39.197 -unfolding sumhr_app by transfer simp
  39.198 +  "(\<forall>n. m \<le> Suc n \<longrightarrow> f n = r) \<and> m \<le> na \<Longrightarrow>
  39.199 +    sumhr (hypnat_of_nat m, hypnat_of_nat na, f) = hypreal_of_nat (na - m) * hypreal_of_real r"
  39.200 +  unfolding sumhr_app by transfer simp
  39.201  
  39.202 -lemma starfunNat_sumr: "!!N. ( *f* (%n. sum f {0..<n})) N = sumhr(0,N,f)"
  39.203 -unfolding sumhr_app by transfer (rule refl)
  39.204 +lemma starfunNat_sumr: "\<And>N. ( *f* (\<lambda>n. sum f {0..<n})) N = sumhr (0, N, f)"
  39.205 +  unfolding sumhr_app by transfer (rule refl)
  39.206  
  39.207 -lemma sumhr_hrabs_approx [simp]: "sumhr(0, M, f) \<approx> sumhr(0, N, f)
  39.208 -      ==> \<bar>sumhr(M, N, f)\<bar> \<approx> 0"
  39.209 -apply (cut_tac x = M and y = N in linorder_less_linear)
  39.210 -apply (auto simp add: approx_refl)
  39.211 -apply (drule approx_sym [THEN approx_minus_iff [THEN iffD1]])
  39.212 -apply (auto dest: approx_hrabs
  39.213 -            simp add: sumhr_split_diff)
  39.214 -done
  39.215 +lemma sumhr_hrabs_approx [simp]: "sumhr (0, M, f) \<approx> sumhr (0, N, f) \<Longrightarrow> \<bar>sumhr (M, N, f)\<bar> \<approx> 0"
  39.216 +  using linorder_less_linear [where x = M and y = N]
  39.217 +  apply auto
  39.218 +  apply (drule approx_sym [THEN approx_minus_iff [THEN iffD1]])
  39.219 +  apply (auto dest: approx_hrabs simp add: sumhr_split_diff)
  39.220 +  done
  39.221 +
  39.222 +
  39.223 +subsection \<open>Infinite sums: Standard and NS theorems\<close>
  39.224  
  39.225 -(*----------------------------------------------------------------
  39.226 -      infinite sums: Standard and NS theorems
  39.227 - ----------------------------------------------------------------*)
  39.228 -lemma sums_NSsums_iff: "(f sums l) = (f NSsums l)"
  39.229 -by (simp add: sums_def NSsums_def LIMSEQ_NSLIMSEQ_iff)
  39.230 +lemma sums_NSsums_iff: "f sums l \<longleftrightarrow> f NSsums l"
  39.231 +  by (simp add: sums_def NSsums_def LIMSEQ_NSLIMSEQ_iff)
  39.232  
  39.233 -lemma summable_NSsummable_iff: "(summable f) = (NSsummable f)"
  39.234 -by (simp add: summable_def NSsummable_def sums_NSsums_iff)
  39.235 +lemma summable_NSsummable_iff: "summable f \<longleftrightarrow> NSsummable f"
  39.236 +  by (simp add: summable_def NSsummable_def sums_NSsums_iff)
  39.237  
  39.238 -lemma suminf_NSsuminf_iff: "(suminf f) = (NSsuminf f)"
  39.239 -by (simp add: suminf_def NSsuminf_def sums_NSsums_iff)
  39.240 +lemma suminf_NSsuminf_iff: "suminf f = NSsuminf f"
  39.241 +  by (simp add: suminf_def NSsuminf_def sums_NSsums_iff)
  39.242  
  39.243 -lemma NSsums_NSsummable: "f NSsums l ==> NSsummable f"
  39.244 -by (simp add: NSsums_def NSsummable_def, blast)
  39.245 +lemma NSsums_NSsummable: "f NSsums l \<Longrightarrow> NSsummable f"
  39.246 +  unfolding NSsums_def NSsummable_def by blast
  39.247  
  39.248 -lemma NSsummable_NSsums: "NSsummable f ==> f NSsums (NSsuminf f)"
  39.249 -apply (simp add: NSsummable_def NSsuminf_def NSsums_def)
  39.250 -apply (blast intro: theI NSLIMSEQ_unique)
  39.251 -done
  39.252 +lemma NSsummable_NSsums: "NSsummable f \<Longrightarrow> f NSsums (NSsuminf f)"
  39.253 +  unfolding NSsummable_def NSsuminf_def NSsums_def
  39.254 +  by (blast intro: theI NSLIMSEQ_unique)
  39.255  
  39.256 -lemma NSsums_unique: "f NSsums s ==> (s = NSsuminf f)"
  39.257 -by (simp add: suminf_NSsuminf_iff [symmetric] sums_NSsums_iff sums_unique)
  39.258 +lemma NSsums_unique: "f NSsums s \<Longrightarrow> s = NSsuminf f"
  39.259 +  by (simp add: suminf_NSsuminf_iff [symmetric] sums_NSsums_iff sums_unique)
  39.260  
  39.261 -lemma NSseries_zero:
  39.262 -  "\<forall>m. n \<le> Suc m --> f(m) = 0 ==> f NSsums (sum f {..<n})"
  39.263 -by (auto simp add: sums_NSsums_iff [symmetric] not_le[symmetric] intro!: sums_finite)
  39.264 +lemma NSseries_zero: "\<forall>m. n \<le> Suc m \<longrightarrow> f m = 0 \<Longrightarrow> f NSsums (sum f {..<n})"
  39.265 +  by (auto simp add: sums_NSsums_iff [symmetric] not_le[symmetric] intro!: sums_finite)
  39.266  
  39.267  lemma NSsummable_NSCauchy:
  39.268 -     "NSsummable f =
  39.269 -      (\<forall>M \<in> HNatInfinite. \<forall>N \<in> HNatInfinite. \<bar>sumhr(M,N,f)\<bar> \<approx> 0)"
  39.270 -apply (auto simp add: summable_NSsummable_iff [symmetric]
  39.271 -       summable_iff_convergent convergent_NSconvergent_iff atLeast0LessThan[symmetric]
  39.272 -       NSCauchy_NSconvergent_iff [symmetric] NSCauchy_def starfunNat_sumr)
  39.273 -apply (cut_tac x = M and y = N in linorder_less_linear)
  39.274 -apply auto
  39.275 -apply (rule approx_minus_iff [THEN iffD2, THEN approx_sym])
  39.276 -apply (rule_tac [2] approx_minus_iff [THEN iffD2])
  39.277 -apply (auto dest: approx_hrabs_zero_cancel
  39.278 -            simp add: sumhr_split_diff atLeast0LessThan[symmetric])
  39.279 -done
  39.280 +  "NSsummable f \<longleftrightarrow> (\<forall>M \<in> HNatInfinite. \<forall>N \<in> HNatInfinite. \<bar>sumhr (M, N, f)\<bar> \<approx> 0)"
  39.281 +  apply (auto simp add: summable_NSsummable_iff [symmetric]
  39.282 +      summable_iff_convergent convergent_NSconvergent_iff atLeast0LessThan[symmetric]
  39.283 +      NSCauchy_NSconvergent_iff [symmetric] NSCauchy_def starfunNat_sumr)
  39.284 +  apply (cut_tac x = M and y = N in linorder_less_linear)
  39.285 +  apply auto
  39.286 +   apply (rule approx_minus_iff [THEN iffD2, THEN approx_sym])
  39.287 +   apply (rule_tac [2] approx_minus_iff [THEN iffD2])
  39.288 +   apply (auto dest: approx_hrabs_zero_cancel simp: sumhr_split_diff atLeast0LessThan[symmetric])
  39.289 +  done
  39.290  
  39.291 -text\<open>Terms of a convergent series tend to zero\<close>
  39.292 -lemma NSsummable_NSLIMSEQ_zero: "NSsummable f ==> f \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  39.293 -apply (auto simp add: NSLIMSEQ_def NSsummable_NSCauchy)
  39.294 -apply (drule bspec, auto)
  39.295 -apply (drule_tac x = "N + 1 " in bspec)
  39.296 -apply (auto intro: HNatInfinite_add_one approx_hrabs_zero_cancel)
  39.297 -done
  39.298 +text \<open>Terms of a convergent series tend to zero.\<close>
  39.299 +lemma NSsummable_NSLIMSEQ_zero: "NSsummable f \<Longrightarrow> f \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
  39.300 +  apply (auto simp add: NSLIMSEQ_def NSsummable_NSCauchy)
  39.301 +  apply (drule bspec)
  39.302 +   apply auto
  39.303 +  apply (drule_tac x = "N + 1 " in bspec)
  39.304 +   apply (auto intro: HNatInfinite_add_one approx_hrabs_zero_cancel)
  39.305 +  done
  39.306  
  39.307 -text\<open>Nonstandard comparison test\<close>
  39.308 -lemma NSsummable_comparison_test:
  39.309 -     "[| \<exists>N. \<forall>n. N \<le> n --> \<bar>f n\<bar> \<le> g n; NSsummable g |] ==> NSsummable f"
  39.310 -apply (fold summable_NSsummable_iff)
  39.311 -apply (rule summable_comparison_test, simp, assumption)
  39.312 -done
  39.313 +text \<open>Nonstandard comparison test.\<close>
  39.314 +lemma NSsummable_comparison_test: "\<exists>N. \<forall>n. N \<le> n \<longrightarrow> \<bar>f n\<bar> \<le> g n \<Longrightarrow> NSsummable g \<Longrightarrow> NSsummable f"
  39.315 +  apply (fold summable_NSsummable_iff)
  39.316 +  apply (rule summable_comparison_test, simp, assumption)
  39.317 +  done
  39.318  
  39.319  lemma NSsummable_rabs_comparison_test:
  39.320 -     "[| \<exists>N. \<forall>n. N \<le> n --> \<bar>f n\<bar> \<le> g n; NSsummable g |]
  39.321 -      ==> NSsummable (%k. \<bar>f k\<bar>)"
  39.322 -apply (rule NSsummable_comparison_test)
  39.323 -apply (auto)
  39.324 -done
  39.325 +  "\<exists>N. \<forall>n. N \<le> n \<longrightarrow> \<bar>f n\<bar> \<le> g n \<Longrightarrow> NSsummable g \<Longrightarrow> NSsummable (\<lambda>k. \<bar>f k\<bar>)"
  39.326 +  by (rule NSsummable_comparison_test) auto
  39.327  
  39.328  end
    40.1 --- a/src/HOL/Nonstandard_Analysis/StarDef.thy	Tue Dec 20 16:17:13 2016 +0100
    40.2 +++ b/src/HOL/Nonstandard_Analysis/StarDef.thy	Tue Dec 20 16:18:56 2016 +0100
    40.3 @@ -81,7 +81,7 @@
    40.4    by (simp add: FreeUltrafilterNat.proper)
    40.5  
    40.6  text \<open>Standard principles that play a central role in the transfer tactic.\<close>
    40.7 -definition Ifun :: "('a \<Rightarrow> 'b) star \<Rightarrow> 'a star \<Rightarrow> 'b star" ("_ \<star> _" [300,301] 300)
    40.8 +definition Ifun :: "('a \<Rightarrow> 'b) star \<Rightarrow> 'a star \<Rightarrow> 'b star" ("(_ \<star>/ _)" [300, 301] 300)
    40.9    where "Ifun f \<equiv>
   40.10      \<lambda>x. Abs_star (\<Union>F\<in>Rep_star f. \<Union>X\<in>Rep_star x. starrel``{\<lambda>n. F n (X n)})"
   40.11  
    41.1 --- a/src/HOL/Number_Theory/Cong.thy	Tue Dec 20 16:17:13 2016 +0100
    41.2 +++ b/src/HOL/Number_Theory/Cong.thy	Tue Dec 20 16:18:56 2016 +0100
    41.3 @@ -251,7 +251,7 @@
    41.4    done
    41.5  
    41.6  lemma cong_altdef_int: "[(a::int) = b] (mod m) = (m dvd (a - b))"
    41.7 -  by (metis cong_int_def zmod_eq_dvd_iff)
    41.8 +  by (metis cong_int_def mod_eq_dvd_iff)
    41.9  
   41.10  lemma cong_abs_int: "[(x::int) = y] (mod abs m) = [x = y] (mod m)"
   41.11    by (simp add: cong_altdef_int)
   41.12 @@ -429,7 +429,7 @@
   41.13    by (simp add: cong_nat_def mod_mult2_eq  mod_add_left_eq)
   41.14  
   41.15  lemma neg_cong_int: "([(a::int) = b] (mod m)) = ([-a = -b] (mod m))"
   41.16 -  by (metis cong_int_def minus_minus zminus_zmod)
   41.17 +  by (metis cong_int_def minus_minus mod_minus_cong)
   41.18  
   41.19  lemma cong_modulus_neg_int: "([(a::int) = b] (mod m)) = ([a = b] (mod -m))"
   41.20    by (auto simp add: cong_altdef_int)
    42.1 --- a/src/HOL/Number_Theory/Euclidean_Algorithm.thy	Tue Dec 20 16:17:13 2016 +0100
    42.2 +++ b/src/HOL/Number_Theory/Euclidean_Algorithm.thy	Tue Dec 20 16:18:56 2016 +0100
    42.3 @@ -17,7 +17,7 @@
    42.4    The existence of these functions makes it possible to derive gcd and lcm functions 
    42.5    for any Euclidean semiring.
    42.6  \<close> 
    42.7 -class euclidean_semiring = semiring_modulo + normalization_semidom + 
    42.8 +class euclidean_semiring = semidom_modulo + normalization_semidom + 
    42.9    fixes euclidean_size :: "'a \<Rightarrow> nat"
   42.10    assumes size_0 [simp]: "euclidean_size 0 = 0"
   42.11    assumes mod_size_less: 
   42.12 @@ -26,30 +26,6 @@
   42.13      "b \<noteq> 0 \<Longrightarrow> euclidean_size a \<le> euclidean_size (a * b)"
   42.14  begin
   42.15  
   42.16 -lemma mod_0 [simp]: "0 mod a = 0"
   42.17 -  using div_mult_mod_eq [of 0 a] by simp
   42.18 -
   42.19 -lemma dvd_mod_iff: 
   42.20 -  assumes "k dvd n"
   42.21 -  shows   "(k dvd m mod n) = (k dvd m)"
   42.22 -proof -
   42.23 -  from assms have "(k dvd m mod n) \<longleftrightarrow> (k dvd ((m div n) * n + m mod n))" 
   42.24 -    by (simp add: dvd_add_right_iff)
   42.25 -  also have "(m div n) * n + m mod n = m"
   42.26 -    using div_mult_mod_eq [of m n] by simp
   42.27 -  finally show ?thesis .
   42.28 -qed
   42.29 -
   42.30 -lemma mod_0_imp_dvd: 
   42.31 -  assumes "a mod b = 0"
   42.32 -  shows   "b dvd a"
   42.33 -proof -
   42.34 -  have "b dvd ((a div b) * b)" by simp
   42.35 -  also have "(a div b) * b = a"
   42.36 -    using div_mult_mod_eq [of a b] by (simp add: assms)
   42.37 -  finally show ?thesis .
   42.38 -qed
   42.39 -
   42.40  lemma euclidean_size_normalize [simp]:
   42.41    "euclidean_size (normalize a) = euclidean_size a"
   42.42  proof (cases "a = 0")
    43.1 --- a/src/HOL/Number_Theory/Pocklington.thy	Tue Dec 20 16:17:13 2016 +0100
    43.2 +++ b/src/HOL/Number_Theory/Pocklington.thy	Tue Dec 20 16:18:56 2016 +0100
    43.3 @@ -369,7 +369,7 @@
    43.4      hence th: "[a^?r = 1] (mod n)"
    43.5        using eqo mod_mult_left_eq[of "(a^?o)^?q" "a^?r" n]
    43.6        apply (simp add: cong_nat_def del: One_nat_def)
    43.7 -      by (simp add: mod_mult_left_eq[symmetric])
    43.8 +      by (metis mod_mult_left_eq nat_mult_1)
    43.9      {assume r: "?r = 0" hence ?rhs by (simp add: dvd_eq_mod_eq_0)}
   43.10      moreover
   43.11      {assume r: "?r \<noteq> 0"
    44.1 --- a/src/HOL/Number_Theory/Primes.thy	Tue Dec 20 16:17:13 2016 +0100
    44.2 +++ b/src/HOL/Number_Theory/Primes.thy	Tue Dec 20 16:18:56 2016 +0100
    44.3 @@ -241,12 +241,18 @@
    44.4      "prime (p::int) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> {2..<p}. \<not> n dvd p)"
    44.5    by (auto simp add: prime_int_code)
    44.6  
    44.7 -lemmas prime_nat_simp_numeral [simp] = prime_nat_simp [of "numeral m"] for m
    44.8 +lemma prime_int_numeral_eq [simp]:
    44.9 +  "prime (numeral m :: int) \<longleftrightarrow> prime (numeral m :: nat)"
   44.10 +  by (simp add: prime_int_nat_transfer)
   44.11  
   44.12  lemma two_is_prime_nat [simp]: "prime (2::nat)"
   44.13 -  by simp
   44.14 +  by (simp add: prime_nat_simp)
   44.15  
   44.16 -declare prime_int_nat_transfer[of "numeral m" for m, simp]
   44.17 +lemma prime_nat_numeral_eq [simp]:
   44.18 +  "prime (numeral m :: nat) \<longleftrightarrow>
   44.19 +    (1::nat) < numeral m \<and>
   44.20 +    (\<forall>n::nat\<in>set [2..<numeral m]. \<not> n dvd numeral m)"
   44.21 +  by (fact prime_nat_simp) -- \<open>TODO Sieve Of Erathosthenes might speed this up\<close>
   44.22  
   44.23  
   44.24  text\<open>A bit of regression testing:\<close>
    45.1 --- a/src/HOL/Number_Theory/Quadratic_Reciprocity.thy	Tue Dec 20 16:17:13 2016 +0100
    45.2 +++ b/src/HOL/Number_Theory/Quadratic_Reciprocity.thy	Tue Dec 20 16:18:56 2016 +0100
    45.3 @@ -167,7 +167,7 @@
    45.4      fix a b
    45.5      assume a: "P_1 res a" "P_1 res b"
    45.6      hence "int p * int q dvd a - b"
    45.7 -      using divides_mult[of "int p" "a - b" "int q"] pq_coprime_int zmod_eq_dvd_iff[of a _ b]
    45.8 +      using divides_mult[of "int p" "a - b" "int q"] pq_coprime_int mod_eq_dvd_iff [of a _ b]
    45.9        unfolding P_1_def by force
   45.10      hence "a = b" using dvd_imp_le_int[of "a - b"] a unfolding P_1_def by fastforce
   45.11    }
   45.12 @@ -187,7 +187,7 @@
   45.13      assume a: "x \<in> BuC" "y \<in> BuC" "f_1 x = f_1 y"
   45.14      hence "int p * int q dvd x - y"
   45.15        using f_1_def pq_coprime_int divides_mult[of "int p" "x - y" "int q"] 
   45.16 -            zmod_eq_dvd_iff[of x _ y] by auto
   45.17 +            mod_eq_dvd_iff[of x _ y] by auto
   45.18      hence "x = y"
   45.19        using dvd_imp_le_int[of "x - y" "int p * int q"] a unfolding BuC_def by force
   45.20    }
    46.1 --- a/src/HOL/Number_Theory/Residues.thy	Tue Dec 20 16:17:13 2016 +0100
    46.2 +++ b/src/HOL/Number_Theory/Residues.thy	Tue Dec 20 16:18:56 2016 +0100
    46.3 @@ -40,7 +40,7 @@
    46.4    apply (insert m_gt_one)
    46.5    apply (rule abelian_groupI)
    46.6    apply (unfold R_def residue_ring_def)
    46.7 -  apply (auto simp add: mod_add_right_eq [symmetric] ac_simps)
    46.8 +  apply (auto simp add: mod_add_right_eq ac_simps)
    46.9    apply (case_tac "x = 0")
   46.10    apply force
   46.11    apply (subgoal_tac "(x + (m - x)) mod m = 0")
   46.12 @@ -55,7 +55,7 @@
   46.13    apply auto
   46.14    apply (subgoal_tac "x * y mod m * z mod m = z * (x * y mod m) mod m")
   46.15    apply (erule ssubst)
   46.16 -  apply (subst mod_mult_right_eq [symmetric])+
   46.17 +  apply (subst mod_mult_right_eq)+
   46.18    apply (simp_all only: ac_simps)
   46.19    done
   46.20  
   46.21 @@ -64,9 +64,9 @@
   46.22    apply (rule abelian_group)
   46.23    apply (rule comm_monoid)
   46.24    apply (unfold R_def residue_ring_def, auto)
   46.25 -  apply (subst mod_add_eq [symmetric])
   46.26 +  apply (subst mod_add_eq)
   46.27    apply (subst mult.commute)
   46.28 -  apply (subst mod_mult_right_eq [symmetric])
   46.29 +  apply (subst mod_mult_right_eq)
   46.30    apply (simp add: field_simps)
   46.31    done
   46.32  
   46.33 @@ -116,9 +116,9 @@
   46.34    apply auto
   46.35    apply (rule the_equality)
   46.36    apply auto
   46.37 -  apply (subst mod_add_right_eq [symmetric])
   46.38 +  apply (subst mod_add_right_eq)
   46.39    apply auto
   46.40 -  apply (subst mod_add_left_eq [symmetric])
   46.41 +  apply (subst mod_add_left_eq)
   46.42    apply auto
   46.43    apply (subgoal_tac "y mod m = - x mod m")
   46.44    apply simp
   46.45 @@ -143,13 +143,11 @@
   46.46  
   46.47  lemma add_cong: "(x mod m) \<oplus> (y mod m) = (x + y) mod m"
   46.48    unfolding R_def residue_ring_def
   46.49 -  apply auto
   46.50 -  apply presburger
   46.51 -  done
   46.52 +  by (auto simp add: mod_simps)
   46.53  
   46.54  lemma mult_cong: "(x mod m) \<otimes> (y mod m) = (x * y) mod m"
   46.55    unfolding R_def residue_ring_def
   46.56 -  by auto (metis mod_mult_eq)
   46.57 +  by (auto simp add: mod_simps)
   46.58  
   46.59  lemma zero_cong: "\<zero> = 0"
   46.60    unfolding R_def residue_ring_def by auto
    47.1 --- a/src/HOL/ROOT	Tue Dec 20 16:17:13 2016 +0100
    47.2 +++ b/src/HOL/ROOT	Tue Dec 20 16:18:56 2016 +0100
    47.3 @@ -31,18 +31,15 @@
    47.4    *}
    47.5    theories
    47.6      Library
    47.7 -    Nonpos_Ints
    47.8 -    Periodic_Fun
    47.9 +    (*conflicting type class instantiations and dependent applications*)
   47.10 +    Field_as_Ring
   47.11 +    Finite_Lattice
   47.12 +    List_lexord
   47.13      Polynomial_Factorial
   47.14 -    Predicate_Compile_Quickcheck
   47.15      Prefix_Order
   47.16 -    Rewrite
   47.17 -    (*conflicting type class instantiations*)
   47.18 -    List_lexord
   47.19 -    Sublist_Order
   47.20      Product_Lexorder
   47.21      Product_Order
   47.22 -    Finite_Lattice
   47.23 +    Sublist_Order
   47.24      (*data refinements and dependent applications*)
   47.25      AList_Mapping
   47.26      Code_Binary_Nat
   47.27 @@ -54,11 +51,13 @@
   47.28      DAList_Multiset
   47.29      RBT_Mapping
   47.30      RBT_Set
   47.31 +    (*prototypic tools*)
   47.32 +    Predicate_Compile_Quickcheck
   47.33      (*legacy tools*)
   47.34 -    Refute
   47.35      Old_Datatype
   47.36      Old_Recdef
   47.37      Old_SMT
   47.38 +    Refute
   47.39    document_files "root.bib" "root.tex"
   47.40  
   47.41  session "HOL-Hahn_Banach" in Hahn_Banach = HOL +
   47.42 @@ -238,16 +237,14 @@
   47.43      Generate_Target_Nat
   47.44      Generate_Efficient_Datastructures
   47.45      Generate_Pretty_Char
   47.46 +    Code_Test_PolyML
   47.47 +    Code_Test_Scala
   47.48    theories [condition = "ISABELLE_GHC"]
   47.49      Code_Test_GHC
   47.50    theories [condition = "ISABELLE_MLTON"]
   47.51      Code_Test_MLton
   47.52    theories [condition = "ISABELLE_OCAMLC"]
   47.53      Code_Test_OCaml
   47.54 -  theories [condition = "ISABELLE_POLYML"]
   47.55 -    Code_Test_PolyML
   47.56 -  theories [condition = "ISABELLE_SCALA"]
   47.57 -    Code_Test_Scala
   47.58    theories [condition = "ISABELLE_SMLNJ"]
   47.59      Code_Test_SMLNJ
   47.60  
   47.61 @@ -394,7 +391,7 @@
   47.62    theories Decision_Procs
   47.63  
   47.64  session "HOL-Proofs-ex" in "Proofs/ex" = "HOL-Proofs" +
   47.65 -  options [document = false, parallel_proofs = 0]
   47.66 +  options [document = false]
   47.67    theories
   47.68      Hilbert_Classical
   47.69      Proof_Terms
    48.1 --- a/src/HOL/Relation.thy	Tue Dec 20 16:17:13 2016 +0100
    48.2 +++ b/src/HOL/Relation.thy	Tue Dec 20 16:18:56 2016 +0100
    48.3 @@ -389,8 +389,9 @@
    48.4  lemma trans_INTER: "\<forall>x\<in>S. trans (r x) \<Longrightarrow> trans (INTER S r)"
    48.5    by (fast intro: transI elim: transD)
    48.6  
    48.7 -(* FIXME thm trans_INTER [to_pred] *)
    48.8 -
    48.9 +lemma transp_INF: "\<forall>x\<in>S. transp (r x) \<Longrightarrow> transp (INFIMUM S r)"
   48.10 +  by (fact trans_INTER [to_pred])
   48.11 +    
   48.12  lemma trans_join [code]: "trans r \<longleftrightarrow> (\<forall>(x, y1) \<in> r. \<forall>(y2, z) \<in> r. y1 = y2 \<longrightarrow> (x, z) \<in> r)"
   48.13    by (auto simp add: trans_def)
   48.14  
   48.15 @@ -620,13 +621,15 @@
   48.16  lemma relcomp_UNION_distrib: "s O UNION I r = (\<Union>i\<in>I. s O r i) "
   48.17    by auto
   48.18  
   48.19 -(* FIXME thm relcomp_UNION_distrib [to_pred] *)
   48.20 -
   48.21 +lemma relcompp_SUP_distrib: "s OO SUPREMUM I r = (\<Squnion>i\<in>I. s OO r i)"
   48.22 +  by (fact relcomp_UNION_distrib [to_pred])
   48.23 +    
   48.24  lemma relcomp_UNION_distrib2: "UNION I r O s = (\<Union>i\<in>I. r i O s) "
   48.25    by auto
   48.26  
   48.27 -(* FIXME thm relcomp_UNION_distrib2 [to_pred] *)
   48.28 -
   48.29 +lemma relcompp_SUP_distrib2: "SUPREMUM I r OO s = (\<Squnion>i\<in>I. r i OO s)"
   48.30 +  by (fact relcomp_UNION_distrib2 [to_pred])
   48.31 +    
   48.32  lemma single_valued_relcomp: "single_valued r \<Longrightarrow> single_valued s \<Longrightarrow> single_valued (r O s)"
   48.33    unfolding single_valued_def by blast
   48.34  
    49.1 --- a/src/HOL/Rings.thy	Tue Dec 20 16:17:13 2016 +0100
    49.2 +++ b/src/HOL/Rings.thy	Tue Dec 20 16:18:56 2016 +0100
    49.3 @@ -713,9 +713,61 @@
    49.4  lemma div_by_1 [simp]: "a div 1 = a"
    49.5    using nonzero_mult_div_cancel_left [of 1 a] by simp
    49.6  
    49.7 +lemma dvd_div_eq_0_iff:
    49.8 +  assumes "b dvd a"
    49.9 +  shows "a div b = 0 \<longleftrightarrow> a = 0"
   49.10 +  using assms by (elim dvdE, cases "b = 0") simp_all  
   49.11 +
   49.12 +lemma dvd_div_eq_cancel:
   49.13 +  "a div c = b div c \<Longrightarrow> c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a = b"
   49.14 +  by (elim dvdE, cases "c = 0") simp_all
   49.15 +
   49.16 +lemma dvd_div_eq_iff:
   49.17 +  "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a div c = b div c \<longleftrightarrow> a = b"
   49.18 +  by (elim dvdE, cases "c = 0") simp_all
   49.19 +
   49.20  end
   49.21  
   49.22  class idom_divide = idom + semidom_divide
   49.23 +begin
   49.24 +
   49.25 +lemma dvd_neg_div:
   49.26 +  assumes "b dvd a"
   49.27 +  shows "- a div b = - (a div b)"
   49.28 +proof (cases "b = 0")
   49.29 +  case True
   49.30 +  then show ?thesis by simp
   49.31 +next
   49.32 +  case False
   49.33 +  from assms obtain c where "a = b * c" ..
   49.34 +  then have "- a div b = (b * - c) div b"
   49.35 +    by simp
   49.36 +  from False also have "\<dots> = - c"
   49.37 +    by (rule nonzero_mult_div_cancel_left)  
   49.38 +  with False \<open>a = b * c\<close> show ?thesis
   49.39 +    by simp
   49.40 +qed
   49.41 +
   49.42 +lemma dvd_div_neg:
   49.43 +  assumes "b dvd a"
   49.44 +  shows "a div - b = - (a div b)"
   49.45 +proof (cases "b = 0")
   49.46 +  case True
   49.47 +  then show ?thesis by simp
   49.48 +next
   49.49 +  case False
   49.50 +  then have "- b \<noteq> 0"
   49.51 +    by simp
   49.52 +  from assms obtain c where "a = b * c" ..
   49.53 +  then have "a div - b = (- b * - c) div - b"
   49.54 +    by simp
   49.55 +  from \<open>- b \<noteq> 0\<close> also have "\<dots> = - c"
   49.56 +    by (rule nonzero_mult_div_cancel_left)  
   49.57 +  with False \<open>a = b * c\<close> show ?thesis
   49.58 +    by simp
   49.59 +qed
   49.60 +
   49.61 +end
   49.62  
   49.63  class algebraic_semidom = semidom_divide
   49.64  begin
   49.65 @@ -884,6 +936,39 @@
   49.66      by (simp add: mult.commute [of a] mult.assoc)
   49.67  qed
   49.68  
   49.69 +lemma div_div_eq_right:
   49.70 +  assumes "c dvd b" "b dvd a"
   49.71 +  shows   "a div (b div c) = a div b * c"
   49.72 +proof (cases "c = 0 \<or> b = 0")
   49.73 +  case True
   49.74 +  then show ?thesis
   49.75 +    by auto
   49.76 +next
   49.77 +  case False
   49.78 +  from assms obtain r s where "b = c * r" and "a = c * r * s"
   49.79 +    by (blast elim: dvdE)
   49.80 +  moreover with False have "r \<noteq> 0"
   49.81 +    by auto
   49.82 +  ultimately show ?thesis using False
   49.83 +    by simp (simp add: mult.commute [of _ r] mult.assoc mult.commute [of c])
   49.84 +qed
   49.85 +
   49.86 +lemma div_div_div_same:
   49.87 +  assumes "d dvd b" "b dvd a"
   49.88 +  shows   "(a div d) div (b div d) = a div b"
   49.89 +proof (cases "b = 0 \<or> d = 0")
   49.90 +  case True
   49.91 +  with assms show ?thesis
   49.92 +    by auto
   49.93 +next
   49.94 +  case False
   49.95 +  from assms obtain r s
   49.96 +    where "a = d * r * s" and "b = d * r"
   49.97 +    by (blast elim: dvdE)
   49.98 +  with False show ?thesis
   49.99 +    by simp (simp add: ac_simps)
  49.100 +qed
  49.101 +
  49.102  
  49.103  text \<open>Units: invertible elements in a ring\<close>
  49.104  
  49.105 @@ -1060,6 +1145,15 @@
  49.106    shows "a div (b * a) = 1 div b"
  49.107    using assms is_unit_div_mult_cancel_left [of a b] by (simp add: ac_simps)
  49.108  
  49.109 +lemma unit_div_eq_0_iff:
  49.110 +  assumes "is_unit b"
  49.111 +  shows "a div b = 0 \<longleftrightarrow> a = 0"
  49.112 +  by (rule dvd_div_eq_0_iff) (insert assms, auto)  
  49.113 +
  49.114 +lemma div_mult_unit2:
  49.115 +  "is_unit c \<Longrightarrow> b dvd a \<Longrightarrow> a div (b * c) = a div b div c"
  49.116 +  by (rule dvd_div_mult2_eq) (simp_all add: mult_unit_dvd_iff)
  49.117 +
  49.118  end
  49.119  
  49.120  class normalization_semidom = algebraic_semidom +
  49.121 @@ -1373,6 +1467,17 @@
  49.122      by simp
  49.123  qed
  49.124  
  49.125 +lemma normalize_unit_factor_eqI:
  49.126 +  assumes "normalize a = normalize b"
  49.127 +    and "unit_factor a = unit_factor b"
  49.128 +  shows "a = b"
  49.129 +proof -
  49.130 +  from assms have "unit_factor a * normalize a = unit_factor b * normalize b"
  49.131 +    by simp
  49.132 +  then show ?thesis
  49.133 +    by simp
  49.134 +qed
  49.135 +
  49.136  end
  49.137  
  49.138  
    50.1 --- a/src/HOL/SPARK/Examples/RIPEMD-160/Round.thy	Tue Dec 20 16:17:13 2016 +0100
    50.2 +++ b/src/HOL/SPARK/Examples/RIPEMD-160/Round.thy	Tue Dec 20 16:18:56 2016 +0100
    50.3 @@ -456,7 +456,7 @@
    50.4      unfolding round_def
    50.5      unfolding steps_to_steps'
    50.6      unfolding H1[symmetric]
    50.7 -    by (simp add: uint_word_ariths(1) rdmods
    50.8 +    by (simp add: uint_word_ariths(1) mod_simps
    50.9        uint_word_of_int_id)
   50.10  qed
   50.11  
    51.1 --- a/src/HOL/SPARK/Manual/Proc1.thy	Tue Dec 20 16:17:13 2016 +0100
    51.2 +++ b/src/HOL/SPARK/Manual/Proc1.thy	Tue Dec 20 16:18:56 2016 +0100
    51.3 @@ -5,10 +5,10 @@
    51.4  spark_open "loop_invariant/proc1"
    51.5  
    51.6  spark_vc procedure_proc1_5
    51.7 -  by (simp add: ring_distribs pull_mods)
    51.8 +  by (simp add: ring_distribs mod_simps)
    51.9  
   51.10  spark_vc procedure_proc1_8
   51.11 -  by (simp add: ring_distribs pull_mods)
   51.12 +  by (simp add: ring_distribs mod_simps)
   51.13  
   51.14  spark_end
   51.15  
    52.1 --- a/src/HOL/SPARK/Manual/Proc2.thy	Tue Dec 20 16:17:13 2016 +0100
    52.2 +++ b/src/HOL/SPARK/Manual/Proc2.thy	Tue Dec 20 16:18:56 2016 +0100
    52.3 @@ -5,7 +5,7 @@
    52.4  spark_open "loop_invariant/proc2"
    52.5  
    52.6  spark_vc procedure_proc2_7
    52.7 -  by (simp add: ring_distribs pull_mods)
    52.8 +  by (simp add: ring_distribs mod_simps)
    52.9  
   52.10  spark_end
   52.11  
    53.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML	Tue Dec 20 16:17:13 2016 +0100
    53.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML	Tue Dec 20 16:18:56 2016 +0100
    53.3 @@ -141,8 +141,6 @@
    53.4        | flatten' (t as Abs _) (names, prems) = [(t, (names, prems))]
    53.5        | flatten' (t as _ $ _) (names, prems) =
    53.6        if is_constrt ctxt t orelse keep_functions thy t then
    53.7 -       (* FIXME: constructor terms are supposed to be seen in the way the code generator
    53.8 -          sees constructors?*)
    53.9          [(t, (names, prems))]
   53.10        else
   53.11          case (fst (strip_comb t)) of
    54.1 --- a/src/HOL/Tools/Qelim/cooper.ML	Tue Dec 20 16:17:13 2016 +0100
    54.2 +++ b/src/HOL/Tools/Qelim/cooper.ML	Tue Dec 20 16:18:56 2016 +0100
    54.3 @@ -823,15 +823,13 @@
    54.4      |> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}])
    54.5  val div_mod_ss =
    54.6    simpset_of (put_simpset HOL_basic_ss @{context}
    54.7 -    addsimps @{thms simp_thms}
    54.8 -    @ map (Thm.symmetric o mk_meta_eq) 
    54.9 -      [@{thm "dvd_eq_mod_eq_0"},
   54.10 -       @{thm "mod_add_left_eq"}, @{thm "mod_add_right_eq"}, 
   54.11 -       @{thm "mod_add_eq"}, @{thm "div_add1_eq"}, @{thm "zdiv_zadd1_eq"}]
   54.12 -    @ [@{thm "mod_self"}, @{thm "mod_by_0"}, @{thm "div_by_0"},
   54.13 -       @{thm "div_0"}, @{thm "mod_0"}, @{thm "div_by_1"}, @{thm "mod_by_1"},
   54.14 -       @{thm "div_by_Suc_0"}, @{thm "mod_by_Suc_0"}, @{thm "Suc_eq_plus1"}]
   54.15 -    @ @{thms ac_simps}
   54.16 +    addsimps @{thms simp_thms
   54.17 +      mod_eq_0_iff_dvd mod_add_left_eq mod_add_right_eq
   54.18 +      mod_add_eq div_add1_eq [symmetric] zdiv_zadd1_eq [symmetric]
   54.19 +      mod_self mod_by_0 div_by_0
   54.20 +      div_0 mod_0 div_by_1 mod_by_1
   54.21 +      div_by_Suc_0 mod_by_Suc_0 Suc_eq_plus1
   54.22 +      ac_simps}
   54.23     addsimprocs [@{simproc cancel_div_mod_nat}, @{simproc cancel_div_mod_int}])
   54.24  val splits_ss =
   54.25    simpset_of (put_simpset comp_ss @{context}
    55.1 --- a/src/HOL/Word/Bit_Representation.thy	Tue Dec 20 16:17:13 2016 +0100
    55.2 +++ b/src/HOL/Word/Bit_Representation.thy	Tue Dec 20 16:18:56 2016 +0100
    55.3 @@ -308,17 +308,12 @@
    55.4  
    55.5  lemma sbintrunc_mod2p: "sbintrunc n w = (w + 2 ^ n) mod 2 ^ (Suc n) - 2 ^ n"
    55.6    apply (induct n arbitrary: w)
    55.7 -   apply simp
    55.8 -   apply (subst mod_add_left_eq)
    55.9 -   apply (simp add: bin_last_def)
   55.10 -   apply arith
   55.11 -  apply (simp add: bin_last_def bin_rest_def Bit_def)
   55.12 -  apply (clarsimp simp: mod_mult_mult1 [symmetric] 
   55.13 -         mult_div_mod_eq [symmetric, THEN diff_eq_eq [THEN iffD2 [THEN sym]]])
   55.14 -  apply (rule trans [symmetric, OF _ emep1])
   55.15 -  apply auto
   55.16 +   apply (auto simp add: bin_last_odd bin_rest_def Bit_def elim!: evenE oddE)
   55.17 +   apply (smt pos_zmod_mult_2 zle2p)
   55.18 +  apply (simp add: mult_mod_right)
   55.19    done
   55.20  
   55.21 +
   55.22  subsection "Simplifications for (s)bintrunc"
   55.23  
   55.24  lemma bintrunc_n_0 [simp]: "bintrunc n 0 = 0"
   55.25 @@ -647,28 +642,6 @@
   55.26    "x >= (2 ^ n) ==> x - 2 ^ (Suc n) >= sbintrunc n x"
   55.27    unfolding no_sbintr_alt2 by (drule sb_dec_lem') simp
   55.28  
   55.29 -lemmas zmod_uminus' = zminus_zmod [where m=c] for c
   55.30 -lemmas zpower_zmod' = power_mod [where b=c and n=k] for c k
   55.31 -
   55.32 -lemmas brdmod1s' [symmetric] =
   55.33 -  mod_add_left_eq mod_add_right_eq
   55.34 -  mod_diff_left_eq mod_diff_right_eq
   55.35 -  mod_mult_left_eq mod_mult_right_eq
   55.36 -
   55.37 -lemmas brdmods' [symmetric] = 
   55.38 -  zpower_zmod' [symmetric]
   55.39 -  trans [OF mod_add_left_eq mod_add_right_eq] 
   55.40 -  trans [OF mod_diff_left_eq mod_diff_right_eq] 
   55.41 -  trans [OF mod_mult_right_eq mod_mult_left_eq] 
   55.42 -  zmod_uminus' [symmetric]
   55.43 -  mod_add_left_eq [where b = "1::int"]
   55.44 -  mod_diff_left_eq [where b = "1::int"]
   55.45 -
   55.46 -lemmas bintr_arith1s =
   55.47 -  brdmod1s' [where c="2^n::int", folded bintrunc_mod2p] for n
   55.48 -lemmas bintr_ariths =
   55.49 -  brdmods' [where c="2^n::int", folded bintrunc_mod2p] for n
   55.50 -
   55.51  lemmas m2pths = pos_mod_sign pos_mod_bound [OF zless2p]
   55.52  
   55.53  lemma bintr_ge0: "0 \<le> bintrunc n w"
    56.1 --- a/src/HOL/Word/Bits_Int.thy	Tue Dec 20 16:17:13 2016 +0100
    56.2 +++ b/src/HOL/Word/Bits_Int.thy	Tue Dec 20 16:18:56 2016 +0100
    56.3 @@ -643,14 +643,14 @@
    56.4  lemma mod_BIT:
    56.5    "bin BIT bit mod 2 ^ Suc n = (bin mod 2 ^ n) BIT bit"
    56.6  proof -
    56.7 -  have "bin mod 2 ^ n < 2 ^ n" by simp
    56.8 -  then have "bin mod 2 ^ n \<le> 2 ^ n - 1" by simp
    56.9 -  then have "2 * (bin mod 2 ^ n) \<le> 2 * (2 ^ n - 1)"
   56.10 -    by (rule mult_left_mono) simp
   56.11 -  then have "2 * (bin mod 2 ^ n) + 1 < 2 * 2 ^ n" by simp
   56.12 -  then show ?thesis
   56.13 -    by (auto simp add: Bit_def mod_mult_mult1 mod_add_left_eq [of "2 * bin"]
   56.14 -      mod_pos_pos_trivial)
   56.15 +  have "2 * (bin mod 2 ^ n) + 1 = (2 * bin mod 2 ^ Suc n) + 1"
   56.16 +    by (simp add: mod_mult_mult1)
   56.17 +  also have "\<dots> = ((2 * bin mod 2 ^ Suc n) + 1) mod 2 ^ Suc n"
   56.18 +    by (simp add: ac_simps p1mod22k')
   56.19 +  also have "\<dots> = (2 * bin + 1) mod 2 ^ Suc n"
   56.20 +    by (simp only: mod_simps)
   56.21 +  finally show ?thesis
   56.22 +    by (auto simp add: Bit_def)
   56.23  qed
   56.24  
   56.25  lemma AND_mod:
    57.1 --- a/src/HOL/Word/Misc_Numeric.thy	Tue Dec 20 16:17:13 2016 +0100
    57.2 +++ b/src/HOL/Word/Misc_Numeric.thy	Tue Dec 20 16:18:56 2016 +0100
    57.3 @@ -8,6 +8,10 @@
    57.4  imports Main
    57.5  begin
    57.6  
    57.7 +lemma one_mod_exp_eq_one [simp]:
    57.8 +  "1 mod (2 * 2 ^ n) = (1::int)"
    57.9 +  by (smt mod_pos_pos_trivial zero_less_power)
   57.10 +
   57.11  lemma mod_2_neq_1_eq_eq_0:
   57.12    fixes k :: int
   57.13    shows "k mod 2 \<noteq> 1 \<longleftrightarrow> k mod 2 = 0"
    58.1 --- a/src/HOL/Word/Word.thy	Tue Dec 20 16:17:13 2016 +0100
    58.2 +++ b/src/HOL/Word/Word.thy	Tue Dec 20 16:18:56 2016 +0100
    58.3 @@ -282,10 +282,10 @@
    58.4  subsection \<open>Arithmetic operations\<close>
    58.5  
    58.6  lift_definition word_succ :: "'a::len0 word \<Rightarrow> 'a word" is "\<lambda>x. x + 1"
    58.7 -  by (metis bintr_ariths(6))
    58.8 +  by (auto simp add: bintrunc_mod2p intro: mod_add_cong)
    58.9  
   58.10  lift_definition word_pred :: "'a::len0 word \<Rightarrow> 'a word" is "\<lambda>x. x - 1"
   58.11 -  by (metis bintr_ariths(7))
   58.12 +  by (auto simp add: bintrunc_mod2p intro: mod_diff_cong)
   58.13  
   58.14  instantiation word :: (len0) "{neg_numeral, modulo, comm_monoid_mult, comm_ring}"
   58.15  begin
   58.16 @@ -295,16 +295,16 @@
   58.17  lift_definition one_word :: "'a word" is "1" .
   58.18  
   58.19  lift_definition plus_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" is "op +"
   58.20 -  by (metis bintr_ariths(2))
   58.21 +  by (auto simp add: bintrunc_mod2p intro: mod_add_cong)
   58.22  
   58.23  lift_definition minus_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" is "op -"
   58.24 -  by (metis bintr_ariths(3))
   58.25 +  by (auto simp add: bintrunc_mod2p intro: mod_diff_cong)
   58.26  
   58.27  lift_definition uminus_word :: "'a word \<Rightarrow> 'a word" is uminus
   58.28 -  by (metis bintr_ariths(5))
   58.29 +  by (auto simp add: bintrunc_mod2p intro: mod_minus_cong)
   58.30  
   58.31  lift_definition times_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" is "op *"
   58.32 -  by (metis bintr_ariths(4))
   58.33 +  by (auto simp add: bintrunc_mod2p intro: mod_mult_cong)
   58.34  
   58.35  definition
   58.36    word_div_def: "a div b = word_of_int (uint a div uint b)"
   58.37 @@ -332,9 +332,6 @@
   58.38    unfolding word_succ_def word_pred_def zero_word_def one_word_def
   58.39    by simp_all
   58.40  
   58.41 -lemmas arths = 
   58.42 -  bintr_ariths [THEN word_ubin.norm_eq_iff [THEN iffD1], folded word_ubin.eq_norm]
   58.43 -
   58.44  lemma wi_homs: 
   58.45    shows
   58.46    wi_hom_add: "word_of_int a + word_of_int b = word_of_int (a + b)" and
   58.47 @@ -1340,10 +1337,11 @@
   58.48      and "sint (word_pred a) = sbintrunc (len_of TYPE('a) - 1) (sint a - 1)"
   58.49      and "sint (0 :: 'a word) = sbintrunc (len_of TYPE('a) - 1) 0"
   58.50      and "sint (1 :: 'a word) = sbintrunc (len_of TYPE('a) - 1) 1"
   58.51 -  by (simp_all add: uint_word_arith_bintrs
   58.52 -    [THEN uint_sint [symmetric, THEN trans],
   58.53 -    unfolded uint_sint bintr_arith1s bintr_ariths 
   58.54 -      len_gt_0 [THEN bin_sbin_eq_iff'] word_sbin.norm_Rep])
   58.55 +         apply (simp_all only: word_sbin.inverse_norm [symmetric])
   58.56 +         apply (simp_all add: wi_hom_syms)
   58.57 +   apply transfer apply simp
   58.58 +  apply transfer apply simp
   58.59 +  done
   58.60  
   58.61  lemmas uint_div_alt = word_div_def [THEN trans [OF uint_cong int_word_uint]]
   58.62  lemmas uint_mod_alt = word_mod_def [THEN trans [OF uint_cong int_word_uint]]
   58.63 @@ -1443,7 +1441,7 @@
   58.64    with \<open>1 \<le> uint w\<close> have "nat ((uint w - 1) mod 2 ^ len_of TYPE('a)) = nat (uint w) - 1"
   58.65      by auto
   58.66    then show ?thesis
   58.67 -    by (simp only: unat_def int_word_uint word_arith_wis mod_diff_right_eq [symmetric])
   58.68 +    by (simp only: unat_def int_word_uint word_arith_wis mod_diff_right_eq)
   58.69  qed
   58.70  
   58.71  lemma measure_unat: "p ~= 0 \<Longrightarrow> unat (p - 1) < unat p"
   58.72 @@ -2699,7 +2697,7 @@
   58.73  lemma nth_w2p:
   58.74    "((2::'a::len word) ^ n) !! m \<longleftrightarrow> m = n \<and> m < len_of TYPE('a::len)"
   58.75    unfolding test_bit_2p [symmetric] word_of_int [symmetric]
   58.76 -  by (simp add:  of_int_power)
   58.77 +  by simp
   58.78  
   58.79  lemma uint_2p: 
   58.80    "(0::'a::len word) < 2 ^ n \<Longrightarrow> uint (2 ^ n::'a::len word) = 2 ^ n"
   58.81 @@ -2723,16 +2721,7 @@
   58.82    done
   58.83  
   58.84  lemma word_of_int_2p: "(word_of_int (2 ^ n) :: 'a :: len word) = 2 ^ n" 
   58.85 -  apply (unfold word_arith_power_alt)
   58.86 -  apply (case_tac "len_of TYPE ('a)")
   58.87 -   apply clarsimp
   58.88 -  apply (case_tac "nat")
   58.89 -   apply (rule word_ubin.norm_eq_iff [THEN iffD1]) 
   58.90 -   apply (rule box_equals) 
   58.91 -     apply (rule_tac [2] bintr_ariths (1))+ 
   58.92 -   apply simp
   58.93 -  apply simp
   58.94 -  done
   58.95 +  by (induct n) (simp_all add: wi_hom_syms)
   58.96  
   58.97  lemma bang_is_le: "x !! m \<Longrightarrow> 2 ^ m <= (x :: 'a :: len word)" 
   58.98    apply (rule xtr3) 
   58.99 @@ -3244,6 +3233,9 @@
  58.100  lemma and_mask_wi: "word_of_int i AND mask n = word_of_int (bintrunc n i)"
  58.101    by (auto simp add: nth_bintr word_size word_ops_nth_size word_eq_iff)
  58.102  
  58.103 +lemma and_mask_wi': "word_of_int i AND mask n = (word_of_int (bintrunc (min LENGTH('a) n) i) :: 'a::len word)"
  58.104 +  by (auto simp add: nth_bintr word_size word_ops_nth_size word_eq_iff)
  58.105 +
  58.106  lemma and_mask_no: "numeral i AND mask n = word_of_int (bintrunc n (numeral i))"
  58.107    unfolding word_numeral_alt by (rule and_mask_wi)
  58.108  
  58.109 @@ -3342,12 +3334,12 @@
  58.110    "word_succ (a AND mask n) AND mask n = word_succ a AND mask n"
  58.111    "word_pred (a AND mask n) AND mask n = word_pred a AND mask n"
  58.112    using word_of_int_Ex [where x=a] word_of_int_Ex [where x=b]
  58.113 -  by (auto simp: and_mask_wi bintr_ariths bintr_arith1s word_of_int_homs)
  58.114 +  by (auto simp add: and_mask_wi' word_of_int_homs word.abs_eq_iff bintrunc_mod2p mod_simps)
  58.115  
  58.116  lemma mask_power_eq:
  58.117    "(x AND mask n) ^ k AND mask n = x ^ k AND mask n"
  58.118    using word_of_int_Ex [where x=x]
  58.119 -  by (clarsimp simp: and_mask_wi word_of_int_power_hom bintr_ariths)
  58.120 +  by (auto simp add: and_mask_wi' word_of_int_power_hom word.abs_eq_iff bintrunc_mod2p mod_simps)
  58.121  
  58.122  
  58.123  subsubsection \<open>Revcast\<close>
  58.124 @@ -4242,7 +4234,7 @@
  58.125    apply (simp add: word_size nat_mod_distrib)
  58.126    apply (rule of_nat_eq_0_iff [THEN iffD1])
  58.127    apply (auto simp add: not_le mod_eq_0_iff_dvd zdvd_int nat_add_distrib [symmetric])
  58.128 -  using mod_mod_trivial zmod_eq_dvd_iff
  58.129 +  using mod_mod_trivial mod_eq_dvd_iff
  58.130    apply blast
  58.131    done
  58.132  
  58.133 @@ -4579,9 +4571,9 @@
  58.134    shows "(x + y) mod b = z' mod b'"
  58.135  proof -
  58.136    from 1 2[symmetric] 3[symmetric] have "(x + y) mod b = (x' mod b' + y' mod b') mod b'"
  58.137 -    by (simp add: mod_add_eq[symmetric])
  58.138 +    by (simp add: mod_add_eq)
  58.139    also have "\<dots> = (x' + y') mod b'"
  58.140 -    by (simp add: mod_add_eq[symmetric])
  58.141 +    by (simp add: mod_add_eq)
  58.142    finally show ?thesis by (simp add: 4)
  58.143  qed
  58.144  
  58.145 @@ -4591,11 +4583,8 @@
  58.146        and 3: "y mod b' = y' mod b'"
  58.147        and 4: "x' - y' = z'"
  58.148    shows "(x - y) mod b = z' mod b'"
  58.149 -  using assms
  58.150 -  apply (subst mod_diff_left_eq)
  58.151 -  apply (subst mod_diff_right_eq)
  58.152 -  apply (simp add: mod_diff_left_eq [symmetric] mod_diff_right_eq [symmetric])
  58.153 -  done
  58.154 +  using 1 2 3 4 [symmetric]
  58.155 +  by (auto intro: mod_diff_cong)
  58.156  
  58.157  lemma word_induct_less: 
  58.158    "\<lbrakk>P (0::'a::len word); \<And>n. \<lbrakk>n < m; P n\<rbrakk> \<Longrightarrow> P (1 + n)\<rbrakk> \<Longrightarrow> P m"
    59.1 --- a/src/HOL/Word/Word_Miscellaneous.thy	Tue Dec 20 16:17:13 2016 +0100
    59.2 +++ b/src/HOL/Word/Word_Miscellaneous.thy	Tue Dec 20 16:18:56 2016 +0100
    59.3 @@ -201,10 +201,6 @@
    59.4  
    59.5  lemmas push_mods = push_mods' [THEN eq_reflection]
    59.6  lemmas pull_mods = push_mods [symmetric] rdmods [THEN eq_reflection]
    59.7 -lemmas mod_simps = 
    59.8 -  mod_mult_self2_is_0 [THEN eq_reflection]
    59.9 -  mod_mult_self1_is_0 [THEN eq_reflection]
   59.10 -  mod_mod_trivial [THEN eq_reflection]
   59.11  
   59.12  lemma nat_mod_eq:
   59.13    "!!b. b < n ==> a mod n = b mod n ==> a mod n = (b :: nat)" 
    60.1 --- a/src/HOL/ex/Word_Type.thy	Tue Dec 20 16:17:13 2016 +0100
    60.2 +++ b/src/HOL/ex/Word_Type.thy	Tue Dec 20 16:18:56 2016 +0100
    60.3 @@ -57,7 +57,7 @@
    60.4  
    60.5  lemma bitrunc_plus:
    60.6    "bitrunc n (bitrunc n a + bitrunc n b) = bitrunc n (a + b)"
    60.7 -  by (simp add: bitrunc_eq_mod mod_add_eq [symmetric])
    60.8 +  by (simp add: bitrunc_eq_mod mod_add_eq)
    60.9  
   60.10  lemma bitrunc_of_1_eq_0_iff [simp]:
   60.11    "bitrunc n 1 = 0 \<longleftrightarrow> n = 0"
   60.12 @@ -74,12 +74,12 @@