Introduction de Arg.Set et Arg.Clear.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@249 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

7 files changed, 60 insertions, 54 deletions

diff --git a/driver/main.ml b/driver/main.ml
index 3561afa2b..c2d9c67bc 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -43,18 +43,18 @@ let main () =
   try
     Arg.parse
       ["-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs);
-       "-c", Arg.Unit(fun () -> compile_only := true);
+       "-c", Arg.Set compile_only;
        "-o", Arg.String(fun s -> exec_name := s; archive_name := s);
-       "-i", Arg.Unit(fun () -> print_types := true);
-       "-a", Arg.Unit(fun () -> make_archive := true);
-       "-unsafe", Arg.Unit(fun () -> fast := true);
-       "-nopervasives", Arg.Unit(fun () -> nopervasives := true);
-       "-custom", Arg.Unit(fun () -> custom_runtime := true);
+       "-i", Arg.Set print_types;
+       "-a", Arg.Set make_archive;
+       "-unsafe", Arg.Set fast;
+       "-nopervasives", Arg.Set nopervasives;
+       "-custom", Arg.Set custom_runtime;
        "-ccopt", Arg.String(fun s -> ccopts := s :: !ccopts);
        "-cclib", Arg.String(fun s -> ccobjs := ("-l" ^ s) :: !ccobjs);
-       "-linkall", Arg.Unit(fun s -> link_everything := true);
-       "-dlambda", Arg.Unit(fun () -> dump_lambda := true);
-       "-dinstr", Arg.Unit(fun () -> dump_instr := true);
+       "-linkall", Arg.Set link_everything;
+       "-dlambda", Arg.Set dump_lambda;
+       "-dinstr", Arg.Set dump_instr;
        "-v", Arg.Unit print_version_number;
        "-", Arg.String process_file]
       process_file;
diff --git a/driver/optmain.ml b/driver/optmain.ml
index f0f3ebe4b..f7fb6a4af 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -43,31 +43,31 @@ let main () =
   try
     Arg.parse
       ["-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs);
-       "-c", Arg.Unit(fun () -> compile_only := true);
-       "-S", Arg.Unit(fun () -> keep_asm_file := true);
+       "-c", Arg.Set compile_only;
+       "-S", Arg.Set keep_asm_file;
        "-o", Arg.String(fun s -> exec_name := s; archive_name := s);
-       "-i", Arg.Unit(fun () -> print_types := true);
-       "-a", Arg.Unit(fun () -> make_archive := true);
-       "-unsafe", Arg.Unit(fun () -> fast := true);
-       "-compact", Arg.Unit(fun () -> optimize_for_speed := false);
-       "-nopervasives", Arg.Unit(fun () -> nopervasives := true);
+       "-i", Arg.Set print_types;
+       "-a", Arg.Set make_archive;
+       "-unsafe", Arg.Set fast;
+       "-compact", Arg.Clear optimize_for_speed;
+       "-nopervasives", Arg.Set nopervasives;
        "-ccopt", Arg.String(fun s -> ccopts := s :: !ccopts);
        "-cclib", Arg.String(fun s -> ccobjs := ("-l" ^ s) :: !ccobjs);
-       "-dlambda", Arg.Unit(fun () -> dump_lambda := true);
-       "-dcmm", Arg.Unit(fun () -> dump_cmm := true);
-       "-dsel", Arg.Unit(fun () -> dump_selection := true);
+       "-dlambda", Arg.Set dump_lambda;
+       "-dcmm", Arg.Set dump_cmm;
+       "-dsel", Arg.Set dump_selection;
        "-dlive", Arg.Unit(fun () -> dump_live := true;
                                     Printmach.print_live := true);
-       "-dspill", Arg.Unit(fun () -> dump_spill := true);
-       "-dsplit", Arg.Unit(fun () -> dump_split := true);
-       "-dscheduling", Arg.Unit(fun () -> dump_scheduling := true);
-       "-dinterf", Arg.Unit(fun () -> dump_interf := true);
-       "-dprefer", Arg.Unit(fun () -> dump_prefer := true);
-       "-dalloc", Arg.Unit(fun () -> dump_regalloc := true);
-       "-dreload", Arg.Unit(fun () -> dump_reload := true);
-       "-dscheduling", Arg.Unit(fun () -> dump_scheduling := true);
-       "-dlinear", Arg.Unit(fun () -> dump_linear := true);
-       "-dstartup", Arg.Unit(fun () -> keep_startup_file := true);
+       "-dspill", Arg.Set dump_spill;
+       "-dsplit", Arg.Set dump_split;
+       "-dscheduling", Arg.Set dump_scheduling;
+       "-dinterf", Arg.Set dump_interf;
+       "-dprefer", Arg.Set dump_prefer;
+       "-dalloc", Arg.Set dump_regalloc;
+       "-dreload", Arg.Set dump_reload;
+       "-dscheduling", Arg.Set dump_scheduling;
+       "-dlinear", Arg.Set dump_linear;
+       "-dstartup", Arg.Set keep_startup_file;
        "-v", Arg.Unit print_version_number;
        "-", Arg.String process_file]
       process_file;
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index 0d214b7a9..3cd16739f 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -12,10 +12,12 @@
 (* $Id$ *)
 
 type spec =
-    String of (string -> unit)
-  | Int of (int -> unit)
-  | Unit of (unit -> unit)
-  | Float of (float -> unit)
+    Unit of (unit -> unit)     (* Call the function with no argument *)
+  | 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 *)
+  | Int of (int -> unit)       (* Call the function with an int argument *)
+  | Float of (float -> unit)   (* Call the function with a float argument *)
 
 exception Bad of string
 
@@ -59,6 +61,8 @@ let parse speclist anonfun =
     try
       match (action, l) with
         (Unit f, l) -> f (); p l
+      | (Set r, l) -> r := true; p l
+      | (Clear r, l) -> r := false; p l
       | (String f, arg::t) -> f arg; p t
       | (Int f, arg::t) ->
           begin try f (int_of_string arg)
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
index d40a7068a..b7fb1a464 100644
--- a/stdlib/arg.mli
+++ b/stdlib/arg.mli
@@ -19,8 +19,8 @@
 (* Syntax of command lines:
     A keyword is a character string starting with a [-].
     An option is a keyword alone or followed by an argument.
-    There are four types of keywords: [Unit], [String], [Int], and [Float].
-    [Unit] keywords do not take an argument.
+    There are six types of keywords: [Unit], [String], [Int], and [Float].
+    [Unit], [Set_flag] and [Clear_flag] keywords do not take an argument.
     [String], [Int], and [Float] keywords take the following word on the
     command line as an argument.
     Arguments not preceded by a keyword are called anonymous arguments. *)
@@ -34,10 +34,12 @@
 *)
 
 type spec =
-    String of (string -> unit)
-  | Int of (int -> unit)
-  | Unit of (unit -> unit)
-  | Float of (float -> unit)
+    Unit of (unit -> unit)     (* Call the function with no argument *)
+  | 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 *)
+  | Int of (int -> unit)       (* Call the function with an int argument *)
+  | Float of (float -> unit)   (* Call the function with a float argument *)
         (* The concrete type describing the behavior associated
            with a keyword. *)
 
diff --git a/testasmcomp/main.ml b/testasmcomp/main.ml
index 274344b74..4cc638259 100644
--- a/testasmcomp/main.ml
+++ b/testasmcomp/main.ml
@@ -37,18 +37,18 @@ let compile_file filename =
 
 let main() =
   Arg.parse
-    ["-dcmm", Arg.Unit(fun () -> dump_cmm := true);
-     "-dsel", Arg.Unit(fun () -> dump_selection := true);
+    ["-dcmm", Arg.Set dump_cmm;
+     "-dsel", Arg.Set dump_selection;
      "-dlive", Arg.Unit(fun () -> dump_live := true;
                                   Printmach.print_live := true);
-     "-dspill", Arg.Unit(fun () -> dump_spill := true);
-     "-dsplit", Arg.Unit(fun () -> dump_split := true);
-     "-dinterf", Arg.Unit(fun () -> dump_interf := true);
-     "-dprefer", Arg.Unit(fun () -> dump_prefer := true);
-     "-dalloc", Arg.Unit(fun () -> dump_regalloc := true);
-     "-dreload", Arg.Unit(fun () -> dump_reload := true);
-     "-dscheduling", Arg.Unit(fun () -> dump_scheduling := true);
-     "-dlinear", Arg.Unit(fun () -> dump_linear := true)]
+     "-dspill", Arg.Set dump_spill;
+     "-dsplit", Arg.Set dump_split;
+     "-dinterf", Arg.Set dump_interf;
+     "-dprefer", Arg.Set dump_prefer;
+     "-dalloc", Arg.Set dump_regalloc;
+     "-dreload", Arg.Set dump_reload;
+     "-dscheduling", Arg.Set dump_scheduling;
+     "-dlinear", Arg.Set dump_linear]
     compile_file
 
 let _ = Printexc.catch main (); exit 0
diff --git a/tools/camldep.mll b/tools/camldep.mll
index cc23428f3..0639c8245 100644
--- a/tools/camldep.mll
+++ b/tools/camldep.mll
@@ -164,8 +164,8 @@ let file_dependencies source_file =
 let _ =
   Arg.parse
     ["-I", Arg.String(fun dir -> load_path := dir :: !load_path);
-     "-opt", Arg.Unit(fun () -> opt_flag := true);
-     "-noopt", Arg.Unit(fun () -> opt_flag := false)]
+     "-opt", Arg.Set opt_flag;
+     "-noopt", Arg.Clear opt_flag]
     file_dependencies;
   exit 0
     
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
index 80311169f..72a16022c 100644
--- a/toplevel/topmain.ml
+++ b/toplevel/topmain.ml
@@ -16,9 +16,9 @@ open Clflags
 let main () =
   Arg.parse
     ["-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs);
-     "-unsafe", Arg.Unit(fun () -> fast := true);
-     "-dlambda", Arg.Unit(fun () -> dump_lambda := true);
-     "-dinstr", Arg.Unit(fun () -> dump_instr := true)]
+     "-unsafe", Arg.Set fast;
+     "-dlambda", Arg.Set dump_lambda;
+     "-dinstr", Arg.Set dump_instr]
     (fun name -> raise(Arg.Bad("don't know what to do with " ^ name)));
   Toploop.loop()