doc-src/IsarAdvanced/Codegen/Thy/examples/integers.ML
author haftmann
Thu, 26 Apr 2007 13:32:55 +0200
changeset 22798 e3962371f568
parent 22015 12b94d7f7e1f
permissions -rw-r--r--
updated doc
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
21178
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
     1
structure ROOT = 
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
     2
struct
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
     3
22798
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
     4
structure Integer = 
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
     5
struct
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
     6
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
     7
datatype bit = B0 | B1;
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
     8
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
     9
datatype int = Pls | Min | Bit of int * bit | Number_of_int of int;
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    10
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    11
fun pred (Bit (k, B0)) = Bit (pred k, B1)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    12
  | pred (Bit (k, B1)) = Bit (k, B0)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    13
  | pred Min = Bit (Min, B0)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    14
  | pred Pls = Min;
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    15
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    16
fun succ (Bit (k, B0)) = Bit (k, B1)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    17
  | succ (Bit (k, B1)) = Bit (succ k, B0)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    18
  | succ Min = Pls
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    19
  | succ Pls = Bit (Pls, B1);
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    20
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    21
fun plus_int (Number_of_int v) (Number_of_int w) =
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    22
  Number_of_int (plus_int v w)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    23
  | plus_int k Min = pred k
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    24
  | plus_int k Pls = k
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    25
  | plus_int (Bit (k, B1)) (Bit (l, B1)) = Bit (plus_int k (succ l), B0)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    26
  | plus_int (Bit (k, B1)) (Bit (l, B0)) = Bit (plus_int k l, B1)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    27
  | plus_int (Bit (k, B0)) (Bit (l, b)) = Bit (plus_int k l, b)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    28
  | plus_int Min k = pred k
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    29
  | plus_int Pls k = k;
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    30
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    31
fun uminus_int (Number_of_int w) = Number_of_int (uminus_int w)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    32
  | uminus_int (Bit (k, B0)) = Bit (uminus_int k, B0)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    33
  | uminus_int (Bit (k, B1)) = Bit (pred (uminus_int k), B1)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    34
  | uminus_int Min = Bit (Pls, B1)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    35
  | uminus_int Pls = Pls;
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    36
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    37
fun times_int (Number_of_int v) (Number_of_int w) =
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    38
  Number_of_int (times_int v w)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    39
  | times_int (Bit (k, B0)) l = Bit (times_int k l, B0)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    40
  | times_int (Bit (k, B1)) l = plus_int (Bit (times_int k l, B0)) l
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    41
  | times_int Min k = uminus_int k
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    42
  | times_int Pls w = Pls;
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    43
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    44
end; (*struct Integer*)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    45
21178
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
    46
structure Codegen = 
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
    47
struct
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
    48
22015
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    49
fun double_inc k =
22798
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    50
  Integer.plus_int
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    51
    (Integer.times_int
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    52
      (Integer.Number_of_int
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    53
        (Integer.Bit (Integer.Bit (Integer.Pls, Integer.B1), Integer.B0)))
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    54
      k)
e3962371f568 updated doc
haftmann
parents: 22015
diff changeset
    55
    (Integer.Number_of_int (Integer.Bit (Integer.Pls, Integer.B1)));
21178
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
    56
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
    57
end; (*struct Codegen*)
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
    58
c3618fc6a6f7 added gfx
haftmann
parents:
diff changeset
    59
end; (*struct ROOT*)