src/ZF/Tools/twos_compl.ML
author wenzelm
Thu, 31 May 2007 12:06:31 +0200
changeset 23146 0bc590051d95
child 24584 01e83ffa6c54
permissions -rw-r--r--
moved Integ files to canonical place;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
23146
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     1
(*  Title:      ZF/ex/twos-compl.ML
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     4
    Copyright   1993  University of Cambridge
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     5
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     6
ML code for Arithmetic on binary integers; the model for theory Bin
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     7
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     8
   The sign Pls stands for an infinite string of leading 0s.
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
     9
   The sign Min stands for an infinite string of leading 1s.
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    10
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    11
See int_of_binary for the numerical interpretation.  A number can have
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    12
multiple representations, namely leading 0s with sign Pls and leading 1s with
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    13
sign Min.  A number is in NORMAL FORM if it has no such extra bits.
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    14
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    15
The representation expects that (m mod 2) is 0 or 1, even if m is negative;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    16
For instance, ~5 div 2 = ~3 and ~5 mod 2 = 1; thus ~5 = (~3)*2 + 1
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    17
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    18
Still needs division!
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    19
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    20
print_depth 40;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    21
System.Control.Print.printDepth := 350; 
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    22
*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    23
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    24
infix 5 $$ $$$
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    25
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    26
(*Recursive datatype of binary integers*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    27
datatype bin = Pls | Min | $$ of bin * int;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    28
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    29
(** Conversions between bin and int **)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    30
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    31
fun int_of_binary Pls = 0
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    32
  | int_of_binary Min = ~1
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    33
  | int_of_binary (w$$b) = 2 * int_of_binary w + b;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    34
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    35
fun binary_of_int 0 = Pls
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    36
  | binary_of_int ~1 = Min
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    37
  | binary_of_int n = binary_of_int (n div 2) $$ (n mod 2);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    38
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    39
(*** Addition ***)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    40
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    41
(*Attach a bit while preserving the normal form.  Cases left as default
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    42
  are Pls$$$1 and Min$$$0. *)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    43
fun  Pls $$$ 0 = Pls
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    44
  | Min $$$ 1 = Min
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    45
  |     v $$$ x = v$$x;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    46
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    47
(*Successor of an integer, assumed to be in normal form.
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    48
  If w$$1 is normal then w is not Min, so bin_succ(w) $$ 0 is normal.
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    49
  But Min$$0 is normal while Min$$1 is not.*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    50
fun bin_succ Pls = Pls$$1
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    51
  | bin_succ Min = Pls
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    52
  | bin_succ (w$$1) = bin_succ(w) $$ 0
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    53
  | bin_succ (w$$0) = w $$$ 1;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    54
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    55
(*Predecessor of an integer, assumed to be in normal form.
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    56
  If w$$0 is normal then w is not Pls, so bin_pred(w) $$ 1 is normal.
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    57
  But Pls$$1 is normal while Pls$$0 is not.*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    58
fun bin_pred Pls = Min
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    59
  | bin_pred Min = Min$$0
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    60
  | bin_pred (w$$1) = w $$$ 0
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    61
  | bin_pred (w$$0) = bin_pred(w) $$ 1;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    62
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    63
(*Sum of two binary integers in normal form.  
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    64
  Ensure last $$ preserves normal form! *)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    65
fun bin_add (Pls, w) = w
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    66
  | bin_add (Min, w) = bin_pred w
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    67
  | bin_add (v$$x, Pls) = v$$x
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    68
  | bin_add (v$$x, Min) = bin_pred (v$$x)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    69
  | bin_add (v$$x, w$$y) = 
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    70
      bin_add(v, if x+y=2 then bin_succ w else w) $$$ ((x+y) mod 2);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    71
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    72
(*** Subtraction ***)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    73
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    74
(*Unary minus*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    75
fun bin_minus Pls = Pls
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    76
  | bin_minus Min = Pls$$1
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    77
  | bin_minus (w$$1) = bin_pred (bin_minus(w) $$$ 0)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    78
  | bin_minus (w$$0) = bin_minus(w) $$ 0;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    79
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    80
(*** Multiplication ***)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    81
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    82
(*product of two bins; a factor of 0 might cause leading 0s in result*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    83
fun bin_mult (Pls, _) = Pls
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    84
  | bin_mult (Min, v) = bin_minus v
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    85
  | bin_mult (w$$1, v) = bin_add(bin_mult(w,v) $$$ 0,  v)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    86
  | bin_mult (w$$0, v) = bin_mult(w,v) $$$ 0;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    87
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    88
(*** Testing ***)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    89
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    90
(*tests addition*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    91
fun checksum m n =
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    92
    let val wm = binary_of_int m
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    93
        and wn = binary_of_int n
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    94
        val wsum = bin_add(wm,wn)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    95
    in  if m+n = int_of_binary wsum then (wm, wn, wsum, m+n)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    96
        else raise Match
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    97
    end;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    98
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
    99
fun bfact n = if n=0 then  Pls$$1  
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   100
              else  bin_mult(binary_of_int n, bfact(n-1));
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   101
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   102
(*Examples...
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   103
bfact 5;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   104
int_of_binary it;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   105
bfact 69;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   106
int_of_binary it;
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   107
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   108
(*For {HOL,ZF}/ex/BinEx.ML*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   109
bin_add(binary_of_int 13, binary_of_int 19);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   110
bin_add(binary_of_int 1234, binary_of_int 5678);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   111
bin_add(binary_of_int 1359, binary_of_int ~2468);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   112
bin_add(binary_of_int 93746, binary_of_int ~46375);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   113
bin_minus(binary_of_int 65745);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   114
bin_minus(binary_of_int ~54321);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   115
bin_mult(binary_of_int 13, binary_of_int 19);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   116
bin_mult(binary_of_int ~84, binary_of_int 51);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   117
bin_mult(binary_of_int 255, binary_of_int 255);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   118
bin_mult(binary_of_int 1359, binary_of_int ~2468);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   119
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   120
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   121
(*leading zeros??*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   122
bin_add(binary_of_int 1234, binary_of_int ~1234);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   123
bin_mult(binary_of_int 1234, Pls);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   124
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   125
(*leading ones??*)
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   126
bin_add(binary_of_int 1, binary_of_int ~2);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   127
bin_add(binary_of_int 1234, binary_of_int ~1235);
0bc590051d95 moved Integ files to canonical place;
wenzelm
parents:
diff changeset
   128
*)