mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 09:23:44 +00:00
Code Issues Projects Releases Wiki Activity

Let mdb run an external command for 'list'.

Browse Source 
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.

    Rename mercury_stream_to_c_FILE_star to
    mercury_stream_to_c_file_ptr.

    Consolidate some output calls with string.format.

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.

tests/debugger/completion.exp:
tests/debugger/mdb_command_test.inp:
    Update for new command.

NEWS:
    Announce changes.
This commit is contained in:
Peter Wang
2020-10-02 16:05:41 +10:00
parent b55c2ad6a8
commit a22e973025
9 changed files with 241 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
NEWS
View File

@@ -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
========================

135
browser/listing.m
View File

@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2005-2007, 2010-2011 The University of Melbourne.
% Copyright (C) 2015, 2017-2018 The Mercury team.
% Copyright (C) 2015, 2017-2018, 2020 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
@@ -86,14 +86,32 @@
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
%
% The command should print all the lines from the first to the last,
% both inclusive, with the current line marked (or highlighted) in
% some fashion to standard output, and report any errors to 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.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
:- import_module dir.
:- import_module int.
:- import_module maybe.
:- import_module string.
:- import_module type_desc.
%---------------------------------------------------------------------------%
@@ -122,6 +140,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").
@@ -158,35 +178,42 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
io.open_input(FileName, Result0, !IO),
(
Result0 = ok(InStream),
InStrm = mercury_stream_to_c_FILE_star(InStream),
InStrm = mercury_stream_to_c_file_ptr(InStream),
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),
write_to_c_file(ErrStrm, "mdb: cannot open file ", !IO),
write_to_c_file(ErrStrm, FileName, !IO),
write_to_c_file(ErrStrm, ": ", !IO),
write_to_c_file(ErrStrm, ErrorMsg, !IO),
write_to_c_file(ErrStrm, "\n", !IO)
write_to_c_file(ErrStrm,
string.format("mdb: cannot open file %s: %s\n",
[s(FileName), s(ErrorMsg)]), !IO)
)
else
find_and_open_file([dir.this_directory | Path], FileName, Result, !IO),
(
Result = yes(InStream),
InStrm = mercury_stream_to_c_FILE_star(InStream),
InStrm = mercury_stream_to_c_file_ptr(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),
write_to_c_file(ErrStrm, FileName, !IO),
write_to_c_file(ErrStrm, "\n", !IO)
write_to_c_file(ErrStrm,
string.format("mdb: cannot find file %s\n",
[s(FileName)]), !IO)
)
).
:- func mercury_stream_to_c_file_ptr(io.input_stream) = c_file_ptr.
:- pragma foreign_proc("C",
mercury_stream_to_c_file_ptr(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,54 @@ 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,
string.format("mdb: %s: %s\n", [s(Command), s(Error)]), !IO)
)
;
FindResult = no,
write_to_c_file(ErrStrm,
string.format("mdb: cannot find file %s\n", [s(FileName)]), !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 +326,38 @@ 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,
FollowSymLinks = yes,
io.file_type(FollowSymLinks, FileName, FileTypeRes, !IO),
(
FileTypeRes = ok(FileType),
(
( FileType = regular_file
; FileType = symbolic_link
; FileType = named_pipe
; FileType = socket
; FileType = character_device
; FileType = block_device
; FileType = message_queue
; FileType = semaphore
; FileType = shared_memory
; FileType = unknown
),
Result = yes(FileName)
;
FileType = directory,
% It is debatable whether we should continue searching.
find_file(Path, FileName0, Result, !IO)
)
;
FileTypeRes = error(_),
find_file(Path, FileName0, Result, !IO)
).
%---------------------------------------------------------------------------%

20
doc/user_guide.texi
View File

@@ -4112,6 +4112,26 @@ 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
@item list_cmd @var{ExternalCommand}
@kindex list_cmd (mdb command)
Tells mdb that all future @samp{list} commands should be handled by
@var{ExternalCommand}.
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 all the lines from the first to the last,
both inclusive, with the current line marked (or highlighted) in some fashion
to standard output, and report any errors to standard error.
@sp 1
If @var{ExternalCommand} is @samp{none} then the @samp{list} command
will revert to printing source listings internally.
@sp 1
@item list_cmd
When invoked without arguments, the @samp{list_cmd} command
prints the last value set by the @samp{list_cmd} command.
@sp 1
@item fail_trace_counts @var{filename}
@kindex fail_trace_counts (mdb command)
The declarative debugger can exploit information

82
tests/debugger/completion.exp
View File

@@ -3,47 +3,47 @@ mdb> echo on
Command echo enabled.
mdb> register --quiet
mdb>
! fail_trace_counts query
? finish quit
P flag r
alias format register
all_class_decls format_param retry
all_procedures forward return
all_regs g s
all_type_ctors gen_stack save
ambiguity goal_paths scope
b goto scroll
break grep shell
break_print h source
browse held_vars stack
c help stack_default_limit
cc_query histogram_all stack_regs
class_decl histogram_exp stats
clear_histogram hold step
condition ignore subgoal
consumer io_query table
context level table_io
continue list term_size
current list_context_lines track
cut_stack list_path trail_details
d max_io_actions trust
dd maxdepth trusted
debug_vars mindepth type_ctor
delete mm_stacks unalias
dice mmc_options unhide_events
diff modules untrust
disable next up
document nondet_stack user
document_category open user_event_context
down p v
dump pass_trace_counts var_details
e pneg_stack vars
echo pop_list_dir view
enable print web_browser_cmd
exception print_optionals xml_browser_cmd
excp printlevel xml_tmp_filename
f procedures
fail push_list_dir
! fail_trace_counts push_list_dir
? finish query
P flag quit
alias format r
all_class_decls format_param register
all_procedures forward retry
all_regs g return
all_type_ctors gen_stack s
ambiguity goal_paths save
b goto scope
break grep scroll
break_print h shell
browse held_vars source
c help stack
cc_query histogram_all stack_default_limit
class_decl histogram_exp stack_regs
clear_histogram hold stats
condition ignore step
consumer io_query subgoal
context level table
continue list table_io
current list_cmd term_size
cut_stack list_context_lines track
d list_path trail_details
dd max_io_actions trust
debug_vars maxdepth trusted
delete mindepth type_ctor
dice mm_stacks unalias
diff mmc_options unhide_events
disable modules untrust
document next up
document_category nondet_stack user
down open user_event_context
dump p v
e pass_trace_counts var_details
echo pneg_stack vars
enable pop_list_dir view
exception print web_browser_cmd
excp print_optionals xml_browser_cmd
f printlevel xml_tmp_filename
fail procedures
h help histogram_exp
held_vars histogram_all hold
var_details vars view

1
tests/debugger/mdb_command_test.inp
View File

@@ -75,6 +75,7 @@ list_context_lines xyzzy xyzzy xyzzy xyzzy xyzzy
list_path xyzzy xyzzy xyzzy xyzzy xyzzy
push_list_dir xyzzy xyzzy xyzzy xyzzy xyzzy
pop_list_dir xyzzy xyzzy xyzzy xyzzy xyzzy
list_cmd xyzzy xyzzy xyzzy xyzzy xyzzy
fail_trace_counts xyzzy xyzzy xyzzy xyzzy xyzzy
pass_trace_counts xyzzy xyzzy xyzzy xyzzy xyzzy
max_io_actions xyzzy xyzzy xyzzy xyzzy xyzzy

18
trace/mercury_trace_cmd_browsing.c
View File

@@ -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;
}

36
trace/mercury_trace_cmd_parameter.c
View File

@@ -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.
// This module implements the mdb commands in the "parameter" category.
@@ -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,38 @@ 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) {
if (MR_streq(words[1], "none")) {
MR_listing_cmd = NULL;
} else {
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, "No external listing command has 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)

5
trace/mercury_trace_cmd_parameter.h
View File

@@ -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;

2
trace/mercury_trace_internal.c
View File

@@ -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,