Tbl: ajout de la fonction mem qui teste si un élément donné est dans

la table.
Warnings: ajout du pilotage des warnings par l'utilisateur.


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

utils/tbl.ml

@@ -5,7 +5,7 @@
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  Automatique.  Distributed only by permission.                      *)
+(*  en Automatique.  Distributed only by permission.                   *)
 (*                                                                     *)
 (***********************************************************************)
 
@@ -64,6 +64,12 @@ let rec find x = function
       if c = 0 then d
       else find x (if c < 0 then l else r)
 
+let rec mem x = function
+    Empty -> false
+  | Node(l, v, d, r, _) ->
+      let c = compare x v in
+      c = 0 || mem x (if c < 0 then l else r)
+
 let rec merge t1 t2 =
   match (t1, t2) with
     (Empty, t) -> t

utils/tbl.mli

@@ -5,7 +5,7 @@
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  Automatique.  Distributed only by permission.                      *)
+(*  en Automatique.  Distributed only by permission.                   *)
 (*                                                                     *)
 (***********************************************************************)
 
@@ -19,6 +19,7 @@ type ('a, 'b) t
 val empty: ('a, 'b) t
 val add: 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t
 val find: 'a -> ('a, 'b) t -> 'b
+val mem: 'a -> ('a, 'b) t -> bool
 val remove: 'a -> ('a,  'b) t -> ('a, 'b) t
 val iter: ('a -> 'b -> 'c) -> ('a, 'b) t -> unit
 

utils/warnings.ml

@@ -0,0 +1,81 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Pierre Weis && Damien Doligez, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  Distributed only by permission.                   *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+type t =
+  | Partial_match                    (* P *)
+  | Unused_match                     (* U *)
+  | Method_override of string list   (* M *)
+  | Hide_instance_variable of string (* V *)
+  | Partial_application              (* F *)
+  | Statement_type                   (* S *)
+  | Other of string                  (* X *)
+;;
+
+let pflag = ref true;;
+let uflag = ref true;;
+let mflag = ref true;;
+let vflag = ref true;;
+let fflag = ref true;;
+let sflag = ref true;;
+let xflag = ref true;;
+
+let rec parse_options s =
+  for i = 0 to String.length s - 1 do
+    match s.[i] with
+    | 'P' -> pflag := true
+    | 'p' -> pflag := false
+    | 'U' -> uflag := true
+    | 'u' -> uflag := false
+    | 'M' -> mflag := true
+    | 'm' -> mflag := false
+    | 'V' -> vflag := true
+    | 'v' -> vflag := false
+    | 'F' -> fflag := true
+    | 'f' -> fflag := false
+    | 'S' -> sflag := true
+    | 's' -> sflag := false
+    | 'X' -> xflag := true
+    | 'x' -> xflag := false
+    | 'A' -> parse_options "PUMVFSX"
+    | 'a' -> parse_options "pumvfsx"
+    | c -> raise (Arg.Bad (Printf.sprintf "unknown warning option %c" c))
+  done
+;;
+
+let is_active = function
+  | Partial_match -> !pflag
+  | Unused_match -> !uflag
+  | Method_override slist -> !mflag
+  | Hide_instance_variable string -> !vflag
+  | Partial_application -> !fflag
+  | Statement_type -> !sflag
+  | Other _ -> !xflag
+;;
+
+let message = function
+  | Partial_match -> "this pattern-matching is not exhaustive."
+  | Unused_match -> "this match case is unused."
+  | Method_override slist ->
+      String.concat " "
+        ("the following methods are overriden \
+          by the inherited class:\n " :: slist)
+  | Hide_instance_variable lab ->
+      "this definition of an instance variable " ^ lab ^
+      " hides a previously\ndefined instance variable of the same name."
+  | Partial_application ->
+      "this function application is partial,\n\
+       maybe some arguments are missing."
+  | Statement_type ->
+      "this expression should have type unit."
+  | Other s -> s
+;;

utils/warnings.mli

@@ -0,0 +1,28 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Pierre Weis && Damien Doligez, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  Distributed only by permission.                   *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+type t =
+  | Partial_match                    (* P *)
+  | Unused_match                     (* U *)
+  | Method_override of string list   (* M *)
+  | Hide_instance_variable of string (* V *)
+  | Partial_application              (* F *)
+  | Statement_type                   (* S *)
+  | Other of string                  (* X *)
+;;
+
+val parse_options : string -> unit;;
+
+val is_active : t -> bool;;
+
+val message : t -> string;;