More warnings for debugger/.

debugger/Makefile.shared

@@ -18,7 +18,7 @@ CAMLRUN ?= ../boot/ocamlrun
 CAMLYACC ?= ../boot/ocamlyacc
 
 CAMLC=$(CAMLRUN) ../ocamlc -nostdlib -I ../stdlib
-COMPFLAGS=-warn-error A -safe-string $(INCLUDES)
+COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A -safe-string -strict-sequence -strict-formats
 LINKFLAGS=-linkall -I $(UNIXDIR)
 YACCFLAGS=
 CAMLLEX=$(CAMLRUN) ../boot/ocamllex

debugger/breakpoints.ml

@@ -19,7 +19,6 @@
 open Checkpoints
 open Debugcom
 open Instruct
-open Primitives
 open Printf
 
 (*** Debugging. ***)
@@ -137,7 +136,7 @@ let execute_without_breakpoints f =
       f ();
       change_version version pos
     with
-      x ->
+      _ ->
         change_version version pos
 
 (* Add a position in the position list. *)

debugger/breakpoints.mli

@@ -16,7 +16,6 @@
 
 (******************************* Breakpoints ***************************)
 
-open Primitives
 open Instruct
 
 (*** Debugging. ***)

debugger/command_line.ml

@@ -179,7 +179,7 @@ let interprete_line ppf line =
               i.instr_action ppf lexbuf;
               resume_user_input ();
               i.instr_repeat
-          | l ->
+          | _ ->
               error "Ambiguous command."
           end
       | None ->
@@ -216,7 +216,7 @@ let line_loop ppf line_buffer =
         error ("System error: " ^ s) *)
 
 (** Instructions. **)
-let instr_cd ppf lexbuf =
+let instr_cd _ppf lexbuf =
   let dir = argument_eol argument lexbuf in
     if ask_kill_program () then
       try
@@ -225,7 +225,7 @@ let instr_cd ppf lexbuf =
       | Sys_error s ->
           error s
 
-let instr_shell ppf lexbuf =
+let instr_shell _ppf lexbuf =
   let cmdarg = argument_list_eol argument lexbuf in
   let cmd = String.concat " " cmdarg in
   (* perhaps we should use $SHELL -c ? *)
@@ -233,7 +233,7 @@ let instr_shell ppf lexbuf =
   if (err != 0) then
     eprintf "Shell command %S failed with exit code %d\n%!" cmd err
 
-let instr_env ppf lexbuf =
+let instr_env _ppf lexbuf =
   let cmdarg = argument_list_eol argument lexbuf in
   let cmdarg = string_trim (String.concat " " cmdarg) in
   if cmdarg <> "" then
@@ -286,7 +286,7 @@ let instr_dir ppf lexbuf =
                  dirs)
       Debugger_config.load_path_for
 
-let instr_kill ppf lexbuf =
+let instr_kill _ppf lexbuf =
   eol lexbuf;
   if not !loaded then error "The program is not being run.";
   if (yes_or_no "Kill the program being debugged") then begin
@@ -393,7 +393,7 @@ let print_info_list ppf =
   let pr_infos ppf = List.iter (fun i -> fprintf ppf "%s@ " i.info_name)  in
   fprintf ppf "List of info commands: %a@." pr_infos !info_list
 
-let instr_complete ppf lexbuf =
+let instr_complete _ppf lexbuf =
   let ppf = Format.err_formatter in
   let rec print_list l =
     try
@@ -465,7 +465,7 @@ let instr_help ppf lexbuf =
           find_variable
             (fun v _ _ ->
                print_help ("show " ^ v.var_name) ("show " ^ v.var_help))
-            (fun v ->
+            (fun _v ->
                print_help "show" "display debugger variable.";
                print_variable_list ppf)
             ppf
@@ -585,8 +585,8 @@ let instr_source ppf lexbuf =
 
 let instr_set =
   find_variable
-    (fun {var_action = (funct, _)} ppf lexbuf -> funct lexbuf)
-    (function ppf -> error "Argument required.")
+    (fun {var_action = (funct, _)} _ppf lexbuf -> funct lexbuf)
+    (function _ppf -> error "Argument required.")
 
 let instr_show =
   find_variable
@@ -600,8 +600,8 @@ let instr_show =
 
 let instr_info =
   find_info
-    (fun i ppf lexbuf -> i.info_action lexbuf)
-    (function ppf ->
+    (fun i _ppf lexbuf -> i.info_action lexbuf)
+    (function _ppf ->
        error "\"info\" must be followed by the name of an info command.")
 
 let instr_break ppf lexbuf =
@@ -673,7 +673,7 @@ let instr_break ppf lexbuf =
         | Not_found ->
             eprintf "Can\'t find any event there.@."
 
-let instr_delete ppf lexbuf =
+let instr_delete _ppf lexbuf =
   match integer_list_eol Lexer.lexeme lexbuf with
   | [] ->
       if breakpoints_count () <> 0 && yes_or_no "Delete all breakpoints"
@@ -771,7 +771,7 @@ let instr_last ppf lexbuf =
     go_to (History.previous_time count);
     show_current_event ppf
 
-let instr_list ppf lexbuf =
+let instr_list _ppf lexbuf =
   let (mo, beg, e) = list_arguments_eol Lexer.lexeme lexbuf in
     let (curr_mod, line, column) =
       try
@@ -866,9 +866,9 @@ let loading_mode_variable ppf =
   (find_ident
      "loading mode"
      (matching_elements (ref loading_modes) fst)
-     (fun (_, mode) ppf lexbuf ->
+     (fun (_, mode) _ppf lexbuf ->
         eol lexbuf; set_launching_function mode)
-     (function ppf -> error "Syntax error.")
+     (function _ppf -> error "Syntax error.")
      ppf),
   function ppf ->
     let rec find = function
@@ -946,7 +946,7 @@ let info_breakpoints ppf lexbuf =
   end
 ;;
 
-let info_events ppf lexbuf =
+let info_events _ppf lexbuf =
   ensure_loaded ();
   let mdle =
     convert_module (module_of_longident (opt_longident_eol Lexer.lexeme lexbuf))
@@ -1210,7 +1210,7 @@ It can be either:\n\
        var_action = follow_fork_variable;
        var_help =
 "process to follow after forking.\n\
-It can be either :
+It can be either :\n\
   child: the newly created process.\n\
   parent: the process that called fork.\n" }];
 

debugger/debugcom.ml

@@ -282,7 +282,7 @@ module Remote_value =
       Remote(input_remote_value !conn.io_in)
 
     let closure_code = function
-    | Local obj -> assert false
+    | Local _ -> assert false
     | Remote v ->
         output_char !conn.io_out 'C';
         output_remote_value !conn.io_out v;

debugger/eval.ml

@@ -61,12 +61,12 @@ let rec path event = function
         | None ->
             raise(Error(Unbound_identifier id))
         end
-  | Pdot(root, fieldname, pos) ->
+  | Pdot(root, _fieldname, pos) ->
       let v = path event root in
       if not (Debugcom.Remote_value.is_block v) then
         raise(Error(Not_initialized_yet root));
       Debugcom.Remote_value.field v pos
-  | Papply(p1, p2) ->
+  | Papply _ ->
       fatal_error "Eval.path: Papply"
 
 let rec expression event env = function
@@ -135,10 +135,10 @@ let rec expression event env = function
   | E_field(arg, lbl) ->
       let (v, ty) = expression event env arg in
       begin match (Ctype.repr(Ctype.expand_head_opt env ty)).desc with
-        Tconstr(path, args, _) ->
+        Tconstr(path, _, _) ->
           let tydesc = Env.find_type path env in
           begin match tydesc.type_kind with
-            Type_record(lbl_list, repr) ->
+            Type_record(lbl_list, _repr) ->
               let (pos, ty_res) =
                 find_label lbl env ty path tydesc 0 lbl_list in
               (Debugcom.Remote_value.field v pos, ty_res)

debugger/exec.ml

@@ -20,7 +20,7 @@ let interrupted = ref false
 
 let is_protected = ref false
 
-let break signum =
+let break _signum =
   if !is_protected
   then interrupted := true
   else raise Sys.Break

debugger/frames.ml

@@ -125,6 +125,6 @@ let do_backtrace action =
 
 let stack_depth () =
   let num_frames = ref 0 in
-  do_backtrace (function Some ev -> incr num_frames; true
+  do_backtrace (function Some _ev -> incr num_frames; true
                        | None -> num_frames := -1; false);
   !num_frames

debugger/frames.mli

@@ -17,7 +17,6 @@
 (****************************** Frames *********************************)
 
 open Instruct
-open Primitives
 
 (* Current frame number *)
 val current_frame : int ref

debugger/loadprinter.ml

@@ -94,8 +94,8 @@ let loadfile ppf name =
 
 let rec eval_path = function
     Pident id -> Symtable.get_global_value id
-  | Pdot(p, s, pos) -> Obj.field (eval_path p) pos
-  | Papply(p1, p2) -> fatal_error "Loadprinter.eval_path"
+  | Pdot(p, _, pos) -> Obj.field (eval_path p) pos
+  | Papply _ -> fatal_error "Loadprinter.eval_path"
 
 (* Install, remove a printer (as in toplevel/topdirs) *)
 
@@ -146,13 +146,13 @@ let install_printer ppf lid =
       raise(Error(Unavailable_module(s, lid))) in
   let print_function =
     if is_old_style then
-      (fun formatter repr -> Obj.obj v (Obj.obj repr))
+      (fun _formatter repr -> Obj.obj v (Obj.obj repr))
     else
       (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
   Printval.install_printer path ty_arg ppf print_function
 
 let remove_printer lid =
-  let (ty_arg, path, is_old_style) = find_printer_type lid in
+  let (_ty_arg, path, _is_old_style) = find_printer_type lid in
   try
     Printval.remove_printer path
   with Not_found ->

debugger/main.ml

@@ -29,7 +29,7 @@ open Primitives
 
 let line_buffer = Lexing.from_function read_user_input
 
-let rec loop ppf = line_loop ppf line_buffer
+let loop ppf = line_loop ppf line_buffer
 
 let current_duration = ref (-1L)
 

debugger/parameters.ml

@@ -20,7 +20,6 @@ open Primitives
 open Config
 open Debugger_config
 
-let program_loaded = ref false
 let program_name = ref ""
 let socket_name = ref ""
 let arguments = ref ""

debugger/parser_aux.mli

@@ -14,10 +14,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(*open Globals*)
-
-open Primitives
-
 type expression =
     E_ident of Longident.t              (* x or Mod.x *)
   | E_name of int                       (* $xxx *)

debugger/pos.ml

@@ -16,8 +16,6 @@
 open Instruct;;
 open Lexing;;
 open Location;;
-open Primitives;;
-open Source;;
 
 let get_desc ev =
   let loc = ev.ev_loc in

debugger/printval.ml

@@ -40,7 +40,7 @@ let name_value v ty =
 let find_named_value name =
   Hashtbl.find named_values name
 
-let check_depth ppf depth obj ty =
+let check_depth depth obj ty =
   if depth <= 0 then begin
     let n = name_value obj ty in
     Some (Outcometree.Oval_stuff ("$" ^ string_of_int n))
@@ -57,19 +57,19 @@ module EvalPath =
         with Symtable.Error _ ->
           raise Error
         end
-    | Pdot(root, fieldname, pos) ->
+    | Pdot(root, _fieldname, pos) ->
         let v = eval_path env root in
         if not (Debugcom.Remote_value.is_block v)
         then raise Error
         else Debugcom.Remote_value.field v pos
-    | Papply(p1, p2) ->
+    | Papply _ ->
         raise Error
     let same_value = Debugcom.Remote_value.same
   end
 
 module Printer = Genprintval.Make(Debugcom.Remote_value)(EvalPath)
 
-let install_printer path ty ppf fn =
+let install_printer path ty _ppf fn =
   Printer.install_printer path ty
     (fun ppf remote_val ->
        try
@@ -90,7 +90,7 @@ let print_exception ppf obj =
 let print_value max_depth env obj (ppf : Format.formatter) ty =
   let t =
     Printer.outval_of_value !max_printer_steps max_depth
-      (check_depth ppf) env obj ty in
+      check_depth env obj ty in
   !Oprint.out_value ppf t
 
 let print_named_value max_depth exp env obj ppf ty =

debugger/source.ml

@@ -67,8 +67,6 @@ type buffer = string * (int * int) list ref
 
 let buffer_max_count = ref 10
 
-let cache_size = 30
-
 let buffer_list =
   ref ([] : (string * buffer) list)
 
@@ -101,7 +99,7 @@ let insert_pos buffer ((position, line) as pair) =
     function
       [] ->
         [(position, line)]
-    | ((pos, lin) as a::l) as l' ->
+    | ((_pos, lin) as a::l) as l' ->
         if lin < line then
           pair::l'
         else if lin = line then
@@ -141,13 +139,13 @@ let line_of_pos buffer position =
           raise Out_of_range
         else
           (0, 1)
-    | ((pos, line) as pair)::l ->
+    | ((pos, _line) as pair)::l ->
         if pos > position then
           find l
         else
           pair
   and find_line previous =
-    let (pos, line) as next = next_line buffer previous in
+    let (pos, _line) as next = next_line buffer previous in
       if pos <= position then
         find_line next
       else
@@ -166,7 +164,7 @@ let pos_of_line buffer line =
           raise Out_of_range
         else
           (0, 1)
-    | ((pos, lin) as pair)::l ->
+    | ((_pos, lin) as pair)::l ->
         if lin > line then
           find l
         else

debugger/symbols.ml

@@ -62,7 +62,7 @@ let read_symbols' bytecode_file =
   let num_eventlists = input_binary_int ic in
   let dirs = ref StringSet.empty in
   let eventlists = ref [] in
-  for i = 1 to num_eventlists do
+  for _i = 1 to num_eventlists do
     let orig = input_binary_int ic in
     let evl = (input_value ic : debug_event list) in
     (* Relocate events in event list *)
@@ -182,7 +182,7 @@ let event_near_pos md char =
 (* Flip "event" bit on all instructions *)
 let set_all_events () =
   Hashtbl.iter
-    (fun pc ev ->
+    (fun _pc ev ->
        match ev.ev_kind with
          Event_pseudo -> ()
        | _            -> Debugcom.set_event ev.ev_pos)

debugger/time_travel.ml

@@ -271,7 +271,7 @@ let rec stop_on_event report =
         None   -> find_event ()
       | Some _ -> ()
       end
-  | {rep_type = Trap_barrier; rep_stack_pointer = trap_frame} ->
+  | {rep_type = Trap_barrier} ->
       (* No event at current position. *)
       find_event ()
   | _ ->
@@ -452,7 +452,7 @@ let go_to time =
 
 (* Return the time of the last breakpoint *)
 (* between current time and `max_time'. *)
-let rec find_last_breakpoint max_time =
+let find_last_breakpoint max_time =
   let rec find break =
     let time = current_time () in
     step_forward (max_time -- time);
@@ -559,14 +559,14 @@ let next_1 () =
     None ->                             (* Beginning of the program. *)
       step _1
   | Some event1 ->
-      let (frame1, pc1) = initial_frame() in
+      let (frame1, _pc1) = initial_frame() in
       step _1;
       if not !interrupted then begin
         Symbols.update_current_event ();
         match !current_event with
           None -> ()
         | Some event2 ->
-            let (frame2, pc2) = initial_frame() in
+            let (frame2, _pc2) = initial_frame() in
             (* Call `finish' if we've entered a function. *)
             if frame1 >= 0 && frame2 >= 0 &&
                frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize
@@ -627,14 +627,14 @@ let previous_1 () =
     None ->                             (* End of the program. *)
       step _minus1
   | Some event1 ->
-      let (frame1, pc1) = initial_frame() in
+      let (frame1, _pc1) = initial_frame() in
       step _minus1;
       if not !interrupted then begin
         Symbols.update_current_event ();
         match !current_event with
           None -> ()
         | Some event2 ->
-            let (frame2, pc2) = initial_frame() in
+            let (frame2, _pc2) = initial_frame() in
             (* Call `start' if we've entered a function. *)
             if frame1 >= 0 && frame2 >= 0 &&
                frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize

debugger/unix_tools.ml

@@ -18,7 +18,6 @@
 
 open Misc
 open Unix
-open Primitives
 
 (*** Convert a socket name into a socket address. ***)
 let convert_address address =