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

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

Bytes mostly finished.

File size: 4.9 KB
Line 
1(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
2(* FILENAME:    Nibble.ml                                                    *)
3(* DESCRIPTION: An ADT implementing 4 bit nibbles, and common operations on  *)
4(*              them.                                                        *)
5(* CREATED:     10/09/2010, Dominic Mulligan                                 *)
6(* BUGS:                                                                     *)
7(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
8
9open Bit;;
10
11module type NIBBLE =
12sig
13  type bit
14  type nibble
15
16  val from_bits: bit -> bit -> bit -> bit -> nibble
17  val from_bit: bit -> nibble
18  val from_int: int -> nibble option
19  (* val from_string: string -> nibble option *)
20
21  val to_bits: nibble -> (bit * bit * bit * bit)
22  val to_bit: nibble -> bit option
23  val to_int: nibble -> int
24  val to_string: nibble -> string
25
26  val get_bit_at: int -> nibble -> bit option
27  val set_bit_at: int -> bit -> nibble -> nibble option
28
29  val (-&-): nibble -> nibble -> nibble
30  val (-|-): nibble -> nibble -> nibble
31  val (-^-): nibble -> nibble -> nibble
32  val rotate_right: nibble -> nibble
33  val rotate_left: nibble -> nibble
34  val shift_right: nibble -> nibble
35  val shift_left: nibble -> nibble
36  val not: nibble -> nibble
37
38  val map_bit: (bit -> bit) -> nibble -> nibble
39  val iter_bit: (bit -> string) -> nibble -> string
40  val zip_bit: (bit -> bit -> bit) -> nibble -> nibble -> nibble
41end
42
43module NibbleFunctor(Bit: BIT) : NIBBLE
44  with type bit = Bit.bit =
45struct
46  type bit = Bit.bit
47  type nibble = bit * bit * bit * bit
48
49  let from_bits b1 b2 b3 b4 = (b1, b2, b3, b4)
50  let from_bit h = (Bit.from_bool false, Bit.from_bool false, Bit.from_bool false, h)
51  let from_int int_val =
52    match int_val with
53      0 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0)
54    | 1 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1)
55    | 2 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 0)
56    | 3 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1)
57    | 4 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0)
58    | 5 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1)
59    | 6 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0)
60    | 7 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1)
61    | 8 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0)
62    | 9 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1)
63    | 10 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 1, Bit.from_int 0)
64    | 11 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1)
65    | 12 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0)
66    | 13 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1)
67    | 14 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0)
68    | 15 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1)
69    | _ -> None
70
71  let to_bit (b1, b2, b3, b4) =
72    let (d1, d2, d3, d4) = Bit.to_bool b1, Bit.to_bool b2, Bit.to_bool b3, Bit.to_bool b4 in
73    match (d1, d2, d3, d4) with
74      (false, false, false, b) -> Some (Bit.from_bool b)
75   |  _ -> None
76  let to_bits (b1, b2, b3, b4) = (b1, b2, b3, b4)
77  let to_int (b1, b2, b3, b4) = (8 * Bit.to_int b1) + (4 * Bit.to_int b2) + 
78                                (2 * Bit.to_int b3) + Bit.to_int b4
79
80  let get_bit_at index (b1, b2, b3, b4) =
81    match index with
82      0 -> Some b4
83    | 1 -> Some b3
84    | 2 -> Some b2
85    | 3 -> Some b1
86    | _ -> None
87
88  let set_bit_at index new_bit (b1, b2, b3, b4) =
89    match index with
90      0 -> Some (b1, b2, b3, new_bit)
91    | 1 -> Some (b1, b2, new_bit, b4)
92    | 2 -> Some (b1, new_bit, b3, b4)
93    | 3 -> Some (new_bit, b2, b3, b4)
94    | _ -> None
95
96  let (-&-) (l1, l2, l3, l4) (r1, r2, r3, r4) =
97     (Bit.(-&-) l1 r1, Bit.(-&-) l2 r2, Bit.(-&-) l3 r3, Bit.(-&-) l4 r4)
98  let (-|-) (l1, l2, l3, l4) (r1, r2, r3, r4) =
99     (Bit.(-|-) l1 r1, Bit.(-|-) l2 r2, Bit.(-|-) l3 r3, Bit.(-|-) l4 r4)
100  let (-^-) (l1, l2, l3, l4) (r1, r2, r3, r4) =
101     (Bit.(-^-) l1 r1, Bit.(-^-) l2 r2, Bit.(-^-) l3 r3, Bit.(-^-) l4 r4)
102  let rotate_right (b1, b2, b3, b4) = (b4, b1, b2, b3)
103  let rotate_left (b1, b2, b3, b4) = (b2, b3, b4, b1)
104  let shift_right (b1, b2, b3, b4) = (Bit.from_bool false, b1, b2, b3)
105  let shift_left (b1, b2, b3, b4) = (b2, b3, b4, Bit.from_bool false)
106  let not (b1, b2, b3, b4) = (Bit.not b1, Bit.not b2, Bit.not b3, Bit.not b4)
107
108  let map_bit f (b1, b2, b3, b4) = (f b1, f b2, f b3, f b4)
109  let iter_bit f (b1, b2, b3, b4) =
110    let str_b1 = f b1 in
111    let str_b2 = f b2 in
112    let str_b3 = f b3 in
113    let str_b4 = f b4 in
114      str_b1 ^ str_b2 ^ str_b3 ^ str_b4
115  let zip_bit f (l1, l2, l3, l4) (r1, r2, r3, r4) = (f l1 r1, f l2 r2, f l3 r3, f l4 r4)
116
117  let to_string = iter_bit Bit.to_string
118end
119
120module Nibble = NibbleFunctor(Bit)
Note: See TracBrowser for help on using the repository browser.