src/HOL/Hyperreal/StarClasses.thy
author haftmann
Fri Dec 07 15:07:59 2007 +0100 (2007-12-07)
changeset 25571 c9e39eafc7a0
parent 25304 7491c00f0915
permissions -rw-r--r--
instantiation target rather than legacy instance
huffman@17296
     1
(*  Title       : HOL/Hyperreal/StarClasses.thy
huffman@17296
     2
    ID          : $Id$
huffman@17296
     3
    Author      : Brian Huffman
huffman@17296
     4
*)
huffman@17296
     5
huffman@17296
     6
header {* Class Instances *}
huffman@17296
     7
huffman@17296
     8
theory StarClasses
huffman@17429
     9
imports StarDef
huffman@17296
    10
begin
huffman@17296
    11
huffman@17332
    12
subsection {* Syntactic classes *}
huffman@17332
    13
haftmann@25571
    14
instantiation star :: (zero) zero
haftmann@25571
    15
begin
haftmann@25571
    16
haftmann@25571
    17
definition
haftmann@25571
    18
  star_zero_def:    "0 \<equiv> star_of 0"
haftmann@25571
    19
haftmann@25571
    20
instance ..
haftmann@25571
    21
haftmann@25571
    22
end
haftmann@25571
    23
haftmann@25571
    24
instantiation star :: (one) one
haftmann@25571
    25
begin
haftmann@25571
    26
haftmann@25571
    27
definition
haftmann@25571
    28
  star_one_def:     "1 \<equiv> star_of 1"
haftmann@22316
    29
haftmann@25571
    30
instance ..
haftmann@25571
    31
haftmann@25571
    32
end
haftmann@25571
    33
haftmann@25571
    34
instantiation star :: (plus) plus
haftmann@25571
    35
begin
haftmann@22316
    36
haftmann@25571
    37
definition
haftmann@25571
    38
  star_add_def:     "(op +) \<equiv> *f2* (op +)"
haftmann@25571
    39
haftmann@25571
    40
instance ..
haftmann@25571
    41
haftmann@25571
    42
end
haftmann@25571
    43
haftmann@25571
    44
instantiation star :: (times) times
haftmann@25571
    45
begin
haftmann@22316
    46
haftmann@25571
    47
definition
haftmann@25571
    48
  star_mult_def:    "(op *) \<equiv> *f2* (op *)"
haftmann@25571
    49
haftmann@25571
    50
instance ..
huffman@17332
    51
haftmann@25571
    52
end
haftmann@25571
    53
haftmann@25571
    54
instantiation star :: (minus) minus
haftmann@25571
    55
begin
haftmann@25571
    56
haftmann@25571
    57
definition
huffman@17429
    58
  star_minus_def:   "uminus \<equiv> *f* uminus"
haftmann@25571
    59
haftmann@25571
    60
definition
haftmann@25571
    61
  star_diff_def:    "(op -) \<equiv> *f2* (op -)"
haftmann@25571
    62
haftmann@25571
    63
instance ..
haftmann@25571
    64
haftmann@25571
    65
end
haftmann@23879
    66
haftmann@25571
    67
instantiation star :: (abs) abs
haftmann@25571
    68
begin
haftmann@25571
    69
haftmann@25571
    70
definition
haftmann@25571
    71
  star_abs_def:     "abs \<equiv> *f* abs"
haftmann@25571
    72
haftmann@25571
    73
instance ..
haftmann@25571
    74
haftmann@25571
    75
end
haftmann@25571
    76
haftmann@25571
    77
instantiation star :: (sgn) sgn
haftmann@25571
    78
begin
haftmann@22316
    79
haftmann@25571
    80
definition
haftmann@25571
    81
  star_sgn_def:     "sgn \<equiv> *f* sgn"
haftmann@25571
    82
haftmann@25571
    83
instance ..
nipkow@24506
    84
haftmann@25571
    85
end
haftmann@25571
    86
haftmann@25571
    87
instantiation star :: (inverse) inverse
haftmann@25571
    88
begin
haftmann@25571
    89
haftmann@25571
    90
definition
huffman@17429
    91
  star_divide_def:  "(op /) \<equiv> *f2* (op /)"
haftmann@25571
    92
haftmann@25571
    93
definition
haftmann@25571
    94
  star_inverse_def: "inverse \<equiv> *f* inverse"
haftmann@25571
    95
haftmann@25571
    96
instance ..
haftmann@25571
    97
haftmann@25571
    98
end
haftmann@22316
    99
haftmann@25571
   100
instantiation star :: (number) number
haftmann@25571
   101
begin
haftmann@25571
   102
haftmann@25571
   103
definition
haftmann@25571
   104
  star_number_def:  "number_of b \<equiv> star_of (number_of b)"
haftmann@25571
   105
haftmann@25571
   106
instance ..
haftmann@25571
   107
haftmann@25571
   108
end
haftmann@25571
   109
haftmann@25571
   110
instantiation star :: (Divides.div) Divides.div
haftmann@25571
   111
begin
haftmann@22316
   112
haftmann@25571
   113
definition
huffman@17429
   114
  star_div_def:     "(op div) \<equiv> *f2* (op div)"
haftmann@25571
   115
haftmann@25571
   116
definition
haftmann@25571
   117
  star_mod_def:     "(op mod) \<equiv> *f2* (op mod)"
haftmann@25571
   118
haftmann@25571
   119
instance ..
haftmann@25571
   120
haftmann@25571
   121
end
haftmann@25571
   122
haftmann@25571
   123
instantiation star :: (power) power
haftmann@25571
   124
begin
haftmann@25571
   125
haftmann@25571
   126
definition
haftmann@25571
   127
  star_power_def:   "(op ^) \<equiv> \<lambda>x n. ( *f* (\<lambda>x. x ^ n)) x"
haftmann@22316
   128
haftmann@25571
   129
instance ..
haftmann@25571
   130
haftmann@25571
   131
end
haftmann@25571
   132
haftmann@25571
   133
instantiation star :: (ord) ord
haftmann@25571
   134
begin
huffman@17332
   135
haftmann@25571
   136
definition
haftmann@22452
   137
  star_le_def:      "(op \<le>) \<equiv> *p2* (op \<le>)"
haftmann@25571
   138
haftmann@25571
   139
definition
haftmann@25571
   140
  star_less_def:    "(op <) \<equiv> *p2* (op <)"
haftmann@25571
   141
haftmann@25571
   142
instance ..
haftmann@25571
   143
haftmann@25571
   144
end
haftmann@22452
   145
huffman@17332
   146
lemmas star_class_defs [transfer_unfold] =
huffman@17332
   147
  star_zero_def     star_one_def      star_number_def
huffman@17332
   148
  star_add_def      star_diff_def     star_minus_def
huffman@17332
   149
  star_mult_def     star_divide_def   star_inverse_def
nipkow@24506
   150
  star_le_def       star_less_def     star_abs_def       star_sgn_def
huffman@17332
   151
  star_div_def      star_mod_def      star_power_def
huffman@17332
   152
huffman@20719
   153
text {* Class operations preserve standard elements *}
huffman@20719
   154
huffman@20719
   155
lemma Standard_zero: "0 \<in> Standard"
huffman@20719
   156
by (simp add: star_zero_def)
huffman@20719
   157
huffman@20719
   158
lemma Standard_one: "1 \<in> Standard"
huffman@20719
   159
by (simp add: star_one_def)
huffman@20719
   160
huffman@20719
   161
lemma Standard_number_of: "number_of b \<in> Standard"
huffman@20719
   162
by (simp add: star_number_def)
huffman@20719
   163
huffman@20719
   164
lemma Standard_add: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x + y \<in> Standard"
huffman@20719
   165
by (simp add: star_add_def)
huffman@20719
   166
huffman@20719
   167
lemma Standard_diff: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x - y \<in> Standard"
huffman@20719
   168
by (simp add: star_diff_def)
huffman@20719
   169
huffman@20719
   170
lemma Standard_minus: "x \<in> Standard \<Longrightarrow> - x \<in> Standard"
huffman@20719
   171
by (simp add: star_minus_def)
huffman@20719
   172
huffman@20719
   173
lemma Standard_mult: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x * y \<in> Standard"
huffman@20719
   174
by (simp add: star_mult_def)
huffman@20719
   175
huffman@20719
   176
lemma Standard_divide: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x / y \<in> Standard"
huffman@20719
   177
by (simp add: star_divide_def)
huffman@20719
   178
huffman@20719
   179
lemma Standard_inverse: "x \<in> Standard \<Longrightarrow> inverse x \<in> Standard"
huffman@20719
   180
by (simp add: star_inverse_def)
huffman@20719
   181
huffman@20719
   182
lemma Standard_abs: "x \<in> Standard \<Longrightarrow> abs x \<in> Standard"
huffman@20719
   183
by (simp add: star_abs_def)
huffman@20719
   184
huffman@20719
   185
lemma Standard_div: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x div y \<in> Standard"
huffman@20719
   186
by (simp add: star_div_def)
huffman@20719
   187
huffman@20719
   188
lemma Standard_mod: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x mod y \<in> Standard"
huffman@20719
   189
by (simp add: star_mod_def)
huffman@20719
   190
huffman@20719
   191
lemma Standard_power: "x \<in> Standard \<Longrightarrow> x ^ n \<in> Standard"
huffman@20719
   192
by (simp add: star_power_def)
huffman@20719
   193
huffman@20719
   194
lemmas Standard_simps [simp] =
huffman@20719
   195
  Standard_zero  Standard_one  Standard_number_of
huffman@20719
   196
  Standard_add  Standard_diff  Standard_minus
huffman@20719
   197
  Standard_mult  Standard_divide  Standard_inverse
huffman@20719
   198
  Standard_abs  Standard_div  Standard_mod
huffman@20719
   199
  Standard_power
huffman@20719
   200
huffman@17332
   201
text {* @{term star_of} preserves class operations *}
huffman@17332
   202
huffman@17332
   203
lemma star_of_add: "star_of (x + y) = star_of x + star_of y"
huffman@17332
   204
by transfer (rule refl)
huffman@17332
   205
huffman@17332
   206
lemma star_of_diff: "star_of (x - y) = star_of x - star_of y"
huffman@17332
   207
by transfer (rule refl)
huffman@17332
   208
huffman@17332
   209
lemma star_of_minus: "star_of (-x) = - star_of x"
huffman@17332
   210
by transfer (rule refl)
huffman@17332
   211
huffman@17332
   212
lemma star_of_mult: "star_of (x * y) = star_of x * star_of y"
huffman@17332
   213
by transfer (rule refl)
huffman@17332
   214
huffman@17332
   215
lemma star_of_divide: "star_of (x / y) = star_of x / star_of y"
huffman@17332
   216
by transfer (rule refl)
huffman@17332
   217
huffman@17332
   218
lemma star_of_inverse: "star_of (inverse x) = inverse (star_of x)"
huffman@17332
   219
by transfer (rule refl)
huffman@17332
   220
huffman@17332
   221
lemma star_of_div: "star_of (x div y) = star_of x div star_of y"
huffman@17332
   222
by transfer (rule refl)
huffman@17332
   223
huffman@17332
   224
lemma star_of_mod: "star_of (x mod y) = star_of x mod star_of y"
huffman@17332
   225
by transfer (rule refl)
huffman@17332
   226
huffman@17332
   227
lemma star_of_power: "star_of (x ^ n) = star_of x ^ n"
huffman@17332
   228
by transfer (rule refl)
huffman@17332
   229
huffman@17332
   230
lemma star_of_abs: "star_of (abs x) = abs (star_of x)"
huffman@17332
   231
by transfer (rule refl)
huffman@17332
   232
huffman@17332
   233
text {* @{term star_of} preserves numerals *}
huffman@17332
   234
huffman@17332
   235
lemma star_of_zero: "star_of 0 = 0"
huffman@17332
   236
by transfer (rule refl)
huffman@17332
   237
huffman@17332
   238
lemma star_of_one: "star_of 1 = 1"
huffman@17332
   239
by transfer (rule refl)
huffman@17332
   240
huffman@17332
   241
lemma star_of_number_of: "star_of (number_of x) = number_of x"
huffman@17332
   242
by transfer (rule refl)
huffman@17332
   243
huffman@17332
   244
text {* @{term star_of} preserves orderings *}
huffman@17332
   245
huffman@17332
   246
lemma star_of_less: "(star_of x < star_of y) = (x < y)"
huffman@17332
   247
by transfer (rule refl)
huffman@17332
   248
huffman@17332
   249
lemma star_of_le: "(star_of x \<le> star_of y) = (x \<le> y)"
huffman@17332
   250
by transfer (rule refl)
huffman@17332
   251
huffman@17332
   252
lemma star_of_eq: "(star_of x = star_of y) = (x = y)"
huffman@17332
   253
by transfer (rule refl)
huffman@17332
   254
huffman@17332
   255
text{*As above, for 0*}
huffman@17332
   256
huffman@17332
   257
lemmas star_of_0_less = star_of_less [of 0, simplified star_of_zero]
huffman@17332
   258
lemmas star_of_0_le   = star_of_le   [of 0, simplified star_of_zero]
huffman@17332
   259
lemmas star_of_0_eq   = star_of_eq   [of 0, simplified star_of_zero]
huffman@17332
   260
huffman@17332
   261
lemmas star_of_less_0 = star_of_less [of _ 0, simplified star_of_zero]
huffman@17332
   262
lemmas star_of_le_0   = star_of_le   [of _ 0, simplified star_of_zero]
huffman@17332
   263
lemmas star_of_eq_0   = star_of_eq   [of _ 0, simplified star_of_zero]
huffman@17332
   264
huffman@17332
   265
text{*As above, for 1*}
huffman@17332
   266
huffman@17332
   267
lemmas star_of_1_less = star_of_less [of 1, simplified star_of_one]
huffman@17332
   268
lemmas star_of_1_le   = star_of_le   [of 1, simplified star_of_one]
huffman@17332
   269
lemmas star_of_1_eq   = star_of_eq   [of 1, simplified star_of_one]
huffman@17332
   270
huffman@17332
   271
lemmas star_of_less_1 = star_of_less [of _ 1, simplified star_of_one]
huffman@17332
   272
lemmas star_of_le_1   = star_of_le   [of _ 1, simplified star_of_one]
huffman@17332
   273
lemmas star_of_eq_1   = star_of_eq   [of _ 1, simplified star_of_one]
huffman@17332
   274
huffman@17332
   275
text{*As above, for numerals*}
huffman@17332
   276
huffman@17332
   277
lemmas star_of_number_less =
huffman@17332
   278
  star_of_less [of "number_of w", standard, simplified star_of_number_of]
huffman@17332
   279
lemmas star_of_number_le   =
huffman@17332
   280
  star_of_le   [of "number_of w", standard, simplified star_of_number_of]
huffman@17332
   281
lemmas star_of_number_eq   =
huffman@17332
   282
  star_of_eq   [of "number_of w", standard, simplified star_of_number_of]
huffman@17332
   283
huffman@17332
   284
lemmas star_of_less_number =
huffman@17332
   285
  star_of_less [of _ "number_of w", standard, simplified star_of_number_of]
huffman@17332
   286
lemmas star_of_le_number   =
huffman@17332
   287
  star_of_le   [of _ "number_of w", standard, simplified star_of_number_of]
huffman@17332
   288
lemmas star_of_eq_number   =
huffman@17332
   289
  star_of_eq   [of _ "number_of w", standard, simplified star_of_number_of]
huffman@17332
   290
huffman@17332
   291
lemmas star_of_simps [simp] =
huffman@17332
   292
  star_of_add     star_of_diff    star_of_minus
huffman@17332
   293
  star_of_mult    star_of_divide  star_of_inverse
huffman@17332
   294
  star_of_div     star_of_mod
huffman@17332
   295
  star_of_power   star_of_abs
huffman@17332
   296
  star_of_zero    star_of_one     star_of_number_of
huffman@17332
   297
  star_of_less    star_of_le      star_of_eq
huffman@17332
   298
  star_of_0_less  star_of_0_le    star_of_0_eq
huffman@17332
   299
  star_of_less_0  star_of_le_0    star_of_eq_0
huffman@17332
   300
  star_of_1_less  star_of_1_le    star_of_1_eq
huffman@17332
   301
  star_of_less_1  star_of_le_1    star_of_eq_1
huffman@17332
   302
  star_of_number_less star_of_number_le star_of_number_eq
huffman@17332
   303
  star_of_less_number star_of_le_number star_of_eq_number
huffman@17332
   304
haftmann@22452
   305
subsection {* Ordering and lattice classes *}
huffman@17296
   306
huffman@17296
   307
instance star :: (order) order
huffman@17296
   308
apply (intro_classes)
haftmann@22316
   309
apply (transfer, rule order_less_le)
huffman@17296
   310
apply (transfer, rule order_refl)
huffman@17296
   311
apply (transfer, erule (1) order_trans)
huffman@17296
   312
apply (transfer, erule (1) order_antisym)
huffman@17296
   313
done
huffman@17296
   314
haftmann@25571
   315
instantiation star :: (lower_semilattice) lower_semilattice
haftmann@25571
   316
begin
haftmann@25571
   317
haftmann@25571
   318
definition
haftmann@22452
   319
  star_inf_def [transfer_unfold]: "inf \<equiv> *f2* inf"
haftmann@25571
   320
haftmann@25571
   321
instance
haftmann@22452
   322
  by default (transfer star_inf_def, auto)+
haftmann@22452
   323
haftmann@25571
   324
end
haftmann@25571
   325
haftmann@25571
   326
instantiation star :: (upper_semilattice) upper_semilattice
haftmann@25571
   327
begin
haftmann@25571
   328
haftmann@25571
   329
definition
haftmann@22452
   330
  star_sup_def [transfer_unfold]: "sup \<equiv> *f2* sup"
haftmann@25571
   331
haftmann@25571
   332
instance
haftmann@22452
   333
  by default (transfer star_sup_def, auto)+
haftmann@22452
   334
haftmann@25571
   335
end
haftmann@25571
   336
haftmann@22452
   337
instance star :: (lattice) lattice ..
haftmann@22452
   338
haftmann@22452
   339
instance star :: (distrib_lattice) distrib_lattice
haftmann@22452
   340
  by default (transfer, auto simp add: sup_inf_distrib1)
haftmann@22452
   341
haftmann@22452
   342
lemma Standard_inf [simp]:
haftmann@22452
   343
  "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> inf x y \<in> Standard"
haftmann@22452
   344
by (simp add: star_inf_def)
haftmann@22452
   345
haftmann@22452
   346
lemma Standard_sup [simp]:
haftmann@22452
   347
  "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> sup x y \<in> Standard"
haftmann@22452
   348
by (simp add: star_sup_def)
haftmann@22452
   349
haftmann@22452
   350
lemma star_of_inf [simp]: "star_of (inf x y) = inf (star_of x) (star_of y)"
haftmann@22452
   351
by transfer (rule refl)
haftmann@22452
   352
haftmann@22452
   353
lemma star_of_sup [simp]: "star_of (sup x y) = sup (star_of x) (star_of y)"
haftmann@22452
   354
by transfer (rule refl)
haftmann@22452
   355
huffman@17296
   356
instance star :: (linorder) linorder
huffman@17296
   357
by (intro_classes, transfer, rule linorder_linear)
huffman@17296
   358
huffman@20720
   359
lemma star_max_def [transfer_unfold]: "max = *f2* max"
huffman@20720
   360
apply (rule ext, rule ext)
huffman@20720
   361
apply (unfold max_def, transfer, fold max_def)
huffman@20720
   362
apply (rule refl)
huffman@20720
   363
done
huffman@20720
   364
huffman@20720
   365
lemma star_min_def [transfer_unfold]: "min = *f2* min"
huffman@20720
   366
apply (rule ext, rule ext)
huffman@20720
   367
apply (unfold min_def, transfer, fold min_def)
huffman@20720
   368
apply (rule refl)
huffman@20720
   369
done
huffman@20720
   370
huffman@20720
   371
lemma Standard_max [simp]:
huffman@20720
   372
  "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> max x y \<in> Standard"
huffman@20720
   373
by (simp add: star_max_def)
huffman@20720
   374
huffman@20720
   375
lemma Standard_min [simp]:
huffman@20720
   376
  "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> min x y \<in> Standard"
huffman@20720
   377
by (simp add: star_min_def)
huffman@20720
   378
huffman@20720
   379
lemma star_of_max [simp]: "star_of (max x y) = max (star_of x) (star_of y)"
huffman@20720
   380
by transfer (rule refl)
huffman@20720
   381
huffman@20720
   382
lemma star_of_min [simp]: "star_of (min x y) = min (star_of x) (star_of y)"
huffman@20720
   383
by transfer (rule refl)
huffman@20720
   384
huffman@17296
   385
huffman@17332
   386
subsection {* Ordered group classes *}
huffman@17296
   387
huffman@17296
   388
instance star :: (semigroup_add) semigroup_add
huffman@17296
   389
by (intro_classes, transfer, rule add_assoc)
huffman@17296
   390
huffman@17296
   391
instance star :: (ab_semigroup_add) ab_semigroup_add
huffman@17296
   392
by (intro_classes, transfer, rule add_commute)
huffman@17296
   393
huffman@17296
   394
instance star :: (semigroup_mult) semigroup_mult
huffman@17296
   395
by (intro_classes, transfer, rule mult_assoc)
huffman@17296
   396
huffman@17296
   397
instance star :: (ab_semigroup_mult) ab_semigroup_mult
huffman@17296
   398
by (intro_classes, transfer, rule mult_commute)
huffman@17296
   399
huffman@17296
   400
instance star :: (comm_monoid_add) comm_monoid_add
haftmann@22384
   401
by (intro_classes, transfer, rule comm_monoid_add_class.zero_plus.add_0)
huffman@17296
   402
huffman@17296
   403
instance star :: (monoid_mult) monoid_mult
huffman@17296
   404
apply (intro_classes)
huffman@17296
   405
apply (transfer, rule mult_1_left)
huffman@17296
   406
apply (transfer, rule mult_1_right)
huffman@17296
   407
done
huffman@17296
   408
huffman@17296
   409
instance star :: (comm_monoid_mult) comm_monoid_mult
huffman@17296
   410
by (intro_classes, transfer, rule mult_1)
huffman@17296
   411
huffman@17296
   412
instance star :: (cancel_semigroup_add) cancel_semigroup_add
huffman@17296
   413
apply (intro_classes)
huffman@17296
   414
apply (transfer, erule add_left_imp_eq)
huffman@17296
   415
apply (transfer, erule add_right_imp_eq)
huffman@17296
   416
done
huffman@17296
   417
huffman@17296
   418
instance star :: (cancel_ab_semigroup_add) cancel_ab_semigroup_add
huffman@17296
   419
by (intro_classes, transfer, rule add_imp_eq)
huffman@17296
   420
huffman@17296
   421
instance star :: (ab_group_add) ab_group_add
huffman@17296
   422
apply (intro_classes)
huffman@17296
   423
apply (transfer, rule left_minus)
huffman@17296
   424
apply (transfer, rule diff_minus)
huffman@17296
   425
done
huffman@17296
   426
huffman@17296
   427
instance star :: (pordered_ab_semigroup_add) pordered_ab_semigroup_add
huffman@17296
   428
by (intro_classes, transfer, rule add_left_mono)
huffman@17296
   429
huffman@17296
   430
instance star :: (pordered_cancel_ab_semigroup_add) pordered_cancel_ab_semigroup_add ..
huffman@17296
   431
huffman@17296
   432
instance star :: (pordered_ab_semigroup_add_imp_le) pordered_ab_semigroup_add_imp_le
huffman@17296
   433
by (intro_classes, transfer, rule add_le_imp_le_left)
huffman@17296
   434
haftmann@25304
   435
instance star :: (pordered_comm_monoid_add) pordered_comm_monoid_add ..
huffman@17296
   436
instance star :: (pordered_ab_group_add) pordered_ab_group_add ..
haftmann@25304
   437
haftmann@25304
   438
instance star :: (pordered_ab_group_add_abs) pordered_ab_group_add_abs 
haftmann@25304
   439
  by intro_classes (transfer,
haftmann@25304
   440
    simp add: abs_ge_self abs_leI abs_triangle_ineq)+
haftmann@25304
   441
huffman@17296
   442
instance star :: (ordered_cancel_ab_semigroup_add) ordered_cancel_ab_semigroup_add ..
haftmann@25304
   443
instance star :: (lordered_ab_group_add_meet) lordered_ab_group_add_meet ..
haftmann@25304
   444
instance star :: (lordered_ab_group_add_meet) lordered_ab_group_add_meet ..
haftmann@25304
   445
instance star :: (lordered_ab_group_add) lordered_ab_group_add ..
huffman@17296
   446
haftmann@25304
   447
instance star :: (lordered_ab_group_add_abs) lordered_ab_group_add_abs
huffman@17332
   448
by (intro_classes, transfer, rule abs_lattice)
huffman@17296
   449
huffman@17429
   450
subsection {* Ring and field classes *}
huffman@17296
   451
huffman@17296
   452
instance star :: (semiring) semiring
huffman@17296
   453
apply (intro_classes)
huffman@17296
   454
apply (transfer, rule left_distrib)
huffman@17296
   455
apply (transfer, rule right_distrib)
huffman@17296
   456
done
huffman@17296
   457
krauss@21199
   458
instance star :: (semiring_0) semiring_0 
krauss@21199
   459
by intro_classes (transfer, simp)+
krauss@21199
   460
huffman@17296
   461
instance star :: (semiring_0_cancel) semiring_0_cancel ..
huffman@17296
   462
paulson@24742
   463
instance star :: (comm_semiring) comm_semiring 
paulson@24742
   464
by (intro_classes, transfer, rule left_distrib)
huffman@17296
   465
huffman@17296
   466
instance star :: (comm_semiring_0) comm_semiring_0 ..
huffman@17296
   467
instance star :: (comm_semiring_0_cancel) comm_semiring_0_cancel ..
huffman@17296
   468
wenzelm@20633
   469
instance star :: (zero_neq_one) zero_neq_one
huffman@17296
   470
by (intro_classes, transfer, rule zero_neq_one)
huffman@17296
   471
huffman@17296
   472
instance star :: (semiring_1) semiring_1 ..
huffman@17296
   473
instance star :: (comm_semiring_1) comm_semiring_1 ..
huffman@17296
   474
wenzelm@20633
   475
instance star :: (no_zero_divisors) no_zero_divisors
huffman@17296
   476
by (intro_classes, transfer, rule no_zero_divisors)
huffman@17296
   477
huffman@17296
   478
instance star :: (semiring_1_cancel) semiring_1_cancel ..
huffman@17296
   479
instance star :: (comm_semiring_1_cancel) comm_semiring_1_cancel ..
huffman@17296
   480
instance star :: (ring) ring ..
huffman@17296
   481
instance star :: (comm_ring) comm_ring ..
huffman@17296
   482
instance star :: (ring_1) ring_1 ..
huffman@17296
   483
instance star :: (comm_ring_1) comm_ring_1 ..
huffman@22992
   484
instance star :: (ring_no_zero_divisors) ring_no_zero_divisors ..
wenzelm@23551
   485
instance star :: (ring_1_no_zero_divisors) ring_1_no_zero_divisors ..
huffman@17296
   486
instance star :: (idom) idom .. 
huffman@17296
   487
huffman@20540
   488
instance star :: (division_ring) division_ring
huffman@20540
   489
apply (intro_classes)
huffman@20540
   490
apply (transfer, erule left_inverse)
huffman@20540
   491
apply (transfer, erule right_inverse)
huffman@20540
   492
done
huffman@20540
   493
huffman@17296
   494
instance star :: (field) field
huffman@17296
   495
apply (intro_classes)
huffman@17296
   496
apply (transfer, erule left_inverse)
huffman@17296
   497
apply (transfer, rule divide_inverse)
huffman@17296
   498
done
huffman@17296
   499
huffman@17296
   500
instance star :: (division_by_zero) division_by_zero
huffman@17296
   501
by (intro_classes, transfer, rule inverse_zero)
huffman@17296
   502
huffman@17296
   503
instance star :: (pordered_semiring) pordered_semiring
huffman@17296
   504
apply (intro_classes)
huffman@17296
   505
apply (transfer, erule (1) mult_left_mono)
huffman@17296
   506
apply (transfer, erule (1) mult_right_mono)
huffman@17296
   507
done
huffman@17296
   508
huffman@17296
   509
instance star :: (pordered_cancel_semiring) pordered_cancel_semiring ..
huffman@17296
   510
huffman@17296
   511
instance star :: (ordered_semiring_strict) ordered_semiring_strict
huffman@17296
   512
apply (intro_classes)
huffman@17296
   513
apply (transfer, erule (1) mult_strict_left_mono)
huffman@17296
   514
apply (transfer, erule (1) mult_strict_right_mono)
huffman@17296
   515
done
huffman@17296
   516
huffman@17296
   517
instance star :: (pordered_comm_semiring) pordered_comm_semiring
haftmann@25230
   518
by (intro_classes, transfer, rule mult_mono1_class.times_zero_less_eq_less.mult_mono1)
huffman@17296
   519
huffman@17296
   520
instance star :: (pordered_cancel_comm_semiring) pordered_cancel_comm_semiring ..
huffman@17296
   521
huffman@17296
   522
instance star :: (ordered_comm_semiring_strict) ordered_comm_semiring_strict
haftmann@25208
   523
by (intro_classes, transfer, rule ordered_comm_semiring_strict_class.plus_times_zero_less_eq_less.mult_strict_mono)
huffman@17296
   524
huffman@17296
   525
instance star :: (pordered_ring) pordered_ring ..
haftmann@25304
   526
instance star :: (pordered_ring_abs) pordered_ring_abs
haftmann@25304
   527
  by intro_classes  (transfer, rule abs_eq_mult)
huffman@17296
   528
instance star :: (lordered_ring) lordered_ring ..
huffman@17296
   529
wenzelm@20633
   530
instance star :: (abs_if) abs_if
huffman@17296
   531
by (intro_classes, transfer, rule abs_if)
huffman@17296
   532
nipkow@24506
   533
instance star :: (sgn_if) sgn_if
nipkow@24506
   534
by (intro_classes, transfer, rule sgn_if)
nipkow@24506
   535
huffman@17296
   536
instance star :: (ordered_ring_strict) ordered_ring_strict ..
huffman@17296
   537
instance star :: (pordered_comm_ring) pordered_comm_ring ..
huffman@17296
   538
huffman@17296
   539
instance star :: (ordered_semidom) ordered_semidom
huffman@17296
   540
by (intro_classes, transfer, rule zero_less_one)
huffman@17296
   541
huffman@17296
   542
instance star :: (ordered_idom) ordered_idom ..
huffman@17296
   543
instance star :: (ordered_field) ordered_field ..
huffman@17296
   544
huffman@17332
   545
subsection {* Power classes *}
huffman@17296
   546
huffman@17296
   547
text {*
huffman@17296
   548
  Proving the class axiom @{thm [source] power_Suc} for type
huffman@17296
   549
  @{typ "'a star"} is a little tricky, because it quantifies
huffman@17296
   550
  over values of type @{typ nat}. The transfer principle does
huffman@17296
   551
  not handle quantification over non-star types in general,
huffman@17296
   552
  but we can work around this by fixing an arbitrary @{typ nat}
huffman@17296
   553
  value, and then applying the transfer principle.
huffman@17296
   554
*}
huffman@17296
   555
huffman@17296
   556
instance star :: (recpower) recpower
huffman@17296
   557
proof
huffman@17296
   558
  show "\<And>a::'a star. a ^ 0 = 1"
huffman@17296
   559
    by transfer (rule power_0)
huffman@17296
   560
next
huffman@17296
   561
  fix n show "\<And>a::'a star. a ^ Suc n = a * a ^ n"
huffman@17296
   562
    by transfer (rule power_Suc)
huffman@17296
   563
qed
huffman@17296
   564
huffman@17332
   565
subsection {* Number classes *}
huffman@17296
   566
huffman@20720
   567
lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
haftmann@25230
   568
by (induct n, simp_all)
huffman@20720
   569
huffman@20720
   570
lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
huffman@20720
   571
by (simp add: star_of_nat_def)
huffman@17296
   572
huffman@17332
   573
lemma star_of_of_nat [simp]: "star_of (of_nat n) = of_nat n"
huffman@17332
   574
by transfer (rule refl)
huffman@17332
   575
huffman@20720
   576
lemma star_of_int_def [transfer_unfold]: "of_int z = star_of (of_int z)"
huffman@20720
   577
by (rule_tac z=z in int_diff_cases, simp)
huffman@20720
   578
huffman@20720
   579
lemma Standard_of_int [simp]: "of_int z \<in> Standard"
huffman@20720
   580
by (simp add: star_of_int_def)
huffman@17332
   581
huffman@17332
   582
lemma star_of_of_int [simp]: "star_of (of_int z) = of_int z"
huffman@17332
   583
by transfer (rule refl)
huffman@17296
   584
huffman@23282
   585
instance star :: (semiring_char_0) semiring_char_0
haftmann@24195
   586
by intro_classes (simp only: star_of_nat_def star_of_eq of_nat_eq_iff)
huffman@23282
   587
huffman@23282
   588
instance star :: (ring_char_0) ring_char_0 ..
huffman@22911
   589
huffman@17296
   590
instance star :: (number_ring) number_ring
huffman@17296
   591
by (intro_classes, simp only: star_number_def star_of_int_def number_of_eq)
huffman@17296
   592
huffman@17429
   593
subsection {* Finite class *}
huffman@17429
   594
huffman@17429
   595
lemma starset_finite: "finite A \<Longrightarrow> *s* A = star_of ` A"
huffman@17429
   596
by (erule finite_induct, simp_all)
huffman@17429
   597
huffman@17429
   598
instance star :: (finite) finite
huffman@17429
   599
apply (intro_classes)
huffman@17429
   600
apply (subst starset_UNIV [symmetric])
huffman@17429
   601
apply (subst starset_finite [OF finite])
huffman@17429
   602
apply (rule finite_imageI [OF finite])
huffman@17429
   603
done
huffman@17429
   604
huffman@17296
   605
end