1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
|
(* *)
|
|
|
|
|
(* Caml Special Light *)
|
|
|
|
|
(* *)
|
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
|
(* *)
|
|
|
|
|
(* Copyright 1995 Institut National de Recherche en Informatique et *)
|
|
|
|
|
(* Automatique. Distributed only by permission. *)
|
|
|
|
|
(* *)
|
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
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
|
