source: Deliverables/D4.1/tentative.ml @ 86

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

Adding bit vector file.

File size: 3.6 KB
Line 
1module Vect :
2 sig
3  type bit = bool
4
5  type 'a vect
6
7  type nibble = [`Four] vect
8  type byte7 = [`Seven] vect
9  type byte = [`Eight] vect
10  type word = [`Sixteen] vect
11  type word11 = [`Eleven] vect
12
13  val mk_nibble: bit -> bit -> bit -> bit -> nibble
14  val from_nibble: nibble -> bit * bit * bit * bit
15  val mk_byte7: bit -> bit -> bit -> nibble -> byte7
16  val from_byte7: byte7 -> bit * bit * bit * nibble
17  val mk_byte: nibble -> nibble -> byte
18  val from_byte: byte -> nibble * nibble
19  val mk_word: byte -> byte -> word
20  val from_word: word -> byte * byte
21  val mk_word11: bit -> bit -> bit -> byte -> word11
22  val from_word11: word11 -> bit * bit * bit * byte
23
24  val to_bits: 'a vect -> bit list
25  val get_bit: 'a vect -> int -> bit option
26  val set_bit: 'a vect -> int -> bit -> 'a vect option
27
28  val (-&-): 'a vect -> 'a vect -> 'a vect
29  val (-|-): 'a vect -> 'a vect -> 'a vect
30  val (-^-): 'a vect -> 'a vect -> 'a vect
31  val not: 'a vect -> 'a vect
32
33  val iter_bits: (bit -> string) -> 'a vect -> string
34  val map_bits: (bit -> bit) -> 'a vect -> 'a vect
35  val map2_bits: (bit -> bit -> bit) -> 'a vect -> 'a vect -> 'a vect
36
37  val string_of_vect: 'a vect -> string
38
39  val half_add: 'a vect -> 'a vect -> bit * 'a vect
40  val full_add: 'a vect -> 'a vect -> bit -> bit * 'a vect
41
42  val rotate_left : 'a vect -> 'a vect
43  val rotate_right : 'a vect -> 'a vect
44  val shift_right : 'a vect -> 'a vect
45  val shift_left : 'a vect -> 'a vect
46 end
47=
48 struct
49  type bit = bool
50  type 'a vect = bit list
51  type nibble = [`Four] vect
52  type byte7 = [`Seven] vect
53  type byte = [`Eight] vect
54  type word = [`Sixteen] vect
55  type word11 = [`Eleven] vect
56
57  let mk_nibble b1 b2 b3 b4 = [b1; b2; b3; b4]
58  let from_nibble =
59   function
60      [b1; b2; b3; b4] -> b1,b2,b3,b4
61    | _ -> assert false
62  let mk_byte n1 n2 = n1 @ n2
63  let from_byte =
64   function
65      b1::b2::b3::b4::r -> [b1;b2;b3;b4],r
66    | _ -> assert false
67  let mk_byte7 b1 b2 b3 n1 = b1::b2::b3::n1
68  let from_byte7 =
69   function
70      b1::b2::b3::r -> b1,b2,b3,r
71    | _ -> assert false
72  let mk_word = mk_byte
73  let from_word =
74   function
75      b1::b2::b3::b4::b5::b6::b7::b8::r -> [b1;b2;b3;b4;b5;b6;b7;b8],r
76    | _ -> assert false
77  let mk_word11 = mk_byte7
78  let from_word11 = from_byte7
79
80  let to_bits l = l
81
82  let get_bit index l =
83    try
84      Some (List.nth index l)
85    with (Failure _ | Invalid_argument _) -> None
86
87  let set_bit l index new_val =
88    try
89      let rec aux index l = 
90        match index, l with
91          _, [] -> raise (Invalid_argument "")
92        | 0,_::tl -> new_val::tl
93        | n,hd::tl -> hd::(aux (n-1) tl) in
94       Some (List.rev (aux index (List.rev l)))
95    with Invalid_argument "" -> None
96
97  let (-&-) l1 l2 = List.map2 (fun b1 b2 -> b1 & b2) l1 l2
98  let (-|-) l1 l2 = List.map2 (fun b1 b2 -> b1 || b2) l1 l2
99  let xor b1 b2 = b1 <> b2
100  let (-^-) l1 l2 = List.map2 xor l1 l2
101  let not l1 = List.map (not) l1
102
103  let iter_bits f v = String.concat "" (List.map f v)
104  let map_bits = List.map
105  let map2_bits = List.map2
106
107  let string_of_vect l =
108   String.concat "" (List.map (function false -> "0" | true -> "1") l)
109
110  let full_add l r c = List.fold_right2 (fun b1 b2 (c,r) -> b1 & b2 || c & (b1 || b2),xor (xor b1 b2) c::r) l r (c,[])
111  let half_add l r = full_add l r false
112
113  let rec split_last = function [] -> assert false | [he] -> he,[] | he::tl -> let l,res = split_last tl in l,he::res
114
115  let shift_left = function [] -> assert false | _::tl -> tl @ [false]
116  let shift_right l = false :: snd (split_last l)
117  let rotate_left = function [] -> assert false | he::tl -> tl @ [he]
118  let rotate_right l = let he,tl = split_last l in he::tl
119 end
120;;
Note: See TracBrowser for help on using the repository browser.