[m-rev.] for review: use proc layouts in annotated trace
Ian MacLarty
maclarty at cs.mu.OZ.AU
Wed Jun 30 18:25:32 AEST 2004
For review by Zoltan.
Estimated hours taken: 5
Branches: main
The annotated trace used for declarative debugging now keeps a reference to the
proc layout for a predicate/function, instead of all the details of the
predicate/function. This saves space and gives access to more information
about the predicate/function.
browser/declarative_debugger.m
Changed write_origin to look up the proc name through the proc_layout.
browser/declarative_execution.m
Info about the predicate like its name, module etc is now represented
by a proc_layout type. Changed the trace_atom type appropriately and
added useful predicates and functions to manipulate proc_layouts -
thanks to Zoltan.
browser/declarative_oracle.m
Compiler generated predicates always trusted. This is now possible
since we have access to this info through the proc_layout. Also since
proc_layouts are unique per mode, all modes must now be added to the
knowledge base in assert_oracle_kb.
browser/declarative_tree.m
Minor changes to predicate that expected four arguments to trace_atom
type.
browser/declarative_user.m
Minor changes to predicates that used the old trace_atom type.
tests/debugger/declarative/remember_modes.m
Test to see that all modes of a predicate are added to the knowledge
base of the oracle.
tests/debugger/declarative/Mmakefile
Added remember_modes test.
tests/debugger/declarative/remember_modes.exp
Expected results for remember_modes test.
tests/debugger/declarative/remember_modes.inp
Input to remember_modes test.
tests/debugger/declarative/trust.m
Removed superfluous import of trust_1 in interface.
trace/mercury_trace_declarative.c
Removed MR_decl_atom_name_and_module which is no longer necessary
since the debugger looks the name and module up in the proc_layout
directly.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.37
diff -u -r1.37 declarative_debugger.m
--- browser/declarative_debugger.m 15 Jun 2004 05:35:08 -0000 1.37
+++ browser/declarative_debugger.m 23 Jun 2004 05:55:03 -0000
@@ -579,19 +579,22 @@
:- pred write_origin(wrap(S)::in, subterm_origin(edt_node(R))::in,
io__state::di, io__state::uo) is det <= annotated_trace(S, R).
-write_origin(wrap(Store), Origin) -->
- ( { Origin = output(dynamic(NodeId), ArgPos, TermPath) } ->
- { exit_node_from_id(Store, NodeId, ExitNode) },
- { ProcName = ExitNode ^ exit_atom ^ proc_name },
- io__write_string("output("),
- io__write_string(ProcName),
- io__write_string(", "),
- io__write(ArgPos),
- io__write_string(", "),
- io__write(TermPath),
- io__write_string(")")
+write_origin(wrap(Store), Origin, !IO) :-
+ (Origin = output(dynamic(NodeId), ArgPos, TermPath) ->
+ exit_node_from_id(Store, NodeId, ExitNode),
+ ProcId = get_proc_id_from_layout(
+ ExitNode ^ exit_atom ^ proc_label),
+ (ProcId = proc(_, _, _, ProcName, _, _)
+ ;ProcId = uci_proc(_, _, _, ProcName , _, _)),
+ io__write_string("output(", !IO),
+ io__write_string(ProcName, !IO),
+ io__write_string(", ", !IO),
+ io__write(ArgPos, !IO),
+ io__write_string(", ", !IO),
+ io__write(TermPath, !IO),
+ io__write_string(")", !IO)
;
- io__write(Origin)
+ io__write(Origin, !IO)
).
:- pragma foreign_code("C",
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.24
diff -u -r1.24 declarative_execution.m
--- browser/declarative_execution.m 15 Jun 2004 05:35:08 -0000 1.24
+++ browser/declarative_execution.m 29 Jun 2004 04:34:29 -0000
@@ -21,7 +21,7 @@
:- import_module mdb__util.
:- import_module mdbcomp__program_representation.
-:- import_module list, std_util, string, io, bool.
+:- import_module list, std_util, io, bool.
% This type represents a port in the annotated trace.
% The type R is the type of references to other nodes
@@ -175,16 +175,12 @@
:- type trace_atom
---> atom(
- pred_or_func :: pred_or_func,
-
- module_name ::string,
- % The module in which the
- % procedure was declared.
-
- proc_name :: string,
- % Procedure name.
- %
-
+ proc_label :: proc_layout,
+ % Info about the
+ % procedure like its name
+ % and module and whether it is
+ % a function or a predicate.
+
atom_args :: list(trace_atom_arg)
% The arguments, including the
% compiler-generated ones.
@@ -192,6 +188,44 @@
% handle partially instantiated
% data structures.
).
+
+ % A module name should consist of a base name and a list of the names
+ % of the enclosing modules. For now, we have them all in one string.
+:- type module_name == string.
+
+:- type special_pred_id
+ ---> unify
+ ; index
+ ; compare.
+
+:- type proc_id
+ ---> proc(
+ module_name, % defining module
+ pred_or_func,
+ module_name, % declaring module
+ string, % name
+ int, % arity
+ int % mode number
+ )
+ ; uci_proc(
+ module_name, % defining module
+ special_pred_id,% indirectly defines pred name
+ module_name, % type module
+ string, % type name
+ int, % type arity
+ int % mode number
+ ).
+
+ % Should be a foreign type, MR_Proc_Layout *. This is a
+ % temporary workaround: we can't do compare_representation
+ % on foreign types yet.
+:- type proc_layout.
+
+:- func get_proc_id_from_layout(proc_layout) = proc_id.
+
+:- func get_all_modes_for_layout(proc_layout) = list(proc_layout).
+
+%-----------------------------------------------------------------------------%
% If the following type is modified, some of the macros in
% trace/mercury_trace_declarative.h may need to be updated.
@@ -351,10 +385,178 @@
is det.
%-----------------------------------------------------------------------------%
-
+
:- implementation.
+
:- import_module mdb__declarative_debugger.
:- import_module int, map, exception, store.
+:- import_module require.
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_type("C", proc_layout, "const MR_Proc_Layout *",
+ [can_pass_as_mercury_type, stable]).
+
+get_proc_id_from_layout(Layout) = ProcId :-
+ ( proc_layout_is_uci(Layout) ->
+ proc_layout_get_uci_fields(Layout, TypeName, TypeModule,
+ DefModule, PredName, TypeArity, ModeNum),
+ ( PredName = "__Unify__" ->
+ SpecialId = unify
+ ; PredName = "__Index__" ->
+ SpecialId = index
+ ; PredName = "__Compare__" ->
+ SpecialId = compare
+ ;
+ error("get_proc_id_from_layout: bad special_pred_id")
+ ),
+ ProcId = uci_proc(DefModule, SpecialId, TypeModule, TypeName,
+ TypeArity, ModeNum)
+ ;
+ proc_layout_get_non_uci_fields(Layout, PredOrFunc,
+ DeclModule, DefModule, PredName, Arity, ModeNum),
+ ProcId = proc(DefModule, PredOrFunc, DeclModule, PredName,
+ Arity, ModeNum)
+ ).
+
+:- pred proc_layout_is_uci(proc_layout::in) is semidet.
+
+:- pragma foreign_proc("C",
+ proc_layout_is_uci(Layout::in),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ if (MR_PROC_ID_IS_UCI(Layout->MR_sle_proc_id)) {
+ SUCCESS_INDICATOR = MR_TRUE;
+ } else {
+ SUCCESS_INDICATOR = MR_FALSE;
+ }
+").
+
+:- pred proc_layout_get_uci_fields(proc_layout::in, string::out,
+ string::out, string::out, string::out, int::out, int::out) is det.
+
+:- pragma foreign_proc("C",
+ proc_layout_get_uci_fields(Layout::in, TypeName::out, TypeModule::out,
+ DefModule::out, PredName::out, TypeArity::out, ModeNum::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ const MR_UCI_Proc_Id *proc_id;
+
+ proc_id = &Layout->MR_sle_uci;
+
+ /* The casts are there to cast away const without warnings */
+ TypeName = (MR_String) (MR_Integer) proc_id->MR_uci_type_name;
+ TypeModule = (MR_String) (MR_Integer) proc_id->MR_uci_type_module;
+ DefModule = (MR_String) (MR_Integer) proc_id->MR_uci_def_module;
+ PredName = (MR_String) (MR_Integer) proc_id->MR_uci_pred_name;
+ TypeArity = proc_id->MR_uci_type_arity;
+ ModeNum = proc_id->MR_uci_mode;
+").
+
+:- pred proc_layout_get_non_uci_fields(proc_layout::in, pred_or_func::out,
+ string::out, string::out, string::out, int::out, int::out) is det.
+
+:- pragma foreign_proc("C",
+ proc_layout_get_non_uci_fields(Layout::in, PredOrFunc::out,
+ DeclModule::out, DefModule::out, PredName::out,
+ Arity::out, ModeNum::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ const MR_User_Proc_Id *proc_id;
+
+ proc_id = &Layout->MR_sle_user;
+
+ /* The casts are there to cast away const without warnings */
+ PredOrFunc = proc_id->MR_user_pred_or_func;
+ DeclModule = (MR_String) (MR_Integer) proc_id->MR_user_decl_module;
+ DefModule = (MR_String) (MR_Integer) proc_id->MR_user_def_module;
+ PredName = (MR_String) (MR_Integer) proc_id->MR_user_name;
+ Arity = proc_id->MR_user_arity;
+ ModeNum = proc_id->MR_user_mode;
+").
+
+:- pragma foreign_proc("C",
+ get_all_modes_for_layout(Layout::in) = (Layouts::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+ "
+ const MR_Module_Layout *module;
+ const MR_Proc_Layout *proc;
+ int i;
+ MR_Word list;
+ MR_bool match;
+ const MR_Proc_Layout *selected_proc;
+
+ selected_proc = Layout;
+
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(selected_proc)) {
+ MR_fatal_error(
+ ""get_all_modes_for_layout: selected_proc"");
+ }
+
+ module = selected_proc->MR_sle_module_layout;
+ list = MR_list_empty();
+ for (i = 0; i < module->MR_ml_proc_count; i++) {
+ proc = module->MR_ml_procs[i];
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(selected_proc)) {
+ MR_fatal_error(
+ ""get_all_modes_for_layout: proc"");
+ }
+
+ if (MR_PROC_LAYOUT_IS_UCI(selected_proc)
+ && MR_PROC_LAYOUT_IS_UCI(proc))
+ {
+ const MR_UCI_Proc_Id *proc_id;
+ const MR_UCI_Proc_Id *selected_proc_id;
+
+ proc_id = &proc->MR_sle_uci;
+ selected_proc_id = &selected_proc->MR_sle_uci;
+
+ if (MR_streq(proc_id->MR_uci_type_name,
+ selected_proc_id->MR_uci_type_name)
+ && MR_streq(proc_id->MR_uci_type_module,
+ selected_proc_id->MR_uci_type_module)
+ && MR_streq(proc_id->MR_uci_pred_name,
+ selected_proc_id->MR_uci_pred_name)
+ && (proc_id->MR_uci_type_arity ==
+ selected_proc_id->MR_uci_type_arity))
+ {
+ match = MR_TRUE;
+ } else {
+ match = MR_FALSE;
+ }
+ } else if (!MR_PROC_LAYOUT_IS_UCI(selected_proc)
+ && !MR_PROC_LAYOUT_IS_UCI(proc))
+ {
+ const MR_User_Proc_Id *proc_id;
+ const MR_User_Proc_Id *selected_proc_id;
+
+ proc_id = &proc->MR_sle_user;
+ selected_proc_id = &selected_proc->MR_sle_user;
+
+ if ((proc_id->MR_user_pred_or_func ==
+ selected_proc_id->MR_user_pred_or_func)
+ && MR_streq(proc_id->MR_user_decl_module,
+ selected_proc_id->MR_user_decl_module)
+ && MR_streq(proc_id->MR_user_name,
+ selected_proc_id->MR_user_name)
+ && (proc_id->MR_user_arity ==
+ selected_proc_id->MR_user_arity))
+ {
+ match = MR_TRUE;
+ } else {
+ match = MR_FALSE;
+ }
+ } else {
+ match = MR_FALSE;
+ }
+
+ if (match) {
+ list = MR_int_list_cons((MR_Integer) proc, list);
+ }
+ }
+
+ Layouts = list;
+ ").
%-----------------------------------------------------------------------------%
@@ -978,13 +1180,11 @@
null_trace_node_id(_) :-
private_builtin__sorry("null_trace_node_id").
-
-:- func construct_trace_atom(pred_or_func, string, string, int) = trace_atom.
-:- pragma export(construct_trace_atom(in, in, in, in) = out,
+:- func construct_trace_atom(proc_layout, int) = trace_atom.
+:- pragma export(construct_trace_atom(in, in) = out,
"MR_DD_construct_trace_atom").
-construct_trace_atom(PredOrFunc, ModuleName, Functor, Arity) = Atom :-
- Atom = atom(PredOrFunc, ModuleName, Functor, Args),
+construct_trace_atom(ProcLabel, Arity) = atom(ProcLabel, Args) :-
list__duplicate(Arity, dummy_arg_info, Args).
% add_trace_atom_arg_value(Atom0, ArgNum, HldsNum, ProgVis, Val):
@@ -996,8 +1196,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, M, F, Args0), ArgNum, HldsNum, ProgVis, Val)
- = atom(C, M, F, Args) :-
+add_trace_atom_arg_value(atom(P, Args0), ArgNum, HldsNum, ProgVis, Val)
+ = atom(P, Args) :-
Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, yes(Val)),
list__replace_nth_det(Args0, ArgNum, Arg, Args).
@@ -1007,8 +1207,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, M, F, Args0), ArgNum, HldsNum, ProgVis)
- = atom(C, M, F, Args) :-
+add_trace_atom_arg_no_value(atom(P, Args0), ArgNum, HldsNum, ProgVis)
+ = atom(P, Args) :-
Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, no),
list__replace_nth_det(Args0, ArgNum, Arg, Args).
@@ -1174,7 +1374,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.22
diff -u -r1.22 declarative_oracle.m
--- browser/declarative_oracle.m 21 Jun 2004 07:43:30 -0000 1.22
+++ browser/declarative_oracle.m 30 Jun 2004 04:29:05 -0000
@@ -305,9 +305,17 @@
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?
- set__member(Atom ^ module_name, OS ^ trusted_modules)
+ (
+ % do we trust the correctness of the procedure?
+ ProcId = get_proc_id_from_layout(Atom ^ proc_label),
+ (
+ % always trust compiler generated procs
+ ProcId = uci_proc(_, _, _, _, _, _)
+ ;
+ % is the atom in a trusted module?
+ ProcId = proc(Module, _, _, _, _, _),
+ member(Module, OS ^ trusted_modules)
+ )
->
As = [truth_value(get_decl_question_node(Q), yes) | As0]
;
@@ -387,8 +395,26 @@
assert_oracle_kb(wrong_answer(_, Atom), truth_value(_, Truth), KB0, KB) :-
get_kb_ground_map(KB0, Map0),
- tree234_cc__set(Map0, Atom, Truth, Map),
+ % insert all modes of the predicate/function
+ foldl(add_atom_to_ground_map(Truth, Atom),
+ get_all_modes_for_layout(Atom ^ final_atom ^ proc_label),
+ Map0, Map),
set_kb_ground_map(KB0, Map, KB).
+
+:- pred add_atom_to_ground_map(decl_truth::in, final_decl_atom::in,
+ proc_layout::in, map_cc(final_decl_atom, decl_truth)::in,
+ map_cc(final_decl_atom, decl_truth)::out) is det.
+
+add_atom_to_ground_map(Truth, FinalAtom, ProcLayout, Map0, Map) :-
+ Map = promise_only_solution(
+ (pred(M::out) is cc_multi :-
+ tree234_cc.set(Map0, final_decl_atom(
+ atom(ProcLayout,
+ FinalAtom ^ final_atom ^ atom_args),
+ FinalAtom ^ final_io_actions),
+ Truth, M)
+ )
+ ).
assert_oracle_kb(missing_answer(_, Call, _), truth_value(_, Truth), KB0, KB) :-
get_kb_complete_map(KB0, Map0),
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.5
diff -u -r1.5 declarative_tree.m
--- browser/declarative_tree.m 15 Jun 2004 05:35:09 -0000 1.5
+++ browser/declarative_tree.m 17 Jun 2004 04:15:20 -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.27
diff -u -r1.27 declarative_user.m
--- browser/declarative_user.m 15 Jun 2004 05:35:09 -0000 1.27
+++ browser/declarative_user.m 17 Jun 2004 04:15:20 -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) },
@@ -676,20 +676,27 @@
:- pred write_decl_atom(user_state::in, string::in, browse_caller_type::in,
some_decl_atom::in, io__state::di, io__state::uo) is cc_multi.
-write_decl_atom(User, Indent, CallerType, DeclAtom) -->
- io__write_string(User ^ outstr, Indent),
- { unravel_decl_atom(DeclAtom, TraceAtom, IoActions) },
- { 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) },
+write_decl_atom(User, Indent, CallerType, DeclAtom, !IO) :-
+ io__write_string(User ^ outstr, Indent, !IO),
+ unravel_decl_atom(DeclAtom, TraceAtom, IoActions),
+ TraceAtom = atom(ProcLabel, Args0),
+ ProcId = get_proc_id_from_layout(ProcLabel),
+ (
+ ProcId = proc(_, PredOrFunc, _, Functor, _, _)
+ ;
+ ProcId = uci_proc(_, _, _, Functor, _, _),
+ PredOrFunc = predicate
+ ),
+ Which = chosen_head_vars_presentation,
+ maybe_filter_headvars(Which, Args0, Args1),
+ list__map(trace_atom_arg_to_univ, Args1, Args),
%
% Call the term browser to print the atom (or part of it
% up to a size limit) as a goal.
%
browse__print_synthetic(Functor, Args, is_function(PredOrFunc),
- User ^ outstr, CallerType, User ^ browser),
- write_io_actions(User, IoActions).
+ User ^ outstr, CallerType, User ^ browser, !IO),
+ write_io_actions(User, IoActions, !IO).
:- pred trace_atom_arg_to_univ(trace_atom_arg::in, univ::out) is det.
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.63
diff -u -r1.63 Mmakefile
--- tests/debugger/declarative/Mmakefile 24 Jun 2004 05:57:01 -0000 1.63
+++ tests/debugger/declarative/Mmakefile 30 Jun 2004 04:57:42 -0000
@@ -49,7 +49,8 @@
tabled_read_decl \
throw \
unsafe_cast \
- trust
+ trust \
+ remember_modes
# The following should not be run in `debug' or `mm' grades.
#
@@ -283,5 +284,9 @@
trust.out: trust trust.inp
$(MDB_STD) ./trust < trust.inp > trust.out 2>&1
+
+remember_modes.out: remember_modes remember_modes.inp
+ $(MDB_STD) ./remember_modes < remember_modes.inp \
+ > remember_modes.out 2>&1
#-----------------------------------------------------------------------------#
Index: tests/debugger/declarative/remember_modes.exp
===================================================================
RCS file: tests/debugger/declarative/remember_modes.exp
diff -N tests/debugger/declarative/remember_modes.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/remember_modes.exp 30 Jun 2004 04:56:42 -0000
@@ -0,0 +1,24 @@
+ E1: C1 1 CALL pred remember_modes.main/2-0 (det) remember_modes.m:37
+mdb> Contexts will not be printed.
+mdb> mdb> echo on
+Command echo enabled.
+mdb> break q
+ 0: + stop interface pred remember_modes.q/5-0 (semidet)
+mdb> continue
+ E2: C2 2 CALL pred remember_modes.q/5-0 (semidet)
+mdb> finish
+ E3: C2 2 EXIT pred remember_modes.q/5-0 (semidet)
+mdb> dd
+q(1, 1, 2, 1, 2)
+Valid? no
+p(1, 2)
+Valid? yes
+Found incorrect contour:
+q(1, 1, 2, 1, 2)
+Is this a bug? yes
+ E3: C2 2 EXIT pred remember_modes.q/5-0 (semidet)
+mdb> continue
+1
+2
+1
+2
Index: tests/debugger/declarative/remember_modes.inp
===================================================================
RCS file: tests/debugger/declarative/remember_modes.inp
diff -N tests/debugger/declarative/remember_modes.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/remember_modes.inp 23 Jun 2004 05:44:34 -0000
@@ -0,0 +1,11 @@
+context none
+register --quiet
+echo on
+break q
+continue
+finish
+dd
+no
+yes
+yes
+continue
Index: tests/debugger/declarative/remember_modes.m
===================================================================
RCS file: tests/debugger/declarative/remember_modes.m
diff -N tests/debugger/declarative/remember_modes.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/remember_modes.m 23 Jun 2004 05:33:10 -0000
@@ -0,0 +1,39 @@
+:- module remember_modes.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+:- pred p(int, int).
+:- mode p(in, in) is semidet.
+:- mode p(in, out) is semidet.
+:- mode p(out, in) is semidet.
+:- mode p(out, out) is det.
+
+p(1, 2).
+
+:- pred q(int::in, int::out, int::out, int::out, int::out) is semidet.
+
+q(V, W, X, Y, Z) :-
+ p(V, 2),
+ p(W, 2),
+ p(1, X),
+ p(Y, Z).
+
+main(!IO) :-
+ (
+ q(1, W, X, Y, Z)
+ ->
+ write(W, !IO), nl(!IO),
+ write(X, !IO), nl(!IO),
+ write(Y, !IO), nl(!IO),
+ write(Z, !IO), nl(!IO)
+ ;
+ write_string("failed\n", !IO)
+ ).
Index: tests/debugger/declarative/trust.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/trust.m,v
retrieving revision 1.1
diff -u -r1.1 trust.m
--- tests/debugger/declarative/trust.m 15 Jun 2004 05:35:12 -0000 1.1
+++ tests/debugger/declarative/trust.m 30 Jun 2004 04:33:55 -0000
@@ -2,7 +2,7 @@
:- interface.
-:- import_module trust_1, io.
+:- import_module io.
:- pred main(io::di,io::uo) is cc_multi.
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.67
diff -u -r1.67 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 15 Jun 2004 05:35:13 -0000 1.67
+++ trace/mercury_trace_declarative.c 15 Jun 2004 06:40:57 -0000
@@ -198,10 +198,6 @@
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 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,
@@ -942,8 +938,6 @@
MR_Trace_Port port)
{
MR_PredFunc pred_or_func;
- MR_ConstString name;
- MR_ConstString module_name;
int arity;
MR_Word atom;
int hv; /* any head variable */
@@ -952,18 +946,12 @@
const MR_Proc_Layout *entry = layout->MR_sll_entry;
MR_trace_init_point_vars(layout, saved_regs, port, MR_TRUE);
-
- 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);
+ atom = MR_DD_construct_trace_atom((MR_Word)entry,
+ (MR_Integer) entry->MR_sle_num_head_vars);
);
for (hv = 0; hv < entry->MR_sle_num_head_vars; hv++) {
@@ -1006,39 +994,6 @@
}
static void
-MR_decl_atom_name_and_module(const MR_Proc_Layout *entry,
- MR_ConstString *proc_name, MR_ConstString *module_name)
-{
- if (MR_PROC_LAYOUT_HAS_PROC_ID(entry)) {
- if (MR_PROC_LAYOUT_IS_UCI(entry)) {
- MR_TRACE_USE_HP(
- 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 {
- 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(*proc_name, "<<unknown>>");
- MR_make_aligned_string(*module_name, "<<unknown>>");
- );
- }
-}
-
-static void
MR_trace_decl_ensure_init(void)
{
static MR_bool done = MR_FALSE;
@@ -1068,7 +1023,7 @@
);
MR_trace_decl_ensure_init();
MR_TRACE_CALL_MERCURY(
- MR_DD_decl_add_trusted_module(aligned_module_name,
+ MR_DD_decl_add_trusted_module((MR_String)aligned_module_name,
MR_trace_front_end_state,
&MR_trace_front_end_state);
);
--------------------------------------------------------------------------
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