doc-src/IsarAdvanced/Classes/Thy/code_examples/Classes.hs
author haftmann
Tue, 24 Jul 2007 15:21:54 +0200
changeset 23956 48494ccfabaf
parent 22813 882513df2472
child 24628 33137422d7fd
permissions -rw-r--r--
updated
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
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     4
data Nat = Zero_nat | Suc Nat;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     5
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     6
data Bit = B0 | B1;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     7
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     8
nat_aux :: Integer -> Nat -> Nat;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
     9
nat_aux i n = (if i <= 0 then n else nat_aux (i - 1) (Suc n));
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    10
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    11
nat :: Integer -> Nat;
48494ccfabaf updated
haftmann
parents: 22813
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
23956
48494ccfabaf updated
haftmann
parents: 22813
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
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    22
class (Monoidl a) => Group a where {
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    23
  inverse :: a -> a;
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    24
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    25
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    26
inverse_int :: Integer -> Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    27
inverse_int i = negate i;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    28
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    29
neutral_int :: Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    30
neutral_int = 0;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    31
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    32
mult_int :: Integer -> Integer -> Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    33
mult_int i j = i + j;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    34
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    35
instance Semigroup Integer where {
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    36
  mult = mult_int;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    37
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    38
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    39
instance Monoidl Integer where {
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    40
  neutral = neutral_int;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    41
};
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    42
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    43
instance Group Integer where {
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    44
  inverse = inverse_int;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    45
};
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    46
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    47
pow_nat :: (Group b) => Nat -> b -> b;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    48
pow_nat (Suc n) x = mult x (pow_nat n x);
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    49
pow_nat Zero_nat x = neutral;
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    50
23956
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    51
pow_int :: (Group a) => Integer -> a -> a;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    52
pow_int k x =
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    53
  (if 0 <= k then pow_nat (nat k) x
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    54
    else inverse (pow_nat (nat (negate k)) x));
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    55
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    56
example :: Integer;
48494ccfabaf updated
haftmann
parents: 22813
diff changeset
    57
example = pow_int 10 (-2);
22317
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    58
b550d2c6ca90 continued class tutorial
haftmann
parents:
diff changeset
    59
}