[m-rev.] diff: list functionality for ssdebug
Peter Wang
novalazy at gmail.com
Wed Jun 16 17:25:39 AEST 2010
Branches: main, 10.04
Add `list' functionality to ssdebug.
browser/listing.m:
Implement a version of `list_path' which doesn't use C foreign code.
Close opened streams in `list_path'. (not ssdebug related)
ssdb/ssdb.m:
Add commands `list', `list_path', `push_list_dir', `pop_list_dir',
`list_context_lines using the listing.m module. Unlike in mdb, `list'
prints the source code at the call site as that is the information we
currently have.
diff --git a/browser/listing.m b/browser/listing.m
index e6cff27..9347410 100644
--- a/browser/listing.m
+++ b/browser/listing.m
@@ -80,12 +80,21 @@
:- pred list_file(c_file_ptr::in, c_file_ptr::in, file_name::in, line_no::in,
line_no::in, line_no::in, search_path::in, io::di, io::uo) is det.
+ % As above, but implemented without foreign code. This is used by the
+ % source-to-source debugger which does not enable debugging in standard
+ % library so does not suffer the problem of excessive stack usage.
+ %
+:- pred list_file_portable(io.output_stream::in, io.output_stream::in,
+ file_name::in, line_no::in, line_no::in, line_no::in, search_path::in,
+ io::di, io::uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module dir.
+:- import_module int.
:- import_module maybe.
:- import_module type_desc.
@@ -150,8 +159,9 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
(
Result0 = ok(InStream),
InStrm = mercury_stream_to_c_FILE_star(InStream),
- print_lines_in_range(InStrm, OutStrm, 1, FirstLine, LastLine,
- MarkLine, !IO)
+ print_lines_in_range_c(InStrm, OutStrm, 1, FirstLine, LastLine,
+ MarkLine, !IO),
+ io.close_input(InStream, !IO)
;
Result0 = error(Error),
ErrorMsg = io.error_message(Error),
@@ -164,9 +174,11 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
;
find_and_open_file([dir.this_directory | Path], FileName, Result, !IO),
(
- Result = yes(InStrm),
- print_lines_in_range(InStrm, OutStrm, 1, FirstLine, LastLine,
- MarkLine, !IO)
+ Result = yes(InStream),
+ InStrm = mercury_stream_to_c_FILE_star(InStream),
+ print_lines_in_range_c(InStrm, OutStrm, 1, FirstLine, LastLine,
+ MarkLine, !IO),
+ io.close_input(InStream, !IO)
;
Result = no,
write_to_c_file(ErrStrm, "mdb: cannot find file ", !IO),
@@ -187,20 +199,54 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
%-----------------------------------------------------------------------------%
+list_file_portable(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
+ !IO) :-
+ ( dir.path_name_is_absolute(FileName) ->
+ io.open_input(FileName, Result0, !IO),
+ (
+ Result0 = ok(InStrm),
+ print_lines_in_range_m(InStrm, OutStrm, 1, FirstLine, LastLine,
+ MarkLine, !IO),
+ io.close_input(InStrm, !IO)
+ ;
+ Result0 = error(Error),
+ ErrorMsg = io.error_message(Error),
+ io.write_string(ErrStrm, "mdb: cannot open file ", !IO),
+ io.write_string(ErrStrm, FileName, !IO),
+ io.write_string(ErrStrm, ": ", !IO),
+ io.write_string(ErrStrm, ErrorMsg, !IO),
+ io.write_string(ErrStrm, "\n", !IO)
+ )
+ ;
+ find_and_open_file([dir.this_directory | Path], FileName, Result, !IO),
+ (
+ Result = yes(InStrm),
+ print_lines_in_range_m(InStrm, OutStrm, 1, FirstLine, LastLine,
+ MarkLine, !IO),
+ io.close_input(InStrm, !IO)
+ ;
+ Result = no,
+ io.write_string(ErrStrm, "mdb: cannot find file ", !IO),
+ io.write_string(ErrStrm, FileName, !IO),
+ io.write_string(ErrStrm, "\n", !IO)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
% Search for the first file with the given name on the search path
% that we can open for reading and return the complete file name
% (including the path component) and input stream handle.
%
:- pred find_and_open_file(search_path::in, file_name::in,
- maybe(c_file_ptr)::out, io::di, io::uo) is det.
+ maybe(io.input_stream)::out, io::di, io::uo) is det.
find_and_open_file([], _, no, !IO).
find_and_open_file([Dir | Path], FileName, Result, !IO) :-
io.open_input(Dir / FileName, Result0, !IO),
(
Result0 = ok(InStream),
- InStrm = mercury_stream_to_c_FILE_star(InStream),
- Result = yes(InStrm)
+ Result = yes(InStream)
;
Result0 = error(_),
find_and_open_file(Path, FileName, Result, !IO)
@@ -226,11 +272,11 @@ find_and_open_file([Dir | Path], FileName, Result, !IO) :-
% numbered MarkLine, if it occurs in the range FirstLine .. LastLine,
% which is indented with "> ".
%
-:- pred print_lines_in_range(c_file_ptr::in, c_file_ptr::in,
+:- pred print_lines_in_range_c(c_file_ptr::in, c_file_ptr::in,
line_no::in, line_no::in, line_no::in, line_no::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- print_lines_in_range(InStrm::in, OutStrm::in, ThisLine::in, FirstLine::in,
+ print_lines_in_range_c(InStrm::in, OutStrm::in, ThisLine::in, FirstLine::in,
LastLine::in, MarkLine::in, IO0::di, IO::uo),
[promise_pure, thread_safe, will_not_call_mercury],
"
@@ -259,4 +305,35 @@ find_and_open_file([Dir | Path], FileName, Result, !IO) :-
").
%-----------------------------------------------------------------------------%
+
+:- pred print_lines_in_range_m(io.input_stream::in, io.output_stream::in,
+ line_no::in, line_no::in, line_no::in, line_no::in, io::di, io::uo) is det.
+
+print_lines_in_range_m(InStrm, OutStrm, ThisLine, FirstLine, LastLine,
+ MarkLine, !IO) :-
+ io.read_line_as_string(InStrm, Res, !IO),
+ (
+ Res = ok(Line),
+ ( FirstLine =< ThisLine, ThisLine =< LastLine ->
+ ( ThisLine = MarkLine ->
+ io.write_string(OutStrm, "> ", !IO)
+ ;
+ io.write_string(OutStrm, " ", !IO)
+ ),
+ io.write_string(OutStrm, Line, !IO)
+ ;
+ true
+ ),
+ print_lines_in_range_m(InStrm, OutStrm, ThisLine + 1, FirstLine,
+ LastLine, MarkLine, !IO)
+ ;
+ Res = eof
+ ;
+ Res = error(Error),
+ io.write_string(OutStrm, "Error: ", !IO),
+ io.write_string(OutStrm, io.error_message(Error), !IO),
+ io.write_string(OutStrm, "\n", !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
diff --git a/ssdb/ssdb.m b/ssdb/ssdb.m
index c2cd0af..a621cec 100755
--- a/ssdb/ssdb.m
+++ b/ssdb/ssdb.m
@@ -124,6 +124,7 @@
:- import_module mdb.browse.
:- import_module mdb.browser_info.
:- import_module mdb.browser_term.
+:- import_module mdb.listing.
:- pragma foreign_decl("C",
"
@@ -167,6 +168,12 @@
sf_list_var_value :: list(var_value)
).
+:- type list_params
+ ---> list_params(
+ list_path :: listing.search_path,
+ list_context_lines :: int
+ ).
+
%----------------------------------------------------------------------------%
% Type used by the read_and_execute_cmd predicate to configure
@@ -279,6 +286,13 @@
init_browser_persistent_state = State :-
browser_info.init_persistent_state(State).
+:- mutable(list_params, list_params, init_list_params, ground,
+ [untrailed, attach_to_io_state]).
+
+:- func init_list_params = list_params.
+
+init_list_params = list_params(new_list_path, 2).
+
%-----------------------------------------------------------------------------%
:- mutable(tty_in, io.input_stream, io.stdin_stream, ground,
@@ -1172,9 +1186,7 @@ pred_catches_exceptions(ProcId) :-
%----------------------------------------------------------------------------%
:- type ssdb_cmd
- ---> ssdb_help
-
- ; ssdb_step
+ ---> ssdb_step
; ssdb_next
; ssdb_goto
; ssdb_continue
@@ -1196,21 +1208,24 @@ pred_catches_exceptions(ProcId) :-
; ssdb_format
; ssdb_format_param
+ ; ssdb_list
+ ; ssdb_list_path
+ ; ssdb_push_list_dir
+ ; ssdb_pop_list_dir
+ ; ssdb_list_context_lines
+
; ssdb_break
; ssdb_enable
; ssdb_disable
; ssdb_delete
+ ; ssdb_help
; ssdb_quit.
:- pred ssdb_cmd_name(string, ssdb_cmd).
:- mode ssdb_cmd_name(in, out) is semidet.
:- mode ssdb_cmd_name(out, in) is multi.
-ssdb_cmd_name("h", ssdb_help).
-ssdb_cmd_name("help", ssdb_help).
-ssdb_cmd_name("?", ssdb_help).
-
ssdb_cmd_name("s", ssdb_step).
ssdb_cmd_name("step", ssdb_step).
ssdb_cmd_name("n", ssdb_next).
@@ -1248,12 +1263,23 @@ ssdb_cmd_name("cur", ssdb_current).
ssdb_cmd_name("format", ssdb_format).
ssdb_cmd_name("format_param", ssdb_format_param).
+ssdb_cmd_name("list", ssdb_list).
+ssdb_cmd_name("l", ssdb_list).
+ssdb_cmd_name("list_path", ssdb_list_path).
+ssdb_cmd_name("push_list_dir", ssdb_push_list_dir).
+ssdb_cmd_name("pld", ssdb_push_list_dir).
+ssdb_cmd_name("pop_list_dir", ssdb_pop_list_dir).
+ssdb_cmd_name("list_context_lines", ssdb_list_context_lines).
+
ssdb_cmd_name("b", ssdb_break).
ssdb_cmd_name("break", ssdb_break).
ssdb_cmd_name("enable", ssdb_enable).
ssdb_cmd_name("disable", ssdb_disable).
ssdb_cmd_name("delete", ssdb_delete).
+ssdb_cmd_name("h", ssdb_help).
+ssdb_cmd_name("help", ssdb_help).
+ssdb_cmd_name("?", ssdb_help).
ssdb_cmd_name("q", ssdb_quit).
ssdb_cmd_name("quit", ssdb_quit).
@@ -1261,6 +1287,10 @@ ssdb_cmd_name("quit", ssdb_quit).
is semidet.
ssdb_cmd_name("P", ssdb_print, ["*"]).
+ssdb_cmd_name("depth", ssdb_format_param, ["depth"]).
+ssdb_cmd_name("lines", ssdb_format_param, ["lines"]).
+ssdb_cmd_name("size", ssdb_format_param, ["size"]).
+ssdb_cmd_name("width", ssdb_format_param, ["width"]).
%---------------------------------------------------------------------------%
@@ -1320,10 +1350,6 @@ read_and_execute_cmd(Event, Depth, WhatNext, !IO) :-
execute_cmd(Cmd, Args, Event, Depth, WhatNext, !IO) :-
(
- Cmd = ssdb_help,
- execute_ssdb_help(Args, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
Cmd = ssdb_step,
execute_ssdb_step(Args, Event, Depth, WhatNext, !IO)
;
@@ -1348,64 +1374,73 @@ execute_cmd(Cmd, Args, Event, Depth, WhatNext, !IO) :-
Cmd = ssdb_retry,
execute_ssdb_retry(Args, Event, Depth, WhatNext, !IO)
;
- Cmd = ssdb_stack,
- execute_ssdb_stack(Args, Depth, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_print,
- execute_ssdb_print(Args, Depth, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_browse,
- execute_ssdb_browse(Args, Depth, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_vars,
- execute_ssdb_vars(Args, Depth, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_down,
- execute_ssdb_down(Args, Depth, NewDepth, !IO),
- read_and_execute_cmd(Event, NewDepth, WhatNext, !IO)
- ;
- Cmd = ssdb_up,
- execute_ssdb_up(Args, Depth, NewDepth, !IO),
- read_and_execute_cmd(Event, NewDepth, WhatNext, !IO)
- ;
- Cmd = ssdb_level,
- execute_ssdb_level(Args, Depth, NewDepth, !IO),
+ (
+ Cmd = ssdb_down,
+ execute_ssdb_down(Args, Depth, NewDepth, !IO)
+ ;
+ Cmd = ssdb_up,
+ execute_ssdb_up(Args, Depth, NewDepth, !IO)
+ ;
+ Cmd = ssdb_level,
+ execute_ssdb_level(Args, Depth, NewDepth, !IO)
+ ),
read_and_execute_cmd(Event, NewDepth, WhatNext, !IO)
;
- Cmd = ssdb_current,
- execute_ssdb_current(Args, Event, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_format,
- execute_ssdb_format(Args, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_format_param,
- execute_ssdb_format_param(Args, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_break,
- execute_ssdb_break(Args, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_enable,
- execute_ssdb_enable(Args, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_disable,
- execute_ssdb_disable(Args, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_delete,
- execute_ssdb_delete(Args, !IO),
- read_and_execute_cmd(Event, Depth, WhatNext, !IO)
- ;
- Cmd = ssdb_quit,
- execute_ssdb_quit(Args, !IO),
+ (
+ Cmd = ssdb_stack,
+ execute_ssdb_stack(Args, Depth, !IO)
+ ;
+ Cmd = ssdb_print,
+ execute_ssdb_print(Args, Depth, !IO)
+ ;
+ Cmd = ssdb_browse,
+ execute_ssdb_browse(Args, Depth, !IO)
+ ;
+ Cmd = ssdb_vars,
+ execute_ssdb_vars(Args, Depth, !IO)
+ ;
+ Cmd = ssdb_current,
+ execute_ssdb_current(Args, Event, !IO)
+ ;
+ Cmd = ssdb_format,
+ execute_ssdb_format(Args, !IO)
+ ;
+ Cmd = ssdb_format_param,
+ execute_ssdb_format_param(Args, !IO)
+ ;
+ Cmd = ssdb_list,
+ execute_ssdb_list(Args, Depth, !IO)
+ ;
+ Cmd = ssdb_list_path,
+ execute_ssdb_list_path(Args, !IO)
+ ;
+ Cmd = ssdb_push_list_dir,
+ execute_ssdb_push_list_dir(Args, !IO)
+ ;
+ Cmd = ssdb_pop_list_dir,
+ execute_ssdb_pop_list_dir(Args, !IO)
+ ;
+ Cmd = ssdb_list_context_lines,
+ execute_ssdb_list_context_lines(Args, !IO)
+ ;
+ Cmd = ssdb_break,
+ execute_ssdb_break(Args, !IO)
+ ;
+ Cmd = ssdb_enable,
+ execute_ssdb_enable(Args, !IO)
+ ;
+ Cmd = ssdb_disable,
+ execute_ssdb_disable(Args, !IO)
+ ;
+ Cmd = ssdb_delete,
+ execute_ssdb_delete(Args, !IO)
+ ;
+ Cmd = ssdb_help,
+ execute_ssdb_help(Args, !IO)
+ ;
+ Cmd = ssdb_quit,
+ execute_ssdb_quit(Args, !IO)
+ ),
read_and_execute_cmd(Event, Depth, WhatNext, !IO)
).
@@ -2068,6 +2103,132 @@ format_param_setting([Word, ValueStr], Setting) :-
%-----------------------------------------------------------------------------%
+:- pred execute_ssdb_list(list(string)::in, int::in, io::di, io::uo) is det.
+
+execute_ssdb_list(Args, Depth, !IO) :-
+ (
+ Args = [],
+ get_list_params(Params, !IO),
+ ContextLines = Params ^ list_context_lines,
+ execute_ssdb_list_2(ContextLines, Depth, !IO)
+ ;
+ Args = [Arg],
+ (
+ string.to_int(Arg, ContextLines),
+ ContextLines >= 0
+ ->
+ execute_ssdb_list_2(ContextLines, Depth, !IO)
+ ;
+ io.write_string("ssdb: invalid argument.\n", !IO)
+ )
+ ;
+ Args = [_, _ | _],
+ io.write_string("ssdb: too many arguments.\n", !IO)
+ ).
+
+:- pred execute_ssdb_list_2(int::in, int::in, io::di, io::uo) is det.
+
+execute_ssdb_list_2(ContextLines, Depth, !IO) :-
+ stack_index(Depth, StackFrame, !IO),
+ FileName = StackFrame ^ sf_call_site_file,
+ MarkLine = StackFrame ^ sf_call_site_line,
+ ( FileName = "" ->
+ io.write_string("ssdb: sorry, call site is unknown.\n", !IO)
+ ;
+ FirstLine = int.max(0, MarkLine - ContextLines),
+ LastLine = MarkLine + ContextLines,
+ io.stdout_stream(StdOut, !IO),
+ io.stderr_stream(StdErr, !IO),
+ get_list_params(Params, !IO),
+ ListPath = Params ^ list_path,
+ list_file_portable(StdOut, StdErr, FileName, FirstLine, LastLine,
+ MarkLine, ListPath, !IO)
+ ).
+
+:- pred execute_ssdb_list_path(list(string)::in, io::di, io::uo) is det.
+
+execute_ssdb_list_path(Args, !IO) :-
+ (
+ Args = [],
+ get_list_params(Params, !IO),
+ Dirs = get_list_path(Params ^ list_path),
+ (
+ Dirs = [],
+ io.write_string("Context search path is empty\n", !IO)
+ ;
+ Dirs = [_ | _],
+ io.write_string("Context search path: ", !IO),
+ io.write_list(Dirs, " ", io.write_string, !IO),
+ io.nl(!IO)
+ )
+ ;
+ Args = [_ | _],
+ get_list_params(Params0, !IO),
+ ListPath0 = Params0 ^ list_path,
+ set_list_path(Args, ListPath0, ListPath),
+ Params = Params0 ^ list_path := ListPath,
+ set_list_params(Params, !IO)
+ ).
+
+:- pred execute_ssdb_push_list_dir(list(string)::in, io::di, io::uo) is det.
+
+execute_ssdb_push_list_dir(Args, !IO) :-
+ (
+ Args = [],
+ io.write_string("ssdb: command expects arguments.\n", !IO)
+ ;
+ Args = [_ | _],
+ get_list_params(Params0, !IO),
+ ListPath0 = Params0 ^ list_path,
+ list.foldr(push_list_path, Args, ListPath0, ListPath),
+ Params = Params0 ^ list_path := ListPath,
+ set_list_params(Params, !IO)
+ ).
+
+:- pred execute_ssdb_pop_list_dir(list(string)::in, io::di, io::uo) is det.
+
+execute_ssdb_pop_list_dir(Args, !IO) :-
+ (
+ Args = [],
+ get_list_params(Params0, !IO),
+ ListPath0 = Params0 ^ list_path,
+ pop_list_path(ListPath0, ListPath),
+ Params = Params0 ^ list_path := ListPath,
+ set_list_params(Params, !IO)
+ ;
+ Args = [_ | _],
+ io.write_string("ssdb: unexpected argument.\n", !IO)
+ ).
+
+:- pred execute_ssdb_list_context_lines(list(string)::in, io::di, io::uo)
+ is det.
+
+execute_ssdb_list_context_lines(Args, !IO) :-
+ (
+ Args = [],
+ get_list_params(Params, !IO),
+ Lines = Params ^ list_context_lines,
+ io.format("Printing %d lines around each context listing.\n",
+ [i(Lines)], !IO)
+ ;
+ Args = [Arg],
+ (
+ string.to_int(Arg, N),
+ N >= 0
+ ->
+ get_list_params(Params0, !IO),
+ Params = Params0 ^ list_context_lines := N,
+ set_list_params(Params, !IO)
+ ;
+ io.write_string("ssdb: invalid argument.\n", !IO)
+ )
+ ;
+ Args = [_, _ | _],
+ io.write_string("ssdb: too many arguments.\n", !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred execute_ssdb_break(list(string)::in, io::di, io::uo) is det.
execute_ssdb_break(Args, !IO) :-
@@ -2704,6 +2865,10 @@ print_help(!IO) :-
"current (cur)",
"format [-APB] flat|raw_pretty|pretty|verbose",
"format_param [-APBfpv] depth|size|width|lines NUM",
+ "list [NUM] (l)",
+ "list_path [DIR ...]",
+ "push_list_dir DIR ... (pld)",
+ "pop_list_dir",
"break MODULE PRED (b)",
"break info",
"enable NUM|*",
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list