(* * CCBufferIO - Polymorphic circular buffer * Copyright (C) 2014 Simon Cruanes * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version, * with the special exception on linking described in file LICENSE. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Polymorphic Circular Buffer for IO *) type 'a t = { mutable start : int; mutable stop : int; (* excluded *) mutable buf : 'a array; size: int } exception Empty let create size = { start=0; stop=0; size; buf = Array.of_list []; } let copy b = { b with buf=Array.copy b.buf; } let capacity b = b.size let length b = if b.stop >= b.start then b.stop - b.start else (Array.length b.buf - b.start) + b.stop (* resize [b] so that inner capacity is [cap] *) let resize b cap elem = assert (cap >= Array.length b.buf); let buf' = Array.make cap elem in (* copy into buf' *) let len = if b.stop >= b.start then begin Array.blit b.buf b.start buf' 0 (b.stop - b.start); b.stop - b.start end else begin let len_end = Array.length b.buf - b.start in Array.blit b.buf b.start buf' 0 len_end; Array.blit b.buf 0 buf' len_end b.stop; len_end + b.stop end in b.buf <- buf'; b.start <- 0; b.stop <- len; () let blit_from b from_buf o len = let cap = capacity b - length b in (* resize if needed, with a constant to amortize *) if (Array.length from_buf) = 0 then () else if cap < len then resize b (Array.length b.buf + len + 24) from_buf.(0); assert (capacity b - length b >= len); if b.stop >= b.start then (* [_______ start xxxxxxxxx stop ______] *) let len_end = Array.length b.buf - b.stop in if len_end >= len then (Array.blit from_buf o b.buf b.stop len; b.stop <- b.stop + len) else (Array.blit from_buf o b.buf b.stop len_end; Array.blit from_buf (o+len_end) b.buf 0 (len-len_end); b.stop <- len-len_end) else begin (* [xxxxx stop ____________ start xxxxxx] *) let len_middle = b.start - b.stop in assert (len_middle >= len); Array.blit from_buf 0 b.buf b.stop len; b.stop <- b.stop + len end; () let blit_into b to_buf o len = if o+len > Array.length to_buf then raise (Invalid_argument "BufferIO.blit_into"); if b.stop >= b.start then let n = min (b.stop - b.start) len in let _ = Array.blit b.buf b.start to_buf o n in n else begin let len_end = Array.length b.buf - b.start in Array.blit b.buf b.start to_buf o (min len_end len); if len_end >= len then len (* done *) else begin let n = min b.stop (len - len_end) in Array.blit b.buf 0 to_buf (o+len_end) n; n + len_end end end let add b s = blit_from b s 0 (Array.length s) (*$Q (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \ let b = create 24 in add b s; add_string b s'; \ Array.length s + String.length s' = length b) *) let clear b = b.stop <- 0; b.start <- 0; () let reset b = clear b; if capacity b > 64 then b.buf <- Array.sub b.buf 0 64; () let is_empty b = b.start = b.stop let next b = if b.start = b.stop then raise Empty; b.buf.(b.start) let pop b = if b.start = b.stop then raise Empty; let c = b.buf.(b.start) in if b.start + 1 = Array.length b.buf then b.start <- 0 else b.start <- b.start + 1; c let junk b = if b.start = b.stop then raise Empty; if b.start + 1 = Array.length b.buf then b.start <- 0 else b.start <- b.start + 1 let skip b len = if len > length b then raise (Invalid_argument "BufferIO.skip"); if b.stop >= b.start then b.start <- b.start + len else let len_end = Array.length b.buf - b.start in if len > len_end then b.start <- len-len_end (* wrap to the beginning *) else b.start <- b.start + len (*$Q (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \ let b = create 24 in add_string b s; add_string b s'; \ add_string b "hello world"; (* big enough *) \ let l = length b in let l' = l/2 in skip b l'; \ length b + l' = l) *) let iteri b f = if b.stop >= b.start then for i = b.start to b.stop - 1 do f i b.buf.(i) done else ( for i = b.start to Array.length b.buf -1 do f i b.buf.(i) done; for i = 0 to b.stop - 1 do f i b.buf.(i) done; ) (*$T let s = "hello world" in \ let b = of_string s in \ try iteri b (fun i c -> if s.[i] <> c then raise Exit); true with Exit -> false *) let get b i = if b.stop >= b.start then if i >= b.stop - b.start then raise (Invalid_argument "BufferIO.get") else b.buf.(b.start + i) else let len_end = Array.length b.buf - b.start in if i < len_end then b.buf.(b.start + i) else if i - len_end > b.stop then raise (Invalid_argument "BufferIO.get") else b.buf.(i - len_end) let to_list b = Array.to_list (Array.sub b.buf b.start b.stop)