# HG changeset patch # User wenzelm # Date 1165524253 -3600 # Node ID dfc7b21d0ee90d1ca62796b089528a60a3063545 # Parent e811cf937c64ada4eaa7299f2b8dac5a7b41d116 begin/end blocks; tuned notation; diff -r e811cf937c64 -r dfc7b21d0ee9 src/HOL/ex/Classpackage.thy --- a/src/HOL/ex/Classpackage.thy Thu Dec 07 21:08:51 2006 +0100 +++ b/src/HOL/ex/Classpackage.thy Thu Dec 07 21:44:13 2006 +0100 @@ -2,7 +2,7 @@ Author: Florian Haftmann, TU Muenchen *) -header {* Test and Examples for Pure/Tools/class_package.ML *} +header {* Test and examples for new class package *} theory Classpackage imports Main @@ -96,30 +96,33 @@ from monoid_comm_num_def show "k \ l = l \ k" by simp qed -definition (in monoid) +context monoid +begin + +definition units :: "'a set" where - "units = { y. \x. x \<^loc>\ y = \<^loc>\ \ y \<^loc>\ x = \<^loc>\ }" + "units = {y. \x. x \<^loc>\ y = \<^loc>\ \ y \<^loc>\ x = \<^loc>\}" -lemma (in monoid) inv_obtain: - assumes ass: "x \ units" +lemma inv_obtain: + assumes "x \ units" obtains y where "y \<^loc>\ x = \<^loc>\" and "x \<^loc>\ y = \<^loc>\" proof - - from ass units_def obtain y + from assms units_def obtain y where "y \<^loc>\ x = \<^loc>\" and "x \<^loc>\ y = \<^loc>\" by auto thus ?thesis .. qed -lemma (in monoid) inv_unique: - assumes eq: "y \<^loc>\ x = \<^loc>\" "x \<^loc>\ y' = \<^loc>\" +lemma inv_unique: + assumes "y \<^loc>\ x = \<^loc>\" "x \<^loc>\ y' = \<^loc>\" shows "y = y'" proof - - from eq neutr have "y = y \<^loc>\ (x \<^loc>\ y')" by simp + from assms neutr have "y = y \<^loc>\ (x \<^loc>\ y')" by simp also with assoc have "... = (y \<^loc>\ x) \<^loc>\ y'" by simp - also with eq neutl have "... = y'" by simp + also with assms neutl have "... = y'" by simp finally show ?thesis . qed -lemma (in monoid) units_inv_comm: +lemma units_inv_comm: assumes inv: "x \<^loc>\ y = \<^loc>\" and G: "x \ units" shows "y \<^loc>\ x = \<^loc>\" @@ -131,6 +134,8 @@ with neutl z_choice show ?thesis by simp qed +end + consts reduce :: "('a \ 'a \ 'a) \ 'a \ nat \ 'a \ 'a" @@ -138,35 +143,38 @@ "reduce f g 0 x = g" "reduce f g (Suc n) x = f x (reduce f g n x)" -definition (in monoid) +context monoid +begin + +definition npow :: "nat \ 'a \ 'a" where npow_def_prim: "npow n x = reduce (op \<^loc>\) \<^loc>\ n x" -abbreviation (in monoid) - abbrev_npow :: "'a \ nat \ 'a" (infix "\<^loc>\" 75) where +abbreviation + npow_syn :: "'a \ nat \ 'a" (infix "\<^loc>\" 75) where "x \<^loc>\ n \ npow n x" -lemma (in monoid) npow_def: +lemma npow_def: "x \<^loc>\ 0 = \<^loc>\" "x \<^loc>\ Suc n = x \<^loc>\ x \<^loc>\ n" using npow_def_prim by simp_all -lemma (in monoid) nat_pow_one: +lemma nat_pow_one: "\<^loc>\ \<^loc>\ n = \<^loc>\" using npow_def neutl by (induct n) simp_all -lemma (in monoid) nat_pow_mult: - "npow n x \<^loc>\ npow m x = npow (n + m) x" +lemma nat_pow_mult: "x \<^loc>\ n \<^loc>\ x \<^loc>\ m = x \<^loc>\ (n + m)" proof (induct n) case 0 with neutl npow_def show ?case by simp next case (Suc n) with Suc.hyps assoc npow_def show ?case by simp qed -lemma (in monoid) nat_pow_pow: - "npow n (npow m x) = npow (n * m) x" +lemma nat_pow_pow: "(x \<^loc>\ m) \<^loc>\ n = x \<^loc>\ (n * m)" using npow_def nat_pow_mult by (induct n) simp_all +end + class group = monoidl + fixes inv :: "'a \ 'a" ("\<^loc>\
_" [81] 80) assumes invl: "\<^loc>\
x \<^loc>\ x = \<^loc>\" @@ -277,7 +285,7 @@ else (monoid.npow (op \<^loc>\) \<^loc>\ (nat k) x))" abbreviation (in group) - abbrev_pow :: "'a \ int \ 'a" (infix "\<^loc>\" 75) where + pow_syn :: "'a \ int \ 'a" (infix "\<^loc>\" 75) where "x \<^loc>\ k \ pow k x" lemma (in group) int_pow_zero: