[m-rev.] for review: Added trust command to mdb
Ian MacLarty
maclarty at cs.mu.OZ.AU
Tue Jun 8 16:05:23 AEST 2004
For review by Zoltan
Estimated hours taken: 35
Branches: main
Added a `trust' command to mdb which tells the declarative debugger to assume
all procedures in a given module are correct.
browser/declarative_debugger.m
Added function which finds out the atom a given question relates to.
Exported a add_trusted_module predicate so modules can be added from
c code (used by trace/mercury_trace_declarative.c).
browser/declarative_execution.m
Add module_name field to the atom constructor for the trace_atom type.
Made necessary changes to predicates that expected 3 fields for the
atom constructor for the trace_atom type.
browser/declarative_oracle.m
Added a set of trusted module names to the oracle_state type.
browser/declarative_tree.m
Updated various predicates that expected the atom constructor to have
3 fields where now it has 4.
browser/declarative_user.m
Updated various predicates that expected the atom constructor to have
3 fields where now it has 4.
trace/mercury_trace_declarative.h
Added MR_decl_add_trusted_module function to add a module to the set of
trusted modules for the currect diagnoser.
trace/mercury_trace_declarative.c
Implemented the MR_decl_add_trusted_module function. This calls
MR_trace_decl_ensure_init to make sure the diagnoser is initialised
first.
Changed the MR_decl_make_atom function to include the module name
when constructing an atom.
Added MR_decl_atom_name_and_module function which extracts the proc
name and module from a MR_Proc_Layout. This replaces the
MR_decl_atom_name function which just extracted the name. This
function will also extract the name and module of user defined equality
and comparison predicates.
trace/mercury_trace_internal.c
Added MR_trace_cmd_trust function to add a trusted module to the
current diagnoser when the user issues a `trust' command.
doc/mdb_categories
Added `trust' command to misc category (will need to make a declarative
category when there are more commands).
doc/user_guide.texi
Added some help text for the `trust' command.
tests/debugger/mdb_command_test.inp
Added `trust' command to list of tests.
tests/debugger/declarative/Mmakefile
Added calls to the trust.m program to test the `trust' command.
tests/debugger/declarative/trust.m
Test program for the `trust' command. This imports 2 modules in the
and calls a user-defined comparison predicate from the one module and
a normal predicate from the other.
tests/debugger/declarative/trust_1.m
Imported by trust.m. Defines a new type and a user-defined comparison
predicate on the type.
tests/debugger/declarative/trust_2.m
Also imported by trust.m. Defines a predicate using the type defined
in trust_1.m.
tests/debugger/declarative/trust.inp
Input to mdb to test the `trust' command. Contains commands to tell
mdb to trust the trust_1 and trust_2 modules.
tests/debugger/declarative/trust.exp
Expected output of mdb when running trust with trust.inp as input.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.36
diff -u -r1.36 declarative_debugger.m
--- browser/declarative_debugger.m 27 Oct 2003 06:00:31 -0000 1.36
+++ browser/declarative_debugger.m 4 Jun 2004 06:20:35 -0000
@@ -161,6 +161,10 @@
%
:- func get_decl_question_node(decl_question(T)) = T.
+ % Get the atom the question relates to.
+ %
+:- func get_decl_question_atom(decl_question(_)) = trace_atom.
+
:- type some_decl_atom
---> init(init_decl_atom)
; final(final_decl_atom).
@@ -263,6 +267,11 @@
get_decl_question_node(missing_answer(Node, _, _)) = Node.
get_decl_question_node(unexpected_exception(Node, _, _)) = Node.
+get_decl_question_atom(wrong_answer(_, final_decl_atom(Atom, _))) = Atom.
+get_decl_question_atom(missing_answer(_, init_decl_atom(Atom), _)) = Atom.
+get_decl_question_atom(unexpected_exception(_, init_decl_atom(Atom), _)) =
+ Atom.
+
%-----------------------------------------------------------------------------%
:- type diagnoser_state(R)
@@ -502,6 +511,22 @@
"MR_DD_diagnoser_require_subtree").
diagnoser_require_subtree(require_subtree(Event, SeqNo), Event, SeqNo).
+
+%-----------------------------------------------------------------------------%
+
+ % Adds a trusted module to the given diagnoser.
+ %
+:- pred add_trusted_module(string::in, diagnoser_state(trace_node_id)::in,
+ diagnoser_state(trace_node_id)::out) is det.
+
+:- pragma export(add_trusted_module(in, in, out),
+ "MR_DD_decl_add_trusted_module").
+
+add_trusted_module(ModuleName, OldDiagnoserState,
+ OldDiagnoserState ^ oracle_state :=
+ mdb.declarative_oracle.add_trusted_module(ModuleName,
+ OldDiagnoserState ^ oracle_state)
+).
%-----------------------------------------------------------------------------%
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.23
diff -u -r1.23 declarative_execution.m
--- browser/declarative_execution.m 27 Oct 2003 06:00:31 -0000 1.23
+++ browser/declarative_execution.m 3 Jun 2004 05:43:18 -0000
@@ -177,6 +177,10 @@
---> atom(
pred_or_func :: pred_or_func,
+ module_name ::string,
+ % The module in which the
+ % procedure was declared.
+
proc_name :: string,
% Procedure name.
%
@@ -975,12 +979,12 @@
private_builtin__sorry("null_trace_node_id").
-:- func construct_trace_atom(pred_or_func, string, int) = trace_atom.
-:- pragma export(construct_trace_atom(in, in, in) = out,
+:- func construct_trace_atom(pred_or_func, string, string, int) = trace_atom.
+:- pragma export(construct_trace_atom(in, in, in, in) = out,
"MR_DD_construct_trace_atom").
-construct_trace_atom(PredOrFunc, Functor, Arity) = Atom :-
- Atom = atom(PredOrFunc, Functor, Args),
+construct_trace_atom(PredOrFunc, ModuleName, Functor, Arity) = Atom :-
+ Atom = atom(PredOrFunc, ModuleName, Functor, Args),
list__duplicate(Arity, dummy_arg_info, Args).
% add_trace_atom_arg_value(Atom0, ArgNum, HldsNum, ProgVis, Val):
@@ -992,8 +996,8 @@
:- pragma export(add_trace_atom_arg_value(in, in, in, in, in) = out,
"MR_DD_add_trace_atom_arg_value").
-add_trace_atom_arg_value(atom(C, F, Args0), ArgNum, HldsNum, ProgVis, Val)
- = atom(C, F, Args) :-
+add_trace_atom_arg_value(atom(C, M, F, Args0), ArgNum, HldsNum, ProgVis, Val)
+ = atom(C, M, F, Args) :-
Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, yes(Val)),
list__replace_nth_det(Args0, ArgNum, Arg, Args).
@@ -1003,8 +1007,8 @@
:- pragma export(add_trace_atom_arg_no_value(in, in, in, in) = out,
"MR_DD_add_trace_atom_arg_no_value").
-add_trace_atom_arg_no_value(atom(C, F, Args0), ArgNum, HldsNum, ProgVis)
- = atom(C, F, Args) :-
+add_trace_atom_arg_no_value(atom(C, M, F, Args0), ArgNum, HldsNum, ProgVis)
+ = atom(C, M, F, Args) :-
Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, no),
list__replace_nth_det(Args0, ArgNum, Arg, Args).
@@ -1170,7 +1174,7 @@
list__index1_det(Args, N, Arg).
absolute_arg_num(any_head_var(ArgNum), _, ArgNum).
-absolute_arg_num(user_head_var(N), atom(_, _, Args), ArgNum) :-
+absolute_arg_num(user_head_var(N), atom(_, _, _, Args), ArgNum) :-
head_var_num_to_arg_num(Args, N, 1, ArgNum).
:- pred head_var_num_to_arg_num(list(trace_atom_arg)::in, int::in, int::in,
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.20
diff -u -r1.20 declarative_oracle.m
--- browser/declarative_oracle.m 27 Oct 2003 06:24:43 -0000 1.20
+++ browser/declarative_oracle.m 4 Jun 2004 07:16:00 -0000
@@ -49,6 +49,10 @@
:- pred oracle_state_init(io__input_stream, io__output_stream, oracle_state).
:- mode oracle_state_init(in, in, out) is det.
+ % Add a module to the set of modules trusted by the oracle
+ %
+:- func add_trusted_module(string, oracle_state) = oracle_state.
+
% Query the oracle about the program being debugged. The first
% argument is a queue of nodes in the evaluation tree, the second
% argument is the oracle response to any of these. The oracle
@@ -71,6 +75,7 @@
:- implementation.
+:- import_module mdb__declarative_execution.
:- import_module mdb__declarative_user.
:- import_module mdb__tree234_cc.
:- import_module mdb__set_cc.
@@ -79,7 +84,7 @@
:- import_module bool, std_util, set.
query_oracle(Questions, Response, Oracle0, Oracle) -->
- { query_oracle_kb_list(Oracle0 ^ kb_current, Questions, Answers) },
+ { query_oracle_list(Oracle0, Questions, Answers) },
(
{ Answers = [] }
->
@@ -182,15 +187,26 @@
% and subsequently revised, but new answers
% to the questions have not yet been given.
- user_state :: user_state
+ user_state :: user_state,
% User interface.
+
+ trusted_modules :: set(string)
+ % If a module name is in this set then the
+ % oracle will report any calls to predicates
+ % or functions in that module as valid.
+
).
oracle_state_init(InStr, OutStr, Oracle) :-
oracle_kb_init(Current),
oracle_kb_init(Old),
user_state_init(InStr, OutStr, User),
- Oracle = oracle(Current, Old, User).
+ set.init(TrustedModules),
+ Oracle = oracle(Current, Old, User, TrustedModules).
+
+add_trusted_module(ModuleName, OracleState) =
+ OracleState ^ trusted_modules :=
+ insert(OracleState ^ trusted_modules, ModuleName).
%-----------------------------------------------------------------------------%
@@ -282,21 +298,28 @@
%-----------------------------------------------------------------------------%
-:- pred query_oracle_kb_list(oracle_kb, list(decl_question(T)),
- list(decl_answer(T))).
-:- mode query_oracle_kb_list(in, in, out) is cc_multi.
-
-query_oracle_kb_list(_, [], []).
-query_oracle_kb_list(KB, [Q | Qs0], As) :-
- query_oracle_kb_list(KB, Qs0, As0),
- query_oracle_kb(KB, Q, MaybeA),
- (
- MaybeA = yes(A),
- As = [A | As0]
+:- pred query_oracle_list(oracle_state::in, list(decl_question(T))::in,
+ list(decl_answer(T))::out) is cc_multi.
+
+query_oracle_list(_, [], []).
+query_oracle_list(OS, [Q | Qs0], As) :-
+ query_oracle_list(OS, Qs0, As0),
+ Atom = get_decl_question_atom(Q),
+ (
+ % is the atom in a trusted module?
+ member(Atom ^ module_name, OS ^ trusted_modules)
+ ->
+ As = [truth_value(get_decl_question_node(Q), yes) | As0]
;
- MaybeA = no,
- As = As0
- ).
+ query_oracle_kb(OS ^ kb_current, Q, MaybeA),
+ (
+ MaybeA = yes(A),
+ As = [A | As0]
+ ;
+ MaybeA = no,
+ As = As0
+ )
+ ).
:- pred query_oracle_kb(oracle_kb, decl_question(T), maybe(decl_answer(T))).
:- mode query_oracle_kb(in, in, out) is cc_multi.
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.4
diff -u -r1.4 declarative_tree.m
--- browser/declarative_tree.m 27 Oct 2003 06:00:31 -0000 1.4
+++ browser/declarative_tree.m 3 Jun 2004 05:43:19 -0000
@@ -1076,7 +1076,7 @@
:- pred trace_atom_subterm_is_ground(trace_atom, arg_pos, term_path).
:- mode trace_atom_subterm_is_ground(in, in, in) is semidet.
-trace_atom_subterm_is_ground(atom(_, _, Args), ArgPos, _) :-
+trace_atom_subterm_is_ground(atom(_, _, _, Args), ArgPos, _) :-
select_arg_at_pos(ArgPos, Args, ArgInfo),
ArgInfo = arg_info(_, _, MaybeArg),
MaybeArg = yes(_).
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.26
diff -u -r1.26 declarative_user.m
--- browser/declarative_user.m 27 Oct 2003 06:00:31 -0000 1.26
+++ browser/declarative_user.m 3 Jun 2004 05:43:19 -0000
@@ -337,7 +337,7 @@
is cc_multi.
browse_atom_argument(Atom, ArgNum, MaybeMark, User0, User) -->
- { Atom = atom(_, _, Args0) },
+ { Atom = atom(_, _, _, Args0) },
{ maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args) },
(
{ list__index1(Args, ArgNum, ArgInfo) },
@@ -369,7 +369,7 @@
io__state::di, io__state::uo) is cc_multi.
print_atom_argument(Atom, ArgNum, User0, OK) -->
- { Atom = atom(_, _, Args0) },
+ { Atom = atom(_, _, _, Args0) },
{ maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args) },
(
{ list__index1(Args, ArgNum, ArgInfo) },
@@ -679,7 +679,7 @@
write_decl_atom(User, Indent, CallerType, DeclAtom) -->
io__write_string(User ^ outstr, Indent),
{ unravel_decl_atom(DeclAtom, TraceAtom, IoActions) },
- { TraceAtom = atom(PredOrFunc, Functor, Args0) },
+ { TraceAtom = atom(PredOrFunc, _, Functor, Args0) },
{ Which = chosen_head_vars_presentation },
{ maybe_filter_headvars(Which, Args0, Args1) },
{ list__map(trace_atom_arg_to_univ, Args1, Args) },
Index: doc/mdb_categories
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/mdb_categories,v
retrieving revision 1.21
diff -u -r1.21 mdb_categories
--- doc/mdb_categories 13 May 2004 08:50:29 -0000 1.21
+++ doc/mdb_categories 3 Jun 2004 05:43:19 -0000
@@ -55,8 +55,8 @@
end
document_category 900 misc
misc - Commands that are of interest to most users but do not fit into
- other categories. The misc commands are `source', `save', `dd'
- and `quit'.
+ other categories. The misc commands are `source', `save', `dd',
+ `trust' and `quit'.
end
document_category 1000 exp
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.387
diff -u -r1.387 user_guide.texi
--- doc/user_guide.texi 31 May 2004 04:12:57 -0000 1.387
+++ doc/user_guide.texi 3 Jun 2004 05:43:19 -0000
@@ -3246,6 +3246,13 @@
using the current event as the initial symptom.
For details, see @ref{Declarative debugging}.
@sp 1
+ at item trust @var{module-name}
+ at kindex trust (mdb command)
+The declarative debugger will assume that all predicates and functions in the
+given module are correct. Use this command with modules you are confident do
+not contain any bugs to reduce the number of questions the declarative
+debugger needs to ask to find a bug.
+ at sp 1
@item quit [-y]
@kindex quit (mdb command)
Quits the debugger and aborts the execution of the program.
Index: tests/debugger/mdb_command_test.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/mdb_command_test.inp,v
retrieving revision 1.28
diff -u -r1.28 mdb_command_test.inp
--- tests/debugger/mdb_command_test.inp 13 May 2004 08:50:32 -0000 1.28
+++ tests/debugger/mdb_command_test.inp 8 Jun 2004 04:44:28 -0000
@@ -42,6 +42,7 @@
source xyzzy xyzzy xyzzy xyzzy xyzzy
save xyzzy xyzzy xyzzy xyzzy xyzzy
dd xyzzy xyzzy xyzzy xyzzy xyzzy
+trust xyzzy xyzzy xyzzy xyzzy xyzzy
quit xyzzy xyzzy xyzzy xyzzy xyzzy
histogram_all xyzzy xyzzy xyzzy xyzzy xyzzy
histogram_exp xyzzy xyzzy xyzzy xyzzy xyzzy
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.60
diff -u -r1.60 Mmakefile
--- tests/debugger/declarative/Mmakefile 14 Sep 2003 22:24:41 -0000 1.60
+++ tests/debugger/declarative/Mmakefile 3 Jun 2004 05:43:19 -0000
@@ -48,7 +48,8 @@
special_term_dep \
tabled_read_decl \
throw \
- unsafe_cast
+ unsafe_cast \
+ trust
# The following should not be run in `debug' or `mm' grades.
#
@@ -279,5 +280,8 @@
untraced_subgoal.out: untraced_subgoal untraced_subgoal.inp
$(MDB) ./untraced_subgoal < untraced_subgoal.inp \
> untraced_subgoal.out 2>&1
+
+trust.out: trust trust.inp
+ $(MDB) ./trust < trust.inp > trust.out 2>&1
#-----------------------------------------------------------------------------#
Index: tests/debugger/declarative/trust.exp
===================================================================
RCS file: tests/debugger/declarative/trust.exp
diff -N tests/debugger/declarative/trust.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/trust.exp 8 Jun 2004 04:44:19 -0000
@@ -0,0 +1,20 @@
+ 1: 1 1 CALL pred trust.main/2-0 (cc_multi) trust.m:13
+mdb> Contexts will not be printed.
+mdb> echo on
+Command echo enabled.
+mdb> trust trust_1
+mdb> trust trust_2
+mdb> step
+ 2: 2 2 CALL pred trust.dostuff/2-0 (cc_multi)
+mdb> finish
+ 11: 2 2 EXIT pred trust.dostuff/2-0 (cc_multi)
+mdb> dd
+dostuff(w("aaabbb"), '=')
+Valid? n
+Found incorrect contour:
+dostuff(w("aaabbb"), '=')
+Is this a bug? y
+ 11: 2 2 EXIT pred trust.dostuff/2-0 (cc_multi)
+mdb> continue
+aaabbb
+'='
Index: tests/debugger/declarative/trust.inp
===================================================================
RCS file: tests/debugger/declarative/trust.inp
diff -N tests/debugger/declarative/trust.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/trust.inp 4 Jun 2004 06:50:49 -0000
@@ -0,0 +1,10 @@
+context none
+echo on
+trust trust_1
+trust trust_2
+step
+finish
+dd
+n
+y
+continue
Index: tests/debugger/declarative/trust.m
===================================================================
RCS file: tests/debugger/declarative/trust.m
diff -N tests/debugger/declarative/trust.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/trust.m 8 Jun 2004 04:33:51 -0000
@@ -0,0 +1,25 @@
+:- module trust.
+
+:- interface.
+
+:- import_module trust_1, io.
+
+:- pred main(io::di,io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module trust_1, trust_2.
+
+main(!IO) :-
+ dostuff(w(S), R),
+ write_string(S, !IO),
+ nl(!IO),
+ write(R, !IO),
+ nl(!IO).
+
+:- pred dostuff(w::out, comparison_result::uo) is cc_multi.
+
+dostuff(W, R) :-
+ compare(R, w("aaB"), w("aAB")),
+ concat(w("aaa"),w("bbb"),W).
+
Index: tests/debugger/declarative/trust_1.m
===================================================================
RCS file: tests/debugger/declarative/trust_1.m
diff -N tests/debugger/declarative/trust_1.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/trust_1.m 2 Jun 2004 07:09:49 -0000
@@ -0,0 +1,24 @@
+:- module trust_1.
+
+:- interface.
+
+:- import_module string.
+
+:- type w ---> w(string) where comparison is w_cmp.
+
+:- pred w_cmp(builtin.comparison_result::uo, w::in, w::in) is det.
+
+:- implementation.
+
+w_cmp(R, W1, W2) :-
+ R = unsafe_promise_unique(
+ promise_only_solution(
+ (pred(R1::out) is cc_multi :-
+ W1 = w(S1),
+ W2 = w(S2),
+ compare(R1, to_upper(S1)`with_type`string,
+ to_upper(S2))
+ )
+ )
+ ).
+
Index: tests/debugger/declarative/trust_2.m
===================================================================
RCS file: tests/debugger/declarative/trust_2.m
diff -N tests/debugger/declarative/trust_2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/trust_2.m 2 Jun 2004 07:09:53 -0000
@@ -0,0 +1,14 @@
+:- module trust_2.
+
+:- interface.
+
+:- import_module trust_1.
+
+:- pred concat(w::in, w::in, w::out) is cc_multi.
+
+:- implementation.
+
+:- import_module string.
+
+concat(w(S), w(T), w(S++T)).
+
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.66
diff -u -r1.66 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 23 May 2004 22:16:56 -0000 1.66
+++ trace/mercury_trace_declarative.c 3 Jun 2004 05:43:20 -0000
@@ -198,7 +198,10 @@
static MR_bool MR_trace_single_component(const char *path);
static MR_Word MR_decl_make_atom(const MR_Label_Layout *layout,
MR_Word *saved_regs, MR_Trace_Port port);
-static MR_ConstString MR_decl_atom_name(const MR_Proc_Layout *entry);
+static void MR_decl_atom_name_and_module(
+ const MR_Proc_Layout *entry,
+ MR_ConstString *proc_name,
+ MR_ConstString *module_name);
static MR_Word MR_decl_atom_args(const MR_Label_Layout *layout,
MR_Word *saved_regs);
static const char *MR_trace_start_collecting(MR_Unsigned event,
@@ -940,6 +943,7 @@
{
MR_PredFunc pred_or_func;
MR_ConstString name;
+ MR_ConstString module_name;
int arity;
MR_Word atom;
int hv; /* any head variable */
@@ -949,13 +953,15 @@
MR_trace_init_point_vars(layout, saved_regs, port, MR_TRUE);
- name = MR_decl_atom_name(entry);
+ MR_decl_atom_name_and_module(entry, &name, &module_name);
+
MR_proc_id_arity_addedargs_predfunc(entry, &arity, &num_added_args,
&pred_or_func);
MR_TRACE_CALL_MERCURY(
atom = MR_DD_construct_trace_atom(
(MR_Word) pred_or_func,
+ (MR_String) module_name,
(MR_String) name,
(MR_Word) entry->MR_sle_num_head_vars);
);
@@ -999,26 +1005,37 @@
return atom;
}
-static MR_ConstString
-MR_decl_atom_name(const MR_Proc_Layout *entry)
+static void
+MR_decl_atom_name_and_module(const MR_Proc_Layout *entry,
+ MR_ConstString *proc_name, MR_ConstString *module_name)
{
- MR_ConstString name;
-
if (MR_PROC_LAYOUT_HAS_PROC_ID(entry)) {
if (MR_PROC_LAYOUT_IS_UCI(entry)) {
MR_TRACE_USE_HP(
- MR_make_aligned_string(name, "<<internal>>");
+ MR_make_aligned_string(*proc_name,
+ entry->MR_sle_proc_id.MR_proc_uci.\
+ MR_uci_type_name);
+ MR_make_aligned_string(*module_name,
+ entry->MR_sle_proc_id.MR_proc_uci.\
+ MR_uci_def_module);
);
} else {
- name = entry->MR_sle_proc_id.MR_proc_user.MR_user_name;
+ MR_TRACE_USE_HP(
+ MR_make_aligned_string(*proc_name,
+ entry->MR_sle_proc_id.MR_proc_user.\
+ MR_user_name);
+ MR_make_aligned_string(*module_name,
+ entry->MR_sle_proc_id.MR_proc_user.\
+ MR_user_decl_module);
+ );
}
} else {
+ /* XXX Should maybe raise an exception? */
MR_TRACE_USE_HP(
- MR_make_aligned_string(name, "<<unknown>>");
+ MR_make_aligned_string(*proc_name, "<<unknown>>");
+ MR_make_aligned_string(*module_name, "<<unknown>>");
);
}
-
- return name;
}
static void
@@ -1039,6 +1056,22 @@
);
done = MR_TRUE;
}
+}
+
+void
+MR_decl_add_trusted_module(const char *module_name)
+{
+ MR_ConstString aligned_module_name;
+
+ MR_TRACE_USE_HP(
+ MR_make_aligned_string(aligned_module_name, module_name);
+ );
+ MR_trace_decl_ensure_init();
+ MR_TRACE_CALL_MERCURY(
+ MR_DD_decl_add_trusted_module(aligned_module_name,
+ MR_trace_front_end_state,
+ &MR_trace_front_end_state);
+ );
}
MR_bool
Index: trace/mercury_trace_declarative.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.16
diff -u -r1.16 mercury_trace_declarative.h
--- trace/mercury_trace_declarative.h 6 Nov 2002 02:02:38 -0000 1.16
+++ trace/mercury_trace_declarative.h 3 Jun 2004 05:43:20 -0000
@@ -50,6 +50,15 @@
extern MR_bool MR_trace_decl_assume_all_io_is_tabled;
/*
+** This function adds a module to the set of trusted modules in the
+** oracle_state inside the current diagnoser_state. It will call
+** MR_trace_decl_ensure_init to ensure the diagnoser_state is initialised
+** first.
+*/
+
+extern void MR_decl_add_trusted_module(const char *module_name);
+
+/*
** The following macros are provided to help C code manipulate the
** Mercury data structure. The values here must match the corresponding
** values in the definitions in browser/declarative_execution.m.
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.173
diff -u -r1.173 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 31 May 2004 04:13:39 -0000 1.173
+++ trace/mercury_trace_internal.c 3 Jun 2004 05:43:22 -0000
@@ -462,6 +462,7 @@
static MR_TraceCmdFunc MR_trace_cmd_quit;
static MR_TraceCmdFunc MR_trace_cmd_dd;
static MR_TraceCmdFunc MR_trace_cmd_dd_dd;
+static MR_TraceCmdFunc MR_trace_cmd_trust;
static void MR_maybe_print_spy_point(int slot, const char *problem);
static void MR_print_unsigned_var(FILE *fp, const char *var,
@@ -5280,6 +5281,20 @@
return KEEP_INTERACTING;
}
+static MR_Next
+MR_trace_cmd_trust(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
+ MR_Event_Info *event_info, MR_Event_Details *event_details,
+ MR_Code **jumpaddr)
+{
+ if (word_count == 2) {
+ MR_decl_add_trusted_module(words[1]);
+ } else {
+ MR_trace_usage("dd", "trust");
+ }
+ return KEEP_INTERACTING;
+}
+
+
static void
MR_maybe_print_spy_point(int slot, const char *problem)
{
@@ -7062,6 +7077,8 @@
NULL, MR_trace_null_completer },
{ "misc", "quit", MR_trace_cmd_quit,
MR_trace_quit_cmd_args, NULL },
+ { "misc", "trust", MR_trace_cmd_trust, NULL,
+ MR_trace_null_completer },
{ "exp", "histogram_all", MR_trace_cmd_histogram_all,
NULL, MR_trace_filename_completer },
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list