1 files changed, 61 insertions, 0 deletions
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
new file mode 100644
index 000000000..3726760f4
--- /dev/null
+++ b/stdlib/arg.ml
@@ -0,0 +1,61 @@
+type spec =
+    String of (string -> unit)
+  | Int of (int -> unit)
+  | Unit of (unit -> unit)
+  | Float of (float -> unit)
+
+exception Bad of string
+
+type error =
+    Unknown of string
+  | Wrong of string * string * string  (* option, actual, expected *)
+  | Missing of string
+  | Message of string
+
+open Printf
+
+let stop error =
+  let progname =
+    if Array.length Sys.argv > 0 then Sys.argv.(0) else "(?)" in
+  begin match error with
+      Unknown s ->
+        eprintf "%s: unknown option `%s'.\n" progname s
+    | Missing s ->
+        eprintf "%s: option `%s' needs an argument.\n" progname s
+    | Wrong (opt, arg, expected) ->
+        eprintf "%s: wrong argument `%s'; option `%s' expects %s.\n"
+                progname arg opt expected
+    | Message s ->
+        eprintf "%s: %s.\n" progname s
+  end;
+  exit 2
+
+let parse speclist anonfun =
+  let rec p = function
+      [] -> ()
+    | s :: t ->
+        if String.length s >= 1 & String.get s 0 = '-'
+        then do_key s t
+        else begin try (anonfun s); p t with Bad m -> stop (Message m) end
+  and do_key s l =    
+    let action =
+      try
+        List.assoc s speclist
+      with Not_found ->
+        stop (Unknown s) in
+    try
+      match (action, l) with
+        (Unit f, l) -> f (); p l
+      | (String f, arg::t) -> f arg; p t
+      | (Int f, arg::t) ->
+          begin try f (int_of_string arg)
+          with Failure "int_of_string" -> stop (Wrong (s, arg, "an integer"))
+          end;
+          p t
+      | (Float f, arg::t) -> f (float_of_string arg); p t
+      | (_, []) -> stop (Missing s)
+    with Bad m -> stop (Message m)
+  in
+    match Array.to_list Sys.argv with
+      [] -> ()
+    | a::l -> p l