Permalink
Browse files

[enhance] libbase: Made Buf module optionally resizable according to …

…global flag.
  • Loading branch information...
1 parent f13de22 commit bbb47cb472f7d965e4f1c6123b4fc61c34ba01f1 @nrs135 nrs135 committed Oct 17, 2011
Showing with 64 additions and 11 deletions.
  1. +59 −10 libbase/buf.ml
  2. +5 −1 libbase/buf.mli
View
@@ -21,18 +21,63 @@
type buf = { mutable str : string; mutable i : int }
type t = buf
-let empty = { str=""; i=0; }
+type resize_mode =
+ | RM_stdout
+ | RM_stderr
+ | RM_custom of (string -> unit)
+ | RM_failwith
+ | RM_exit
+ | RM_noresize
+
+let auto_resize = ref RM_stderr
+
+let empty () = { str=""; i=0; }
let create size = { str=String.create size; i=0; }
let make size ch = { str=String.make size ch; i=size; }
-let resize buf size =
- let str = String.create size in
- let newlen = min buf.i (String.length str) in
+(* More conservative than Buffer, we grow more slowly and
+ * we allow shrinkage by giving negative values to extra.
+ *)
+let resize buf extra =
+ let strlen = String.length buf.str in
+ let target = max 0 (if extra >= 0 then buf.i + extra else strlen + extra) in
+ let newsize =
+ if extra >= 0
+ then
+ let newsize = ref (max strlen 2) in
+ while !newsize < target do
+ newsize := max (!newsize+1) ((!newsize + !newsize + !newsize) / 2)
+ done;
+ if !newsize > Sys.max_string_length
+ then
+ if target <= Sys.max_string_length
+ then Sys.max_string_length
+ else failwith "Buf.resize: cannot increase size of buffer"
+ else !newsize
+ else target
+ in
+ let str = String.create newsize in
+ let newlen = min buf.i newsize in
if buf.i > 0 then String.unsafe_blit buf.str 0 str 0 newlen;
buf.str <- str;
- buf.i <- newlen
+ buf.i <- newlen;
+ if newsize > strlen
+ then
+ let msg = Printf.sprintf "Buf.resize called (now %d), please resize your buffers" newsize in
+ match !auto_resize with
+ | RM_stdout -> Printf.printf "%s\n%!" msg
+ | RM_stderr -> Printf.eprintf "%s\n%!" msg
+ | RM_custom f -> f msg
+ | RM_failwith -> failwith msg
+ | RM_exit -> exit 1
+ | RM_noresize -> ()
+
+let autoresize buf extra msg =
+ if !auto_resize <> RM_noresize
+ then resize buf extra
+ else invalid_arg msg
let copy buf = { str=String.copy buf.str; i=buf.i }
@@ -62,19 +107,19 @@ let sub buf base len =
String.sub buf.str base len
let add_char buf ch =
- if String.length buf.str - buf.i < 1 then invalid_arg (Printf.sprintf "Buf.add_char %c" ch);
+ if String.length buf.str - buf.i < 1 then autoresize buf 1 (Printf.sprintf "Buf.add_char %c" ch);
buf.str.[buf.i] <- ch;
buf.i <- buf.i + 1
let add_substring buf str base len =
- if String.length buf.str - buf.i < len then invalid_arg (Printf.sprintf "Buf.add_substring %s %d %d" str base len);
+ if String.length buf.str - buf.i < len then autoresize buf len (Printf.sprintf "Buf.add_substring %s %d %d" str base len);
String.unsafe_blit str base buf.str buf.i len;
buf.i <- buf.i + len
let append buf str len = add_substring buf str 0 len
let extend buf len =
- if String.length buf.str - buf.i < len then invalid_arg (Printf.sprintf "Buf.extend %d" len);
+ if String.length buf.str - buf.i < len then autoresize buf len (Printf.sprintf "Buf.extend %d" len);
buf.i <- buf.i + len
let add_string buf str =
@@ -109,11 +154,15 @@ let () = resize buf 8;;
let len = length buf;;
let rlen = real_length buf;;
let str = to_string buf;;
-let () = resize buf 2;;
+let () = resize buf (-2);;
let len = length buf;;
let rlen = real_length buf;;
let str = to_string buf;;
-let str = try ignore (add_char empty 'x'); "NOT OK" with Invalid_argument str -> "OK: "^str;;
+let str =
+ try ignore (add_char (empty()) 'x');
+ if !auto_resize <> RM_noresize then "OK: resized" else "NOT OK"
+ with Invalid_argument str ->
+ if !auto_resize <> RM_noresize then "NOT OK" else "OK: "^str;;
let () = resize buf 10;;
let () = add_string buf "fghi";;
let str = to_string buf;;
View
@@ -24,6 +24,10 @@
(** This type is concrete **)
type buf = { mutable str : string; mutable i : int; }
+(** Global flag for resize **)
+type resize_mode = RM_stdout | RM_stderr | RM_custom of (string -> unit) | RM_failwith | RM_exit | RM_noresize
+val auto_resize : resize_mode ref
+
(** Common to String and Buffer **)
type t = buf
val length : buf -> int
@@ -48,7 +52,7 @@ val add_substring : buf -> string -> int -> int -> unit
val contents : buf -> string
(** Specifics **)
-val empty : buf
+val empty : unit -> buf
val append : buf -> string -> int -> unit
val add_buf : buf -> buf -> unit
val of_string : string -> buf

0 comments on commit bbb47cb

Please sign in to comment.