doc-src/IsarAdvanced/Classes/Thy/code_examples/Classes.hs
author haftmann
Fri, 26 Oct 2007 15:42:23 +0200
changeset 25200 f1d2e106f2fe
parent 24991 c6f5cc939c29
child 25731 b3e415b0cf5c
permissions -rw-r--r--
adjusted
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
24628
33137422d7fd updated
haftmann
parents: 23956
diff changeset
     6
data Bit = B1 | B0;
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     7
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
     8
nat_aux :: Integer -> Nat -> Nat;
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
     9
nat_aux i n = (if i <= 0 then n else nat_aux (i - 1) (Suc n));
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    10
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    11
nat :: Integer -> Nat;
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    12
nat i = nat_aux i Zero_nat;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    13
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    14
class Semigroup a where {
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    15
  mult :: a -> a -> a;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    16
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    17
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    18
class (Semigroup a) => Monoidl a where {
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    19
  neutral :: a;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    20
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    21
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    22
class (Monoidl a) => Monoid a where {
24991
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    23
};
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    24
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    25
class (Monoid a) => Group a where {
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    26
  inverse :: a -> a;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    27
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    28
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    29
inverse_int :: Integer -> Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    30
inverse_int i = negate i;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    31
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    32
neutral_int :: Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    33
neutral_int = 0;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    34
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    35
mult_int :: Integer -> Integer -> Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    36
mult_int i j = i + j;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    37
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    38
instance Semigroup Integer where {
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    39
  mult = mult_int;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    40
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    41
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    42
instance Monoidl Integer where {
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    43
  neutral = neutral_int;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    44
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    45
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    46
instance Monoid Integer where {
24991
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    47
};
c6f5cc939c29 added subclass command
haftmann
parents: 24628
diff changeset
    48
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    49
instance Group Integer where {
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    50
  inverse = inverse_int;
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    51
};
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    52
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    53
pow_nat :: (Monoid a) => Nat -> a -> a;
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    54
pow_nat (Suc n) x = mult x (pow_nat n x);
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    55
pow_nat Zero_nat x = neutral;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    56
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    57
pow_int :: (Group a) => Integer -> a -> a;
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    58
pow_int k x =
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    59
  (if 0 <= k then pow_nat (nat k) x
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    60
    else inverse (pow_nat (nat (negate k)) x));
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    61
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    62
example :: Integer;
25200
f1d2e106f2fe adjusted
haftmann
parents: 24991
diff changeset
    63
example = pow_int 10 (-2);
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    64
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    65
}