[m-rev.] for review: Let mdb run an external command for 'list'.
Peter Wang
novalazy at gmail.com
Fri Oct 2 13:59:11 AEST 2020
browser/listing.m
Add list_file_with_command which calls an external command to print
source listings instead of doing it internally. The implementation
is incomplete in that the external command's standard output and
standard error streams are not redirected into OutStrm and ErrStrm.
trace/mercury_trace_cmd_parameter.c:
trace/mercury_trace_cmd_parameter.h:
trace/mercury_trace_internal.c:
Add a 'list_cmd' command which sets or prints the current
external listing command.
trace/mercury_trace_cmd_browsing.c:
Make 'list' command call list_file_with_command if an external
listing command was set.
doc/user_guide.texi:
Document 'list_cmd' command.
NEWS:
Announce changes.
---
NEWS | 8 +++
browser/listing.m | 97 ++++++++++++++++++++++++++---
doc/user_guide.texi | 15 +++++
trace/mercury_trace_cmd_browsing.c | 18 ++++--
trace/mercury_trace_cmd_parameter.c | 30 +++++++++
trace/mercury_trace_cmd_parameter.h | 5 +-
trace/mercury_trace_internal.c | 2 +
7 files changed, 162 insertions(+), 13 deletions(-)
diff --git a/NEWS b/NEWS
index 6e8946f29..6fe80dc9c 100644
--- a/NEWS
+++ b/NEWS
@@ -131,6 +131,14 @@ Changes to the Mercury compiler
keep opt1 enabled even if opt1 is not normally enabled at optimization
level N.
+Changes to the Mercury implementation
+-------------------------------------
+
+* The `list` command in mdb (the Mercury debugger) may now call an external
+ command to print source listings; the command is set using `list_cmd`.
+ For example, the command could produce syntax highlighted source listings.
+
+
NEWS for Mercury 20.06.1
========================
diff --git a/browser/listing.m b/browser/listing.m
index c62ff855a..8c79ebd47 100644
--- a/browser/listing.m
+++ b/browser/listing.m
@@ -86,6 +86,21 @@
file_name::in, line_no::in, line_no::in, line_no::in, search_path::in,
io::di, io::uo) is det.
+ % list_file_with_command(OutStrm, ErrStrm, FileName, FirstLine, LastLine,
+ % MarkLine, Path, !IO):
+ %
+ % Like list_file, but invokes an external command to print the source
+ % listing. The command is passed the four arguments:
+ %
+ % FileName, FirstLine, LastLine, MarkLine
+ %
+ % It should produce output on standard output, and report errors on
+ % standard error.
+ %
+:- pred list_file_with_command(c_file_ptr::in, c_file_ptr::in, string::in,
+ file_name::in, line_no::in, line_no::in, line_no::in, search_path::in,
+ io::di, io::uo) is det.
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -94,6 +109,7 @@
:- import_module dir.
:- import_module int.
:- import_module maybe.
+:- import_module string.
:- import_module type_desc.
%---------------------------------------------------------------------------%
@@ -122,6 +138,8 @@
"ML_LISTING_pop_list_path").
:- pragma foreign_export("C", list_file(in, in, in, in, in, in, in, di, uo),
"ML_LISTING_list_file").
+:- pragma foreign_export("C", list_file_with_command(in, in, in, in, in, in,
+ in, in, di, uo), "ML_LISTING_list_file_with_command").
:- func listing_type = type_desc.
:- pragma foreign_export("C", listing_type = out, "ML_LISTING_listing_type").
@@ -187,6 +205,15 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
)
).
+:- func mercury_stream_to_c_FILE_star(io.input_stream) = c_file_ptr.
+
+:- pragma foreign_proc("C",
+ mercury_stream_to_c_FILE_star(InStream::in) = (InStrm::out),
+ [promise_pure, thread_safe, will_not_call_mercury],
+"
+ InStrm = MR_file(*(MR_unwrap_input_stream(InStream)));
+").
+
:- pred write_to_c_file(c_file_ptr::in, string::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
@@ -231,6 +258,56 @@ list_file_portable(OutStrm, ErrStrm, FileName, FirstLine, LastLine,
)
).
+%---------------------------------------------------------------------------%
+
+list_file_with_command(OutStrm, ErrStrm, Command, FileName, FirstLine,
+ LastLine, MarkLine, Path, !IO) :-
+ LineArgs = [string.from_int(FirstLine), string.from_int(LastLine),
+ string.from_int(MarkLine)],
+ ( if dir.path_name_is_absolute(FileName) then
+ FindResult = yes(FileName)
+ else
+ find_file([dir.this_directory | Path], FileName, FindResult, !IO)
+ ),
+ (
+ FindResult = yes(FoundFileName),
+ execute_command(OutStrm, ErrStrm, Command, [FoundFileName | LineArgs],
+ CallResult, !IO),
+ (
+ CallResult = ok
+ ;
+ CallResult = error(Error),
+ write_to_c_file(ErrStrm, "mdb: error running command: ", !IO),
+ write_to_c_file(ErrStrm, Error, !IO),
+ write_to_c_file(ErrStrm, "\n", !IO)
+ )
+ ;
+ FindResult = no,
+ write_to_c_file(ErrStrm, "mdb: cannot find file ", !IO),
+ write_to_c_file(ErrStrm, FileName, !IO),
+ write_to_c_file(ErrStrm, "\n", !IO)
+ ).
+
+:- pred execute_command(c_file_ptr::in, c_file_ptr::in, string::in,
+ list(string)::in, maybe_error::out, io::di, io::uo) is det.
+
+execute_command(_OutStrm, _ErrStrm, Command, Args, Result, !IO) :-
+ % XXX use posix_spawn to avoid shell meta characters
+ % XXX use posix_spawn to redirect 1>OutStrm 2>ErrStrm
+ CommandString = string.join_list(" ", [Command | Args]),
+ io.call_system(CommandString, CallResult, !IO),
+ (
+ CallResult = ok(ExitStatus),
+ ( if ExitStatus = 0 then
+ Result = ok
+ else
+ Result = error("exit status " ++ string.from_int(ExitStatus))
+ )
+ ;
+ CallResult = error(Error),
+ Result = error(io.error_message(Error))
+ ).
+
%---------------------------------------------------------------------------%
% Search for the first file with the given name on the search path
@@ -251,14 +328,20 @@ find_and_open_file([Dir | Path], FileName, Result, !IO) :-
find_and_open_file(Path, FileName, Result, !IO)
).
-:- func mercury_stream_to_c_FILE_star(io.input_stream) = c_file_ptr.
+:- pred find_file(search_path::in, file_name::in, maybe(file_name)::out,
+ io::di, io::uo) is det.
-:- pragma foreign_proc("C",
- mercury_stream_to_c_FILE_star(InStream::in) = (InStrm::out),
- [promise_pure, thread_safe, will_not_call_mercury],
-"
- InStrm = MR_file(*(MR_unwrap_input_stream(InStream)));
-").
+find_file([], _, no, !IO).
+find_file([Dir | Path], FileName0, Result, !IO) :-
+ FileName = Dir / FileName0,
+ io.check_file_accessibility(FileName, [read], AccessRes, !IO),
+ (
+ AccessRes = ok,
+ Result = yes(FileName)
+ ;
+ AccessRes = error(_),
+ find_file(Path, FileName0, Result, !IO)
+ ).
%---------------------------------------------------------------------------%
diff --git a/doc/user_guide.texi b/doc/user_guide.texi
index d11d82b1d..eebd30ad7 100644
--- a/doc/user_guide.texi
+++ b/doc/user_guide.texi
@@ -4112,6 +4112,21 @@ on to the search path consulted by the @samp{list} command.
Pops the leftmost (most recently pushed) directory
from the search path consulted by the @samp{list} command.
@sp 1
+ at item list_cmd @var{command}
+ at kindex list_cmd (mdb command)
+Sets an external command to be executed by the @samp{list} command.
+The command will be called with four arguments:
+the source file name,
+the first line number (counting from 1),
+the last line number,
+the current line number.
+The command should print the lines within the range given
+to standard output, and report any errors to standard error.
+ at sp 1
+ at item list_cmd
+When invoked without arguments, the @samp{list_cmd} command
+prints the last value set by the @samp{list_cmd} command.
+ at sp 1
@item fail_trace_counts @var{filename}
@kindex fail_trace_counts (mdb command)
The declarative debugger can exploit information
diff --git a/trace/mercury_trace_cmd_browsing.c b/trace/mercury_trace_cmd_browsing.c
index 531acbe60..0341c214d 100644
--- a/trace/mercury_trace_cmd_browsing.c
+++ b/trace/mercury_trace_cmd_browsing.c
@@ -1,7 +1,7 @@
// vim: ts=4 sw=4 expandtab ft=c
// Copyright (C) 1998-2008,2010,2012 The University of Melbourne.
-// Copyright (C) 2017-2018 The Mercury team.
+// Copyright (C) 2017-2018, 2020 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
// This module implements the mdb commands in the "browsing" category.
@@ -923,10 +923,18 @@ MR_trace_cmd_list(char **words, int word_count,
MR_make_aligned_string(aligned_filename, (MR_String) filename);
);
- MR_TRACE_CALL_MERCURY(
- ML_LISTING_list_file(MR_mdb_out, MR_mdb_err, (char *) aligned_filename,
- lineno - num, lineno + num, lineno, MR_listing_path);
- );
+ if (MR_listing_cmd != NULL && strlen(MR_listing_cmd) > 0) {
+ MR_TRACE_CALL_MERCURY(
+ ML_LISTING_list_file_with_command(MR_mdb_out, MR_mdb_err,
+ MR_listing_cmd, (char *) aligned_filename,
+ lineno - num, lineno + num, lineno, MR_listing_path);
+ );
+ } else {
+ MR_TRACE_CALL_MERCURY(
+ ML_LISTING_list_file(MR_mdb_out, MR_mdb_err, (char *) aligned_filename,
+ lineno - num, lineno + num, lineno, MR_listing_path);
+ );
+ }
return KEEP_INTERACTING;
}
diff --git a/trace/mercury_trace_cmd_parameter.c b/trace/mercury_trace_cmd_parameter.c
index 3a6a7c930..da105aa6c 100644
--- a/trace/mercury_trace_cmd_parameter.c
+++ b/trace/mercury_trace_cmd_parameter.c
@@ -61,6 +61,8 @@ MR_Word MR_listing_path;
MR_Unsigned MR_num_context_lines = 2;
+char *MR_listing_cmd = NULL;
+
MR_SpyWhen MR_default_breakpoint_scope = MR_SPY_INTERFACE;
////////////////////////////////////////////////////////////////////////////
@@ -582,6 +584,34 @@ MR_trace_cmd_pop_list_dir(char **words, int word_count,
return KEEP_INTERACTING;
}
+MR_Next
+MR_trace_cmd_list_cmd(char **words, int word_count,
+ MR_TraceCmdInfo *cmd, MR_EventInfo *event_info, MR_Code **jumpaddr)
+{
+ if (word_count == 2) {
+ char *copied_value;
+ char *aligned_value;
+
+ copied_value = (char *) MR_GC_malloc(strlen(words[1]) + 1);
+ strcpy(copied_value, words[1]);
+ MR_TRACE_USE_HP(
+ MR_make_aligned_string(aligned_value, copied_value);
+ );
+ MR_listing_cmd = aligned_value;
+ } else if (word_count == 1) {
+ if (MR_listing_cmd != NULL && strlen(MR_listing_cmd) > 0) {
+ fprintf(MR_mdb_out, "The external listing command is %s\n",
+ MR_listing_cmd);
+ } else {
+ fprintf(MR_mdb_out, "The external listing command has not been set.\n");
+ }
+ } else {
+ MR_trace_usage_cur_cmd();
+ }
+
+ return KEEP_INTERACTING;
+}
+
MR_Next
MR_trace_cmd_fail_trace_counts(char **words, int word_count,
MR_TraceCmdInfo *cmd, MR_EventInfo *event_info, MR_Code **jumpaddr)
diff --git a/trace/mercury_trace_cmd_parameter.h b/trace/mercury_trace_cmd_parameter.h
index fdc905b4b..261227e06 100644
--- a/trace/mercury_trace_cmd_parameter.h
+++ b/trace/mercury_trace_cmd_parameter.h
@@ -1,7 +1,7 @@
// vim: ts=4 sw=4 expandtab ft=c
// Copyright (C) 1998-2007 The University of Melbourne.
-// Copyright (C) 2017-2018 The Mercury team.
+// Copyright (C) 2017-2018, 2020 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
#ifndef MERCURY_TRACE_CMD_PARAMETER_H
@@ -84,6 +84,8 @@ extern void MR_trace_listing_path_ensure_init(void);
extern MR_Unsigned MR_num_context_lines;
+extern char * MR_listing_cmd;
+
extern MR_SpyWhen MR_default_breakpoint_scope;
extern MR_TraceCmdFunc MR_trace_cmd_mmc_options;
@@ -99,6 +101,7 @@ extern MR_TraceCmdFunc MR_trace_cmd_list_context_lines;
extern MR_TraceCmdFunc MR_trace_cmd_list_path;
extern MR_TraceCmdFunc MR_trace_cmd_push_list_dir;
extern MR_TraceCmdFunc MR_trace_cmd_pop_list_dir;
+extern MR_TraceCmdFunc MR_trace_cmd_list_cmd;
extern MR_TraceCmdFunc MR_trace_cmd_fail_trace_counts;
extern MR_TraceCmdFunc MR_trace_cmd_pass_trace_counts;
extern MR_TraceCmdFunc MR_trace_cmd_max_io_actions;
diff --git a/trace/mercury_trace_internal.c b/trace/mercury_trace_internal.c
index 808b0f71d..1845ae047 100644
--- a/trace/mercury_trace_internal.c
+++ b/trace/mercury_trace_internal.c
@@ -1556,6 +1556,8 @@ static const MR_TraceCmdTableEntry MR_trace_command_table[] =
NULL, MR_trace_null_completer },
{ "parameter", "pop_list_dir", MR_trace_cmd_pop_list_dir,
NULL, MR_trace_null_completer },
+ { "parameter", "list_cmd", MR_trace_cmd_list_cmd,
+ NULL, MR_trace_null_completer },
{ "parameter", "fail_trace_counts", MR_trace_cmd_fail_trace_counts,
NULL, MR_trace_filename_completer },
{ "parameter", "pass_trace_counts", MR_trace_cmd_pass_trace_counts,
--
2.28.0
More information about the reviews
mailing list