/[mldonkey]/mldonkey/src/utils/lib/fifo.ml
ViewVC logotype

Diff of /mldonkey/src/utils/lib/fifo.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by mldonkey, Wed Aug 4 16:59:27 2004 UTC revision 1.4 by spiralvoice, Tue Aug 9 10:50:02 2005 UTC
# Line 23  exception Empty;; Line 23  exception Empty;;
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 =
# Line 35  let rec take t = Line 35  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    
# Line 55  let to_list t = Line 55  let to_list t =
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;
# Line 81  let create () = { Line 80  let create () = {
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
# Line 92  let iter f t = Line 91  let iter f t =
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
# Line 108  let mem t v = Line 107  let mem t v =
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
# Line 123  let realloc t = Line 122  let realloc t =
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;
# Line 135  lprintf "FIFO NOT EMPTY %s" (string_of_b Line 152  lprintf "FIFO NOT EMPTY %s" (string_of_b
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    
# Line 187  let to_array t = Line 215  let to_array t =
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 ->
# Line 218  let reformat t = Line 238  let reformat t =
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;
# Line 228  let remove t e = Line 248  let remove t e =
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
# Line 246  let remove t e = Line 266  let remove t e =
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
# Line 268  while true do Line 288  while true do
288    Printf.printf "%d\n" (Fifo.take t)    Printf.printf "%d\n" (Fifo.take t)
289  done;;  done;;
290    
 *)  
291    *)

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26