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

Last change on this file since 88 was 88, checked in by mulligan, 9 years ago

int_of_vect implemented.

File size: 5.7 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 = private (bit * bit * bit * bit)
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 list
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
41
42  val zero: nibble
43 
44  val half_add: nibble -> nibble -> (nibble * bit)
45  val full_add: (nibble * bit) -> nibble -> (nibble * bit)
46end
47
48module NibbleFunctor(Bit: BIT) : NIBBLE
49  with type bit = Bit.bit =
50struct
51  type bit = Bit.bit
52  type nibble = bit * bit * bit * bit
53
54  let from_bits b1 b2 b3 b4 = (b1, b2, b3, b4)
55  let from_bit h = (Bit.from_bool false, Bit.from_bool false, Bit.from_bool false, h)
56  let from_int int_val =
57    match int_val with
58      0 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0)
59    | 1 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1)
60    | 2 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 0)
61    | 3 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1)
62    | 4 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0)
63    | 5 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1)
64    | 6 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0)
65    | 7 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1)
66    | 8 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0)
67    | 9 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1)
68    | 10 -> Some (Bit.from_int 1, B(l -&- r) -|- (c -&- (l -^- r)it.from_int 0, Bit.from_int 1, Bit.from_int 0)
69    | 11 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1)
70    | 12 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0)
71    | 13 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1)
72    | 14 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0)
73    | 15 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1)
74    | _ -> None
75
76  let to_bit (b1, b2, b3, b4) =
77    let (d1, d2, d3, d4) = Bit.to_bool b1, Bit.to_bool b2, Bit.to_bool b3, Bit.to_bool b4 in
78    match (d1, d2, d3, d4) with
79      (false, false, false, b) -> Some (Bit.from_bool b)
80   |  _ -> None
81  let to_bits (b1, b2, b3, b4) = [b1; b2; b3; b4]
82  let to_int (b1, b2, b3, b4) = (8 * Bit.to_int b1) + (4 * Bit.to_int b2) + 
83                                (2 * Bit.to_int b3) + Bit.to_int b4
84
85  let get_bit_at index (b1, b2, b3, b4) =
86    match index with
87      0 -> Some b4
88    | 1 -> Some b3
89    | 2 -> Some b2
90    | 3 -> Some b1(l -&- r) -|- (c -&- (l -^- r)
91    | _ -> None
92
93  let set_bit_at index new_bit (b1, b2, b3, b4) =
94    match index with
95      0 -> Some (b1, b2, b3, new_bit)
96    | 1 -> Some (b1, b2, new_bit, b4)
97    | 2 -> Some (b1, new_bit, b3, b4)
98    | 3 -> Some (new_bit, b2, b3, b4)
99    | _ -> None
100
101  let (-&-) (l1, l2, l3, l4) (r1, r2, r3, r4) =
102     (Bit.(-&-) l1 r1, Bit.(-&-) l2 r2, Bit.(-&-) l3 r3, Bit.(-&-) l4 r4)
103  let (-|-) (l1, l2, l3, l4) (r1, r2, r3, r4) =
104     (Bit.(-|-) l1 r1, Bit.(-|-) l2 r2, Bit.(-|-) l3 r3, Bit.(-|-) l4 r4)
105  let (-^-) (l1, l2, l3, l4) (r1, r2, r3, r4) =
106     (Bit.(-^-) l1 r1, Bit.(-^-) l2 r2, Bit.(-^-) l3 r3, Bit.(-^-) l4 r4)
107  let rotate_right (b1, b2, b3, b4) = (b4, b1, b2, b3)
108  let rotate_left (b1, b2, b3, b4) = (b2, b3, b4, b1)
109  let shift_right (b1, b2, b3, b4) = (Bit.from_bool false, b1, b2, b3)
110  let shift_left (b1, b2, b3, b4) = (b2, b3, b4, Bit.from_bool false)
111  let not (b1, b2, b3, b4) = (Bit.not b1, Bit.not b2, Bit.not b3, Bit.not b4)
112
113  let map_bit f (b1, b2, b3, b4) = (f b1, f b2, f b3, f b4)
114  let iter_bit f (b1, b2, b3, b4) =
115    let str_b1 = f b1 in
116    let str_b2 = f b2 in
117    let str_b3 = f b3 in
118    let str_b4 = f b4 in
119      str_b1 ^ str_b2 ^ str_b3 ^ str_b4
120  let zip_bit f (l1, l2, l3, l4) (r1, r2, r3, r4) = (f l1 r1, f l2 r2, f l3 r3, f l4 r4)
121
122  let to_string = iter_bit Bit.to_string
123
124  let zero = (Bit.zero, Bit.zero, Bit.zero, Bit.zero)
125  let half_add (l1, l2, l3, l4) (r1, r2, r3, r4) =
126    let (a4, c4) = Bit.half_add l4 r4 in
127    let (a3, c3) = Bit.full_add (l3, c4) r3 in
128    let (a2, c2) = Bit.full_add (l2, c3) r2 in
129    let (a1, c1) = Bit.full_add (l1, c2) r1 in
130      ((a1, a2, a3, a4), c1)
131  let full_add ((l1, l2, l3, l4), c) (r1, r2, r3, r4) =
132    let (a4, c4) = Bit.full_add (l4, c) r4 in
133    let (a3, c3) = Bit.full_add (l3, c4) r3 in
134    let (a2, c2) = Bit.full_add (l2, c3) r2 in
135    let (a1, c1) = Bit.full_add (l1, c2) r1 in
136      ((a1, a2, a3, a4), c1)
137end;;
138
139module Nibble = NibbleFunctor(Bit);;
Note: See TracBrowser for help on using the repository browser.