[m-rev.] for review: dependency tracking
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Apr 23 13:45:24 AEST 2002
On 23-Apr-2002, Mark Brown <dougl at cs.mu.OZ.AU> wrote:
> We could modify step_left_in_contour to handle the neg case, so that it
> doesn't have to be specially handled here (and below). The code for
> step_left_in_contour assumes that a neg node will only be reached if an
> exception is thrown inside a negation, but now that we use that function
> here the assumption is false. I can't think of any problems that removing
> this assumption might cause. What do you think?
We should add an extra argument to step_left_in_contour that says whether
we may start inside a negation.
> This completes this round of reviewing.
I have done all the changes you suggested except the ones I mentioned in my
previous messages. The updated diff, which I am now bootchecking, will follow
in the next message; the interdiff is below.
Zoltan.
diff -u browser/declarative_analyser.m browser/declarative_analyser.m
--- browser/declarative_analyser.m
+++ browser/declarative_analyser.m
@@ -22,30 +22,30 @@
% node is represented implicitly. In this case, the analyser
% must request that it be made explicit before continuing.
%
-:- typeclass mercury_edt(S, R) where [
+:- typeclass mercury_edt(S, T) where [
% Gives the root node of an EDT.
%
- pred edt_root_question(S, R, decl_question),
+ pred edt_root_question(S, T, decl_question),
mode edt_root_question(in, in, out) is det,
% If this node is an e_bug, then find the bug.
%
- pred edt_root_e_bug(S, R, decl_e_bug),
+ pred edt_root_e_bug(S, T, decl_e_bug),
mode edt_root_e_bug(in, in, out) is det,
% Gives the list of children of a tree. If the tree is
% represented implicitly, then the procedure fails.
%
- pred edt_children(S, R, list(R)),
+ pred edt_children(S, T, list(T)),
mode edt_children(in, in, out) is semidet,
% Given a subterm of a tree, find the mode of that subterm
% and the origin of it amongst the parent, siblings or
% children.
%
- pred edt_dependency(S, R, arg_pos, term_path, subterm_mode,
- subterm_origin(R)),
+ pred edt_dependency(S, T, arg_pos, term_path, subterm_mode,
+ subterm_origin(T)),
mode edt_dependency(in, in, in, in, out, out) is det
].
@@ -53,35 +53,29 @@
---> subterm_in
; subterm_out.
-:- type subterm_origin(R)
+:- type subterm_origin(T)
- % Subterm came from an output of a child or sibling
- % call. The first argument records the id of the exit
- % event of the call. The second and third arguments
- % state which part of which argument is the origin.
+ % Subterm came from an output of a child or sibling.
%
- ---> output(R, arg_pos, term_path)
+ ---> output(T, arg_pos, term_path)
- % Subterm came from an input of the parent. The
- % arguments identify which part of which argument of
- % the clause head is the origin.
+ % Subterm came from an input of the parent.
%
; input(arg_pos, term_path)
% Subterm was constructed in the body. We record
% the filename and line number of the primitive
- % operation that constructed it, which may be a
- % unification or (if inlining was enabled) a
- % foreign_proc.
+ % operation (unification or inlined foreign_proc)
+ % that constructed it.
%
- ; primitive(string, int)
+ ; primitive_op(string, int)
% The origin could not be found due to missing
% information.
%
; not_found.
-:- type analyser_response(R)
+:- type analyser_response(T)
% There are no suspects left, and no incorrect
% nodes have been found.
@@ -95,68 +89,76 @@
% The analyser desires answers to any of a list
% of queries.
%
- ; oracle_queries(list(decl_question), maybe(subterm_origin(R)))
+ ; oracle_queries(list(decl_question))
% The analyser requires the given implicit sub-tree
% to be made explicit.
%
- ; require_explicit(R).
+ ; require_explicit(T).
-:- type analyser_state(R).
+:- type analyser_state(T).
-:- pred analyser_state_init(analyser_state(R)).
+:- pred analyser_state_init(analyser_state(T)).
:- mode analyser_state_init(out) is det.
% Perform analysis on the given EDT, which may be a new tree
% to diagnose, or a sub-tree that was required to be made
% explicit.
%
-:- pred start_analysis(S, R, analyser_response(R), analyser_state(R),
- analyser_state(R)) <= mercury_edt(S, R).
+:- pred start_analysis(S, T, analyser_response(T), analyser_state(T),
+ analyser_state(T)) <= mercury_edt(S, T).
:- mode start_analysis(in, in, out, in, out) is det.
% Continue analysis after the oracle has responded with some
% answers.
%
-:- pred continue_analysis(S, list(decl_answer), analyser_response(R),
- analyser_state(R), analyser_state(R)) <= mercury_edt(S, R).
+:- pred continue_analysis(S, list(decl_answer), analyser_response(T),
+ analyser_state(T), analyser_state(T)) <= mercury_edt(S, T).
:- mode continue_analysis(in, in, out, in, out) is det.
+ % Return information within the analyser state that is intended for
+ % debugging the declarative debugger itself.
+ %
+:- pred debug_analyser_state(analyser_state(T)::in,
+ maybe(subterm_origin(T))::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
-
-:- import_module mdb__declarative_execution.
:- import_module std_util, bool, require.
% The analyser state represents a set of suspects. We
% consider one incorrect node at a time, and store its suspect
% children.
%
-:- type analyser_state(R)
+:- type analyser_state(T)
---> analyser(
% Current incorrect node (initially `no').
% This is the most recent node that the
% oracle has said is incorrect.
%
- maybe_prime :: maybe(prime_suspect(R)),
+ maybe_prime :: maybe(prime_suspect(T)),
% Current suspects.
%
- suspects :: list(suspect(R)),
+ suspects :: list(suspect(T)),
% Previous prime suspects.
%
- previous :: list(suspect(R))
+ previous :: list(suspect(T)),
+
+ debug_origin :: maybe(subterm_origin(T))
).
-analyser_state_init(analyser(no, [], [])).
+analyser_state_init(analyser(no, [], [], no)).
+
+debug_analyser_state(Analyser, Analyser ^ debug_origin).
start_analysis(Store, Tree, Response, Analyser0, Analyser) :-
make_suspects(Store, [Tree], Suspects, Queries),
get_all_prime_suspects(Analyser0, OldPrimes),
- Analyser = analyser(no, Suspects, OldPrimes),
- Response = oracle_queries(Queries, no).
+ Analyser = analyser(no, Suspects, OldPrimes, no),
+ Response = oracle_queries(Queries).
continue_analysis(Store, Answers, Response, Analyser0, Analyser) :-
%
@@ -178,18 +180,18 @@
;
find_incorrect_suspect(Answers, Suspects, Suspect)
->
- make_new_prime_suspect(Store, no, Suspect, Response,
+ make_new_prime_suspect(Store, Suspect, Response,
Analyser0, Analyser)
;
- remove_suspects(Store, no, Answers, Response,
+ remove_suspects(Store, Answers, Response,
Analyser0, Analyser)
).
% Find an answer which is a suspicious subterm, and find the
% suspect that corresponds to it, or else fail.
%
-:- pred find_suspicious_subterm(list(decl_answer), list(suspect(R)),
- suspect(R), arg_pos, term_path).
+:- pred find_suspicious_subterm(list(decl_answer), list(suspect(T)),
+ suspect(T), arg_pos, term_path).
:- mode find_suspicious_subterm(in, in, out, out, out) is semidet.
find_suspicious_subterm([Answer | Answers], Suspects, Suspect, ArgPos,
@@ -222,16 +224,17 @@
%
(
SubtermMode = subterm_in,
- remove_suspects(Store, yes(Origin), [truth_value(Query, yes)],
- Response0, Analyser0, Analyser)
+ remove_suspects(Store, [truth_value(Query, yes)], Response0,
+ Analyser0, Analyser1)
;
SubtermMode = subterm_out,
- make_new_prime_suspect(Store, yes(Origin), Suspect, Response0,
- Analyser0, Analyser)
+ make_new_prime_suspect(Store, Suspect, Response0,
+ Analyser0, Analyser1)
),
+ Analyser = Analyser1 ^ debug_origin := yes(Origin),
(
Origin = output(Node, _, _),
- Response0 = oracle_queries(_, MaybeOrigin)
+ Response0 = oracle_queries(_)
->
%
% Replace all of the queries with just the one which output
@@ -240,7 +243,7 @@
% previous answer available.
%
create_suspect(Store, Node, suspect(_, NodeQuery)),
- Response = oracle_queries([NodeQuery], MaybeOrigin)
+ Response = oracle_queries([NodeQuery])
;
Response = Response0
).
@@ -248,8 +251,8 @@
% Find an answer which is `no' and find the suspect that
% corresponds to it from the given list, or else fail.
%
-:- pred find_incorrect_suspect(list(decl_answer), list(suspect(R)),
- suspect(R)).
+:- pred find_incorrect_suspect(list(decl_answer), list(suspect(T)),
+ suspect(T)).
:- mode find_incorrect_suspect(in, in, out) is semidet.
find_incorrect_suspect([Answer | Answers], Suspects, Child) :-
@@ -265,12 +268,11 @@
% Create a new prime suspect from the given suspect, which is
% assumed to be incorrect.
%
-:- pred make_new_prime_suspect(S::in, maybe(subterm_origin(R))::in,
- suspect(R)::in, analyser_response(R)::out,
- analyser_state(R)::in, analyser_state(R)::out) is det
- <= mercury_edt(S, R).
+:- pred make_new_prime_suspect(S::in, suspect(T)::in,
+ analyser_response(T)::out, analyser_state(T)::in,
+ analyser_state(T)::out) is det <= mercury_edt(S, T).
-make_new_prime_suspect(Store, MaybeOrigin, Suspect, Response,
+make_new_prime_suspect(Store, Suspect, Response,
Analyser0, Analyser) :-
get_all_prime_suspects(Analyser0, OldPrimes),
suspect_get_edt_node(Suspect, Tree),
@@ -286,7 +288,7 @@
edt_root_e_bug(Store, Tree, EBug),
Response = bug_found(e_bug(EBug))
;
- Response = oracle_queries(Queries, MaybeOrigin)
+ Response = oracle_queries(Queries)
)
;
% The real suspects cannot be found, so we
@@ -296,12 +298,12 @@
MaybePrime = no,
Response = require_explicit(Tree)
),
- Analyser = analyser(MaybePrime, Suspects, OldPrimes).
+ Analyser = analyser(MaybePrime, Suspects, OldPrimes, no).
% Make a list of previous prime suspects, and include the current
% one if it exists.
%
-:- pred get_all_prime_suspects(analyser_state(R), list(suspect(R))).
+:- pred get_all_prime_suspects(analyser_state(T), list(suspect(T))).
:- mode get_all_prime_suspects(in, out) is det.
get_all_prime_suspects(Analyser, OldPrimes) :-
@@ -314,8 +316,8 @@
OldPrimes = Analyser ^ previous
).
-:- pred make_suspects(S, list(R), list(suspect(R)), list(decl_question))
- <= mercury_edt(S, R).
+:- pred make_suspects(S, list(T), list(suspect(T)), list(decl_question))
+ <= mercury_edt(S, T).
:- mode make_suspects(in, in, out, out) is det.
make_suspects(_, [], [], []).
@@ -327,12 +329,11 @@
% Go through the answers (none of which should be `no') and
% remove the corresponding children from the suspect list.
%
-:- pred remove_suspects(S::in, maybe(subterm_origin(R))::in,
- list(decl_answer)::in, analyser_response(R)::out,
- analyser_state(R)::in, analyser_state(R)::out) is det
- <= mercury_edt(S, R).
+:- pred remove_suspects(S::in, list(decl_answer)::in,
+ analyser_response(T)::out, analyser_state(T)::in,
+ analyser_state(T)::out) is det <= mercury_edt(S, T).
-remove_suspects(Store, MaybeOrigin, [], Response, Analyser, Analyser) :-
+remove_suspects(Store, [], Response, Analyser, Analyser) :-
(
Analyser ^ suspects = []
->
@@ -347,18 +348,17 @@
)
;
list__map(suspect_get_question, Analyser ^ suspects, Queries),
- Response = oracle_queries(Queries, MaybeOrigin)
+ Response = oracle_queries(Queries)
).
-remove_suspects(Store, MaybeOrigin, [Answer | Answers], Response,
- Analyser0, Analyser) :-
+remove_suspects(Store, [Answer | Answers], Response, Analyser0, Analyser) :-
(
Answer = truth_value(_, yes)
->
find_matching_suspects(get_decl_question(Answer),
Analyser0 ^ suspects, _, Suspects),
Analyser1 = Analyser0 ^ suspects := Suspects,
- remove_suspects(Store, MaybeOrigin, Answers, Response,
+ remove_suspects(Store, Answers, Response,
Analyser1, Analyser)
;
error("remove_suspects: unexpected incorrect node")
@@ -371,28 +371,28 @@
%-----------------------------------------------------------------------------%
-:- type suspect(R)
- ---> suspect(R, decl_question).
+:- type suspect(T)
+ ---> suspect(T, decl_question).
-:- pred create_suspect(S, R, suspect(R)) <= mercury_edt(S, R).
+:- pred create_suspect(S, T, suspect(T)) <= mercury_edt(S, T).
:- mode create_suspect(in, in, out) is det.
-create_suspect(S, R, Suspect) :-
- edt_root_question(S, R, Question),
- Suspect = suspect(R, Question).
+create_suspect(S, T, Suspect) :-
+ edt_root_question(S, T, Question),
+ Suspect = suspect(T, Question).
-:- pred suspect_get_edt_node(suspect(R), R).
+:- pred suspect_get_edt_node(suspect(T), T).
:- mode suspect_get_edt_node(in, out) is det.
suspect_get_edt_node(suspect(Node, _), Node).
-:- pred suspect_get_question(suspect(R), decl_question).
+:- pred suspect_get_question(suspect(T), decl_question).
:- mode suspect_get_question(in, out) is det.
suspect_get_question(suspect(_, Question), Question).
-:- pred find_matching_suspects(decl_question, list(suspect(R)),
- list(suspect(R)), list(suspect(R))).
+:- pred find_matching_suspects(decl_question, list(suspect(T)),
+ list(suspect(T)), list(suspect(T))).
:- mode find_matching_suspects(in, in, out, out) is det.
find_matching_suspects(Question, Suspects, Matches, NoMatches) :-
@@ -403,39 +403,39 @@
%-----------------------------------------------------------------------------%
-:- type prime_suspect(R)
+:- type prime_suspect(T)
---> prime_suspect(
% Incorrect node.
%
- suspect(R),
+ suspect(T),
% Evidence: the oracle said these nodes
% were either correct or inadmissible.
%
- list(suspect(R)),
+ list(suspect(T)),
% Earliest inadmissible child, if there
% have been any at all. This child
% is also included in the list of
% evidence.
%
- maybe(suspect(R))
+ maybe(suspect(T))
).
% Create a prime suspect from a suspect.
%
-:- pred create_prime_suspect(suspect(R), prime_suspect(R)).
+:- pred create_prime_suspect(suspect(T), prime_suspect(T)).
:- mode create_prime_suspect(in, out) is det.
create_prime_suspect(Suspect, Prime) :-
Prime = prime_suspect(Suspect, [], no).
-:- pred prime_suspect_get_suspect(prime_suspect(R), suspect(R)).
+:- pred prime_suspect_get_suspect(prime_suspect(T), suspect(T)).
:- mode prime_suspect_get_suspect(in, out) is det.
prime_suspect_get_suspect(prime_suspect(Suspect, _, _), Suspect).
-:- pred prime_suspect_get_edt_node(prime_suspect(R), R).
+:- pred prime_suspect_get_edt_node(prime_suspect(T), T).
:- mode prime_suspect_get_edt_node(in, out) is det.
prime_suspect_get_edt_node(prime_suspect(Suspect, _, _), EDT) :-
@@ -445,8 +445,8 @@
% and who are deemed correct or inadmissible. Maybe get
% the earliest inadmissible child (if there was one).
%
-:- pred prime_suspect_get_evidence(prime_suspect(R), list(suspect(R)),
- maybe(suspect(R))).
+:- pred prime_suspect_get_evidence(prime_suspect(T), list(suspect(T)),
+ maybe(suspect(T))).
:- mode prime_suspect_get_evidence(in, out, out) is det.
prime_suspect_get_evidence(prime_suspect(_, E, M), E, M).
@@ -456,8 +456,8 @@
% This predicate will be more interesting when decl_truth
% has three values.
%
-:- pred prime_suspect_add_evidence(prime_suspect(R), suspect(R), decl_truth,
- prime_suspect(R)).
+:- pred prime_suspect_add_evidence(prime_suspect(T), suspect(T), decl_truth,
+ prime_suspect(T)).
:- mode prime_suspect_add_evidence(in, in, in, out) is det.
prime_suspect_add_evidence(Prime0, Suspect, yes, Prime) :-
@@ -467,3 +467,4 @@
prime_suspect_add_evidence(_, _, no, _) :-
error("prime_suspect_add_evidence: not evidence").
+
diff -u browser/declarative_debugger.m browser/declarative_debugger.m
--- browser/declarative_debugger.m
+++ browser/declarative_debugger.m
@@ -210,28 +210,29 @@
{ start_analysis(wrap(Store), dynamic(NodeId), AnalyserResponse,
Analyser0, Analyser) },
{ diagnoser_set_analyser(Diagnoser0, Analyser, Diagnoser1) },
- handle_analyser_response(Store, AnalyserResponse, Response,
- Diagnoser1, Diagnoser).
+ { debug_analyser_state(Analyser, MaybeOrigin) },
+ handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
+ Response, Diagnoser1, Diagnoser).
:- pred handle_analyser_response(S::in, analyser_response(edt_node(R))::in,
- diagnoser_response::out,
+ maybe(subterm_origin(edt_node(R)))::in, diagnoser_response::out,
diagnoser_state(R)::in, diagnoser_state(R)::out,
io__state::di, io__state::uo) is cc_multi <= annotated_trace(S, R).
-handle_analyser_response(_, no_suspects, no_bug_found, D, D) -->
+handle_analyser_response(_, no_suspects, _, no_bug_found, D, D) -->
io__write_string("No bug found.\n").
-handle_analyser_response(_, bug_found(Bug), Response, Diagnoser0,
+handle_analyser_response(_, bug_found(Bug), _, Response, Diagnoser0,
Diagnoser) -->
confirm_bug(Bug, Response, Diagnoser0, Diagnoser).
-handle_analyser_response(Store, oracle_queries(Queries, MaybeOrigin), Response,
+handle_analyser_response(Store, oracle_queries(Queries), MaybeOrigin, Response,
Diagnoser0, Diagnoser) -->
{ diagnoser_get_oracle(Diagnoser0, Oracle0) },
+ debug_origin(Flag),
(
{ MaybeOrigin = yes(Origin) },
- { debug_origin(Flag) },
{ Flag > 0 }
->
io__write_string("Origin: "),
@@ -245,7 +246,7 @@
handle_oracle_response(Store, OracleResponse, Response, Diagnoser1,
Diagnoser).
-handle_analyser_response(Store, require_explicit(Tree), Response,
+handle_analyser_response(Store, require_explicit(Tree), _, Response,
Diagnoser, Diagnoser) -->
{
edt_subtree_details(Store, Tree, Event, Seqno),
@@ -263,8 +264,9 @@
{ continue_analysis(wrap(Store), Answers, AnalyserResponse,
Analyser0, Analyser) },
{ diagnoser_set_analyser(Diagnoser0, Analyser, Diagnoser1) },
- handle_analyser_response(Store, AnalyserResponse, Response,
- Diagnoser1, Diagnoser).
+ { debug_analyser_state(Analyser, MaybeOrigin) },
+ handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
+ Response, Diagnoser1, Diagnoser).
handle_oracle_response(_, no_oracle_answers, no_bug_found, D, D) -->
[].
@@ -631,10 +633,11 @@
% position in the full list of
% arguments, including the
% compiler-generated ones.
- R, % The id of the exit goal,
- % if start_loc is cur_goal
- % and the id of the call goal
- % if start_loc is parent_goal.
+ R, % The id of the node preceding the exit
+ % node, if start_loc is cur_goal
+ % and the id of the node preceding the
+ % call node if start_loc is
+ % parent_goal.
maybe(goal_path),
% No if start_loc is cur_goal;
% and yes wrapped around the goal path
@@ -659,7 +662,7 @@
list(var_rep), % vars bound by the atomic goal
atomic_goal_rep,% the atomic goal itself
goal_path, % its goal path
- maybe(edt_node(R))
+ maybe(R)
% if the atomic goal is a call,
% the id of the call's exit event
).
@@ -669,8 +672,7 @@
subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
- find_chain_start(wrap(Store), dynamic(Ref), ArgPos, TermPath,
- ChainStart),
+ find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart),
ChainStart = chain_start(StartLoc, ArgNum, NodeId, StartPath,
MaybeProcRep),
Mode = start_loc_to_subterm_mode(StartLoc),
@@ -680,109 +682,114 @@
;
MaybeProcRep = yes(ProcRep),
det_trace_node_from_id(Store, NodeId, Node),
- materialize_contour(wrap(Store), dynamic(NodeId), Node,
- [], Contour0),
+ materialize_contour(Store, NodeId, Node, [], Contour0),
(
StartLoc = parent_goal(CallId, CallNode),
- Contour = list__append(Contour0,
- [dynamic(CallId) - CallNode])
+ Contour = list__append(Contour0, [CallId - CallNode])
;
StartLoc = cur_goal,
Contour = Contour0
),
ProcRep = proc_rep(HeadVars, GoalRep),
- make_primitive_list(wrap(Store), [goal_and_path(GoalRep, [])],
+ make_primitive_list(Store, [goal_and_path(GoalRep, [])],
Contour, StartPath, ArgNum, HeadVars, Var,
[], Primitives),
traverse_primitives(Primitives, Var, TermPath,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
).
-:- pred find_chain_start(wrap(S)::in, edt_node(R)::in,
- arg_pos::in, term_path::in, dependency_chain_start(R)::out)
- is det <= annotated_trace(S, R).
+:- pred find_chain_start(S::in, R::in, arg_pos::in, term_path::in,
+ dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
-find_chain_start(wrap(Store), dynamic(Ref), ArgPos, TermPath,
- ChainStart) :-
+find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart) :-
det_edt_return_node_from_id(Store, Ref, Node),
(
- Node = exit(ExitPrec, CallId, _, ExitAtom, _),
- call_node_from_id(Store, CallId, Call),
- Call = call(CallPrec, _, CallAtom, _, _, _, ProcRep,
- CallPathStr),
+ Node = exit(_, CallId, _, ExitAtom, _),
+ call_node_from_id(Store, CallId, CallNode),
+ CallAtom = CallNode ^ call_atom,
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
- path_from_string_det(CallPathStr, CallPath),
- StartLoc = parent_goal(CallId, Call),
- absolute_arg_num(ArgPos, CallAtom, ArgNum),
- StartId = CallPrec,
- StartPath = yes(CallPath),
- parent_proc_rep(wrap(Store), dynamic(CallId), StartRep)
+ find_chain_start_inside(Store, CallId, CallNode,
+ ArgPos, ChainStart)
; trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath) ->
- StartLoc = cur_goal,
- absolute_arg_num(ArgPos, ExitAtom, ArgNum),
- StartId = ExitPrec,
- StartPath = no,
- StartRep = ProcRep
+ find_chain_start_outside(CallNode, Node, ArgPos,
+ ChainStart)
;
error("find_chain_start: unbound wrong answer term")
)
;
Node = fail(_, CallId, _, _),
- call_node_from_id(Store, CallId, Call),
- Call = call(CallPrec, _, CallAtom, _, _, _, _, CallPathStr),
+ call_node_from_id(Store, CallId, CallNode),
+ CallAtom = CallNode ^ call_atom,
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
- path_from_string_det(CallPathStr, CallPath),
- StartLoc = parent_goal(CallId, Call),
- absolute_arg_num(ArgPos, CallAtom, ArgNum),
- StartId = CallPrec,
- StartPath = yes(CallPath),
- parent_proc_rep(wrap(Store), dynamic(CallId), StartRep)
+ find_chain_start_inside(Store, CallId, CallNode,
+ ArgPos, ChainStart)
;
error("find_chain_start: unbound missing answer term")
)
;
Node = excp(_, CallId, _, _, _),
- call_node_from_id(Store, CallId, Call),
- Call = call(CallPrec, _, CallAtom, _, _, _, _, CallPathStr),
+ call_node_from_id(Store, CallId, CallNode),
+ CallAtom = CallNode ^ call_atom,
%
% XXX we don't yet handle tracking of the exception value.
%
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
- path_from_string_det(CallPathStr, CallPath),
- StartLoc = parent_goal(CallId, Call),
- absolute_arg_num(ArgPos, CallAtom, ArgNum),
- StartId = CallPrec,
- StartPath = yes(CallPath),
- parent_proc_rep(wrap(Store), dynamic(CallId), StartRep)
+ find_chain_start_inside(Store, CallId, CallNode,
+ ArgPos, ChainStart)
;
error("find_chain_start: unbound exception term")
)
- ),
+ ).
+
+:- pred find_chain_start_inside(S::in, R::in,
+ trace_node(R)::in(trace_node_call), arg_pos::in,
+ dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
+
+find_chain_start_inside(Store, CallId, CallNode, ArgPos, ChainStart) :-
+ CallNode = call(CallPrecId, _, CallAtom, _, _, _, _, CallPathStr),
+ path_from_string_det(CallPathStr, CallPath),
+ StartLoc = parent_goal(CallId, CallNode),
+ absolute_arg_num(ArgPos, CallAtom, ArgNum),
+ StartId = CallPrecId,
+ StartPath = yes(CallPath),
+ parent_proc_rep(Store, CallId, StartRep),
ChainStart = chain_start(StartLoc, ArgNum, StartId, StartPath,
StartRep).
-:- pred parent_proc_rep(wrap(S)::in, edt_node(R)::in, maybe(proc_rep)::out)
+:- pred find_chain_start_outside(trace_node(R)::in(trace_node_call),
+ trace_node(R)::in(trace_node_exit), arg_pos::in,
+ dependency_chain_start(R)::out) is det.
+
+find_chain_start_outside(CallNode, ExitNode, ArgPos, ChainStart) :-
+ StartLoc = cur_goal,
+ ExitAtom = ExitNode ^ exit_atom,
+ absolute_arg_num(ArgPos, ExitAtom, ArgNum),
+ StartId = ExitNode ^ exit_preceding,
+ StartPath = no,
+ StartRep = CallNode ^ call_proc_rep,
+ ChainStart = chain_start(StartLoc, ArgNum, StartId,
+ StartPath, StartRep).
+
+:- pred parent_proc_rep(S::in, R::in, maybe(proc_rep)::out)
is det <= annotated_trace(S, R).
-parent_proc_rep(wrap(Store), dynamic(CallId), ProcRep) :-
+parent_proc_rep(Store, CallId, ProcRep) :-
call_node_from_id(Store, CallId, Call),
Call = call(CallPrecId, _, _, _, _, _, _, _),
( trace_node_from_id(Store, CallPrecId, CallPrecNode) ->
- step_left_to_call(Store, CallPrecId, CallPrecNode,
- ParentCallId),
- call_node_from_id(Store, ParentCallId, ParentCall),
- ProcRep = ParentCall ^ call_proc_rep
+ step_left_to_call(Store, CallPrecNode, ParentCallNode),
+ ProcRep = ParentCallNode ^ call_proc_rep
;
% The parent call is outside the annotated trace.
ProcRep = no
).
-:- pred step_left_to_call(S::in, R::in, trace_node(R)::in, R::out) is det
- <= annotated_trace(S, R).
+:- pred step_left_to_call(S::in, trace_node(R)::in,
+ trace_node(R)::out(trace_node_call)) is det <= annotated_trace(S, R).
-step_left_to_call(Store, Id, Node, ParentCallId) :-
+step_left_to_call(Store, Node, ParentCallNode) :-
( Node = call(_, _, _, _, _, _, _, _) ->
- ParentCallId = Id
+ ParentCallNode = Node
;
( Node = neg(NegPrec, _, _) ->
PrevNodeId = NegPrec
@@ -790,15 +797,14 @@
PrevNodeId = step_left_in_contour(Store, Node)
),
det_trace_node_from_id(Store, PrevNodeId, PrevNode),
- step_left_to_call(Store, PrevNodeId, PrevNode, ParentCallId)
+ step_left_to_call(Store, PrevNode, ParentCallNode)
).
-:- pred materialize_contour(wrap(S)::in, edt_node(R)::in, trace_node(R)::in,
- assoc_list(edt_node(R), trace_node(R))::in,
- assoc_list(edt_node(R), trace_node(R))::out) is det
- <= annotated_trace(S, R).
+:- pred materialize_contour(S::in, R::in, trace_node(R)::in,
+ assoc_list(R, trace_node(R))::in, assoc_list(R, trace_node(R))::out)
+ is det <= annotated_trace(S, R).
-materialize_contour(wrap(Store), NodeId, Node, Nodes0, Nodes) :-
+materialize_contour(Store, NodeId, Node, Nodes0, Nodes) :-
( Node = call(_, _, _, _, _, _, _, _) ->
Nodes = Nodes0
;
@@ -816,24 +822,23 @@
;
Nodes1 = [NodeId - Node | Nodes0]
),
- materialize_contour(wrap(Store), dynamic(PrevNodeId), PrevNode,
+ materialize_contour(Store, PrevNodeId, PrevNode,
Nodes1, Nodes)
).
-:- pred make_primitive_list(wrap(S)::in, goal_and_path_list::in,
- assoc_list(edt_node(R), trace_node(R))::in, maybe(goal_path)::in,
+:- pred make_primitive_list(S::in, goal_and_path_list::in,
+ assoc_list(R, trace_node(R))::in, maybe(goal_path)::in,
int::in, list(var_rep)::in, var_rep::out,
list(annotated_primitive(R))::in, list(annotated_primitive(R))::out)
is det <= annotated_trace(S, R).
-make_primitive_list(wrap(Store), [goal_and_path(Goal, Path) | GoalPaths],
+make_primitive_list(Store, [goal_and_path(Goal, Path) | GoalPaths],
Contour, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives) :-
(
Goal = conj_rep(Conjs),
add_paths_to_conjuncts(Conjs, Path, 1, ConjPaths),
- make_primitive_list(wrap(Store),
- list__append(ConjPaths, GoalPaths),
+ make_primitive_list(Store, list__append(ConjPaths, GoalPaths),
Contour, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
;
@@ -849,8 +854,7 @@
->
list__index1_det(Disjs, N, Disj),
DisjAndPath = goal_and_path(Disj, DisjPath),
- make_primitive_list(wrap(Store),
- [DisjAndPath | GoalPaths],
+ make_primitive_list(Store, [DisjAndPath | GoalPaths],
ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
;
@@ -867,8 +871,7 @@
->
list__index1_det(Arms, N, Arm),
ArmAndPath = goal_and_path(Arm, ArmPath),
- make_primitive_list(wrap(Store),
- [ArmAndPath | GoalPaths],
+ make_primitive_list(Store, [ArmAndPath | GoalPaths],
ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
;
@@ -886,7 +889,7 @@
ThenPath = list__append(Path, [ite_then]),
CondAndPath = goal_and_path(Cond, CondPath),
ThenAndPath = goal_and_path(Then, ThenPath),
- make_primitive_list(wrap(Store),
+ make_primitive_list(Store,
[CondAndPath, ThenAndPath | GoalPaths],
ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
@@ -901,8 +904,7 @@
->
ElsePath = list__append(Path, [ite_else]),
ElseAndPath = goal_and_path(Else, ElsePath),
- make_primitive_list(wrap(Store),
- [ElseAndPath | GoalPaths],
+ make_primitive_list(Store, [ElseAndPath | GoalPaths],
ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
;
@@ -915,7 +917,7 @@
ContourHeadNode = neg_succ(_, _)
->
% The negated goal cannot contribute any bindings.
- make_primitive_list(wrap(Store), GoalPaths,
+ make_primitive_list(Store, GoalPaths,
ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
;
@@ -926,7 +928,7 @@
% NegGoal.
NegPath = list__append(Path, [neg]),
NegAndPath = goal_and_path(NegGoal, NegPath),
- make_primitive_list(wrap(Store), [NegAndPath],
+ make_primitive_list(Store, [NegAndPath],
ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
;
@@ -936,7 +938,7 @@
Goal = some_rep(InnerGoal, MaybeCut),
InnerPath = list__append(Path, [exist(MaybeCut)]),
InnerAndPath = goal_and_path(InnerGoal, InnerPath),
- make_primitive_list(wrap(Store), [InnerAndPath | GoalPaths],
+ make_primitive_list(Store, [InnerAndPath | GoalPaths],
Contour, MaybeEnd, ArgNum, HeadVars, Var,
Primitives0, Primitives)
;
@@ -960,7 +962,7 @@
Primitive = primitive(File, Line, BoundVars,
AtomicGoal, Path, yes(ContourHeadId)),
Primitives1 = [Primitive | Primitives0],
- make_primitive_list(wrap(Store), GoalPaths,
+ make_primitive_list(Store, GoalPaths,
ContourTail, MaybeEnd, ArgNum,
HeadVars, Var, Primitives1, Primitives)
;
@@ -982,7 +984,7 @@
Primitive = primitive(File, Line, BoundVars,
AtomicGoal, Path, no),
Primitives1 = [Primitive | Primitives0],
- make_primitive_list(wrap(Store), GoalPaths,
+ make_primitive_list(Store, GoalPaths,
Contour, MaybeEnd, ArgNum, HeadVars, Var,
Primitives1, Primitives)
)
@@ -996,14 +998,14 @@
list__index1_det(HeadVars, ArgNum, Var).
:- pred traverse_primitives(list(annotated_primitive(R))::in,
- var_rep::in, term_path::in, wrap(S)::in, proc_rep::in,
+ var_rep::in, term_path::in, S::in, proc_rep::in,
subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
traverse_primitives([], Var0, TermPath0, _, ProcRep, Origin) :-
ProcRep = proc_rep(HeadVars, _),
ArgPos = find_arg_pos(HeadVars, Var0),
Origin = input(ArgPos, TermPath0).
-traverse_primitives([Prim | Prims], Var0, TermPath0, wrap(Store), ProcRep,
+traverse_primitives([Prim | Prims], Var0, TermPath0, Store, ProcRep,
Origin) :-
Prim = primitive(File, Line, BoundVars, AtomicGoal, _GoalPath,
MaybeNodeId),
@@ -1012,17 +1014,17 @@
( list__member(Var0, BoundVars) ->
(
TermPath0 = [],
- Origin = primitive(File, Line)
+ Origin = primitive_op(File, Line)
;
TermPath0 = [TermPathStep0 | TermPath],
list__index1_det(FieldVars, TermPathStep0,
Var),
traverse_primitives(Prims, Var, TermPath,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
)
;
traverse_primitives(Prims, Var0, TermPath0,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
)
;
AtomicGoal = unify_deconstruct_rep(CellVar, _Cons, FieldVars),
@@ -1030,13 +1032,13 @@
( list__nth_member_search(FieldVars, Var0, Pos) ->
traverse_primitives(Prims,
CellVar, [Pos | TermPath0],
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
;
error("traverse_primitives: bad deconstruct")
)
;
traverse_primitives(Prims, Var0, TermPath0,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
)
;
AtomicGoal = unify_assign_rep(ToVar, FromVar),
@@ -1044,18 +1046,18 @@
require(unify(Var0, ToVar),
"traverse_primitives: bad assign"),
traverse_primitives(Prims, FromVar, TermPath0,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
;
traverse_primitives(Prims, Var0, TermPath0,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
)
;
AtomicGoal = pragma_foreign_code_rep(_Args),
( list__member(Var0, BoundVars) ->
- Origin = primitive(File, Line)
+ Origin = primitive_op(File, Line)
;
traverse_primitives(Prims, Var0, TermPath0,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
)
;
AtomicGoal = unify_simple_test_rep(_LVar, _RVar),
@@ -1063,22 +1065,22 @@
error("traverse_primitives: bad test")
;
traverse_primitives(Prims, Var0, TermPath0,
- wrap(Store), ProcRep, Origin)
+ Store, ProcRep, Origin)
)
;
AtomicGoal = higher_order_call_rep(_, Args),
traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
- Var0, TermPath0, wrap(Store), ProcRep, Origin)
+ Var0, TermPath0, Store, ProcRep, Origin)
;
AtomicGoal = method_call_rep(_, _, Args),
traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
- Var0, TermPath0, wrap(Store), ProcRep, Origin)
+ Var0, TermPath0, Store, ProcRep, Origin)
;
AtomicGoal = plain_call_rep(ModuleName, PredName, Args),
PlainCallInfo = plain_call_info(File, Line,
ModuleName, PredName),
traverse_call(BoundVars, yes(PlainCallInfo), Args, MaybeNodeId,
- Prims, Var0, TermPath0, wrap(Store), ProcRep, Origin)
+ Prims, Var0, TermPath0, Store, ProcRep, Origin)
).
:- type plain_call_info
@@ -1090,18 +1092,18 @@
).
:- pred traverse_call(list(var_rep)::in, maybe(plain_call_info)::in,
- list(var_rep)::in, maybe(edt_node(R))::in,
+ list(var_rep)::in, maybe(R)::in,
list(annotated_primitive(R))::in, var_rep::in, term_path::in,
- wrap(S)::in, proc_rep::in, subterm_origin(edt_node(R))::out) is det
+ S::in, proc_rep::in, subterm_origin(edt_node(R))::out) is det
<= annotated_trace(S, R).
traverse_call(BoundVars, MaybePlainCallInfo, Args, MaybeNodeId,
- Prims, Var, TermPath, wrap(Store), ProcRep, Origin) :-
+ Prims, Var, TermPath, Store, ProcRep, Origin) :-
( list__member(Var, BoundVars) ->
Pos = find_arg_pos(Args, Var),
(
MaybeNodeId = yes(NodeId),
- Origin = output(NodeId, Pos, TermPath)
+ Origin = output(dynamic(NodeId), Pos, TermPath)
;
MaybeNodeId = no,
(
@@ -1110,14 +1112,14 @@
ModuleName, PredName),
call_is_primitive(ModuleName, PredName)
->
- Origin = primitive(File, Line)
+ Origin = primitive_op(File, Line)
;
error("traverse_call: no node id")
)
)
;
- traverse_primitives(Prims, Var, TermPath,
- wrap(Store), ProcRep, Origin)
+ traverse_primitives(Prims, Var, TermPath, Store, ProcRep,
+ Origin)
).
%-----------------------------------------------------------------------------%
@@ -1224,14 +1226,6 @@
%-----------------------------------------------------------------------------%
-% :- impure pred dump(string::in, T::in) is det.
-
-% dump(Msg, Data) :-
-% impure unsafe_perform_io(io__write_string(Msg)),
-% impure unsafe_perform_io(io__write_string(": ")),
-% impure unsafe_perform_io(io__write(Data)),
-% impure unsafe_perform_io(io__write_string("\n")).
-
:- pred write_origin(wrap(S)::in, subterm_origin(edt_node(R))::in,
io__state::di, io__state::uo) is det <= annotated_trace(S, R).
@@ -1267,11 +1261,12 @@
extern int MR_DD_debug_origin;
").
-:- pred debug_origin(int::out) is det.
+:- pred debug_origin(int::out, io__state::di, io__state::uo) is det.
:- pragma foreign_proc("C",
- debug_origin(Flag::out),
+ debug_origin(Flag::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure],
"
Flag = MR_DD_debug_origin;
+ IO = IO0;
").
diff -u browser/declarative_execution.m browser/declarative_execution.m
--- browser/declarative_execution.m
+++ browser/declarative_execution.m
@@ -100,11 +100,11 @@
% Path for this event.
)
; later_disj(
- last_disj_preceding :: R,
+ later_disj_preceding :: R,
% Preceding event.
- last_disj_goal_path :: goal_path_string,
+ later_disj_goal_path :: goal_path_string,
% Path for this event.
- last_disj_first :: R
+ later_disj_first :: R
% Event of the first DISJ.
)
; cond(
@@ -317,9 +317,9 @@
:- pred maybe_filter_headvars(which_headvars::in, list(trace_atom_arg)::in,
list(trace_atom_arg)::out) is det.
-:- func head_vars_presentation = which_headvars.
+:- func chosen_head_vars_presentation = which_headvars.
-:- pred is_user_vis_arg(trace_atom_arg::in) is semidet.
+:- pred is_user_visible_arg(trace_atom_arg::in) is semidet.
:- pred select_arg_at_pos(arg_pos::in, list(trace_atom_arg)::in,
trace_atom_arg::out) is det.
@@ -688,6 +688,8 @@
:- pragma export(trace_node_path(in, in) = out,
"MR_DD_trace_node_path").
+% XXX fix the returned path for interface events other than calls.
+
trace_node_path(_, call(_, _, _, _, _, _, _, P)) = P.
trace_node_path(_, exit(_, _, _, _, _)) = "".
trace_node_path(_, redo(_, _)) = "".
@@ -939,23 +941,30 @@
Atom = atom(PredOrFunc, Functor, Args),
list__duplicate(Arity, dummy_arg_info, Args).
+ % add_trace_atom_arg_value(Atom0, ArgNum, HldsNum, ProgVis, Val):
+ % Register the fact that argument number ArgNum in Atom is the HLDS
+ % variable whose number is HldsNum and whose value is Val. ProgVis
+ % is a C boolean, which is true iff variable HldsNum is a user visible
+ % variable.
:- func add_trace_atom_arg_value(trace_atom, int, int, int, univ) = trace_atom.
:- 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), Num, ProgVisNum, ProgVis, Val)
+add_trace_atom_arg_value(atom(C, F, Args0), ArgNum, HldsNum, ProgVis, Val)
= atom(C, F, Args) :-
- Arg = arg_info(c_bool_to_merc_bool(ProgVis), ProgVisNum, yes(Val)),
- list__replace_nth_det(Args0, Num, Arg, Args).
+ Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, yes(Val)),
+ list__replace_nth_det(Args0, ArgNum, Arg, Args).
+ % Like add_trace_atom_arg_value, except that the specified variable
+ % has no value (i.e. it is not bound).
:- func add_trace_atom_arg_no_value(trace_atom, int, int, int) = trace_atom.
:- 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), Num, ProgVisNum, ProgVis)
+add_trace_atom_arg_no_value(atom(C, F, Args0), ArgNum, HldsNum, ProgVis)
= atom(C, F, Args) :-
- Arg = arg_info(c_bool_to_merc_bool(ProgVis), ProgVisNum, no),
- list__replace_nth_det(Args0, Num, Arg, Args).
+ Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, no),
+ list__replace_nth_det(Args0, ArgNum, Arg, Args).
% This code converts a C bool (represented as int) to a Mercury bool.
:- func c_bool_to_merc_bool(int) = bool.
@@ -1094,12 +1103,12 @@
Args = Args0
;
Which = only_user_headvars,
- Args = list__filter(is_user_vis_arg, Args0)
+ Args = list__filter(is_user_visible_arg, Args0)
).
-head_vars_presentation = only_user_headvars.
+chosen_head_vars_presentation = only_user_headvars.
-is_user_vis_arg(arg_info(yes, _, _)).
+is_user_visible_arg(arg_info(yes, _, _)).
select_arg_at_pos(ArgPos, Args0, Arg) :-
(
diff -u browser/declarative_user.m browser/declarative_user.m
--- browser/declarative_user.m
+++ browser/declarative_user.m
@@ -103,7 +103,7 @@
User)
;
{ MaybeMark = yes(Mark) },
- { Which = head_vars_presentation },
+ { Which = chosen_head_vars_presentation },
{
Which = only_user_headvars,
ArgPos = user_head_var(ArgNum)
@@ -174,7 +174,7 @@
browse_atom_argument(Atom, ArgNum, MaybeMark, User0, User) -->
{ Atom = atom(_, _, Args0) },
- { maybe_filter_headvars(head_vars_presentation, Args0, Args) },
+ { maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args) },
(
{ list__index1(Args, ArgNum, ArgInfo) },
{ ArgInfo = arg_info(_, _, MaybeArg) },
@@ -404,7 +404,7 @@
% it out directly so that all arguments are put on the
% same line.
%
- { Which = head_vars_presentation },
+ { Which = chosen_head_vars_presentation },
{ check_decl_atom_size(Indent, Which, Atom, RemSize) },
( { RemSize > 0 } ->
write_decl_atom_direct(User ^ outstr, Atom, Which)
diff -u tests/debugger/declarative/dependency.exp tests/debugger/declarative/dependency.m
--- tests/debugger/declarative/dependency.exp
+++ tests/debugger/declarative/dependency.m
@@ -1,104 +1,76 @@
- 1: 1 1 CALL pred dependency:main/2-0 (cc_multi) dependency.m:11
-mdb> echo on
-Command echo enabled.
-mdb> register --quiet
-mdb> goto 3
- 3: 2 2 EXIT pred dependency:turn_on_origin_debug/0-0 (det) dependency.m:69 (dependency.m:12)
-mdb> dd
-turn_on_origin_debug
-Valid? browse 1
-Invalid argument number
-turn_on_origin_debug
-Valid? abort
-Diagnosis aborted.
- 3: 2 2 EXIT pred dependency:turn_on_origin_debug/0-0 (det) dependency.m:69 (dependency.m:12)
-mdb> step
- 4: 3 2 CALL pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> finish
- 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> set depth 20
-mdb> set size 201
-mdb> set format pretty
-mdb> proc_body
-
-proc_rep(
- [|](1, []),
- conj_rep(
- [|](
- atomic_goal_rep(
- det_rep,
- "dependency.m",
- 20,
- [|](3, []),
- plain_call_rep("dependency", "p", [|](3, []))),
- [|](
- ite_rep(atomic_goal_rep/5, atomic_goal_rep/5, atomic_goal_rep/5),
- [|](atomic_goal_rep/5, [|](switch_rep([|]/2), [|](disj_rep([|]/2), [])))))))
-mdb> dd
-test([1, 3, 6, 1, 3])
-Valid? browse 1
-browser> ^1
-browser> mark
-Origin: primitive("dependency.m", 22)
-p(1)
-Valid? abort
-Diagnosis aborted.
- 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> dd
-test([1, 3, 6, 1, 3])
-Valid? browse 1
-browser> ^2^1
-browser> mark
-Origin: output(r, any_head_var(4), [1])
-r(1, [3, 4], 3 - 4)
-Valid? browse 2
-browser> print
-[3, 4]
-browser> mark
-Origin: primitive("dependency.m", 29)
-p(1)
-Valid? abort
-Diagnosis aborted.
- 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> dd
-test([1, 3, 6, 1, 3])
-Valid? browse 1
-browser> ^2^2^1
-browser> mark
-Origin: primitive("dependency.m", 41)
-p(1)
-Valid? abort
-Diagnosis aborted.
- 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> dd
-test([1, 3, 6, 1, 3])
-Valid? browse 1
-browser> ^2^2^2^1
-browser> mark
-Origin: primitive("dependency.m", 22)
-p(1)
-Valid? abort
-Diagnosis aborted.
- 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> dd
-test([1, 3, 6, 1, 3])
-Valid? browse 1
-browser> ^2^2^2^2^1
-browser> mark
-Origin: output(r, any_head_var(4), [1])
-r(1, [3, 4], 3 - 4)
-Valid? abort
-Diagnosis aborted.
- 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> dd
-test([1, 3, 6, 1, 3])
-Valid? browse 1
-browser> ^2^2^2^2^2
-browser> mark
-Origin: primitive("dependency.m", 43)
-p(1)
-Valid? abort
-Diagnosis aborted.
- 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
-mdb> continue
-[1, 3, 6, 1, 3].
+:- module dependency.
+
+:- interface.
+
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+:- import_module bool, int, list, require, std_util.
+
+main -->
+ { turn_on_origin_debug },
+ { test(L) },
+ io__write(L),
+ io__write_string(".\n").
+
+:- pred test(list(int)::out) is cc_multi.
+
+test(L) :-
+ p(U),
+ ( U = 1 ->
+ A = 1
+ ;
+ A = U
+ ),
+ q(V),
+ (
+ V = no,
+ r(A, [3, 4], BX),
+ BX = B - _
+ ;
+ V = yes,
+ B = 4
+ ),
+ AB = {A, B},
+ (
+ A = 2,
+ C = 5,
+ D = []
+ ;
+ C = 6,
+ AB = {Aprime, Bprime},
+ D = [Aprime, Bprime]
+ ),
+ L = [A, B, C | D].
+
+:- pred p(int::out) is det.
+
+p(1).
+
+:- pred q(bool::out) is det.
+
+q(no).
+
+:- pred r(int::in, list(T)::in, pair(T)::out) is det.
+
+r(A, L, BX) :-
+ (
+ A = 1,
+ L = [E1, E2 | _]
+ ->
+ BX = E1 - E2
+ ;
+ error("r: bad input")
+ ).
+
+:- pred turn_on_origin_debug is det.
+
+:- pragma foreign_proc("C",
+ turn_on_origin_debug,
+ [will_not_call_mercury, promise_pure],
+"
+ extern int MR_DD_debug_origin;
+
+ MR_DD_debug_origin = 1;
+").
diff -u tests/debugger/declarative/dependency.inp tests/debugger/declarative/dependency.m
--- tests/debugger/declarative/dependency.inp
+++ tests/debugger/declarative/dependency.m
@@ -1,46 +1,76 @@
-echo on
-register --quiet
-goto 3
-dd
-browse 1
-abort
-step
-finish
-set depth 20
-set size 201
-set format pretty
-proc_body
-dd
-browse 1
-^1
-mark
-abort
-dd
-browse 1
-^2^1
-mark
-browse 2
-print
-mark
-abort
-dd
-browse 1
-^2^2^1
-mark
-abort
-dd
-browse 1
-^2^2^2^1
-mark
-abort
-dd
-browse 1
-^2^2^2^2^1
-mark
-abort
-dd
-browse 1
-^2^2^2^2^2
-mark
-abort
-continue
+:- module dependency.
+
+:- interface.
+
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+:- import_module bool, int, list, require, std_util.
+
+main -->
+ { turn_on_origin_debug },
+ { test(L) },
+ io__write(L),
+ io__write_string(".\n").
+
+:- pred test(list(int)::out) is cc_multi.
+
+test(L) :-
+ p(U),
+ ( U = 1 ->
+ A = 1
+ ;
+ A = U
+ ),
+ q(V),
+ (
+ V = no,
+ r(A, [3, 4], BX),
+ BX = B - _
+ ;
+ V = yes,
+ B = 4
+ ),
+ AB = {A, B},
+ (
+ A = 2,
+ C = 5,
+ D = []
+ ;
+ C = 6,
+ AB = {Aprime, Bprime},
+ D = [Aprime, Bprime]
+ ),
+ L = [A, B, C | D].
+
+:- pred p(int::out) is det.
+
+p(1).
+
+:- pred q(bool::out) is det.
+
+q(no).
+
+:- pred r(int::in, list(T)::in, pair(T)::out) is det.
+
+r(A, L, BX) :-
+ (
+ A = 1,
+ L = [E1, E2 | _]
+ ->
+ BX = E1 - E2
+ ;
+ error("r: bad input")
+ ).
+
+:- pred turn_on_origin_debug is det.
+
+:- pragma foreign_proc("C",
+ turn_on_origin_debug,
+ [will_not_call_mercury, promise_pure],
+"
+ extern int MR_DD_debug_origin;
+
+ MR_DD_debug_origin = 1;
+").
diff -u trace/mercury_trace_vars.c trace/mercury_trace_vars.c
--- trace/mercury_trace_vars.c
+++ trace/mercury_trace_vars.c
@@ -420,7 +420,7 @@
continue;
}
- /* variable number 1 is stored at offset 0 */
+ /* the offset of variable number 1 is stored at index 0 */
offset = entry->MR_sle_used_var_names[var_num - 1];
if (offset > string_table_size) {
MR_fatal_error("array bounds error on string table");
diff -u trace/mercury_trace_vars.h trace/mercury_trace_vars.h
--- trace/mercury_trace_vars.h
+++ trace/mercury_trace_vars.h
@@ -109,7 +109,7 @@
extern const char *MR_trace_list_vars(FILE *out);
/*
-** Return as a side effect the type and value of the value with the
+** Return as a side effect the type and value of the variable with the
** specified HLDS number, in the specified locations, all of which must be
** non-NULL. If the variable isn't live or isn't known, return a non-null
** string giving the problem.
--------------------------------------------------------------------------
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