| 1 | (*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*) |
|---|
| 2 | (* FILENAME: Byte.ml *) |
|---|
| 3 | (* DESCRIPTION: An ADT implementing standard 8 bit bytes, and common *) |
|---|
| 4 | (* operations on them. *) |
|---|
| 5 | (* CREATED: 10/09/2010, Dominic Mulligan *) |
|---|
| 6 | (* BUGS: *) |
|---|
| 7 | (*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*) |
|---|
| 8 | |
|---|
| 9 | open Bit;; |
|---|
| 10 | open Nibble;; |
|---|
| 11 | |
|---|
| 12 | module type BYTE = |
|---|
| 13 | sig |
|---|
| 14 | type bit |
|---|
| 15 | type nibble |
|---|
| 16 | type byte |
|---|
| 17 | |
|---|
| 18 | val from_bits: bit -> bit -> bit -> bit -> bit -> bit -> bit -> bit -> byte |
|---|
| 19 | val from_bit: bit -> byte |
|---|
| 20 | val from_nibbles: nibble -> nibble -> byte |
|---|
| 21 | val from_nibble: nibble -> byte |
|---|
| 22 | (* |
|---|
| 23 | val from_int: int -> byte |
|---|
| 24 | *) |
|---|
| 25 | val to_bit: byte -> bit option |
|---|
| 26 | val to_nibble: byte -> nibble option |
|---|
| 27 | val to_int: byte -> int |
|---|
| 28 | |
|---|
| 29 | val get_nibble_at: int -> byte -> nibble option |
|---|
| 30 | val set_nibble_at: int -> nibble -> byte -> byte option |
|---|
| 31 | val get_bit_at: int -> byte -> bit option |
|---|
| 32 | val set_bit_at: int -> bit -> byte -> byte option |
|---|
| 33 | |
|---|
| 34 | val (-&-): byte -> byte -> byte |
|---|
| 35 | val (-|-): byte -> byte -> byte |
|---|
| 36 | val (-^-): byte -> byte -> byte |
|---|
| 37 | val rotate_right: byte -> byte |
|---|
| 38 | val rotate_left: byte -> byte |
|---|
| 39 | val shift_right: byte -> byte |
|---|
| 40 | val shift_left: byte -> byte |
|---|
| 41 | val not: byte -> byte |
|---|
| 42 | |
|---|
| 43 | val map_nibble: (nibble -> nibble) -> byte -> byte |
|---|
| 44 | val map_bit: (bit -> bit) -> byte -> byte |
|---|
| 45 | val iter_nibble: (nibble -> string) -> byte -> string |
|---|
| 46 | val iter_bit: (bit -> string) -> byte -> string |
|---|
| 47 | val zip_nibble: (nibble -> nibble -> nibble) -> byte -> byte -> byte |
|---|
| 48 | val zip_bit: (bit -> bit -> bit) -> byte -> byte -> byte |
|---|
| 49 | val to_string: byte -> string |
|---|
| 50 | end |
|---|
| 51 | |
|---|
| 52 | module ByteFunctor(Bit: BIT) |
|---|
| 53 | (Nibble: NIBBLE with type bit = Bit.bit): BYTE |
|---|
| 54 | with type bit = Bit.bit |
|---|
| 55 | and type nibble = Nibble.nibble = |
|---|
| 56 | struct |
|---|
| 57 | type bit = Bit.bit |
|---|
| 58 | type nibble = Nibble.nibble |
|---|
| 59 | type byte = nibble * nibble |
|---|
| 60 | |
|---|
| 61 | let from_bits b1 b2 b3 b4 b5 b6 b7 b8 = |
|---|
| 62 | let n1 = Nibble.from_bits b1 b2 b3 b4 in |
|---|
| 63 | let n2 = Nibble.from_bits b5 b6 b7 b8 in |
|---|
| 64 | (n1, n2) |
|---|
| 65 | let from_bit b = |
|---|
| 66 | let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false) |
|---|
| 67 | (Bit.from_bool false) (Bit.from_bool false) in |
|---|
| 68 | let n2 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false) |
|---|
| 69 | (Bit.from_bool false) b in |
|---|
| 70 | (n1, n2) |
|---|
| 71 | let from_nibbles n1 n2 = (n1, n2) |
|---|
| 72 | let from_nibble n2 = |
|---|
| 73 | let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false) |
|---|
| 74 | (Bit.from_bool false) (Bit.from_bool false) in |
|---|
| 75 | (n1, n2) |
|---|
| 76 | |
|---|
| 77 | let get_nibble_at index (n1, n2) = |
|---|
| 78 | match index with |
|---|
| 79 | 0 -> Some n2 |
|---|
| 80 | | 1 -> Some n1 |
|---|
| 81 | | _ -> None |
|---|
| 82 | let get_bit_at index (n1, n2) = |
|---|
| 83 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 84 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 85 | match index with |
|---|
| 86 | 0 -> Some b8 |
|---|
| 87 | | 1 -> Some b7 |
|---|
| 88 | | 2 -> Some b6 |
|---|
| 89 | | 3 -> Some b5 |
|---|
| 90 | | 4 -> Some b4 |
|---|
| 91 | | 3 -> Some b3 |
|---|
| 92 | | 2 -> Some b2 |
|---|
| 93 | | 1 -> Some b1 |
|---|
| 94 | | _ -> None |
|---|
| 95 | |
|---|
| 96 | let set_nibble_at index new_val (n1, n2) = |
|---|
| 97 | match index with |
|---|
| 98 | 0 -> Some (n1, new_val) |
|---|
| 99 | | 1 -> Some (new_val, n2) |
|---|
| 100 | | _ -> None |
|---|
| 101 | let set_bit_at index new_val (n1, n2) = |
|---|
| 102 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 103 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 104 | match index with |
|---|
| 105 | 0 -> Some (from_bits b1 b2 b3 b4 b5 b6 b7 new_val) |
|---|
| 106 | | 1 -> Some (from_bits b1 b2 b3 b4 b5 b6 new_val b8) |
|---|
| 107 | | 2 -> Some (from_bits b1 b2 b3 b4 b5 new_val b7 b8) |
|---|
| 108 | | 3 -> Some (from_bits b1 b2 b3 b4 new_val b6 b7 b8) |
|---|
| 109 | | 4 -> Some (from_bits b1 b2 b3 new_val b5 b6 b7 b8) |
|---|
| 110 | | 3 -> Some (from_bits b1 b2 new_val b4 b5 b6 b7 b8) |
|---|
| 111 | | 2 -> Some (from_bits b1 new_val b3 b4 b5 b6 b7 b8) |
|---|
| 112 | | 1 -> Some (from_bits new_val b2 b3 b4 b5 b6 b7 b8) |
|---|
| 113 | | _ -> None |
|---|
| 114 | |
|---|
| 115 | let to_bit (n1, n2) = |
|---|
| 116 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 117 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 118 | if (Bit.to_bool b1, Bit.to_bool b2, |
|---|
| 119 | Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then |
|---|
| 120 | if Bit.to_bool b5 = false && Bit.to_bool b6 = false && Bit.to_bool b7 = false then |
|---|
| 121 | Some b8 |
|---|
| 122 | else |
|---|
| 123 | None |
|---|
| 124 | else |
|---|
| 125 | None |
|---|
| 126 | let to_nibble (n1, n2) = |
|---|
| 127 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 128 | if (Bit.to_bool b1, Bit.to_bool b2, |
|---|
| 129 | Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then |
|---|
| 130 | Some n2 |
|---|
| 131 | else None |
|---|
| 132 | let to_int (n1, n2) = |
|---|
| 133 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 134 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 135 | (128 * Bit.to_int b8) + (64 * Bit.to_int b8) + |
|---|
| 136 | (32 * Bit.to_int b8) + (16 * Bit.to_int b8) + |
|---|
| 137 | (8 * Bit.to_int b8) + (4 * Bit.to_int b6) + |
|---|
| 138 | (2 * Bit.to_int b7) + Bit.to_int b8 |
|---|
| 139 | |
|---|
| 140 | let (-&-) (l1, l2) (r1, r2) = (Nibble.(-&-) l1 r1, Nibble.(-&-) l2 r2) |
|---|
| 141 | let (-|-) (l1, l2) (r1, r2) = (Nibble.(-|-) l1 r1, Nibble.(-|-) l2 r2) |
|---|
| 142 | let (-^-) (l1, l2) (r1, r2) = (Nibble.(-^-) l1 r1, Nibble.(-^-) l2 r2) |
|---|
| 143 | |
|---|
| 144 | let shift_right (n1, n2) = |
|---|
| 145 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 146 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 147 | let new_n1 = Nibble.from_bits (Bit.from_bool false) b1 b2 b3 in |
|---|
| 148 | let new_n2 = Nibble.from_bits b4 b5 b6 b7 in |
|---|
| 149 | (new_n1, new_n2) |
|---|
| 150 | let shift_left (n1, n2) = |
|---|
| 151 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 152 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 153 | let new_n1 = Nibble.from_bits b1 b2 b3 b4 in |
|---|
| 154 | let new_n2 = Nibble.from_bits b5 b6 b7 (Bit.from_bool false) in |
|---|
| 155 | (new_n1, new_n2) |
|---|
| 156 | let rotate_right (n1, n2) = |
|---|
| 157 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 158 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 159 | let new_n1 = Nibble.from_bits b8 b1 b2 b3 in |
|---|
| 160 | let new_n2 = Nibble.from_bits b4 b5 b6 b7 in |
|---|
| 161 | (new_n1, new_n2) |
|---|
| 162 | let rotate_left (n1, n2) = |
|---|
| 163 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 164 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 165 | let new_n1 = Nibble.from_bits b2 b3 b4 b5 in |
|---|
| 166 | let new_n2 = Nibble.from_bits b5 b6 b7 b1 in |
|---|
| 167 | (new_n1, new_n2) |
|---|
| 168 | let not (n1, n2) = (Nibble.not n1, Nibble.not n2) |
|---|
| 169 | |
|---|
| 170 | let map_nibble f (n1, n2) = (f n1, f n2) |
|---|
| 171 | let map_bit f (n1, n2) = |
|---|
| 172 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 173 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 174 | let new_n1 = Nibble.from_bits (f b1) (f b2) (f b3) (f b4) in |
|---|
| 175 | let new_n2 = Nibble.from_bits (f b5) (f b6) (f b7) (f b8) in |
|---|
| 176 | (new_n1, new_n2) |
|---|
| 177 | let iter_nibble f (n1, n2) = |
|---|
| 178 | let str_n1 = f n1 in |
|---|
| 179 | let str_n2 = f n2 in |
|---|
| 180 | str_n1 ^ str_n2 |
|---|
| 181 | let iter_bit f (n1, n2) = |
|---|
| 182 | let (b1, b2, b3, b4) = Nibble.to_bits n1 in |
|---|
| 183 | let (b5, b6, b7, b8) = Nibble.to_bits n2 in |
|---|
| 184 | let new_n1 = (f b1) ^ (f b2) ^ (f b3) ^ (f b4) in |
|---|
| 185 | let new_n2 = (f b5) ^ (f b6) ^ (f b7) ^ (f b8) in |
|---|
| 186 | new_n1 ^ new_n2 |
|---|
| 187 | let zip_nibble f (l1, l2) (r1, r2) = (f l1 r1, f l2 r2) |
|---|
| 188 | let zip_bit f (l1, l2) (r1, r2) = |
|---|
| 189 | let (lb1, lb2, lb3, lb4) = Nibble.to_bits l1 in |
|---|
| 190 | let (lb5, lb6, lb7, lb8) = Nibble.to_bits l2 in |
|---|
| 191 | let (rb1, rb2, rb3, rb4) = Nibble.to_bits r1 in |
|---|
| 192 | let (rb5, rb6, rb7, rb8) = Nibble.to_bits r2 in |
|---|
| 193 | let (b1, b2, b3, b4) = (f lb1 rb1), (f lb2 rb2), (f lb3 rb3), (f lb4 rb4) in |
|---|
| 194 | let (b5, b6, b7, b8) = (f lb5 rb5), (f lb6 rb6), (f lb7 rb7), (f lb8 rb8) in |
|---|
| 195 | let new_n1 = Nibble.from_bits b1 b2 b3 b4 in |
|---|
| 196 | let new_n2 = Nibble.from_bits b5 b6 b7 b8 in |
|---|
| 197 | (new_n1, new_n2) |
|---|
| 198 | let to_string = iter_nibble Nibble.to_string |
|---|
| 199 | end;; |
|---|
| 200 | |
|---|
| 201 | module Byte = ByteFunctor(Bit) (Nibble);; |
|---|
