2016-02-18 07:11:59 -08:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* OCaml *)
|
|
|
|
(* *)
|
|
|
|
(* Damien Doligez, projet Para, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
|
|
|
(* en Automatique. *)
|
|
|
|
(* *)
|
|
|
|
(* All rights reserved. This file is distributed under the terms of *)
|
|
|
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
|
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
1995-08-09 08:06:35 -07:00
|
|
|
|
2002-12-08 07:17:30 -08:00
|
|
|
type key = string
|
|
|
|
type doc = string
|
|
|
|
type usage_msg = string
|
2003-03-12 08:36:28 -08:00
|
|
|
type anon_fun = (string -> unit)
|
2002-12-08 07:17:30 -08:00
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
type spec =
|
1997-09-11 08:10:23 -07:00
|
|
|
| Unit of (unit -> unit) (* Call the function with unit argument *)
|
2003-04-25 03:19:35 -07:00
|
|
|
| Bool of (bool -> unit) (* Call the function with a bool argument *)
|
1995-09-05 05:30:26 -07:00
|
|
|
| Set of bool ref (* Set the reference to true *)
|
|
|
|
| Clear of bool ref (* Set the reference to false *)
|
|
|
|
| String of (string -> unit) (* Call the function with a string argument *)
|
2003-04-25 03:19:35 -07:00
|
|
|
| Set_string of string ref (* Set the reference to the string argument *)
|
1995-09-05 05:30:26 -07:00
|
|
|
| Int of (int -> unit) (* Call the function with an int argument *)
|
2003-04-25 03:19:35 -07:00
|
|
|
| Set_int of int ref (* Set the reference to the int argument *)
|
1995-09-05 05:30:26 -07:00
|
|
|
| Float of (float -> unit) (* Call the function with a float argument *)
|
2003-04-25 03:19:35 -07:00
|
|
|
| Set_float of float ref (* Set the reference to the float argument *)
|
|
|
|
| Tuple of spec list (* Take several arguments according to the
|
|
|
|
spec list *)
|
2002-11-02 13:24:30 -08:00
|
|
|
| Symbol of string list * (string -> unit)
|
2003-04-25 03:19:35 -07:00
|
|
|
(* Take one of the symbols as argument and
|
|
|
|
call the function with the symbol. *)
|
1998-04-06 09:33:34 -07:00
|
|
|
| Rest of (string -> unit) (* Stop interpreting keywords and call the
|
|
|
|
function with each remaining argument *)
|
2016-10-07 10:28:30 -07:00
|
|
|
| Expand of (string -> string array) (* If the remaining arguments to process
|
|
|
|
are of the form
|
|
|
|
[["-foo"; "arg"] @ rest] where "foo" is
|
|
|
|
registered as [Expand f], then the
|
|
|
|
arguments [f "arg" @ rest] are
|
|
|
|
processed. Only allowed in
|
|
|
|
[parse_and_expand_argv_dynamic]. *)
|
1995-05-04 03:15:53 -07:00
|
|
|
|
|
|
|
exception Bad of string
|
2003-06-19 11:13:31 -07:00
|
|
|
exception Help of string
|
1995-05-04 03:15:53 -07:00
|
|
|
|
|
|
|
type error =
|
1996-10-24 07:17:48 -07:00
|
|
|
| Unknown of string
|
1995-05-04 03:15:53 -07:00
|
|
|
| Wrong of string * string * string (* option, actual, expected *)
|
|
|
|
| Missing of string
|
|
|
|
| Message of string
|
|
|
|
|
2016-04-28 07:00:18 -07:00
|
|
|
exception Stop of error (* used internally *)
|
2003-11-19 06:01:23 -08:00
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
open Printf
|
|
|
|
|
1996-10-24 07:17:48 -07:00
|
|
|
let rec assoc3 x l =
|
|
|
|
match l with
|
|
|
|
| [] -> raise Not_found
|
2016-03-09 14:20:22 -08:00
|
|
|
| (y1, y2, _) :: _ when y1 = x -> y2
|
2002-12-08 07:17:30 -08:00
|
|
|
| _ :: t -> assoc3 x t
|
2016-04-28 07:00:18 -07:00
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2014-04-01 03:21:40 -07:00
|
|
|
let split s =
|
|
|
|
let i = String.index s '=' in
|
|
|
|
let len = String.length s in
|
|
|
|
String.sub s 0 i, String.sub s (i+1) (len-(i+1))
|
2016-04-28 07:00:18 -07:00
|
|
|
|
2014-04-01 03:21:40 -07:00
|
|
|
|
2002-11-02 13:47:02 -08:00
|
|
|
let make_symlist prefix sep suffix l =
|
2002-11-02 13:24:30 -08:00
|
|
|
match l with
|
|
|
|
| [] -> "<none>"
|
2002-11-02 13:47:02 -08:00
|
|
|
| h::t -> (List.fold_left (fun x y -> x ^ sep ^ y) (prefix ^ h) t) ^ suffix
|
2016-04-28 07:00:18 -07:00
|
|
|
|
2002-11-02 13:24:30 -08:00
|
|
|
|
2003-06-19 11:13:31 -07:00
|
|
|
let print_spec buf (key, spec, doc) =
|
2011-12-22 06:04:18 -08:00
|
|
|
if String.length doc > 0 then
|
|
|
|
match spec with
|
2013-03-09 14:38:52 -08:00
|
|
|
| Symbol (l, _) ->
|
|
|
|
bprintf buf " %s %s%s\n" key (make_symlist "{" "|" "}" l) doc
|
|
|
|
| _ ->
|
|
|
|
bprintf buf " %s %s\n" key doc
|
2002-11-02 13:24:30 -08:00
|
|
|
|
2016-04-28 07:00:18 -07:00
|
|
|
|
|
|
|
let help_action () = raise (Stop (Unknown "-help"))
|
2004-06-11 16:45:46 -07:00
|
|
|
|
|
|
|
let add_help speclist =
|
|
|
|
let add1 =
|
|
|
|
try ignore (assoc3 "-help" speclist); []
|
|
|
|
with Not_found ->
|
|
|
|
["-help", Unit help_action, " Display this list of options"]
|
|
|
|
and add2 =
|
|
|
|
try ignore (assoc3 "--help" speclist); []
|
|
|
|
with Not_found ->
|
|
|
|
["--help", Unit help_action, " Display this list of options"]
|
|
|
|
in
|
|
|
|
speclist @ (add1 @ add2)
|
2016-04-28 07:00:18 -07:00
|
|
|
|
2004-06-11 16:45:46 -07:00
|
|
|
|
2003-06-19 11:13:31 -07:00
|
|
|
let usage_b buf speclist errmsg =
|
|
|
|
bprintf buf "%s\n" errmsg;
|
2016-04-28 07:00:18 -07:00
|
|
|
List.iter (print_spec buf) (add_help speclist)
|
|
|
|
|
2003-06-19 11:13:31 -07:00
|
|
|
|
2011-07-20 02:17:07 -07:00
|
|
|
let usage_string speclist errmsg =
|
2003-06-19 11:13:31 -07:00
|
|
|
let b = Buffer.create 200 in
|
|
|
|
usage_b b speclist errmsg;
|
2016-04-28 07:00:18 -07:00
|
|
|
Buffer.contents b
|
|
|
|
|
2011-07-20 02:17:07 -07:00
|
|
|
|
|
|
|
let usage speclist errmsg =
|
2016-04-28 07:00:18 -07:00
|
|
|
eprintf "%s" (usage_string speclist errmsg)
|
|
|
|
|
1996-10-24 07:17:48 -07:00
|
|
|
|
2016-04-28 07:00:18 -07:00
|
|
|
let current = ref 0
|
1997-07-03 07:15:35 -07:00
|
|
|
|
2015-10-15 05:30:10 -07:00
|
|
|
let bool_of_string_opt x =
|
|
|
|
try Some (bool_of_string x)
|
|
|
|
with Invalid_argument _ -> None
|
|
|
|
|
|
|
|
let int_of_string_opt x =
|
|
|
|
try Some (int_of_string x)
|
|
|
|
with Failure _ -> None
|
|
|
|
|
|
|
|
let float_of_string_opt x =
|
|
|
|
try Some (float_of_string x)
|
|
|
|
with Failure _ -> None
|
|
|
|
|
2016-10-07 10:28:30 -07:00
|
|
|
let parse_and_expand_argv_dynamic_aux allow_expand current argv speclist anonfun errmsg =
|
2003-06-19 11:13:31 -07:00
|
|
|
let b = Buffer.create 200 in
|
2003-07-24 11:23:54 -07:00
|
|
|
let initpos = !current in
|
1996-10-24 07:17:48 -07:00
|
|
|
let stop error =
|
2016-10-07 10:28:30 -07:00
|
|
|
let progname = if initpos < (Array.length !argv) then !argv.(initpos) else "(?)" in
|
1996-10-24 07:17:48 -07:00
|
|
|
begin match error with
|
1999-11-29 11:04:07 -08:00
|
|
|
| Unknown "-help" -> ()
|
2001-08-21 08:10:51 -07:00
|
|
|
| Unknown "--help" -> ()
|
1996-10-24 07:17:48 -07:00
|
|
|
| Unknown s ->
|
2014-04-18 08:29:56 -07:00
|
|
|
bprintf b "%s: unknown option '%s'.\n" progname s
|
1996-10-24 07:17:48 -07:00
|
|
|
| Missing s ->
|
2014-04-18 08:29:56 -07:00
|
|
|
bprintf b "%s: option '%s' needs an argument.\n" progname s
|
1996-10-24 07:17:48 -07:00
|
|
|
| Wrong (opt, arg, expected) ->
|
2014-04-18 08:29:56 -07:00
|
|
|
bprintf b "%s: wrong argument '%s'; option '%s' expects %s.\n"
|
1996-10-24 07:17:48 -07:00
|
|
|
progname arg opt expected
|
|
|
|
| Message s ->
|
2003-06-19 11:13:31 -07:00
|
|
|
bprintf b "%s: %s.\n" progname s
|
1996-10-24 07:17:48 -07:00
|
|
|
end;
|
2013-06-13 04:26:16 -07:00
|
|
|
usage_b b !speclist errmsg;
|
2001-08-21 11:49:22 -07:00
|
|
|
if error = Unknown "-help" || error = Unknown "--help"
|
2003-06-19 11:13:31 -07:00
|
|
|
then raise (Help (Buffer.contents b))
|
|
|
|
else raise (Bad (Buffer.contents b))
|
1995-05-04 03:15:53 -07:00
|
|
|
in
|
1997-07-03 07:15:35 -07:00
|
|
|
incr current;
|
2016-10-07 10:28:30 -07:00
|
|
|
while !current < (Array.length !argv) do
|
|
|
|
let s = !argv.(!current) in
|
2014-04-18 08:29:56 -07:00
|
|
|
if String.length s >= 1 && s.[0] = '-' then begin
|
2014-04-01 03:21:40 -07:00
|
|
|
let action, follow =
|
|
|
|
try assoc3 s !speclist, None
|
|
|
|
with Not_found ->
|
|
|
|
try
|
|
|
|
let keyword, arg = split s in
|
|
|
|
assoc3 keyword !speclist, Some arg
|
|
|
|
with Not_found -> stop (Unknown s)
|
1997-07-03 07:15:35 -07:00
|
|
|
in
|
2014-04-01 03:21:40 -07:00
|
|
|
let no_arg () =
|
|
|
|
match follow with
|
|
|
|
| None -> ()
|
|
|
|
| Some arg -> stop (Wrong (s, arg, "no argument")) in
|
2014-04-01 03:17:07 -07:00
|
|
|
let get_arg () =
|
2014-04-01 03:21:40 -07:00
|
|
|
match follow with
|
|
|
|
| None ->
|
2016-10-07 10:28:30 -07:00
|
|
|
if !current + 1 < (Array.length !argv) then !argv.(!current + 1)
|
2014-04-01 03:21:40 -07:00
|
|
|
else stop (Missing s)
|
|
|
|
| Some arg -> arg
|
|
|
|
in
|
|
|
|
let consume_arg () =
|
|
|
|
match follow with
|
|
|
|
| None -> incr current
|
|
|
|
| Some _ -> ()
|
2014-04-01 03:17:07 -07:00
|
|
|
in
|
1997-07-03 07:15:35 -07:00
|
|
|
begin try
|
2003-04-25 03:19:35 -07:00
|
|
|
let rec treat_action = function
|
1997-07-03 07:15:35 -07:00
|
|
|
| Unit f -> f ();
|
2014-04-01 03:17:07 -07:00
|
|
|
| Bool f ->
|
|
|
|
let arg = get_arg () in
|
2015-10-15 05:30:10 -07:00
|
|
|
begin match bool_of_string_opt arg with
|
|
|
|
| None -> raise (Stop (Wrong (s, arg, "a boolean")))
|
|
|
|
| Some s -> f s
|
2003-04-25 03:19:35 -07:00
|
|
|
end;
|
2014-04-01 03:17:07 -07:00
|
|
|
consume_arg ();
|
|
|
|
| Set r -> no_arg (); r := true;
|
|
|
|
| Clear r -> no_arg (); r := false;
|
|
|
|
| String f ->
|
|
|
|
let arg = get_arg () in
|
|
|
|
f arg;
|
|
|
|
consume_arg ();
|
|
|
|
| Symbol (symb, f) ->
|
|
|
|
let arg = get_arg () in
|
2002-11-02 13:24:30 -08:00
|
|
|
if List.mem arg symb then begin
|
2014-04-01 03:17:07 -07:00
|
|
|
f arg;
|
|
|
|
consume_arg ();
|
2002-11-02 13:24:30 -08:00
|
|
|
end else begin
|
2003-11-19 06:01:23 -08:00
|
|
|
raise (Stop (Wrong (s, arg, "one of: "
|
|
|
|
^ (make_symlist "" " " "" symb))))
|
2002-11-02 13:24:30 -08:00
|
|
|
end
|
2014-04-01 03:17:07 -07:00
|
|
|
| Set_string r ->
|
|
|
|
r := get_arg ();
|
|
|
|
consume_arg ();
|
|
|
|
| Int f ->
|
|
|
|
let arg = get_arg () in
|
2015-10-15 05:30:10 -07:00
|
|
|
begin match int_of_string_opt arg with
|
|
|
|
| None -> raise (Stop (Wrong (s, arg, "an integer")))
|
|
|
|
| Some x -> f x
|
1997-07-03 07:15:35 -07:00
|
|
|
end;
|
2014-04-01 03:17:07 -07:00
|
|
|
consume_arg ();
|
|
|
|
| Set_int r ->
|
|
|
|
let arg = get_arg () in
|
2015-10-15 05:30:10 -07:00
|
|
|
begin match int_of_string_opt arg with
|
|
|
|
| None -> raise (Stop (Wrong (s, arg, "an integer")))
|
|
|
|
| Some x -> r := x
|
2002-11-02 13:24:30 -08:00
|
|
|
end;
|
2014-04-01 03:17:07 -07:00
|
|
|
consume_arg ();
|
|
|
|
| Float f ->
|
|
|
|
let arg = get_arg () in
|
2015-10-15 05:30:10 -07:00
|
|
|
begin match float_of_string_opt arg with
|
|
|
|
| None -> raise (Stop (Wrong (s, arg, "a float")))
|
|
|
|
| Some x -> f x
|
2002-03-21 02:45:20 -08:00
|
|
|
end;
|
2014-04-01 03:17:07 -07:00
|
|
|
consume_arg ();
|
|
|
|
| Set_float r ->
|
|
|
|
let arg = get_arg () in
|
2015-10-15 05:30:10 -07:00
|
|
|
begin match float_of_string_opt arg with
|
|
|
|
| None -> raise (Stop (Wrong (s, arg, "a float")))
|
|
|
|
| Some x -> r := x
|
2002-11-02 13:24:30 -08:00
|
|
|
end;
|
2014-04-01 03:17:07 -07:00
|
|
|
consume_arg ();
|
2003-04-25 03:19:35 -07:00
|
|
|
| Tuple specs ->
|
|
|
|
List.iter treat_action specs;
|
1998-04-06 09:33:34 -07:00
|
|
|
| Rest f ->
|
2016-10-07 10:28:30 -07:00
|
|
|
while !current < (Array.length !argv) - 1 do
|
|
|
|
f !argv.(!current + 1);
|
2014-04-01 03:17:07 -07:00
|
|
|
consume_arg ();
|
1998-04-06 09:33:34 -07:00
|
|
|
done;
|
2016-10-07 10:28:30 -07:00
|
|
|
| Expand f ->
|
|
|
|
if not allow_expand then
|
|
|
|
raise (Invalid_argument "Arg.Expand is is only allowed with Arg.parse_and_expand_argv_dynamic");
|
|
|
|
let arg = get_arg () in
|
|
|
|
let newarg = f arg in
|
|
|
|
consume_arg ();
|
|
|
|
let before = Array.sub !argv 0 (!current + 1)
|
|
|
|
and after = Array.sub !argv (!current + 1) ((Array.length !argv) - !current - 1) in
|
|
|
|
argv:= Array.concat [before;newarg;after];
|
2003-11-19 06:01:23 -08:00
|
|
|
in
|
2003-04-25 03:19:35 -07:00
|
|
|
treat_action action
|
1997-07-03 07:15:35 -07:00
|
|
|
with Bad m -> stop (Message m);
|
2003-11-19 06:01:23 -08:00
|
|
|
| Stop e -> stop e;
|
1997-07-03 07:15:35 -07:00
|
|
|
end;
|
|
|
|
incr current;
|
|
|
|
end else begin
|
|
|
|
(try anonfun s with Bad m -> stop (Message m));
|
|
|
|
incr current;
|
|
|
|
end;
|
2016-04-28 07:00:18 -07:00
|
|
|
done
|
|
|
|
|
2016-10-07 10:28:30 -07:00
|
|
|
let parse_and_expand_argv_dynamic current argv speclist anonfun errmsg =
|
|
|
|
parse_and_expand_argv_dynamic_aux true current argv speclist anonfun errmsg
|
|
|
|
|
|
|
|
let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =
|
|
|
|
parse_and_expand_argv_dynamic_aux false current (ref argv) speclist anonfun errmsg
|
|
|
|
|
2002-03-22 12:46:06 -08:00
|
|
|
|
2013-06-13 04:26:16 -07:00
|
|
|
let parse_argv ?(current=current) argv speclist anonfun errmsg =
|
2016-04-28 07:00:18 -07:00
|
|
|
parse_argv_dynamic ~current:current argv (ref speclist) anonfun errmsg
|
|
|
|
|
2013-06-13 04:26:16 -07:00
|
|
|
|
2003-07-03 06:17:09 -07:00
|
|
|
let parse l f msg =
|
2003-06-19 11:13:31 -07:00
|
|
|
try
|
2016-04-28 07:00:18 -07:00
|
|
|
parse_argv Sys.argv l f msg
|
2003-06-19 11:13:31 -07:00
|
|
|
with
|
2016-04-28 07:00:18 -07:00
|
|
|
| Bad msg -> eprintf "%s" msg; exit 2
|
|
|
|
| Help msg -> printf "%s" msg; exit 0
|
|
|
|
|
2004-06-11 16:45:46 -07:00
|
|
|
|
2013-06-13 04:26:16 -07:00
|
|
|
let parse_dynamic l f msg =
|
|
|
|
try
|
2016-04-28 07:00:18 -07:00
|
|
|
parse_argv_dynamic Sys.argv l f msg
|
2013-06-13 04:26:16 -07:00
|
|
|
with
|
2016-04-28 07:00:18 -07:00
|
|
|
| Bad msg -> eprintf "%s" msg; exit 2
|
|
|
|
| Help msg -> printf "%s" msg; exit 0
|
|
|
|
|
2016-10-12 00:30:54 -07:00
|
|
|
let parse_expand l f msg =
|
|
|
|
try
|
|
|
|
let argv = ref Sys.argv in
|
|
|
|
let spec = ref l in
|
|
|
|
let current = ref (!current) in
|
|
|
|
parse_and_expand_argv_dynamic current argv spec f msg
|
|
|
|
with
|
|
|
|
| Bad msg -> eprintf "%s" msg; exit 2
|
|
|
|
| Help msg -> printf "%s" msg; exit 0
|
|
|
|
|
2013-06-13 04:26:16 -07:00
|
|
|
|
2012-05-29 05:52:44 -07:00
|
|
|
let second_word s =
|
2004-06-11 16:45:46 -07:00
|
|
|
let len = String.length s in
|
|
|
|
let rec loop n =
|
|
|
|
if n >= len then len
|
|
|
|
else if s.[n] = ' ' then loop (n+1)
|
|
|
|
else n
|
|
|
|
in
|
|
|
|
try loop (String.index s ' ')
|
|
|
|
with Not_found -> len
|
2016-04-28 07:00:18 -07:00
|
|
|
|
2004-06-11 16:45:46 -07:00
|
|
|
|
2008-01-11 08:13:18 -08:00
|
|
|
let max_arg_len cur (kwd, spec, doc) =
|
|
|
|
match spec with
|
|
|
|
| Symbol _ -> max cur (String.length kwd)
|
|
|
|
| _ -> max cur (String.length kwd + second_word doc)
|
2016-04-28 07:00:18 -07:00
|
|
|
|
2004-06-11 16:45:46 -07:00
|
|
|
|
|
|
|
let add_padding len ksd =
|
|
|
|
match ksd with
|
2011-12-23 05:34:13 -08:00
|
|
|
| (_, _, "") ->
|
|
|
|
(* Do not pad undocumented options, so that they still don't show up when
|
|
|
|
* run through [usage] or [parse]. *)
|
|
|
|
ksd
|
2016-03-09 14:20:22 -08:00
|
|
|
| (kwd, (Symbol _ as spec), msg) ->
|
2008-01-11 08:13:18 -08:00
|
|
|
let cutcol = second_word msg in
|
2014-10-15 06:34:58 -07:00
|
|
|
let spaces = String.make ((max 0 (len - cutcol)) + 3) ' ' in
|
2008-01-11 08:13:18 -08:00
|
|
|
(kwd, spec, "\n" ^ spaces ^ msg)
|
2004-06-11 16:45:46 -07:00
|
|
|
| (kwd, spec, msg) ->
|
|
|
|
let cutcol = second_word msg in
|
2014-10-15 06:34:58 -07:00
|
|
|
let kwd_len = String.length kwd in
|
|
|
|
let diff = len - kwd_len - cutcol in
|
|
|
|
if diff <= 0 then
|
|
|
|
(kwd, spec, msg)
|
|
|
|
else
|
|
|
|
let spaces = String.make diff ' ' in
|
|
|
|
let prefix = String.sub msg 0 cutcol in
|
|
|
|
let suffix = String.sub msg cutcol (String.length msg - cutcol) in
|
|
|
|
(kwd, spec, prefix ^ spaces ^ suffix)
|
2016-04-28 07:00:18 -07:00
|
|
|
|
2004-06-11 16:45:46 -07:00
|
|
|
|
2014-10-15 06:34:58 -07:00
|
|
|
let align ?(limit=max_int) speclist =
|
2004-06-11 16:45:46 -07:00
|
|
|
let completed = add_help speclist in
|
|
|
|
let len = List.fold_left max_arg_len 0 completed in
|
2014-10-15 06:34:58 -07:00
|
|
|
let len = min len limit in
|
2004-06-11 16:45:46 -07:00
|
|
|
List.map (add_padding len) completed
|
2016-10-10 03:10:05 -07:00
|
|
|
|
2016-10-11 09:50:01 -07:00
|
|
|
let trim_cr s =
|
|
|
|
let len = String.length s in
|
|
|
|
if len > 0 && String.get s (len - 1) = '\r' then
|
|
|
|
String.sub s 0 (len - 1)
|
|
|
|
else
|
|
|
|
s
|
2016-10-10 03:10:05 -07:00
|
|
|
|
2016-10-11 09:50:01 -07:00
|
|
|
let read_aux trim sep file =
|
2016-10-10 03:10:05 -07:00
|
|
|
let ic = open_in_bin file in
|
|
|
|
let buf = Buffer.create 200 in
|
|
|
|
let words = ref [] in
|
2016-10-11 09:50:01 -07:00
|
|
|
let stash () =
|
|
|
|
let word = (Buffer.contents buf) in
|
|
|
|
let word = if trim then trim_cr word else word in
|
|
|
|
words := word :: !words;
|
|
|
|
Buffer.clear buf
|
|
|
|
in
|
|
|
|
let rec read () =
|
2016-10-10 03:10:05 -07:00
|
|
|
try
|
|
|
|
let c = input_char ic in
|
|
|
|
if c = sep then begin
|
2016-10-11 09:50:01 -07:00
|
|
|
stash (); read ()
|
2016-10-10 03:10:05 -07:00
|
|
|
end else begin
|
2016-10-11 09:50:01 -07:00
|
|
|
Buffer.add_char buf c; read ()
|
2016-10-10 03:10:05 -07:00
|
|
|
end
|
|
|
|
with End_of_file ->
|
2016-10-11 09:50:01 -07:00
|
|
|
if Buffer.length buf > 0 then
|
|
|
|
stash () in
|
|
|
|
read ();
|
2016-10-10 03:10:05 -07:00
|
|
|
close_in ic;
|
|
|
|
Array.of_list (List.rev !words)
|
|
|
|
|
2016-10-11 09:50:01 -07:00
|
|
|
let read_arg = read_aux true '\n'
|
2016-10-10 03:10:05 -07:00
|
|
|
|
2016-10-11 09:50:01 -07:00
|
|
|
let read_arg0 = read_aux false '\x00'
|
2016-10-10 03:10:05 -07:00
|
|
|
|
|
|
|
let write_aux sep file args =
|
|
|
|
let oc = open_out_bin file in
|
2016-10-11 09:50:01 -07:00
|
|
|
Array.iter (fun s -> fprintf oc "%s%c" s sep) args;
|
2016-10-10 03:10:05 -07:00
|
|
|
close_out oc
|
|
|
|
|
|
|
|
let write_arg = write_aux '\n'
|
|
|
|
|
|
|
|
let write_arg0 = write_aux '\x00'
|