Pass a Lexing.position value to make source_of_module, get_buffer and show

listing more accurate.
Also move the yes_or_no function to it's own module Question to avoid a
module dependency cycle, since Lexer use Parser types and Parser
implementation use Input_handling that defined yes_or_no that use Lexer.


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

12 files changed, 79 insertions, 94 deletions

diff --git a/debugger/.depend b/debugger/.depend
index 996033416..ba3b8646f 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -35,24 +35,24 @@ checkpoints.cmx: ./primitives.cmx ./int64ops.cmx ./debugcom.cmx \
     checkpoints.cmi 
 command_line.cmo: ./unix_tools.cmi ../otherlibs/unix/unix.cmi \
     ../typing/types.cmi ./time_travel.cmi ./symbols.cmi ./source.cmi \
-    ./show_source.cmi ./show_information.cmi ./program_management.cmi \
-    ./program_loading.cmi ./printval.cmi ./primitives.cmi ./pos.cmi \
-    ./parser_aux.cmi ./parser.cmi ./parameters.cmi ../utils/misc.cmi \
-    ../parsing/location.cmi ./loadprinter.cmi ./lexer.cmi ./int64ops.cmi \
-    ../bytecomp/instruct.cmi ./input_handling.cmi ./history.cmi ./frames.cmi \
-    ./events.cmi ./eval.cmi ./envaux.cmi ./debugger_config.cmi ./debugcom.cmi \
-    ../typing/ctype.cmi ../utils/config.cmi ./checkpoints.cmi \
-    ./breakpoints.cmi command_line.cmi 
+    ./show_source.cmi ./show_information.cmi ./question.cmi \
+    ./program_management.cmi ./program_loading.cmi ./printval.cmi \
+    ./primitives.cmi ./pos.cmi ./parser_aux.cmi ./parser.cmi ./parameters.cmi \
+    ../utils/misc.cmi ../parsing/location.cmi ./loadprinter.cmi ./lexer.cmi \
+    ./int64ops.cmi ../bytecomp/instruct.cmi ./input_handling.cmi \
+    ./history.cmi ./frames.cmi ./events.cmi ./eval.cmi ./envaux.cmi \
+    ./debugger_config.cmi ./debugcom.cmi ../typing/ctype.cmi \
+    ../utils/config.cmi ./checkpoints.cmi ./breakpoints.cmi command_line.cmi 
 command_line.cmx: ./unix_tools.cmx ../otherlibs/unix/unix.cmx \
     ../typing/types.cmx ./time_travel.cmx ./symbols.cmx ./source.cmx \
-    ./show_source.cmx ./show_information.cmx ./program_management.cmx \
-    ./program_loading.cmx ./printval.cmx ./primitives.cmx ./pos.cmx \
-    ./parser_aux.cmi ./parser.cmx ./parameters.cmx ../utils/misc.cmx \
-    ../parsing/location.cmx ./loadprinter.cmx ./lexer.cmx ./int64ops.cmx \
-    ../bytecomp/instruct.cmx ./input_handling.cmx ./history.cmx ./frames.cmx \
-    ./events.cmx ./eval.cmx ./envaux.cmx ./debugger_config.cmx ./debugcom.cmx \
-    ../typing/ctype.cmx ../utils/config.cmx ./checkpoints.cmx \
-    ./breakpoints.cmx command_line.cmi 
+    ./show_source.cmx ./show_information.cmx ./question.cmx \
+    ./program_management.cmx ./program_loading.cmx ./printval.cmx \
+    ./primitives.cmx ./pos.cmx ./parser_aux.cmi ./parser.cmx ./parameters.cmx \
+    ../utils/misc.cmx ../parsing/location.cmx ./loadprinter.cmx ./lexer.cmx \
+    ./int64ops.cmx ../bytecomp/instruct.cmx ./input_handling.cmx \
+    ./history.cmx ./frames.cmx ./events.cmx ./eval.cmx ./envaux.cmx \
+    ./debugger_config.cmx ./debugcom.cmx ../typing/ctype.cmx \
+    ../utils/config.cmx ./checkpoints.cmx ./breakpoints.cmx command_line.cmi 
 debugcom.cmo: ./primitives.cmi ../utils/misc.cmi ./int64ops.cmi \
     ./input_handling.cmi debugcom.cmi 
 debugcom.cmx: ./primitives.cmx ../utils/misc.cmx ./int64ops.cmx \
@@ -101,9 +101,9 @@ history.cmo: ./primitives.cmi ../utils/misc.cmi ./int64ops.cmi \
     ./debugger_config.cmi ./checkpoints.cmi history.cmi 
 history.cmx: ./primitives.cmx ../utils/misc.cmx ./int64ops.cmx \
     ./debugger_config.cmx ./checkpoints.cmx history.cmi 
-input_handling.cmo: ../otherlibs/unix/unix.cmi ./primitives.cmi ./lexer.cmi \
+input_handling.cmo: ../otherlibs/unix/unix.cmi ./primitives.cmi \
     input_handling.cmi 
-input_handling.cmx: ../otherlibs/unix/unix.cmx ./primitives.cmx ./lexer.cmx \
+input_handling.cmx: ../otherlibs/unix/unix.cmx ./primitives.cmx \
     input_handling.cmi 
 int64ops.cmo: int64ops.cmi 
 int64ops.cmx: int64ops.cmi 
@@ -120,15 +120,15 @@ loadprinter.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx ./printval.cmx \
     ./dynlink.cmx ./debugger_config.cmx ../typing/ctype.cmx \
     ../utils/config.cmx loadprinter.cmi 
 main.cmo: ./unix_tools.cmi ../otherlibs/unix/unix.cmi ./time_travel.cmi \
-    ./show_information.cmi ./program_management.cmi ./primitives.cmi \
-    ./parameters.cmi ../utils/misc.cmi ./input_handling.cmi ./frames.cmi \
-    ./exec.cmi ../typing/env.cmi ./debugger_config.cmi ../utils/config.cmi \
-    ./command_line.cmi ./checkpoints.cmi 
+    ./show_information.cmi ./question.cmi ./program_management.cmi \
+    ./primitives.cmi ./parameters.cmi ../utils/misc.cmi ./input_handling.cmi \
+    ./frames.cmi ./exec.cmi ../typing/env.cmi ./debugger_config.cmi \
+    ../utils/config.cmi ./command_line.cmi ./checkpoints.cmi 
 main.cmx: ./unix_tools.cmx ../otherlibs/unix/unix.cmx ./time_travel.cmx \
-    ./show_information.cmx ./program_management.cmx ./primitives.cmx \
-    ./parameters.cmx ../utils/misc.cmx ./input_handling.cmx ./frames.cmx \
-    ./exec.cmx ../typing/env.cmx ./debugger_config.cmx ../utils/config.cmx \
-    ./command_line.cmx ./checkpoints.cmx 
+    ./show_information.cmx ./question.cmx ./program_management.cmx \
+    ./primitives.cmx ./parameters.cmx ../utils/misc.cmx ./input_handling.cmx \
+    ./frames.cmx ./exec.cmx ../typing/env.cmx ./debugger_config.cmx \
+    ../utils/config.cmx ./command_line.cmx ./checkpoints.cmx 
 parameters.cmo: ./primitives.cmi ../utils/misc.cmi ./envaux.cmi \
     ../utils/config.cmi parameters.cmi 
 parameters.cmx: ./primitives.cmx ../utils/misc.cmx ./envaux.cmx \
@@ -164,17 +164,19 @@ program_loading.cmx: ./unix_tools.cmx ../otherlibs/unix/unix.cmx \
     ./primitives.cmx ./parameters.cmx ../utils/misc.cmx ./input_handling.cmx \
     ./debugger_config.cmx program_loading.cmi 
 program_management.cmo: ./unix_tools.cmi ../otherlibs/unix/unix.cmi \
-    ./time_travel.cmi ./symbols.cmi ./program_loading.cmi ./primitives.cmi \
-    ./parameters.cmi ../utils/misc.cmi ./int64ops.cmi \
+    ./time_travel.cmi ./symbols.cmi ./question.cmi ./program_loading.cmi \
+    ./primitives.cmi ./parameters.cmi ../utils/misc.cmi ./int64ops.cmi \
     ../bytecomp/instruct.cmi ./input_handling.cmi ./history.cmi \
     ./debugger_config.cmi ./debugcom.cmi ./breakpoints.cmi \
     program_management.cmi 
 program_management.cmx: ./unix_tools.cmx ../otherlibs/unix/unix.cmx \
-    ./time_travel.cmx ./symbols.cmx ./program_loading.cmx ./primitives.cmx \
-    ./parameters.cmx ../utils/misc.cmx ./int64ops.cmx \
+    ./time_travel.cmx ./symbols.cmx ./question.cmx ./program_loading.cmx \
+    ./primitives.cmx ./parameters.cmx ../utils/misc.cmx ./int64ops.cmx \
     ../bytecomp/instruct.cmx ./input_handling.cmx ./history.cmx \
     ./debugger_config.cmx ./debugcom.cmx ./breakpoints.cmx \
     program_management.cmi 
+question.cmo: ./primitives.cmi ./lexer.cmi ./input_handling.cmi question.cmi 
+question.cmx: ./primitives.cmx ./lexer.cmx ./input_handling.cmx question.cmi 
 show_information.cmo: ./symbols.cmi ./show_source.cmi ./printval.cmi \
     ./primitives.cmi ../utils/misc.cmi ../bytecomp/instruct.cmi ./frames.cmi \
     ./events.cmi ./debugcom.cmi ./checkpoints.cmi ./breakpoints.cmi \
@@ -197,13 +199,13 @@ symbols.cmo: ../bytecomp/symtable.cmi ./primitives.cmi \
 symbols.cmx: ../bytecomp/symtable.cmx ./primitives.cmx \
     ../bytecomp/instruct.cmx ./events.cmx ./debugger_config.cmx \
     ./debugcom.cmx ./checkpoints.cmx ../bytecomp/bytesections.cmx symbols.cmi 
-time_travel.cmo: ./trap_barrier.cmi ./symbols.cmi ./program_loading.cmi \
-    ./primitives.cmi ../utils/misc.cmi ./int64ops.cmi \
+time_travel.cmo: ./trap_barrier.cmi ./symbols.cmi ./question.cmi \
+    ./program_loading.cmi ./primitives.cmi ../utils/misc.cmi ./int64ops.cmi \
     ../bytecomp/instruct.cmi ./input_handling.cmi ./exec.cmi ./events.cmi \
     ./debugger_config.cmi ./debugcom.cmi ./checkpoints.cmi ./breakpoints.cmi \
     time_travel.cmi 
-time_travel.cmx: ./trap_barrier.cmx ./symbols.cmx ./program_loading.cmx \
-    ./primitives.cmx ../utils/misc.cmx ./int64ops.cmx \
+time_travel.cmx: ./trap_barrier.cmx ./symbols.cmx ./question.cmx \
+    ./program_loading.cmx ./primitives.cmx ../utils/misc.cmx ./int64ops.cmx \
     ../bytecomp/instruct.cmx ./input_handling.cmx ./exec.cmx ./events.cmx \
     ./debugger_config.cmx ./debugcom.cmx ./checkpoints.cmx ./breakpoints.cmx \
     time_travel.cmi 
diff --git a/debugger/Makefile b/debugger/Makefile
index 96da6825c..a1faabd1f 100644
--- a/debugger/Makefile
+++ b/debugger/Makefile
@@ -53,6 +53,7 @@ OBJS=\
 	parameters.cmo \
 	lexer.cmo \
 	input_handling.cmo \
+	question.cmo \
 	debugcom.cmo \
 	exec.cmo \
 	source.cmo \
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index ef1b025a2..cfbdee303 100644
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -28,6 +28,7 @@ open Parser
 open Parser_aux
 open Lexer
 open Input_handling
+open Question
 open Debugcom
 open Program_loading
 open Program_management
@@ -554,7 +555,7 @@ let instr_break ppf lexbuf =
         new_breakpoint
           (try
              let buffer =
-               try get_buffer module_name with
+               try get_buffer Lexing.dummy_pos module_name with
                | Not_found ->
                   eprintf "No source file for %s.@." module_name;
                   raise Toplevel
@@ -632,11 +633,10 @@ let instr_backtrace ppf lexbuf =
         do_backtrace (print_frame 0 number)
       else begin
         let num_frames = stack_depth() in
-        if num_frames < 0 then begin
+        if num_frames < 0 then
           fprintf ppf
-            "(Encountered a function with no debugging information)";
-          print_newline()
-        end else
+            "(Encountered a function with no debugging information)@."
+        else
           do_backtrace (print_frame (num_frames + number) max_int)
       end
 
@@ -686,13 +686,14 @@ let instr_list ppf lexbuf =
           ("", -1)
     in
       let mdle = convert_module mo in
+      let pos = Lexing.dummy_pos in
         let beginning =
           match beg with
           | None when (mo <> None) || (point = -1) ->
               1
           | None ->
               let buffer =
-                try get_buffer mdle with
+                try get_buffer pos mdle with
                 | Not_found -> error ("No source file for " ^ mdle ^ ".")
               in
               begin try
@@ -708,10 +709,10 @@ let instr_list ppf lexbuf =
             | Some x -> x
           in
             if mdle = curr_mod then
-              show_listing mdle beginning en point
+              show_listing pos mdle beginning en point
                 (current_event_is_before ())
             else
-              show_listing mdle beginning en (-1) true
+              show_listing pos mdle beginning en (-1) true
 
 (** Variables. **)
 let raw_variable kill name =
diff --git a/debugger/input_handling.ml b/debugger/input_handling.ml
index 5aac814b9..dec3f86cc 100644
--- a/debugger/input_handling.ml
+++ b/debugger/input_handling.ml
@@ -113,36 +113,3 @@ let resume_user_input () =
       end;
     add_file !user_channel exit_main_loop
     end
-
-(* Ask user a yes or no question. *)
-let yes_or_no message =
-  if !interactif then
-    let old_prompt = !current_prompt in
-      try
-        current_prompt := message ^ " ? (y or n) ";
-        let answer =
-          let rec ask () =
-            resume_user_input ();
-            let line =
-              string_trim (Lexer.line (Lexing.from_function read_user_input))
-            in
-              stop_user_input ();
-              match (if String.length line > 0 then line.[0] else ' ') with
-                'y' -> true
-              | 'n' -> false
-              | _ ->
-                print_string "Please answer y or n.";
-                print_newline ();
-                ask ()
-          in
-            ask ()
-        in
-          current_prompt := old_prompt;
-          answer
-      with
-        x ->
-          current_prompt := old_prompt;
-          stop_user_input ();
-          raise x
-  else
-    false
diff --git a/debugger/input_handling.mli b/debugger/input_handling.mli
index 872b88081..959547df7 100644
--- a/debugger/input_handling.mli
+++ b/debugger/input_handling.mli
@@ -58,6 +58,3 @@ val stop_user_input : unit -> unit
 
 (* Resume reading user input. *)
 val resume_user_input : unit -> unit
-
-(* Ask user a yes or no question. *)
-val yes_or_no : string -> bool
diff --git a/debugger/main.ml b/debugger/main.ml
index 09dbd23e8..d74beaca8 100644
--- a/debugger/main.ml
+++ b/debugger/main.ml
@@ -16,6 +16,7 @@
 open Primitives
 open Misc
 open Input_handling
+open Question
 open Command_line
 open Debugger_config
 open Checkpoints
@@ -102,7 +103,7 @@ let rec protect ppf restart loop =
           begin
             recover ();
             show_current_event ppf;
-            loop ppf
+            restart ppf
           end)
   | x ->
       kill_program ();
diff --git a/debugger/pos.ml b/debugger/pos.ml
index 1da24c4bd..4beba3de0 100644
--- a/debugger/pos.ml
+++ b/debugger/pos.ml
@@ -26,9 +26,9 @@ let get_desc ev =
                       (loc.loc_start.pos_cnum - loc.loc_start.pos_bol + 1)
                       (loc.loc_end.pos_cnum - loc.loc_start.pos_bol + 1)
   else begin
-    let filename = source_of_module ev.ev_module in
+    let filename = source_of_module ev.ev_loc.loc_start ev.ev_module in
     try
-      let (start, line) = line_of_pos (get_buffer ev.ev_module)
+      let (start, line) = line_of_pos (get_buffer loc.loc_start ev.ev_module)
                                       loc.loc_start.pos_cnum
       in
       Printf.sprintf "file %s, line %d, characters %d-%d"
diff --git a/debugger/program_management.ml b/debugger/program_management.ml
index ec5877fc2..d38adc713 100644
--- a/debugger/program_management.ml
+++ b/debugger/program_management.ml
@@ -24,6 +24,7 @@ open Instruct
 open Primitives
 open Parameters
 open Input_handling
+open Question
 open Debugcom
 open Program_loading
 open Time_travel
diff --git a/debugger/show_source.ml b/debugger/show_source.ml
index 8ec34f8ab..b60a1f9e4 100644
--- a/debugger/show_source.ml
+++ b/debugger/show_source.ml
@@ -46,7 +46,7 @@ let show_point ev selected =
   let before = (ev.ev_kind = Event_before) in
   if !emacs && selected then
     begin try
-      let source = source_of_module mdle in
+      let source = source_of_module ev.ev_loc.Location.loc_start mdle in
       printf "\026\026M%s:%i:%i" source
              ev.ev_loc.Location.loc_start.Lexing.pos_cnum
              ev.ev_loc.Location.loc_end.Lexing.pos_cnum;
@@ -58,21 +58,22 @@ let show_point ev selected =
     end
   else
     begin try
-      let buffer = get_buffer mdle in
-      let point = (Events.get_pos ev).Lexing.pos_cnum in
+      let pos = Events.get_pos ev in
+      let buffer = get_buffer pos mdle in
+      let point = pos.Lexing.pos_cnum in
       let (start, line_number) = line_of_pos buffer point in
       ignore(print_line buffer line_number start point before)
     with
       Out_of_range -> (* line_of_pos *)
         prerr_endline "Position out of range."
-    | Not_found    -> (* get_buffer *)
+    | Not_found    -> (* Events.get_pos || get_buffer *)
         prerr_endline ("No source file for " ^ mdle ^ ".")
     end
 
 (* Display part of the source. *)
-let show_listing mdle start stop point before =
+let show_listing pos mdle start stop point before =
   try
-    let buffer = get_buffer mdle in
+    let buffer = get_buffer pos mdle in
       let rec aff (line_start, line_number) =
         if line_number <= stop then
           aff (print_line buffer line_number line_start point before + 1, line_number + 1)
diff --git a/debugger/show_source.mli b/debugger/show_source.mli
index 17d5ef834..5ba418af5 100644
--- a/debugger/show_source.mli
+++ b/debugger/show_source.mli
@@ -20,4 +20,4 @@ val show_point : Instruct.debug_event -> bool -> unit;;
 val show_no_point : unit -> unit;;
 
 (* Display part of the source. *)
-val show_listing : string -> int -> int -> int -> bool -> unit;;
+val show_listing : Lexing.position -> string -> int -> int -> int -> bool -> unit;;
diff --git a/debugger/source.ml b/debugger/source.ml
index f937c782a..f1519b438 100644
--- a/debugger/source.ml
+++ b/debugger/source.ml
@@ -18,10 +18,24 @@
 open Misc
 open Primitives
 
+let source_extensions = [".ml"]
+
 (*** Conversion function. ***)
 
-let source_of_module mdle =
-  find_in_path_uncap !Config.load_path (mdle ^ ".ml")
+let source_of_module pos mdle =
+  let fname = pos.Lexing.pos_fname in
+  if fname = "" then
+    let rec loop =
+      function
+      | [] -> raise Not_found
+      | ext :: exts ->
+          try find_in_path_uncap !Config.load_path (mdle ^ ext)
+          with Not_found -> loop exts
+    in loop source_extensions
+  else if Filename.is_implicit fname then
+    find_in_path !Config.load_path fname
+  else
+    fname
 
 (*** Buffer cache ***)
 
@@ -38,10 +52,10 @@ let buffer_list =
 let flush_buffer_list () =
   buffer_list := []
 
-let get_buffer mdle =
+let get_buffer pos mdle =
   try List.assoc mdle !buffer_list with
     Not_found ->
-      let inchan = open_in_bin (source_of_module mdle) in
+      let inchan = open_in_bin (source_of_module pos mdle) in
         let (content, _) as buffer =
           (String.create (in_channel_length inchan), ref [])
         in
diff --git a/debugger/source.mli b/debugger/source.mli
index cfd5fe070..5bcbb74d8 100644
--- a/debugger/source.mli
+++ b/debugger/source.mli
@@ -17,7 +17,7 @@
 
 (*** Conversion function. ***)
 
-val source_of_module: string -> string
+val source_of_module: Lexing.position -> string -> string
 
 (*** buffer cache ***)
 
@@ -27,7 +27,7 @@ val buffer_max_count : int ref
 
 val flush_buffer_list : unit -> unit
 
-val get_buffer : string -> buffer
+val get_buffer : Lexing.position -> string -> buffer
 
 val buffer_content : buffer -> string
 val buffer_length : buffer -> int