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 | |
---|
9 | open Bit;; |
---|
10 | |
---|
11 | module type NIBBLE = |
---|
12 | sig |
---|
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 not: nibble -> nibble |
---|
33 | |
---|
34 | val swap_bits: nibble -> nibble |
---|
35 | |
---|
36 | val map_bit: (bit -> bit) -> nibble -> nibble |
---|
37 | val iter_bit: (bit -> string) -> nibble -> string |
---|
38 | val zip_bit: (bit -> bit -> bit) -> nibble -> nibble -> nibble |
---|
39 | end |
---|
40 | |
---|
41 | module NibbleFunctor(Bit: BIT) : NIBBLE with type bit = Bit.bit = |
---|
42 | struct |
---|
43 | type bit = Bit.bit |
---|
44 | type nibble = bit * bit * bit * bit |
---|
45 | |
---|
46 | let from_bits b1 b2 b3 b4 = (b1, b2, b3, b4) |
---|
47 | let from_bit h = (Bit.from_bool false, Bit.from_bool false, Bit.from_bool false, h) |
---|
48 | let from_int int_val = |
---|
49 | match int_val with |
---|
50 | 0 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0) |
---|
51 | | 1 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1) |
---|
52 | | 2 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 0) |
---|
53 | | 3 -> Some (Bit.from_int 0, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1) |
---|
54 | | 4 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0) |
---|
55 | | 5 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1) |
---|
56 | | 6 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0) |
---|
57 | | 7 -> Some (Bit.from_int 0, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1) |
---|
58 | | 8 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 0) |
---|
59 | | 9 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 0, Bit.from_int 1) |
---|
60 | | 10 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 1, Bit.from_int 0) |
---|
61 | | 11 -> Some (Bit.from_int 1, Bit.from_int 0, Bit.from_int 1, Bit.from_int 1) |
---|
62 | | 12 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 0) |
---|
63 | | 13 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 0, Bit.from_int 1) |
---|
64 | | 14 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 0) |
---|
65 | | 15 -> Some (Bit.from_int 1, Bit.from_int 1, Bit.from_int 1, Bit.from_int 1) |
---|
66 | | _ -> None |
---|
67 | let from_string |
---|
68 | |
---|
69 | let to_bit (l, h) = |
---|
70 | let (bl, bh) = Bit.to_bool l, Bit.to_bool h in |
---|
71 | match (bl, bh) with |
---|
72 | (false, b) -> Some (Bit.from_bool b) |
---|
73 | | (true, b) -> None |
---|
74 | let to_int (l, h) = (2 * Bit.to_int l) + Bit.to_int h |
---|
75 | let to_string = iter_bit Bit.to_string |
---|
76 | |
---|
77 | let get_bit_at index (l, h) = |
---|
78 | if index = 0 then |
---|
79 | Some l |
---|
80 | else if index = 1 then |
---|
81 | Some h |
---|
82 | else |
---|
83 | None |
---|
84 | |
---|
85 | let set_bit_at index new_bit (l, h) = |
---|
86 | if index = 0 then |
---|
87 | Some (new_bit, h) |
---|
88 | else if index = 1 then |
---|
89 | Some (l, new_bit) |
---|
90 | else |
---|
91 | None |
---|
92 | |
---|
93 | let (-&-) (l1,h1) (l2, h2) = |
---|
94 | (Bit.(-&-) l1 l2, Bit.(-&-) h1 h2) |
---|
95 | let (-|-) (l1,h1) (l2, h2) = |
---|
96 | (Bit.(-|-) l1 l2, Bit.(-|-) h1 h2) |
---|
97 | let (-^-) (l1,h1) (l2, h2) = |
---|
98 | (Bit.(-^-) l1 l2, Bit.(-^-) h1 h2) |
---|
99 | |
---|
100 | let not (l, h) = (Bit.not l, Bit.not h) |
---|
101 | |
---|
102 | let swap_bits (l, h) = (h, l) |
---|
103 | |
---|
104 | let map_bit f (l, h) = (f l, f h) |
---|
105 | let iter_bit f (l, h) = |
---|
106 | let str_l = f l in |
---|
107 | let str_h = f h in |
---|
108 | str_l ^ str_h |
---|
109 | let zip_bit f (l1, h1) (l2, h2) = (f l1 l2, f l2 h2) |
---|
110 | end |
---|
111 | |
---|
112 | module Nibble = NibbleFunctor(Bit) |
---|