source: Deliverables/D4.1/Byte.ml @ 83

Last change on this file since 83 was 83, checked in by mulligan, 11 years ago

Lots of work done on tidying up code.

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