doc-src/IsarAdvanced/Classes/Thy/code_examples/classes.ML
author haftmann
Tue, 20 Mar 2007 10:23:31 +0100
changeset 22479 de15ea8fb348
parent 22317 b550d2c6ca90
child 22813 882513df2472
permissions -rw-r--r--
updated code generation sections
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     1
structure ROOT = 
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     2
struct
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     3
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     4
structure Nat = 
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     5
struct
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     6
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     7
datatype nat = Zero_nat | Suc of nat;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     8
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     9
end; (*struct Nat*)
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    10
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    11
structure Integer = 
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    12
struct
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    13
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    14
fun nat_aux n i =
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    15
  (if IntInf.<= (i, (0 : IntInf.int)) then n
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    16
    else nat_aux (Nat.Suc n) (IntInf.- (i, (1 : IntInf.int))));
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    17
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    18
fun nat i = nat_aux Nat.Zero_nat i;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    19
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    20
end; (*struct Integer*)
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    21
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    22
structure Classes = 
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    23
struct
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    24
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    25
type 'a semigroup = {mult : 'a -> 'a -> 'a};
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    26
fun mult (A_:'a semigroup) = #mult A_;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    27
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    28
type 'a monoidl =
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    29
  {Classes__monoidl_semigroup : 'a semigroup, neutral : 'a};
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    30
fun monoidl_semigroup (A_:'a monoidl) = #Classes__monoidl_semigroup A_;
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    31
fun neutral (A_:'a monoidl) = #neutral A_;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    32
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    33
type 'a group = {Classes__group_monoidl : 'a monoidl, inverse : 'a -> 'a};
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    34
fun group_monoidl (A_:'a group) = #Classes__group_monoidl A_;
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    35
fun inverse (A_:'a group) = #inverse A_;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    36
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    37
fun inverse_int i = IntInf.~ i;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    38
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    39
val neutral_int : IntInf.int = (0 : IntInf.int);
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    40
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    41
fun mult_int i j = IntInf.+ (i, j);
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    42
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    43
val semigroup_int = {mult = mult_int} : IntInf.int semigroup;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    44
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    45
val monoidl_int =
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    46
  {Classes__monoidl_semigroup = semigroup_int, neutral = neutral_int} :
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    47
  IntInf.int monoidl;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    48
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    49
val group_int =
22479
de15ea8fb348 updated code generation sections
haftmann
parents: 22317
diff changeset
    50
  {Classes__group_monoidl = monoidl_int, inverse = inverse_int} :
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    51
  IntInf.int group;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    52
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    53
fun pow_nat A_ (Nat.Suc n) x =
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    54
  mult (monoidl_semigroup A_) x (pow_nat A_ n x)
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    55
  | pow_nat A_ Nat.Zero_nat x = neutral A_;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    56
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    57
fun pow_int A_ k x =
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    58
  (if IntInf.<= ((0 : IntInf.int), k)
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    59
    then pow_nat (group_monoidl A_) (Integer.nat k) x
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    60
    else inverse A_
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    61
           (pow_nat (group_monoidl A_) (Integer.nat (IntInf.~ k)) x));
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    62
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    63
val example : IntInf.int =
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    64
  pow_int group_int (10 : IntInf.int) (~2 : IntInf.int);
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    65
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    66
end; (*struct Classes*)
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    67
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    68
end; (*struct ROOT*)