Changeset 87 for Deliverables/D4.1
- Timestamp:
- Sep 17, 2010, 5:14:18 PM (10 years ago)
- Location:
- Deliverables/D4.1
- Files:
-
- 1 added
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
Deliverables/D4.1/bit_vectors.ml
r86 r87 1 module Vect : 2 sig 3 type bit = bool 1 type bit = bool 2 type 'a vect = bit list 3 type nibble = [`Four] vect 4 type byte7 = [`Seven] vect 5 type byte = [`Eight] vect 6 type word = [`Sixteen] vect 7 type word11 = [`Eleven] vect 4 8 5 type 'a vect 9 let mk_nibble b1 b2 b3 b4 = [b1; b2; b3; b4] 10 let from_nibble = 11 function 12 [b1; b2; b3; b4] -> b1,b2,b3,b4 13 | _ -> assert false 14 let mk_byte n1 n2 = n1 @ n2 15 let from_byte = 16 function 17 b1::b2::b3::b4::r -> [b1;b2;b3;b4],r 18 | _ -> assert false 19 let mk_byte7 b1 b2 b3 n1 = b1::b2::b3::n1 20 let from_byte7 = 21 function 22 b1::b2::b3::r -> b1,b2,b3,r 23 | _ -> assert false 24 let mk_word = mk_byte 25 let from_word = 26 function 27 b1::b2::b3::b4::b5::b6::b7::b8::r -> [b1;b2;b3;b4;b5;b6;b7;b8],r 28 | _ -> assert false 29 let mk_word11 = mk_byte7 30 let from_word11 = from_byte7 6 31 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 32 let to_bits l = l 12 33 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 34 let get_bit index l = 35 try 36 Some (List.nth index l) 37 with (Failure _ | Invalid_argument _) -> None 23 38 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 39 let set_bit l index new_val = 40 try 41 let rec aux index l = 42 match index, l with 43 _, [] -> raise (Invalid_argument "") 44 | 0,_::tl -> new_val::tl 45 | n,hd::tl -> hd::(aux (n-1) tl) in 46 Some (List.rev (aux index (List.rev l))) 47 with Invalid_argument "" -> None 27 48 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 49 let (-&-) l1 l2 = List.map2 (fun b1 b2 -> b1 & b2) l1 l2 50 let (-|-) l1 l2 = List.map2 (fun b1 b2 -> b1 || b2) l1 l2 51 let xor b1 b2 = b1 <> b2 52 let (-^-) l1 l2 = List.map2 xor l1 l2 53 let not l1 = List.map (not) l1 32 54 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 55 let iter_bits f v = String.concat "" (List.map f v) 56 let map_bits = List.map 57 let map2_bits = List.map2 36 58 37 val string_of_vect: 'a vect -> string 59 let string_of_vect l = 60 String.concat "" (List.map (function false -> "0" | true -> "1") l) 38 61 39 val half_add: 'a vect -> 'a vect -> bit * 'a vect 40 val full_add: 'a vect -> 'a vect -> bit -> bit * 'a vect 62 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,[]) 63 let half_add l r = full_add l r false 41 64 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 65 let rec split_last = function [] -> assert false | [he] -> he,[] | he::tl -> let l,res = split_last tl in l,he::res 56 66 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 ;; 67 let shift_left = function [] -> assert false | _::tl -> tl @ [false] 68 let shift_right l = false :: snd (split_last l) 69 let rotate_left = function [] -> assert false | he::tl -> tl @ [he] 70 let rotate_right l = let he,tl = split_last l in he::tl
Note: See TracChangeset
for help on using the changeset viewer.