CircularArray.ml 7.67 KB
Newer Older
charguer's avatar
charguer committed
1 2
(** Representation of fixed-size circular buffers. *)

charguer's avatar
charguer committed
3
module Make  (Capa : CapacitySig.S) (Item : InhabType.S) =
charguer's avatar
charguer committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
struct

(*--------------------------------------------------------------------------*)

(** Aliases for the type of item and the capacity *)

type item = Item.t

let capacity = Capa.capacity

(** Representation of a queue *)

type t = {
  mutable head : int;
  mutable size : int;
  mutable data : item array; }


(*--------------------------------------------------------------------------*)

(** Builds a new queue *)

charguer's avatar
charguer committed
26
let create () =
charguer's avatar
charguer committed
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
  { head = 0;
    size = 0;
    data = Array.make capacity Item.inhab; }

(** Returns the size of the queue *)

let length q =
  q.size

(** Tests whether the queue is empty *)

let is_empty q =
  q.size = 0

(** Tests whether the queue is full *)

let is_full q =
  q.size = capacity

(** Auxiliary function to circle around indices that exceed capacity *)

let wrap_up i =
   if i < capacity then i else i - capacity

(** Auxiliary function to circle around indices that became negative *)

let wrap_down i =
   if i >= 0 then i else i + capacity


(*--------------------------------------------------------------------------*)

(** Pop an element from the front (assumes non-empty queue) *)

charguer's avatar
charguer committed
61
let pop_front q =
charguer's avatar
charguer committed
62 63 64 65
  let x = Array.get q.data q.head in
  q.head <- wrap_up (q.head + 1);
  q.size <- q.size - 1;
  x
charguer's avatar
charguer committed
66

charguer's avatar
charguer committed
67 68
(** Pop an element from the back (assumes non-empty queue) *)

charguer's avatar
charguer committed
69
let pop_back q =
charguer's avatar
charguer committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
  q.size <- q.size - 1;
  let i = wrap_up (q.head + q.size) in
  Array.get q.data i

(** Push an element to the front (assumes non-full queue) *)

let push_front x q =
  q.head <- wrap_down (q.head - 1);
  Array.set q.data q.head x;
  q.size <- q.size + 1

(** Push an element to the back (assumes non-full queue) *)

let push_back x q =
  let i = wrap_up (q.head + q.size) in
  Array.set q.data i x;
  q.size <- q.size + 1


(*--------------------------------------------------------------------------*)

let debug = false

(** Internal: copy n elements from an array t1 of size capacity,
charguer's avatar
charguer committed
94
    starting at index i1 and possibly wrapping around, into an
charguer's avatar
charguer committed
95 96 97 98
    array t2 starting at index i2 and not wrapping around. *)

let copy_data_wrap_src t1 i1 t2 i2 n =
   if (debug && (i1 < 0 || i1 > capacity || i2 < 0 || i2 + n > capacity || n < 0))
charguer's avatar
charguer committed
99
      then failwith (Printf.sprintf "copy_data_wrap_src error: %d %d %d" i1 i2 n);
charguer's avatar
charguer committed
100 101 102 103 104 105 106 107 108
   let j1 = i1 + n in
   if j1 <= capacity then begin
     Array.blit t1 i1 t2 i2 n
   end else begin
     let na = capacity - i1 in
     let i2' = wrap_up (i2 + na) in
     Array.blit t1 i1 t2 i2 na;
     Array.blit t1 0 t2 i2' (n - na);
   end
charguer's avatar
charguer committed
109

charguer's avatar
charguer committed
110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
(** Internal: copy n elements from an array t1 starting at index i1
    and not wrapping around, into an array t2 of size capacity,
    starting at index i2 and possibly wrapping around. *)

let copy_data_wrap_dst t1 i1 t2 i2 n =
   if (debug && (i1 < 0 || i2 < 0 || i2 > capacity || i1 + n > capacity || n < 0))
      then failwith (Printf.sprintf "copy_data_wrap_dst error: %d %d %d" i1 i2 n);
   let j2 = i2 + n in
   if j2 <= capacity then begin
     Array.blit t1 i1 t2 i2 n;
   end else begin
     let na = capacity - i2 in
     let i1' = wrap_up (i1 + na) in
     Array.blit t1 i1 t2 i2 na;
     Array.blit t1 i1' t2 0 (n - na);
   end

(** Internal: copy n elements from an array t1 starting at index i1
charguer's avatar
charguer committed
128
    and possibly wrapping around, into an array t2 starting at index
charguer's avatar
charguer committed
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
    i2 and possibly wrapping around. Both arrays are assumed to be
    of size capacity. *)

let copy_data_wrap_src_and_dst t1 i1 t2 i2 n =
   if (debug && (i1 < 0 || i1 > capacity || i2 > capacity || i2 < 0 || n < 0))
      then failwith (Printf.sprintf "copy_data_wrap_src_and_dst error: %d %d %d" i1 i2 n);
   let j1 = i1 + n in
   if j1 <= capacity then begin
      copy_data_wrap_dst t1 i1 t2 i2 n
   end else begin
     let na = capacity - i1 in
     let i2' = wrap_up (i2 + na) in
     copy_data_wrap_dst t1 i1 t2 i2 na;
     copy_data_wrap_dst t1 0 t2 i2' (n - na);
   end


(*--------------------------------------------------------------------------*)

(** Transfer N items from the back of a buffer to the front of another buffer *)

let transfer_back_to_front n q1 q2 =
charguer's avatar
charguer committed
151
   if n < 0 || n > q1.size || n + q2.size > capacity
charguer's avatar
charguer committed
152 153 154 155 156 157 158 159 160 161 162
      then invalid_arg "CircularArray.transfer_back_to_front";
   let h1 = wrap_down (wrap_up (q1.head + q1.size) - n) in
   let h2 = wrap_down (q2.head - n) in
   copy_data_wrap_src_and_dst q1.data h1 q2.data h2 n;
   q1.size <- q1.size - n;
   q2.size <- q2.size + n;
   q2.head <- h2

(** Transfer N items from the front of a buffer to the back of another buffer *)

let transfer_front_to_back n q1 q2 =
charguer's avatar
charguer committed
163
   if n < 0 || n > q1.size || n + q2.size > capacity
charguer's avatar
charguer committed
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
      then invalid_arg "CircularArray.transfer_front_to_back";
   let h1 = q1.head in
   let h2 = wrap_up (q2.head + q2.size) in
   copy_data_wrap_src_and_dst q1.data h1 q2.data h2 n;
   q1.size <- q1.size - n;
   q2.size <- q2.size + n;
   q1.head <- wrap_up (h1 + n)


(*--------------------------------------------------------------------------*)

(** Transfer all items from a buffer to the front of another buffer *)

let transfer_all_to_front q1 q2 =
   transfer_back_to_front q1.size q1 q2

(** Transfer all items from a buffer to the back of another buffer *)

let transfer_all_to_back q1 q2 =
   transfer_front_to_back q1.size q1 q2

(*--------------------------------------------------------------------------*)

(** Pop N elements from the front into an array *)

charguer's avatar
charguer committed
189 190
let popn_front_to_array n q =
  if n < 0 || n > q.size
charguer's avatar
charguer committed
191 192 193 194 195 196 197 198 199 200 201 202
     then invalid_arg "CircularArray.popn_front_to_array";
  if n = 0 then [||] else begin
     let h = q.head in
     let t = Array.make n q.data.(h) in
     copy_data_wrap_src q.data h t 0 n;
     q.size <- q.size - n;
     q.head <- wrap_up (h + n);
     t
  end

(** Pop N elements from the back into an array *)

charguer's avatar
charguer committed
203
let popn_back_to_array n q =
charguer's avatar
charguer committed
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
  if n < 0 || n > q.size then invalid_arg "CircularArray.popn_back_to_array";
  if n = 0 then [||] else begin
     let h = wrap_down (wrap_up (q.head + q.size) - n) in
     let t = Array.make n q.data.(h) in
     copy_data_wrap_src q.data h t 0 n;
     q.size <- q.size - n;
     t
  end

(** Push N elements to the front, taking them from an array *)

let pushn_front_from_array n t q =
  if n < 0 || n + q.size > capacity then invalid_arg "CircularArray.pushn_front_from_array";
  let h = wrap_down (q.head - n) in
  copy_data_wrap_dst t 0 q.data h n;
  q.head <- h;
  q.size <- q.size + n

(** Push N elements to the back, taking them from an array *)

let pushn_back_from_array n t q =
  if n < 0 || n + q.size > capacity then invalid_arg "CircularArray.pushn_back_from_array";
  let h = wrap_up (q.head + q.size) in
  copy_data_wrap_dst t 0 q.data h n;
  q.size <- q.size + n


(*--------------------------------------------------------------------------*)

(** Iter *)

let iter f q =
   let i = ref q.head in
   for k = 0 to pred q.size do
      f (Array.get q.data !i);
      incr i;
      if !i = capacity
         then i := 0;
   done

(** Fold-left *)

let fold_left f a q =
   let acc = ref a in
   let i = ref q.head in
   for k = 0 to pred q.size do
      acc := f !acc (Array.get q.data !i);
      incr i;
      if !i = capacity
         then i := 0;
   done;
   !acc

(** Fold-right *)

let fold_right f q a =
   let acc = ref a in
   let i = ref (wrap_down (wrap_up (q.head + q.size) - 1)) in
   for k = 0 to pred q.size do
      acc := f (Array.get q.data !i) !acc;
      decr i;
      if !i = -1;
         then i := capacity-1;
   done;
   !acc

(** Conversions with lists *)

let to_list q =
   fold_right (fun x acc -> x::acc) q []


(*--------------------------------------------------------------------------*)

(** Random access *)

let cell_at q i =
   wrap_up (q.head + i)

charguer's avatar
charguer committed
283
let get q i =
charguer's avatar
charguer committed
284 285 286 287 288 289 290
   q.data.(cell_at q i)

let set q i v =
   q.data.(cell_at q i) <- v


end