source: Deliverables/D4.1/BitVectors.ml @ 140

Last change on this file since 140 was 140, checked in by sacerdot, 10 years ago

More cleanup.

File size: 3.5 KB
RevLine 
[87]1type bit = bool
2type 'a vect = bit list
3type nibble = [`Four] vect
4type byte7 = [`Seven] vect
5type byte = [`Eight] vect
6type word = [`Sixteen] vect
7type word11 = [`Eleven] vect
[86]8
[92]9type sizes = [ `Four | `Seven | `Eight | `Eleven | `Sixteen ]
10
[87]11let mk_nibble b1 b2 b3 b4 = [b1; b2; b3; b4]
12let from_nibble =
13 function
14    [b1; b2; b3; b4] -> b1,b2,b3,b4
15  | _ -> assert false
16let mk_byte n1 n2 = n1 @ n2
[95]17let mk_byte_from_bits ((b1,b2,b3,b4),(b5,b6,b7,b8)) = ([b1;b2;b3;b4;b5;b6;b7;b8] : [`Eight] vect)
[87]18let from_byte =
19 function
20    b1::b2::b3::b4::r -> [b1;b2;b3;b4],r
21  | _ -> assert false
[97]22let bits_of_byte =
23 function
24    [b1;b2;b3;b4;b5;b6;b7;b8] -> (b1,b2,b3,b4),(b5,b6,b7,b8)
25  | _ -> assert false
[87]26let mk_byte7 b1 b2 b3 n1 = b1::b2::b3::n1
27let from_byte7 =
28 function
29    b1::b2::b3::r -> b1,b2,b3,r
30  | _ -> assert false
31let mk_word = mk_byte
32let from_word =
33 function
34    b1::b2::b3::b4::b5::b6::b7::b8::r -> [b1;b2;b3;b4;b5;b6;b7;b8],r
35  | _ -> assert false
36let mk_word11 = mk_byte7
37let from_word11 = from_byte7
[86]38
[87]39let get_bit index l =
40  try
41    Some (List.nth index l)
42  with (Failure _ | Invalid_argument _) -> None
[86]43
[87]44let set_bit l index new_val =
45  try
46    let rec aux index l = 
47      match index, l with
48        _, [] -> raise (Invalid_argument "")
49      | 0,_::tl -> new_val::tl
50      | n,hd::tl -> hd::(aux (n-1) tl) in
51     Some (List.rev (aux index (List.rev l)))
52  with Invalid_argument "" -> None
[86]53
[87]54let (-&-) l1 l2 = List.map2 (fun b1 b2 -> b1 & b2) l1 l2
55let (-|-) l1 l2 = List.map2 (fun b1 b2 -> b1 || b2) l1 l2
56let xor b1 b2 = b1 <> b2
57let (-^-) l1 l2 = List.map2 xor l1 l2
[95]58let complement l1 = List.map (not) l1
[86]59
[87]60let iter_bits f v = String.concat "" (List.map f v)
61let map_bits = List.map
62let map2_bits = List.map2
[86]63
[98]64let string_of_bit = function false -> "0" | true -> "1"
65let string_of_vect l = String.concat "" (List.map string_of_bit l)
[86]66
[87]67let 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,[])
68let half_add l r = full_add l r false
[86]69
[88]70let rec split_last =
71  function
72    [] -> assert false
73  | [he] -> he,[]
74  | he::tl ->
75      let l,res = split_last tl in
76        l,he::res
[86]77
[88]78let shift_left =
79  function
80    [] -> assert false
81  | _::tl -> tl @ [false]
[87]82let shift_right l = false :: snd (split_last l)
[88]83let rotate_left =
84  function
85    [] -> assert false
86  | he::tl -> tl @ [he]
87let rotate_right l =
88  let he,tl = split_last l in
89    he::tl
90
[140]91(* CSC: can overflow!!! *)
[88]92let int_of_vect v =
93  let rec aux pow v =
94    match v with
95      [] -> 0
96    | hd::tl ->
97        if hd = true then
98          pow + (aux (pow * 2) tl)
99        else
100          aux (pow * 2) tl
101  in
102    aux 1 (List.rev v)
[89]103
104let size_lookup =
105  function
106    `Four -> 4
107  | `Seven -> 7
108  | `Eight -> 8
109  | `Eleven -> 11
110  | `Sixteen -> 16
111
112let rec pow v p =
113  if p = 0 then
114    1
115  else
116    v * (pow v (p - 1))
117
118let divide_with_remainder x y = (x / y, x mod y)
119
120let rec aux i =
121  if i < 0 then
122    raise (Invalid_argument "Negative index")
123  else
124    let (d, r) = divide_with_remainder i 2 in
125      if (d, r) = (0, 0) then
126        []
127      else if r = 0 then
128        false :: aux d
129      else
130        true :: aux d
131
[138]132let rec pad i l = if i = 0 then l else false :: (pad (i - 1) l)
133
[89]134let vect_of_int i size =
135  let big_list = List.rev (aux i) in
[138]136    if List.length big_list > size_lookup size then
[89]137      raise (Invalid_argument "Size not big enough")
138    else
[138]139      let diff = size_lookup size - List.length big_list in
140        pad diff big_list
[89]141   
[138]142let zero size = pad (size_lookup size) []
[140]143
144(* CSC: can overflow!!! *)
145let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);;
Note: See TracBrowser for help on using the repository browser.