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

Last change on this file since 66 was 66, checked in by mulligan, 10 years ago

Bytes mostly finished.

File size: 7.4 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:                                                                     *)
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(*
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
50end
51
52module ByteFunctor(Bit: BIT) (Nibble: NIBBLE with type bit = Bit.bit): BYTE
53  with type bit = Bit.bit
54  and  type nibble = Nibble.nibble =
55struct
56  type bit = Bit.bit
57  type nibble = Nibble.nibble
58  type byte = nibble * nibble
59
60  let from_bits b1 b2 b3 b4 b5 b6 b7 b8 =
61    let n1 = Nibble.from_bits b1 b2 b3 b4 in
62    let n2 = Nibble.from_bits b5 b6 b7 b8 in
63      (n1, n2)
64  let from_bit b =
65    let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
66                              (Bit.from_bool false) (Bit.from_bool false) in
67    let n2 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
68                              (Bit.from_bool false) b in
69      (n1, n2)
70  let from_nibbles n1 n2 = (n1, n2)
71  let from_nibble n2 =
72    let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
73                              (Bit.from_bool false) (Bit.from_bool false) in
74      (n1, n2)
75
76  let get_nibble_at index (n1, n2) =
77    match index with
78      0 -> Some n2
79    | 1 -> Some n1
80    | _ -> None
81  let get_bit_at index (n1, n2) =
82    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
83    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
84      match index with
85        0 -> Some b8
86      | 1 -> Some b7
87      | 2 -> Some b6
88      | 3 -> Some b5
89      | 4 -> Some b4
90      | 3 -> Some b3
91      | 2 -> Some b2
92      | 1 -> Some b1
93      | _ -> None
94
95  let set_nibble_at index new_val (n1, n2) =
96    match index with
97      0 -> Some (n1, new_val)
98    | 1 -> Some (new_val, n2)
99    | _ -> None
100  let set_bit_at index new_val (n1, n2) =
101    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
102    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
103      match index with
104        0 -> Some (from_bits b1 b2 b3 b4 b5 b6 b7 new_val)
105      | 1 -> Some (from_bits b1 b2 b3 b4 b5 b6 new_val b8)
106      | 2 -> Some (from_bits b1 b2 b3 b4 b5 new_val b7 b8)
107      | 3 -> Some (from_bits b1 b2 b3 b4 new_val b6 b7 b8)
108      | 4 -> Some (from_bits b1 b2 b3 new_val b5 b6 b7 b8)
109      | 3 -> Some (from_bits b1 b2 new_val b4 b5 b6 b7 b8)
110      | 2 -> Some (from_bits b1 new_val b3 b4 b5 b6 b7 b8)
111      | 1 -> Some (from_bits new_val b2 b3 b4 b5 b6 b7 b8)
112      | _ -> None
113
114  let to_bit (n1, n2) =
115    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
116    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
117      if (Bit.to_bool b1, Bit.to_bool b2,
118          Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then
119        if Bit.to_bool b5 = false && Bit.to_bool b6 = false && Bit.to_bool b7 = false then
120          Some b8
121        else
122          None
123      else
124        None
125  let to_nibble (n1, n2) =
126    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
127      if (Bit.to_bool b1, Bit.to_bool b2,
128          Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then
129        Some n2
130      else None
131  let to_int (n1, n2) =
132    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
133    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
134      (128 * Bit.to_int b8) + (64 * Bit.to_int b8) +
135      (32 * Bit.to_int b8) + (16 * Bit.to_int b8) + 
136      (8 * Bit.to_int b8) + (4 * Bit.to_int b6) + 
137      (2 * Bit.to_int b7) + Bit.to_int b8
138
139  let (-&-) (l1, l2) (r1, r2) = (Nibble.(-&-) l1 r1, Nibble.(-&-) l2 r2)
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
143  let shift_right (n1, n2) =
144    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
145    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
146    let new_n1 = Nibble.from_bits (Bit.from_bool false) b1 b2 b3 in
147    let new_n2 = Nibble.from_bits b4 b5 b6 b7 in
148      (new_n1, new_n2)
149  let shift_left (n1, n2) =
150    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
151    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
152    let new_n1 = Nibble.from_bits b1 b2 b3 b4 in
153    let new_n2 = Nibble.from_bits b5 b6 b7 (Bit.from_bool false) in
154      (new_n1, new_n2)
155  let rotate_right (n1, n2) =
156    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
157    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
158    let new_n1 = Nibble.from_bits b8 b1 b2 b3 in
159    let new_n2 = Nibble.from_bits b4 b5 b6 b7 in
160      (new_n1, new_n2)
161  let rotate_left (n1, n2) =
162    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
163    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
164    let new_n1 = Nibble.from_bits b2 b3 b4 b5 in
165    let new_n2 = Nibble.from_bits b5 b6 b7 b1 in
166      (new_n1, new_n2)
167  let not (n1, n2) = (Nibble.not n1, Nibble.not n2)
168
169  let map_nibble f (n1, n2) = (f n1, f n2)
170  let map_bit f (n1, n2) =
171    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
172    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
173    let new_n1 = Nibble.from_bits (f b1) (f b2) (f b3) (f b4) in
174    let new_n2 = Nibble.from_bits (f b5) (f b6) (f b7) (f b8) in
175      (new_n1, new_n2)
176  let iter_nibble f (n1, n2) =
177    let str_n1 = f n1 in
178    let str_n2 = f n2 in
179      str_n1 ^ str_n2
180  let iter_bit f (n1, n2) =
181    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
182    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
183    let new_n1 = (f b1) ^ (f b2) ^ (f b3) ^ (f b4) in
184    let new_n2 = (f b5) ^ (f b6) ^ (f b7) ^ (f b8) in
185      new_n1 ^ new_n2
186  let zip_nibble f (l1, l2) (r1, r2) = (f l1 r1, f l2 r2)
187  let zip_bit f (l1, l2) (r1, r2) =
188    let (lb1, lb2, lb3, lb4) = Nibble.to_bits l1 in
189    let (lb5, lb6, lb7, lb8) = Nibble.to_bits l2 in
190    let (rb1, rb2, rb3, rb4) = Nibble.to_bits r1 in
191    let (rb5, rb6, rb7, rb8) = Nibble.to_bits r2 in
192    let (b1, b2, b3, b4) = (f lb1 rb1), (f lb2 rb2), (f lb3 rb3), (f lb4 rb4) in
193    let (b5, b6, b7, b8) = (f lb5 rb5), (f lb6 rb6), (f lb7 rb7), (f lb8 rb8) in
194    let new_n1 = Nibble.from_bits b1 b2 b3 b4 in
195    let new_n2 = Nibble.from_bits b5 b6 b7 b8 in
196      (new_n1, new_n2)
197  let to_string = iter_nibble Nibble.to_string
198end;;
199
200module Byte = ByteFunctor(Bit) (Nibble);;
Note: See TracBrowser for help on using the repository browser.