diff options
Diffstat (limited to 'debugger')
| -rw-r--r-- | debugger/command_line.ml | 141 | ||||
| -rw-r--r-- | debugger/debugcom.ml | 12 | ||||
| -rw-r--r-- | debugger/envaux.ml | 12 | ||||
| -rw-r--r-- | debugger/envaux.mli | 4 | ||||
| -rw-r--r-- | debugger/eval.ml | 62 | ||||
| -rw-r--r-- | debugger/eval.mli | 5 | ||||
| -rw-r--r-- | debugger/loadprinter.ml | 50 | ||||
| -rw-r--r-- | debugger/printval.ml | 39 | ||||
| -rw-r--r-- | debugger/printval.mli | 11 | ||||
| -rw-r--r-- | debugger/show_information.ml | 65 | ||||
| -rw-r--r-- | debugger/show_information.mli | 8 | ||||
| -rw-r--r-- | debugger/unix_tools.ml | 2 |
12 files changed, 200 insertions, 211 deletions
diff --git a/debugger/command_line.ml b/debugger/command_line.ml index ce235e701..a50ee4ca5 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -15,7 +15,7 @@ (************************ Reading and executing commands ***************) -open Formatmsg +open Format open Misc open Instruct open Unix @@ -228,12 +228,10 @@ let instr_dir lexbuf = end end else - List.iter (function x -> add_path (expand_path x)) (List.rev new_directory); - open_box 2; - print_string "Directories :"; - List.iter (function x -> print_space(); print_string x) !Config.load_path; - close_box(); - print_newline () + List.iter (function x -> add_path (expand_path x)) + (List.rev new_directory); + let print_dirs ppf l = List.iter (function x -> fprintf ppf "@ %s" x) l in + fprintf ppf "@[<2>Directories :%a@]@." print_dirs !Config.load_path let instr_kill lexbuf = eol lexbuf; @@ -326,26 +324,25 @@ let instr_goto lexbuf = let instr_quit _ = raise Exit -let print_variable_list () = - print_endline "List of variables :"; - List.iter (fun v -> print_string v.var_name; print_space()) !variable_list; - print_newline () +let print_variable_list ppf = + let pr_vars ppf = List.iter (fun v -> fprintf ppf "%s@ " v.var_name) in + fprintf ppf "List of variables :%a@." pr_vars !variable_list -let print_info_list () = - print_endline "List of info commands :"; - List.iter (fun i -> print_string i.info_name; print_space()) !info_list; - print_newline () +let print_info_list ppf = + let pr_infos ppf = List.iter (fun i -> fprintf ppf "%s@ " i.info_name) in + print_endline "List of info commands :%a@." pr_infos !info_list let instr_complete lexbuf = + let ppf = Format.err_formatter in let rec print_list l = try eol lexbuf; - List.iter (function i -> print_string i; print_newline ()) l + List.iter (function i -> fprintf ppf "%s@." i) l with _ -> remove_file !user_channel and match_list lexbuf = match identifier_or_eol Lexer.lexeme lexbuf with - None -> + | None -> List.map (fun i -> i.instr_name) !instruction_list | Some x -> match matching_instructions x with @@ -382,87 +379,77 @@ let instr_complete lexbuf = in print_list(match_list lexbuf) -let instr_help lexbuf = +let instr_help ppf lexbuf = + let pr_instrs ppf = + List.iter (fun i -> fprintf ppf "%s@ " i.instr_name) in match identifier_or_eol Lexer.lexeme lexbuf with - Some x -> + | Some x -> let print_help nm hlp = eol lexbuf; - print_string nm; - print_string " : "; - print_string hlp; - print_newline () - in - begin match matching_instructions x with - [] -> - eol lexbuf; - print_string "No matching command."; - print_newline () - | [ {instr_name = "set"} ] -> - find_variable - (fun v _ -> - print_help ("set " ^ v.var_name) ("set " ^ v.var_help)) - (fun () -> - print_help "set" "set debugger variable."; - print_variable_list ()) - lexbuf - | [ {instr_name = "show"} ] -> - find_variable - (fun v _ -> - print_help ("show " ^ v.var_name) ("show " ^ v.var_help)) - (fun () -> - print_help "show" "display debugger variable."; - print_variable_list ()) - lexbuf - | [ {instr_name = "info"} ] -> - find_info - (fun i _ -> print_help ("info " ^ i.info_name) i.info_help) - (fun () -> - print_help "info" "display infos about the program being debugged."; - print_info_list ()) - lexbuf - | [i] -> - print_help i.instr_name i.instr_help - | l -> - eol lexbuf; - print_string ("Ambiguous command \"" ^ x ^ "\" : "); - List.iter - (fun i -> print_string i.instr_name; print_space()) - l; - print_newline () - end + fprintf ppf "%s : %s@." nm hlp in + begin match matching_instructions x with + | [] -> + eol lexbuf; + fprintf ppf "No matching command.@." + | [ {instr_name = "set"} ] -> + find_variable + (fun v _ -> + print_help ("set " ^ v.var_name) ("set " ^ v.var_help)) + (fun () -> + print_help "set" "set debugger variable."; + print_variable_list ppf) + lexbuf + | [ {instr_name = "show"} ] -> + find_variable + (fun v _ -> + print_help ("show " ^ v.var_name) ("show " ^ v.var_help)) + (fun () -> + print_help "show" "display debugger variable."; + print_variable_list ppf) + lexbuf + | [ {instr_name = "info"} ] -> + find_info + (fun i _ -> print_help ("info " ^ i.info_name) i.info_help) + (fun () -> + print_help "info" + "display infos about the program being debugged."; + print_info_list ppf) + lexbuf + | [i] -> + print_help i.instr_name i.instr_help + | l -> + eol lexbuf; + fprintf ppf "Ambiguous command \"%s\" : @." x pr_instrs l + end | None -> - print_endline "List of commands :"; - List.iter - (fun i -> print_string i.instr_name; print_space()) - !instruction_list; - print_newline () + print_endline "List of commands :%a@." pr_instrs !instruction_list (* Printing values *) -let print_expr depth ev env expr = +let print_expr depth ev env ppf expr = try let (v, ty) = Eval.expression ev env expr in - print_named_value depth expr v ty env + print_named_value depth expr v ty ppf env with Eval.Error msg -> - Eval.report_error msg; + Eval.report_error ppf msg; raise Toplevel -let print_command depth lexbuf = - let exprs = expression_list_eol Lexer.lexeme lexbuf in +let print_command depth ppf lexbuf = + let exprs = expression_list_eol Lexer.lexeme ppf lexbuf in ensure_loaded (); let env = try Envaux.env_of_event !selected_event with Envaux.Error msg -> - Envaux.report_error msg; + Envaux.report_error ppf msg; raise Toplevel in - List.iter (print_expr depth !selected_event env) exprs + List.iter (print_expr depth !selected_event env ppf) exprs -let instr_print lexbuf = print_command !max_printer_depth lexbuf +let instr_print ppf lexbuf = print_command !max_printer_depth ppf lexbuf -let instr_display lexbuf = print_command 1 lexbuf +let instr_display ppf lexbuf = print_command 1 ppf lexbuf (* Loading of command files *) @@ -483,7 +470,7 @@ let instr_source lexbuf = (openfile (find_in_path !Config.load_path (expand_path file)) [O_RDONLY] 0) with - Not_found -> prerr_endline "Source file not found."; raise Toplevel + | Not_found -> prerr_endline "Source file not found."; raise Toplevel | (Unix_error _) as x -> Unix_tools.report_error x; raise Toplevel in try diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml index 79b8fcfd8..3c56fd80a 100644 --- a/debugger/debugcom.ml +++ b/debugger/debugcom.ml @@ -171,7 +171,7 @@ module Remote_value = type t = Remote of string | Local of Obj.t let obj = function - Local obj -> Obj.obj obj + | Local obj -> Obj.obj obj | Remote v -> output_char !conn.io_out 'M'; output_remote_value !conn.io_out v; @@ -182,11 +182,11 @@ module Remote_value = raise Marshalling_error let is_block = function - Local obj -> Obj.is_block obj + | Local obj -> Obj.is_block obj | Remote v -> Obj.is_block (Array.unsafe_get (Obj.magic v : Obj.t array) 0) let tag = function - Local obj -> Obj.tag obj + | Local obj -> Obj.tag obj | Remote v -> output_char !conn.io_out 'H'; output_remote_value !conn.io_out v; @@ -195,7 +195,7 @@ module Remote_value = header land 0xFF let size = function - Local obj -> Obj.size obj + | Local obj -> Obj.size obj | Remote v -> output_char !conn.io_out 'H'; output_remote_value !conn.io_out v; @@ -205,7 +205,7 @@ module Remote_value = let field v n = match v with - Local obj -> Local(Obj.field obj n) + | Local obj -> Local(Obj.field obj n) | Remote v -> output_char !conn.io_out 'F'; output_remote_value !conn.io_out v; @@ -248,7 +248,7 @@ module Remote_value = Remote(input_remote_value !conn.io_in) let closure_code = function - Local obj -> assert false + | Local obj -> assert false | Remote v -> output_char !conn.io_out 'C'; output_remote_value !conn.io_out v; diff --git a/debugger/envaux.ml b/debugger/envaux.ml index 352ea4909..ba8d6dff5 100644 --- a/debugger/envaux.ml +++ b/debugger/envaux.ml @@ -76,12 +76,8 @@ let env_of_event = (* Error report *) -open Formatmsg +open Format -let report_error error = - open_box 0; - begin match error with - Module_not_found p -> - print_string "Cannot find module "; Printtyp.path p - end; - close_box(); print_newline() +let report_error ppf = function + | Module_not_found p -> + fprintf ppf "@[Cannot find module %a@].@." Printtyp.path p diff --git a/debugger/envaux.mli b/debugger/envaux.mli index 7cd206643..8b122cc34 100644 --- a/debugger/envaux.mli +++ b/debugger/envaux.mli @@ -13,6 +13,8 @@ (* $Id$ *) +open Format + (* Convert environment summaries to environments *) val env_of_event: Instruct.debug_event option -> Env.t @@ -28,4 +30,4 @@ type error = exception Error of error -val report_error: error -> unit +val report_error: formatter -> error -> unit diff --git a/debugger/eval.ml b/debugger/eval.ml index dfa1557f5..5024cf5af 100644 --- a/debugger/eval.ml +++ b/debugger/eval.ml @@ -160,44 +160,48 @@ and find_label lbl env ty path tydesc pos = function (* Error report *) -open Formatmsg +open Format -let report_error error = - open_box 0; - begin match error with - Unbound_identifier id -> - printf "Unbound identifier %s" (Ident.name id) +let report_error ppf = function + | Unbound_identifier id -> + fprintf ppf "@[Unbound identifier %s@]@." (Ident.name id) | Not_initialized_yet path -> - print_string "The module path "; Printtyp.path path; - printf " is not yet initialized.@ "; - print_string "Please run program forward until its initialization code is executed." + fprintf ppf + "@[The module path %a is not yet initialized.@ \ + Please run program forward@ \ + until its initialization code is executed.@]@." + Printtyp.path path | Unbound_long_identifier lid -> - print_string "Unbound identifier "; Printtyp.longident lid + fprintf ppf "@[Unbound identifier %a@]@." Printtyp.longident lid | Unknown_name n -> - printf "Unknown value name $%i" n + fprintf ppf "@[Unknown value name $%i@]@." n | Tuple_index(ty, len, pos) -> - printf "Cannot extract field number %i from a %i" pos len; - print_string "-components tuple of type "; - Printtyp.reset (); Printtyp.mark_loops ty; - print_space(); Printtyp.type_expr ty + Printtyp.reset_and_mark_loops ty; + fprintf ppf + "@[Cannot extract field number %i from a %i-components \ + tuple of type@ %a@]@." + pos len Printtyp.type_expr ty | Array_index(len, pos) -> - printf "Cannot extract element number %i from array of length %i" pos len + fprintf ppf + "@[Cannot extract element number %i from array of length %i@]@." pos len | List_index(len, pos) -> - printf "Cannot extract element number %i from list of length %i" pos len + fprintf ppf + "@[Cannot extract element number %i from list of length %i@]@." pos len | String_index(s, len, pos) -> - printf "Cannot extract character number %i" pos; - printf " from the following string of length %i:@ \"%s\"" - len (String.escaped s) + fprintf ppf + "@[Cannot extract character number %i@ \ + from the following string of length %i:@ \"%s\"@]@." + pos len (String.escaped s) | Wrong_item_type(ty, pos) -> - printf "Cannot extract item number %i from a value of type@ " pos; - Printtyp.type_expr ty + fprintf ppf + "@[Cannot extract item number %i from a value of type@ %a@]@." + pos Printtyp.type_expr ty | Wrong_label(ty, lbl) -> - printf "The record type@ "; Printtyp.type_expr ty; - printf "@ has no label named %s" lbl + fprintf ppf + "@[The record type@ %a@ has no label named %s@]@." + Printtyp.type_expr ty lbl | Not_a_record ty -> - printf "The type@ "; Printtyp.type_expr ty; - print_string "@ is not a record type" + fprintf ppf + "@[The type@ %a@ is not a record type@]@." Printtyp.type_expr ty | No_result -> - print_string "No result available at current program event" - end; - close_box(); print_newline() + fprintf ppf "@[No result available at current program event@]@." diff --git a/debugger/eval.mli b/debugger/eval.mli index 6565ebc0e..b2a2998f1 100644 --- a/debugger/eval.mli +++ b/debugger/eval.mli @@ -15,13 +15,14 @@ open Types open Parser_aux +open Format val expression : Instruct.debug_event option -> Env.t -> expression -> Debugcom.Remote_value.t * type_expr type error = - Unbound_identifier of Ident.t + | Unbound_identifier of Ident.t | Not_initialized_yet of Path.t | Unbound_long_identifier of Longident.t | Unknown_name of int @@ -36,4 +37,4 @@ type error = exception Error of error -val report_error: error -> unit +val report_error: formatter -> error -> unit diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml index 4968ccdc0..e516380da 100644 --- a/debugger/loadprinter.ml +++ b/debugger/loadprinter.ml @@ -22,7 +22,7 @@ open Types (* Error report *) type error = - Load_failure of Dynlink.error + | Load_failure of Dynlink.error | Unbound_identifier of Longident.t | Unavailable_module of string * Longident.t | Wrong_type of Longident.t @@ -39,7 +39,7 @@ let debugger_symtable = ref (None: Symtable.global_map option) let use_debugger_symtable fn arg = let old_symtable = Symtable.current_state() in begin match !debugger_symtable with - None -> + | None -> Symtable.init_toplevel(); debugger_symtable := Some(Symtable.current_state()) | Some st -> @@ -56,21 +56,21 @@ let use_debugger_symtable fn arg = (* Load a .cmo or .cma file *) -open Formatmsg +open Format -let rec loadfiles name = +let rec loadfiles ppf name = try let filename = find_in_path !Config.load_path name in use_debugger_symtable Dynlink.loadfile filename; - printf "File %s loaded@." filename; + fprintf ppf "File %s loaded@." filename; true with - Dynlink.Error (Dynlink.Unavailable_unit unit) -> + | Dynlink.Error (Dynlink.Unavailable_unit unit) -> loadfiles (String.uncapitalize unit ^ ".cmo") && loadfiles name | Not_found -> - printf "Cannot find file %s@." name; + fprintf ppf "Cannot find file %s@." name; false | Dynlink.Error e -> raise(Error(Load_failure e)) @@ -106,17 +106,17 @@ let find_printer_type lid = Ctype.generalize ty_arg; (ty_arg, path) with - Not_found -> raise(Error(Unbound_identifier lid)) + | Not_found -> raise(Error(Unbound_identifier lid)) | Ctype.Unify _ -> raise(Error(Wrong_type lid)) -let install_printer lid = +let install_printer ppf lid = let (ty_arg, path) = find_printer_type lid in let v = try use_debugger_symtable eval_path path with Symtable.Error(Symtable.Undefined_global s) -> raise(Error(Unavailable_module(s, lid))) in - Printval.install_printer path ty_arg (Obj.magic v : Obj.t -> unit) + Printval.install_printer path ty_arg ppf (Obj.magic v : Obj.t -> unit) let remove_printer lid = let (ty_arg, path) = find_printer_type lid in @@ -127,27 +127,25 @@ let remove_printer lid = (* Error report *) -open Formatmsg +open Format -let report_error error = - open_box 0; - begin match error with - Load_failure e -> - printf "Error during code loading: %s" (Dynlink.error_message e) +let report_error ppf = function + | Load_failure e -> + fprintf ppf "@[Error during code loading: %s@]@." + (Dynlink.error_message e) | Unbound_identifier lid -> - print_string "Unbound identifier "; + fprintf ppf "@[Unbound identifier %a@]@." Printtyp.longident lid | Unavailable_module(md, lid) -> - printf "The debugger does not contain the code for@ "; - Printtyp.longident lid; printf ".@ "; - printf "Please load an implementation of %s first." md + fprintf ppf + "@[The debugger does not contain the code for@ %a.@ \ + Please load an implementation of %s first.@]@." + Printtyp.longident lid md | Wrong_type lid -> - Printtyp.longident lid; - print_string " has the wrong type for a printing function." + fprintf ppf "@[%a has the wrong type for a printing function.@]@." + Printtyp.longident lid | No_active_printer lid -> - Printtyp.longident lid; - print_string " is not currently active as a printing function." - end; - close_box(); print_newline() + fprintf ppf "@[%a is not currently active as a printing function.@]@." + Printtyp.longident lid diff --git a/debugger/printval.ml b/debugger/printval.ml index fd620358e..cb8117a42 100644 --- a/debugger/printval.ml +++ b/debugger/printval.ml @@ -17,7 +17,7 @@ open Misc open Obj -open Formatmsg +open Format open Parser_aux open Path open Types @@ -41,23 +41,23 @@ let name_value v ty = let find_named_value name = Hashtbl.find named_values name -let check_depth depth obj ty = +let check_depth ppf depth obj ty = if depth <= 0 then begin let n = name_value obj ty in - print_char '$'; print_int n; + fprintf ppf "$%i" n; false end else true module Printer = Genprintval.Make(Debugcom.Remote_value) -let install_printer path ty fn = +let install_printer path ty ppf fn = Printer.install_printer path ty (function remote_val -> try fn (Obj.repr (Debugcom.Remote_value.obj remote_val)) with Debugcom.Marshalling_error -> - print_string "<cannot fetch remote object>") + fprintf ppf "<cannot fetch remote object>") let remove_printer = Printer.remove_printer @@ -66,23 +66,22 @@ let max_printer_steps = ref 300 let print_exception = Printer.print_exception -let print_value max_depth obj ty env = +let print_value max_depth env obj (ppf : Format.formatter) ty = Printer.print_value !max_printer_steps max_depth - check_depth env obj ty + (check_depth ppf) env obj ppf ty -let print_named_value max_depth exp obj ty env = - printf "@[<2>"; - begin match exp with - E_ident lid -> - Printtyp.longident lid +let print_named_value max_depth exp env obj ppf ty = + let print_value_name ppf = function + | E_ident lid -> + Printtyp.longident ppf lid | E_name n -> - print_char '$'; print_int n + fprintf ppf "$%i" n | _ -> let n = name_value obj ty in - print_char '$'; print_int n - end; - Printtyp.reset (); Printtyp.mark_loops ty; - printf " :@ "; Printtyp.type_expr ty; - printf "@ =@ "; - print_value max_depth obj ty env; - printf "@]@." + fprintf ppf "$%i" n in + Printtyp.reset_and_mark_loops ty; + fprintf ppf "@[<2>%a :@ %a@ =@ %a@]@." + print_value_name exp + Printtyp.type_expr ty + (print_value max_depth env obj) ty + diff --git a/debugger/printval.mli b/debugger/printval.mli index 2df6779a1..f34a9e71d 100644 --- a/debugger/printval.mli +++ b/debugger/printval.mli @@ -13,17 +13,20 @@ (* $Id$ *) +open Format + val max_printer_depth : int ref val max_printer_steps : int ref -val print_exception: Debugcom.Remote_value.t -> unit +val print_exception: formatter -> Debugcom.Remote_value.t -> unit val print_named_value : - int -> Parser_aux.expression -> - Debugcom.Remote_value.t -> Types.type_expr -> Env.t -> + int -> Parser_aux.expression -> Env.t -> + Debugcom.Remote_value.t -> formatter -> Types.type_expr -> unit val reset_named_values : unit -> unit val find_named_value : int -> Debugcom.Remote_value.t * Types.type_expr -val install_printer : Path.t -> Types.type_expr -> (Obj.t -> unit) -> unit +val install_printer : + Path.t -> Types.type_expr -> formatter -> (Obj.t -> unit) -> unit val remove_printer : Path.t -> unit diff --git a/debugger/show_information.ml b/debugger/show_information.ml index 65a6b7649..b2d89eddf 100644 --- a/debugger/show_information.ml +++ b/debugger/show_information.ml @@ -14,7 +14,7 @@ (* $Id$ *) open Instruct -open Formatmsg +open Format open Primitives open Debugcom open Checkpoints @@ -25,44 +25,41 @@ open Show_source open Breakpoints (* Display information about the current event. *) -let show_current_event () = - print_string "Time : "; print_int (current_time ()); +let show_current_event ppf = + fprintf ppf "Time : %i" (current_time ()); (match current_pc () with - Some pc -> - print_string " - pc : "; print_int pc + | Some pc -> + fprintf ppf " - pc : %i" pc | _ -> ()); update_current_event (); reset_frame (); match current_report () with - None -> - print_newline (); - print_string "Beginning of program."; print_newline (); + | None -> + fprintf ppf "@.Beginning of program.@."; show_no_point () | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} -> let (mdle, point) = current_point () in - print_string (" - module " ^ mdle); - print_newline (); + fprintf ppf " - module %s@." mdle; (match breakpoints_at_pc pc with - [] -> + | [] -> () | [breakpoint] -> - print_string "Breakpoint : "; print_int breakpoint; - print_newline () + fprintf ppf "Breakpoint : %i@." breakpoint | breakpoints -> - print_string "Breakpoints : "; - List.iter - (function x -> print_int x; print_string " ") - (Sort.list (<) breakpoints); - print_newline ()); + fprintf ppf "Breakpoints : %a@." + (fun ppf l -> + List.iter + (function x -> fprintf ppf "%i " x) l) + (Sort.list (<) breakpoints)); show_point mdle point (current_event_is_before ()) true | Some {rep_type = Exited} -> - print_newline (); print_string "Program exit."; print_newline (); + fprintf ppf "@.Program exit.@."; show_no_point () | Some {rep_type = Uncaught_exc} -> - printf "@.Program end.@."; - printf "@[Uncaught exception:@ "; + fprintf ppf + "@.Program end.@.\ + @[Uncaught exception:@ %a@]@." Printval.print_exception (Debugcom.Remote_value.accu ()); - printf"@]@."; show_no_point () | Some {rep_type = Trap_barrier} -> (* Trap_barrier not visible outside *) @@ -71,27 +68,27 @@ let show_current_event () = (* Display short information about one frame. *) -let show_one_frame framenum event = - printf "#%i Pc : %i %s char %i@." +let show_one_frame framenum ppf event = + fprintf ppf "#%i Pc : %i %s char %i@." framenum event.ev_pos event.ev_module event.ev_char (* Display information about the current frame. *) (* --- `select frame' must have succeded before calling this function. *) -let show_current_frame selected = +let show_current_frame ppf selected = match !selected_event with - None -> - printf "@.No frame selected.@." + | None -> + fprintf ppf "@.No frame selected.@." | Some sel_ev -> - show_one_frame !current_frame sel_ev; + show_one_frame !current_frame ppf sel_ev; begin match breakpoints_at_pc sel_ev.ev_pos with - [] -> - () + | [] -> () | [breakpoint] -> - printf "Breakpoint : %i@." breakpoint + fprintf ppf "Breakpoint : %i@." breakpoint | breakpoints -> - printf "Breakpoints : "; - List.iter (function x -> printf "%i " x) (Sort.list (<) breakpoints); - print_newline () + fprintf ppf "Breakpoints : %a@." + (fun ppf l -> + List.iter (function x -> fprintf ppf "%i " x) l) + (Sort.list (<) breakpoints); end; show_point sel_ev.ev_module sel_ev.ev_char (selected_event_is_before ()) selected diff --git a/debugger/show_information.mli b/debugger/show_information.mli index 68d099da2..3069f9332 100644 --- a/debugger/show_information.mli +++ b/debugger/show_information.mli @@ -13,12 +13,14 @@ (* $Id$ *) +open Format;; + (* Display information about the current event. *) -val show_current_event : unit -> unit;; +val show_current_event : formatter -> unit;; (* Display information about the current frame. *) (* --- `select frame' must have succeded before calling this function. *) -val show_current_frame : bool -> unit;; +val show_current_frame : formatter -> bool -> unit;; (* Display short information about one frame. *) -val show_one_frame : int -> Instruct.debug_event -> unit +val show_one_frame : int -> formatter -> Instruct.debug_event -> unit diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml index ec4f4079c..9de33ca5b 100644 --- a/debugger/unix_tools.ml +++ b/debugger/unix_tools.ml @@ -40,7 +40,7 @@ let convert_address address = (*** Report an unix error. ***) let report_error = function - Unix_error (err, fun_name, arg) -> + | Unix_error (err, fun_name, arg) -> prerr_string "Unix error : '"; prerr_string fun_name; prerr_string "' failed"; |