debut de reforme des locations

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

6 files changed, 76 insertions, 33 deletions

diff --git a/debugger/.depend b/debugger/.depend
index 433b005ef5..3a303e336d 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -9,9 +9,10 @@ events.cmi: ../bytecomp/instruct.cmi
 frames.cmi: ../bytecomp/instruct.cmi primitives.cmi 
 input_handling.cmi: primitives.cmi 
 loadprinter.cmi: ../otherlibs/dynlink/dynlink.cmi ../parsing/longident.cmi 
-parser_aux.cmi: ../parsing/longident.cmi primitives.cmi 
 parser.cmi: ../parsing/longident.cmi parser_aux.cmi 
+parser_aux.cmi: ../parsing/longident.cmi primitives.cmi 
 pattern_matching.cmi: debugcom.cmi parser_aux.cmi ../typing/typedtree.cmi 
+pos.cmi: ../bytecomp/instruct.cmi 
 primitives.cmi: ../otherlibs/unix/unix.cmi 
 printval.cmi: debugcom.cmi ../typing/env.cmi parser_aux.cmi \
     ../typing/path.cmi ../typing/types.cmi 
@@ -21,10 +22,10 @@ symbols.cmi: ../bytecomp/instruct.cmi
 time_travel.cmi: primitives.cmi 
 unix_tools.cmi: ../otherlibs/unix/unix.cmi 
 breakpoints.cmo: checkpoints.cmi debugcom.cmi exec.cmi \
-    ../bytecomp/instruct.cmi primitives.cmi source.cmi symbols.cmi \
+    ../bytecomp/instruct.cmi pos.cmi primitives.cmi source.cmi symbols.cmi \
     breakpoints.cmi 
 breakpoints.cmx: checkpoints.cmx debugcom.cmx exec.cmx \
-    ../bytecomp/instruct.cmx primitives.cmx source.cmx symbols.cmx \
+    ../bytecomp/instruct.cmx pos.cmx primitives.cmx source.cmx symbols.cmx \
     breakpoints.cmi 
 checkpoints.cmo: debugcom.cmi int64ops.cmi primitives.cmi checkpoints.cmi 
 checkpoints.cmx: debugcom.cmx int64ops.cmx primitives.cmx checkpoints.cmi 
@@ -33,7 +34,7 @@ command_line.cmo: breakpoints.cmi checkpoints.cmi ../utils/config.cmi \
     events.cmi frames.cmi history.cmi input_handling.cmi \
     ../bytecomp/instruct.cmi int64ops.cmi ../parsing/lexer.cmi \
     loadprinter.cmi ../utils/misc.cmi parameters.cmi parser.cmi \
-    parser_aux.cmi primitives.cmi printval.cmi program_loading.cmi \
+    parser_aux.cmi pos.cmi primitives.cmi printval.cmi program_loading.cmi \
     program_management.cmi show_information.cmi show_source.cmi source.cmi \
     symbols.cmi time_travel.cmi ../typing/types.cmi \
     ../otherlibs/unix/unix.cmi unix_tools.cmi command_line.cmi 
@@ -42,7 +43,7 @@ command_line.cmx: breakpoints.cmx checkpoints.cmx ../utils/config.cmx \
     events.cmx frames.cmx history.cmx input_handling.cmx \
     ../bytecomp/instruct.cmx int64ops.cmx ../parsing/lexer.cmx \
     loadprinter.cmx ../utils/misc.cmx parameters.cmx parser.cmx \
-    parser_aux.cmi primitives.cmx printval.cmx program_loading.cmx \
+    parser_aux.cmi pos.cmx primitives.cmx printval.cmx program_loading.cmx \
     program_management.cmx show_information.cmx show_source.cmx source.cmx \
     symbols.cmx time_travel.cmx ../typing/types.cmx \
     ../otherlibs/unix/unix.cmx unix_tools.cmx command_line.cmi 
@@ -126,6 +127,8 @@ pattern_matching.cmo: ../typing/ctype.cmi debugcom.cmi debugger_config.cmi \
 pattern_matching.cmx: ../typing/ctype.cmx debugcom.cmx debugger_config.cmx \
     ../utils/misc.cmx parser_aux.cmi ../typing/typedtree.cmx \
     pattern_matching.cmi 
+pos.cmo: ../bytecomp/instruct.cmi primitives.cmi source.cmi pos.cmi 
+pos.cmx: ../bytecomp/instruct.cmx primitives.cmx source.cmx pos.cmi 
 primitives.cmo: ../otherlibs/unix/unix.cmi primitives.cmi 
 primitives.cmx: ../otherlibs/unix/unix.cmx primitives.cmi 
 printval.cmo: debugcom.cmi ../toplevel/genprintval.cmi ../utils/misc.cmi \
diff --git a/debugger/Makefile b/debugger/Makefile
index ddfd607c54..674fda9c7a 100644
--- a/debugger/Makefile
+++ b/debugger/Makefile
@@ -55,6 +55,7 @@ OBJS=\
 	debugcom.cmo \
 	exec.cmo \
 	source.cmo \
+	pos.cmo \
 	checkpoints.cmo \
 	symbols.cmo \
 	events.cmo \
diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml
index 03981e09e3..09695d87ba 100644
--- a/debugger/breakpoints.ml
+++ b/debugger/breakpoints.ml
@@ -15,10 +15,11 @@
 
 (******************************* Breakpoints ***************************)
 
+open Checkpoints
+open Debugcom
 open Instruct
 open Primitives
-open Debugcom
-open Checkpoints
+open Printf
 open Source
 
 (*** Debugging. ***)
@@ -169,24 +170,8 @@ let rec new_breakpoint =
            incr breakpoint_number;
            insert_position event.ev_pos;
            breakpoints := (!breakpoint_number, event) :: !breakpoints);
-      print_string "Breakpoint ";
-      print_int !breakpoint_number;
-      print_string " at ";
-      print_int event.ev_pos;
-      print_string " : file ";
-      print_string event.ev_module;
-      begin try
-        let (start, line) =
-          line_of_pos (get_buffer event.ev_module) event.ev_char.Lexing.pos_cnum
-        in
-        print_string ", line ";
-        print_int line;
-        print_string ", character ";
-        print_int (event.ev_char.Lexing.pos_cnum - start + 1)
-      with Not_found | Out_of_range ->
-        print_string ", character ";
-        print_int event.ev_char.Lexing.pos_cnum
-      end;
+      printf "Breakpoint %d at %d : %s" !breakpoint_number event.ev_pos
+             (Pos.get_desc event);
       print_newline ()
 
 (* Remove a breakpoint from lists. *)
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index 81b40580b3..7651b53f32 100644
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -812,16 +812,18 @@ let info_checkpoints ppf lexbuf =
                Printf.printf "%19Ld %5d\n" time pid)
           !checkpoints))
 
+let info_one_breakpoint ppf (num, ev) =
+  fprintf ppf "%3d %10d  %s@." num ev.ev_pos (Pos.get_desc ev);
+;;
+
 let info_breakpoints ppf lexbuf =
   eol lexbuf;
-  if !breakpoints = [] then fprintf ppf "No breakpoint.@."
-  else
-    (fprintf ppf "Num    Address  Where@.";
-     List.iter
-       (function (num, {ev_pos = pc; ev_module = md; ev_char = char}) ->
-          fprintf ppf "%3d %10d  in %s, character %d@." num pc md
-                  char.Lexing.pos_cnum)
-       (List.rev !breakpoints))
+  if !breakpoints = [] then fprintf ppf "No breakpoints.@."
+  else begin
+    fprintf ppf "Num    Address  Where@.";
+    List.iter (info_one_breakpoint ppf) (List.rev !breakpoints);
+  end
+;;
 
 let info_events ppf lexbuf =
   ensure_loaded ();
diff --git a/debugger/pos.ml b/debugger/pos.ml
new file mode 100644
index 0000000000..235de121d0
--- /dev/null
+++ b/debugger/pos.ml
@@ -0,0 +1,37 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*          Damien Doligez, projet Moscova, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2003 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+open Instruct;;
+open Lexing;;
+open Primitives;;
+open Source;;
+
+let get_desc ev =
+  if ev.ev_char.pos_fname <> ""
+  then Printf.sprintf "file %s, line %d, character %d"
+                      ev.ev_char.pos_fname ev.ev_char.pos_lnum
+                      (ev.ev_char.pos_cnum - ev.ev_char.pos_bol + 1)
+  else begin
+    let filename = source_of_module ev.ev_module in
+    try
+      let (start, line) = line_of_pos (get_buffer ev.ev_module)
+                                      ev.ev_char.pos_cnum
+      in
+      Printf.sprintf "file %s, line %d, character %d"
+                     filename line (ev.ev_char.pos_cnum - start + 1)
+    with Not_found | Out_of_range ->
+      Printf.sprintf "file %s, character %d"
+                     filename (ev.ev_char.pos_cnum + 1)
+  end
+;;
diff --git a/debugger/pos.mli b/debugger/pos.mli
new file mode 100644
index 0000000000..e7632e4274
--- /dev/null
+++ b/debugger/pos.mli
@@ -0,0 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*          Damien Doligez, projet Moscova, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2003 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+val get_desc : Instruct.debug_event -> string;;