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

…global flag.

libbase/buf.ml

@@ -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;;

libbase/buf.mli

@@ -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