23 |
type 'a t = { mutable inlist : 'a list; mutable outlist : 'a list };; |
type 'a t = { mutable inlist : 'a list; mutable outlist : 'a list };; |
24 |
|
|
25 |
let create () = {inlist = []; outlist = []};; |
let create () = {inlist = []; outlist = []};; |
26 |
let put t e = |
let put t e = |
27 |
t.inlist <- e :: t.inlist |
t.inlist <- e :: t.inlist |
28 |
|
|
29 |
let rec take t = |
let rec take t = |
35 |
match t.outlist with |
match t.outlist with |
36 |
e :: queue -> t.outlist <- queue; e |
e :: queue -> t.outlist <- queue; e |
37 |
| [] -> raise Empty |
| [] -> raise Empty |
38 |
let clear t = |
let clear t = |
39 |
t.inlist <- []; |
t.inlist <- []; |
40 |
t.outlist <- [] |
t.outlist <- [] |
41 |
|
|
55 |
t.outlist <- t.outlist @ (List.rev t.inlist); |
t.outlist <- t.outlist @ (List.rev t.inlist); |
56 |
t.inlist <- []; |
t.inlist <- []; |
57 |
t.outlist |
t.outlist |
58 |
|
|
59 |
let length t = List.length t.inlist + List.length t.outlist |
let length t = List.length t.inlist + List.length t.outlist |
60 |
let put_back t l = t.outlist <- l@t.outlist |
let put_back t l = t.outlist <- l@t.outlist |
61 |
|
|
62 |
*) |
*) |
63 |
|
|
64 |
exception Empty;; |
exception Empty;; |
65 |
|
|
66 |
type 'a t = { |
type 'a t = { |
67 |
mutable empty : bool; |
mutable empty : bool; |
68 |
mutable inpos : int; |
mutable inpos : int; |
69 |
mutable outpos : int; |
mutable outpos : int; |
70 |
mutable array : 'a array; |
mutable array : 'a array; |
71 |
mutable size : int; (* bit Mask *) |
mutable size : int; (* bit Mask *) |
72 |
} |
} |
|
|
|
73 |
|
|
74 |
let create () = { |
let create () = { |
75 |
empty = true; |
empty = true; |
80 |
} |
} |
81 |
|
|
82 |
let iter f t = |
let iter f t = |
83 |
if not t.empty then |
if not t.empty then |
84 |
if t.inpos > t.outpos then |
if t.inpos > t.outpos then |
85 |
for i = t.outpos to t.inpos - 1 do |
for i = t.outpos to t.inpos - 1 do |
86 |
f t.array.(i) |
f t.array.(i) |
87 |
done |
done |
91 |
done; |
done; |
92 |
for i = 0 to t.inpos - 1 do |
for i = 0 to t.inpos - 1 do |
93 |
f t.array.(i) |
f t.array.(i) |
94 |
done |
done |
95 |
end |
end |
96 |
|
|
97 |
let mem t v = |
let mem t v = |
98 |
try |
try |
99 |
if not t.empty then |
if not t.empty then |
100 |
if t.inpos > t.outpos then |
if t.inpos > t.outpos then |
101 |
for i = t.outpos to t.inpos - 1 do |
for i = t.outpos to t.inpos - 1 do |
102 |
if t.array.(i) = v then raise Exit; |
if t.array.(i) = v then raise Exit; |
103 |
done |
done |
107 |
done; |
done; |
108 |
for i = 0 to t.inpos - 1 do |
for i = 0 to t.inpos - 1 do |
109 |
if t.array.(i) = v then raise Exit |
if t.array.(i) = v then raise Exit |
110 |
done |
done |
111 |
end; |
end; |
112 |
false |
false |
113 |
with _ -> true |
with _ -> true |
114 |
|
|
115 |
let realloc t = |
let realloc t = |
116 |
let len = Array.length t.array in |
let len = Array.length t.array in |
117 |
let tab = Array.create (2*len) t.array.(0) in |
let tab = Array.create (2*len) t.array.(0) in |
122 |
t.outpos <- 0; |
t.outpos <- 0; |
123 |
t.inpos <- len; |
t.inpos <- len; |
124 |
t.size <- t.size * 2 + 1 |
t.size <- t.size * 2 + 1 |
125 |
|
|
126 |
let put t e = |
let shrink t = |
127 |
|
if t.size > 3 then begin |
128 |
|
let len = Array.length t.array in |
129 |
|
let tab = Array.create (len/2) t.array.(0) in |
130 |
|
if t.outpos < t.inpos then begin |
131 |
|
Array.blit t.array t.outpos tab 0 (t.inpos - t.outpos); |
132 |
|
t.inpos <- t.inpos - t.outpos; |
133 |
|
end else begin |
134 |
|
let ol = len - t.outpos in |
135 |
|
Array.blit t.array t.outpos tab 0 ol; |
136 |
|
Array.blit t.array 0 tab ol t.inpos; |
137 |
|
t.inpos <- ol + t.inpos; |
138 |
|
end; |
139 |
|
t.array <- tab; |
140 |
|
t.outpos <- 0; |
141 |
|
t.size <- (t.size - 1) / 2 ; |
142 |
|
end |
143 |
|
|
144 |
|
let put t e = |
145 |
(* lprintf "FIFO PUT"; lprint_newline (); *) |
(* lprintf "FIFO PUT"; lprint_newline (); *) |
146 |
if t.inpos = t.outpos && not t.empty then realloc t; |
if t.inpos = t.outpos && not t.empty then realloc t; |
147 |
t.array.(t.inpos) <- e; |
t.array.(t.inpos) <- e; |
152 |
*) |
*) |
153 |
() |
() |
154 |
|
|
155 |
|
let clear t = |
156 |
|
(* lprintf "FIFO CLEAR"; lprint_newline (); *) |
157 |
|
let tab = Array.create 4 t.array.(0) in |
158 |
|
t.array <- tab; |
159 |
|
t.size <- 3; |
160 |
|
t.empty <- true; |
161 |
|
t.inpos <- 0; |
162 |
|
t.outpos <- 0 |
163 |
|
|
164 |
|
let length t = |
165 |
|
(* lprintf "FIFO LEN"; lprint_newline (); *) |
166 |
|
if t.empty then 0 else |
167 |
|
if t.inpos > t.outpos then t.inpos - t.outpos else |
168 |
|
let s = Array.length t.array in |
169 |
|
s + t.inpos - t.outpos |
170 |
|
|
171 |
let take t = |
let take t = |
172 |
(* lprintf "FIFO TAKE"; lprint_newline (); *) |
(* lprintf "FIFO TAKE"; lprint_newline (); *) |
173 |
if t.empty then raise Empty; |
if t.empty then raise Empty; |
174 |
|
if (length t) < ((t.size + 1) / 4) then shrink t; |
175 |
let e = t.array.(t.outpos) in |
let e = t.array.(t.outpos) in |
176 |
t.outpos <- (t.outpos + 1) land t.size; |
t.outpos <- (t.outpos + 1) land t.size; |
177 |
t.empty <- (t.outpos = t.inpos); |
if t.outpos = t.inpos then clear t; |
178 |
e |
e |
|
|
|
|
let clear t = |
|
|
(* lprintf "FIFO CLEAR"; lprint_newline (); *) |
|
|
t.empty <- true; |
|
|
t.inpos <- 0; |
|
|
t.outpos <- 0 |
|
179 |
|
|
180 |
let head t = |
let head t = |
181 |
if t.empty then raise Empty; |
if t.empty then raise Empty; |
182 |
t.array.(t.outpos) |
t.array.(t.outpos) |
183 |
|
|
184 |
let empty t = |
let empty t = |
185 |
(* lprintf "FIFO EMPTY %s" (string_of_bool t.empty); lprint_newline (); *) |
(* lprintf "FIFO EMPTY %s" (string_of_bool t.empty); lprint_newline (); *) |
186 |
t.empty |
t.empty |
187 |
|
|
215 |
Array.blit t.array 0 tab (s - t.outpos) t.inpos; |
Array.blit t.array 0 tab (s - t.outpos) t.inpos; |
216 |
tab |
tab |
217 |
|
|
218 |
let length t = |
let put_back_ele t e = |
|
(* lprintf "FIFO LEN"; lprint_newline (); *) |
|
|
if t.empty then 0 else |
|
|
if t.inpos > t.outpos then t.inpos - t.outpos else |
|
|
let s = Array.length t.array in |
|
|
s + t.inpos - t.outpos |
|
|
|
|
|
let put_back_ele t e = |
|
219 |
if t.inpos = t.outpos && not t.empty then realloc t; |
if t.inpos = t.outpos && not t.empty then realloc t; |
220 |
t.outpos <- (t.outpos - 1) land t.size; |
t.outpos <- (t.outpos - 1) land t.size; |
221 |
t.array.(t.outpos) <- e; |
t.array.(t.outpos) <- e; |
222 |
t.empty <- false |
t.empty <- false |
223 |
|
|
224 |
|
let rec put_back t list = |
|
let rec put_back t list = |
|
225 |
match list with |
match list with |
226 |
[] -> () |
[] -> () |
227 |
| ele :: tail -> |
| ele :: tail -> |
238 |
t.inpos <- len; |
t.inpos <- len; |
239 |
t.outpos <- 0; |
t.outpos <- 0; |
240 |
end |
end |
241 |
|
|
242 |
let remove t e = |
let remove t e = |
243 |
if not t.empty then begin |
if not t.empty then begin |
244 |
if t.outpos >= t.inpos then reformat t; |
if t.outpos >= t.inpos then reformat t; |
248 |
if i >= t.inpos then |
if i >= t.inpos then |
249 |
(if i > j then begin |
(if i > j then begin |
250 |
t.inpos <- j; |
t.inpos <- j; |
251 |
t.empty <- (t.inpos = t.outpos); |
if t.inpos = t.outpos then clear t; |
252 |
end) |
end) |
253 |
else |
else |
254 |
let ee = t.array.(i) in |
let ee = t.array.(i) in |
266 |
end |
end |
267 |
|
|
268 |
(* TEST SUITE |
(* TEST SUITE |
269 |
|
|
270 |
let t = Fifo.create ();; |
let t = Fifo.create ();; |
271 |
|
|
272 |
for i = 0 to 100 do |
for i = 0 to 100 do |
288 |
Printf.printf "%d\n" (Fifo.take t) |
Printf.printf "%d\n" (Fifo.take t) |
289 |
done;; |
done;; |
290 |
|
|
|
*) |
|
291 |
|
*) |