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

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

More work on bits, bytes, nibbles, and added modules for byte7s and
words.

File size: 4.0 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 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
39end
40
41module NibbleFunctor(Bit: BIT) : NIBBLE with type bit = Bit.bit =
42struct
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)
110end
111
112module Nibble = NibbleFunctor(Bit)
Note: See TracBrowser for help on using the repository browser.