src/ZF/ex/twos-compl.ML
author wenzelm
Fri, 07 Mar 1997 11:48:46 +0100
changeset 2754 59bd96046ad6
parent 0 a5a9c433f639
permissions -rw-r--r--
moved settings comment to build;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     1
(*  Title: 	ZF/ex/twos-compl.ML
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     2
    ID:         $Id$
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     3
    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
    Copyright   1993  University of Cambridge
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     5
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
ML code for Arithmetic on binary integers; the model for theory BinFn
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     7
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     8
   The sign Plus stands for an infinite string of leading 0's.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     9
   The sign Minus stands for an infinite string of leading 1's.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    10
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    11
A number can have multiple representations, namely leading 0's with sign
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    12
Plus and leading 1's with sign Minus.  See int_of_binary for the numerical
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    13
interpretation.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    14
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    15
The representation expects that (m mod 2) is 0 or 1, even if m is negative;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    16
For instance, ~5 div 2 = ~3 and ~5 mod 2 = 1; thus ~5 = (~3)*2 + 1
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    17
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    18
Still needs division!
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    19
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    20
print_depth 40;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    21
System.Control.Print.printDepth := 350; 
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    22
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    23
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    24
infix 5 $$ 
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    25
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    26
(*Recursive datatype of binary integers*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    27
datatype bin = Plus | Minus | op $$ of bin * int;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    28
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    29
(** Conversions between bin and int **)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    30
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    31
fun int_of_binary Plus = 0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    32
  | int_of_binary Minus = ~1
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    33
  | int_of_binary (w$$b) = 2 * int_of_binary w + b;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    34
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    35
fun binary_of_int 0 = Plus
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    36
  | binary_of_int ~1 = Minus
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    37
  | binary_of_int n = binary_of_int (n div 2) $$ (n mod 2);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    38
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    39
(*** Addition ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    40
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    41
(*Adding one to a number*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    42
fun bin_succ Plus = Plus$$1
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    43
  | bin_succ Minus = Plus
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    44
  | bin_succ (w$$1) = bin_succ(w) $$ 0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    45
  | bin_succ (w$$0) = w$$1;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    46
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    47
(*Subtracing one from a number*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    48
fun bin_pred Plus = Minus
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    49
  | bin_pred Minus = Minus$$0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    50
  | bin_pred (w$$1) = w$$0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    51
  | bin_pred (w$$0) = bin_pred(w) $$ 1;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    52
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    53
(*sum of two binary integers*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    54
fun bin_add (Plus, w) = w
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    55
  | bin_add (Minus, w) = bin_pred w
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    56
  | bin_add (v$$x, Plus) = v$$x
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    57
  | bin_add (v$$x, Minus) = bin_pred (v$$x)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    58
  | bin_add (v$$x, w$$y) = bin_add(v, if x+y=2 then bin_succ w else w) $$ 
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    59
                           ((x+y) mod 2);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    60
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    61
(*** Subtraction ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    62
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    63
(*Unary minus*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    64
fun bin_minus Plus = Plus
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    65
  | bin_minus Minus = Plus$$1
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    66
  | bin_minus (w$$1) = bin_pred (bin_minus(w) $$ 0)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    67
  | bin_minus (w$$0) = bin_minus(w) $$ 0;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    68
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    69
(*** Multiplication ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    70
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    71
(*product of two bins*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    72
fun bin_mult (Plus, _) = Plus
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    73
  | bin_mult (Minus, v) = bin_minus v
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    74
  | bin_mult (w$$1, v) = bin_add(bin_mult(w,v) $$ 0,  v)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    75
  | bin_mult (w$$0, v) = bin_mult(w,v) $$ 0;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    76
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    77
(*** Testing ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    78
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    79
(*tests addition*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    80
fun checksum m n =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    81
    let val wm = binary_of_int m
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    82
        and wn = binary_of_int n
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    83
        val wsum = bin_add(wm,wn)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    84
    in  if m+n = int_of_binary wsum then (wm, wn, wsum, m+n)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    85
        else raise Match
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    86
    end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    87
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    88
fun bfact n = if n=0 then  Plus$$1  
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    89
              else  bin_mult(binary_of_int n, bfact(n-1));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    90
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    91
(*Examples...
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    92
bfact 5;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    93
int_of_binary it;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    94
bfact 69;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    95
int_of_binary it;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    96
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    97
(*leading zeros!*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    98
bin_add(binary_of_int 1234, binary_of_int ~1234);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    99
bin_mult(binary_of_int 1234, Plus);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   100
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   101
(*leading ones!*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   102
bin_add(binary_of_int 1234, binary_of_int ~1235);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   103
*)