1 | module 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 | ;; |
---|