doc-src/IsarAdvanced/Classes/Thy/code_examples/Classes.hs
author wenzelm
Tue, 18 Mar 2008 20:34:26 +0100
changeset 26318 967323f93c67
parent 25731 b3e415b0cf5c
permissions -rw-r--r--
updated generated files;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     1
module Classes where {
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
     2
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     3
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
     4
data Nat = Suc Nat | Zero_nat;
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     5
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
     6
nat_aux :: Integer -> Nat -> Nat;
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
     7
nat_aux i n = (if i <= 0 then n else nat_aux (i - 1) (Suc n));
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     8
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
     9
nat :: Integer -> Nat;
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    10
nat i = nat_aux i Zero_nat;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    11
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    12
class Semigroup a where {
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    13
  mult :: a -> a -> a;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    14
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    15
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    16
class (Semigroup a) => Monoidl a where {
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    17
  neutral :: a;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    18
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    19
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    20
class (Monoidl a) => Monoid a where {
24991
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    21
};
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    22
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    23
class (Monoid a) => Group a where {
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    24
  inverse :: a -> a;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    25
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    26
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    27
inverse_int :: Integer -> Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    28
inverse_int i = negate i;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    29
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    30
neutral_int :: Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    31
neutral_int = 0;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    32
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    33
mult_int :: Integer -> Integer -> Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    34
mult_int i j = i + j;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    35
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    36
instance Semigroup Integer where {
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    37
  mult = mult_int;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    38
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    39
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    40
instance Monoidl Integer where {
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    41
  neutral = neutral_int;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    42
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    43
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    44
instance Monoid Integer where {
24991
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    45
};
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    46
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    47
instance Group Integer where {
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    48
  inverse = inverse_int;
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    49
};
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    50
25731
b3e415b0cf5c updated;
wenzelm
parents: 25200
diff changeset
    51
pow_nat :: forall a. (Monoid a) => Nat -> a -> a;
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    52
pow_nat (Suc n) x = mult x (pow_nat n x);
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    53
pow_nat Zero_nat x = neutral;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    54
25731
b3e415b0cf5c updated;
wenzelm
parents: 25200
diff changeset
    55
pow_int :: forall a. (Group a) => Integer -> a -> a;
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    56
pow_int k x =
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    57
  (if 0 <= k then pow_nat (nat k) x
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    58
    else inverse (pow_nat (nat (negate k)) x));
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    59
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    60
example :: Integer;
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    61
example = pow_int 10 (-2);
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    62
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    63
}