42 inverses or division. This is catered for by @{text field_simps}. *} |
41 inverses or division. This is catered for by @{text field_simps}. *} |
43 |
42 |
44 subsection {* Semigroups and Monoids *} |
43 subsection {* Semigroups and Monoids *} |
45 |
44 |
46 class semigroup_add = plus + |
45 class semigroup_add = plus + |
47 assumes add_assoc[algebra_simps]: "(a + b) + c = a + (b + c)" |
46 assumes add_assoc [algebra_simps]: "(a + b) + c = a + (b + c)" |
|
47 |
|
48 sublocale semigroup_add < plus!: semigroup plus proof |
|
49 qed (fact add_assoc) |
48 |
50 |
49 class ab_semigroup_add = semigroup_add + |
51 class ab_semigroup_add = semigroup_add + |
50 assumes add_commute[algebra_simps]: "a + b = b + a" |
52 assumes add_commute [algebra_simps]: "a + b = b + a" |
51 begin |
53 |
52 |
54 sublocale ab_semigroup_add < plus!: abel_semigroup plus proof |
53 lemma add_left_commute[algebra_simps]: "a + (b + c) = b + (a + c)" |
55 qed (fact add_commute) |
54 by (rule mk_left_commute [of "plus", OF add_assoc add_commute]) |
56 |
|
57 context ab_semigroup_add |
|
58 begin |
|
59 |
|
60 lemmas add_left_commute [algebra_simps] = plus.left_commute |
55 |
61 |
56 theorems add_ac = add_assoc add_commute add_left_commute |
62 theorems add_ac = add_assoc add_commute add_left_commute |
57 |
63 |
58 end |
64 end |
59 |
65 |
60 theorems add_ac = add_assoc add_commute add_left_commute |
66 theorems add_ac = add_assoc add_commute add_left_commute |
61 |
67 |
62 class semigroup_mult = times + |
68 class semigroup_mult = times + |
63 assumes mult_assoc[algebra_simps]: "(a * b) * c = a * (b * c)" |
69 assumes mult_assoc [algebra_simps]: "(a * b) * c = a * (b * c)" |
|
70 |
|
71 sublocale semigroup_mult < times!: semigroup times proof |
|
72 qed (fact mult_assoc) |
64 |
73 |
65 class ab_semigroup_mult = semigroup_mult + |
74 class ab_semigroup_mult = semigroup_mult + |
66 assumes mult_commute[algebra_simps]: "a * b = b * a" |
75 assumes mult_commute [algebra_simps]: "a * b = b * a" |
67 begin |
76 |
68 |
77 sublocale ab_semigroup_mult < times!: abel_semigroup times proof |
69 lemma mult_left_commute[algebra_simps]: "a * (b * c) = b * (a * c)" |
78 qed (fact mult_commute) |
70 by (rule mk_left_commute [of "times", OF mult_assoc mult_commute]) |
79 |
|
80 context ab_semigroup_mult |
|
81 begin |
|
82 |
|
83 lemmas mult_left_commute [algebra_simps] = times.left_commute |
71 |
84 |
72 theorems mult_ac = mult_assoc mult_commute mult_left_commute |
85 theorems mult_ac = mult_assoc mult_commute mult_left_commute |
73 |
86 |
74 end |
87 end |
75 |
88 |
76 theorems mult_ac = mult_assoc mult_commute mult_left_commute |
89 theorems mult_ac = mult_assoc mult_commute mult_left_commute |
77 |
90 |
78 class ab_semigroup_idem_mult = ab_semigroup_mult + |
91 class ab_semigroup_idem_mult = ab_semigroup_mult + |
79 assumes mult_idem[simp]: "x * x = x" |
92 assumes mult_idem: "x * x = x" |
80 begin |
93 |
81 |
94 sublocale ab_semigroup_idem_mult < times!: semilattice times proof |
82 lemma mult_left_idem[simp]: "x * (x * y) = x * y" |
95 qed (fact mult_idem) |
83 unfolding mult_assoc [symmetric, of x] mult_idem .. |
96 |
|
97 context ab_semigroup_idem_mult |
|
98 begin |
|
99 |
|
100 lemmas mult_left_idem = times.left_idem |
84 |
101 |
85 end |
102 end |
86 |
103 |
87 class monoid_add = zero + semigroup_add + |
104 class monoid_add = zero + semigroup_add + |
88 assumes add_0_left [simp]: "0 + a = a" |
105 assumes add_0_left [simp]: "0 + a = a" |
1368 ( |
1385 ( |
1369 |
1386 |
1370 (* term order for abelian groups *) |
1387 (* term order for abelian groups *) |
1371 |
1388 |
1372 fun agrp_ord (Const (a, _)) = find_index (fn a' => a = a') |
1389 fun agrp_ord (Const (a, _)) = find_index (fn a' => a = a') |
1373 [@{const_name HOL.zero}, @{const_name HOL.plus}, |
1390 [@{const_name Algebras.zero}, @{const_name Algebras.plus}, |
1374 @{const_name HOL.uminus}, @{const_name HOL.minus}] |
1391 @{const_name Algebras.uminus}, @{const_name Algebras.minus}] |
1375 | agrp_ord _ = ~1; |
1392 | agrp_ord _ = ~1; |
1376 |
1393 |
1377 fun termless_agrp (a, b) = (TermOrd.term_lpo agrp_ord (a, b) = LESS); |
1394 fun termless_agrp (a, b) = (TermOrd.term_lpo agrp_ord (a, b) = LESS); |
1378 |
1395 |
1379 local |
1396 local |
1380 val ac1 = mk_meta_eq @{thm add_assoc}; |
1397 val ac1 = mk_meta_eq @{thm add_assoc}; |
1381 val ac2 = mk_meta_eq @{thm add_commute}; |
1398 val ac2 = mk_meta_eq @{thm add_commute}; |
1382 val ac3 = mk_meta_eq @{thm add_left_commute}; |
1399 val ac3 = mk_meta_eq @{thm add_left_commute}; |
1383 fun solve_add_ac thy _ (_ $ (Const (@{const_name HOL.plus},_) $ _ $ _) $ _) = |
1400 fun solve_add_ac thy _ (_ $ (Const (@{const_name Algebras.plus},_) $ _ $ _) $ _) = |
1384 SOME ac1 |
1401 SOME ac1 |
1385 | solve_add_ac thy _ (_ $ x $ (Const (@{const_name HOL.plus},_) $ y $ z)) = |
1402 | solve_add_ac thy _ (_ $ x $ (Const (@{const_name Algebras.plus},_) $ y $ z)) = |
1386 if termless_agrp (y, x) then SOME ac3 else NONE |
1403 if termless_agrp (y, x) then SOME ac3 else NONE |
1387 | solve_add_ac thy _ (_ $ x $ y) = |
1404 | solve_add_ac thy _ (_ $ x $ y) = |
1388 if termless_agrp (y, x) then SOME ac2 else NONE |
1405 if termless_agrp (y, x) then SOME ac2 else NONE |
1389 | solve_add_ac thy _ _ = NONE |
1406 | solve_add_ac thy _ _ = NONE |
1390 in |
1407 in |