[m-rev.] for review: dependency tracking
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Apr 19 17:10:56 AEST 2002
For review by Mark.
Zoltan.
Redesign the way the declarative debugger traces dependencies, to avoid bugs
and make the code comprehensible. This required tacking an issue we could
ignore before: the typeinfos added to procedure arguments by the compiler.
browsers/declarative_debugger.m:
Rewrite the dependency algorithm from scratch. It now has three phases:
materializing the contour leading up to the relevent point in the
procedure body, using that contour to construct a list of the conjoined
primitive operations executed up to that point by the procedure body,
and tracing the source of the marked subterm in this list of
primitives.
Add a mechanism to print out the result of the dependency tracing
algorithm if a flag is set, for testing and debugging.
browsers/declarative_analyser.m:
Transmit the result of the trace dependency algorithm to where it may
be printed out.
Be more consistent in the names of type variables.
browsers/declarative_user.m:
Update the user interface to make it switchable between viewing atoms
from the user's perspective (with compiler-generated arguments hidden)
and the implementor's perspective (with compiler-generated arguments
visible). The default view is the user view.
browsers/declarative_execution.m:
Add the immediate parent's goal path to the representation of call
events; this allows us to place the call in the body of its parent.
Expand the representation of atom arguments to include their HLDS
variable numbers, and a boolean that says whether the argument
is a programmer-visible headvar.
Use this extra information to add support for indexing lists of
arguments from either the user view or the implementor view.
Add field names to several types.
browsers/program_representation.m:
Add a field to plain calls, giving the name of the module defining
the called procedure. This is necessary to reliable distinguish
the builtin unify and compare procedures, calls to which must be
handled specially because they generate no events. (They don't need to,
since they are correct by construction.)
Add mechanisms for converting goal paths from strings to structured
terms, for use by the dependency tracking code.
Add tests on atomic goals, for use by the dependency tracking code.
Add a mechanism to let C code retrieve the types of proc_reps as well
as goal_reps.
compiler/prog_rep.m:
Fill in the module name field in plain calls.
trace/mercury_trace_vars.[ch]:
Add functions to get information about a variable specified by HLDS
number.
trace/mercury_trace_declarative.c:
Include typeinfos in the atoms constructed at interface events.
(The same code will work for typeclassinfos as well, once they
become deconstructable and hence printable.)
Fill in the extra slot in call events, and the extra slots in
representations of atom arguments.
trace/mercury_trace_internal.c:
Fix a bug in the implementation of the proc_body command: the
type of the proc_rep slot is proc_rep, not goal_rep.
tests/debugger/declarative/dependency.{m,inp,exp}:
A new test case to exercise dependency tracking. It cooperates with
instrumentation code in the browser directory to print out the result
of each trace_dependency operation.
The test case also tests the proc_body command.
tests/debugger/declarative/Mmakefile:
Enable the new test case.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.8
diff -u -b -r1.8 declarative_analyser.m
--- browser/declarative_analyser.m 23 Apr 2001 17:28:55 -0000 1.8
+++ browser/declarative_analyser.m 11 Apr 2002 06:54:55 -0000
@@ -12,8 +12,8 @@
:- module mdb__declarative_analyser.
:- interface.
-:- import_module list.
:- import_module mdb__declarative_debugger, mdb__program_representation.
+:- import_module list, std_util.
% This typeclass defines how EDTs may be accessed by this module.
% An EDT is a tree of nodes, each of which contains a question
@@ -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, T) where [
+:- typeclass mercury_edt(S, R) where [
% Gives the root node of an EDT.
%
- pred edt_root_question(S, T, decl_question),
+ pred edt_root_question(S, R, 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, T, decl_e_bug),
+ pred edt_root_e_bug(S, R, 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, T, list(T)),
+ pred edt_children(S, R, list(R)),
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, T, arg_pos, term_path, subterm_mode,
- subterm_origin(T)),
+ pred edt_dependency(S, R, arg_pos, term_path, subterm_mode,
+ subterm_origin(R)),
mode edt_dependency(in, in, in, in, out, out) is det
].
@@ -53,27 +53,35 @@
---> subterm_in
; subterm_out.
-:- type subterm_origin(T)
+:- type subterm_origin(R)
- % Subterm came from an output of a child or sibling.
- %
- ---> output(T, arg_pos, term_path)
-
- % Subterm came from an input of the parent.
+ % 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.
+ %
+ ---> output(R, 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.
%
; input(arg_pos, term_path)
% Subterm was constructed in the body. We record
- % the filename and line number of the unification.
+ % 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.
%
- ; unification(string, int)
+ ; primitive(string, int)
% The origin could not be found due to missing
% information.
%
; not_found.
-:- type analyser_response(T)
+:- type analyser_response(R)
% There are no suspects left, and no incorrect
% nodes have been found.
@@ -87,57 +95,59 @@
% The analyser desires answers to any of a list
% of queries.
%
- ; oracle_queries(list(decl_question))
+ ; oracle_queries(list(decl_question), maybe(subterm_origin(R)))
% The analyser requires the given implicit sub-tree
% to be made explicit.
%
- ; require_explicit(T).
+ ; require_explicit(R).
-:- type analyser_state(T).
+:- type analyser_state(R).
-:- pred analyser_state_init(analyser_state(T)).
+:- pred analyser_state_init(analyser_state(R)).
:- 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, T, analyser_response(T), analyser_state(T),
- analyser_state(T)) <= mercury_edt(S, T).
+:- pred start_analysis(S, R, analyser_response(R), analyser_state(R),
+ analyser_state(R)) <= mercury_edt(S, R).
:- 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(T),
- analyser_state(T), analyser_state(T)) <= mercury_edt(S, T).
+:- pred continue_analysis(S, list(decl_answer), analyser_response(R),
+ analyser_state(R), analyser_state(R)) <= mercury_edt(S, R).
:- mode continue_analysis(in, in, out, in, 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(T)
+:- type analyser_state(R)
---> analyser(
% Current incorrect node (initially `no').
% This is the most recent node that the
% oracle has said is incorrect.
%
- maybe_prime :: maybe(prime_suspect(T)),
+ maybe_prime :: maybe(prime_suspect(R)),
% Current suspects.
%
- suspects :: list(suspect(T)),
+ suspects :: list(suspect(R)),
% Previous prime suspects.
%
- previous :: list(suspect(T))
+ previous :: list(suspect(R))
).
analyser_state_init(analyser(no, [], [])).
@@ -146,7 +156,7 @@
make_suspects(Store, [Tree], Suspects, Queries),
get_all_prime_suspects(Analyser0, OldPrimes),
Analyser = analyser(no, Suspects, OldPrimes),
- Response = oracle_queries(Queries).
+ Response = oracle_queries(Queries, no).
continue_analysis(Store, Answers, Response, Analyser0, Analyser) :-
%
@@ -160,30 +170,30 @@
%
Suspects = Analyser0 ^ suspects,
(
- find_suspicious_subterm(Answers, Suspects, Suspect, ArgPos,
- TermPath)
+ find_suspicious_subterm(Answers, Suspects,
+ Suspect, ArgPos, TermPath)
->
follow_suspicious_subterm(Store, Suspect, ArgPos, TermPath,
Response, Analyser0, Analyser)
;
find_incorrect_suspect(Answers, Suspects, Suspect)
->
- make_new_prime_suspect(Store, Suspect, Response, Analyser0,
- Analyser)
+ make_new_prime_suspect(Store, no, Suspect, Response,
+ Analyser0, Analyser)
;
- remove_suspects(Store, Answers, Response, Analyser0, Analyser)
+ remove_suspects(Store, no, 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(T)),
- suspect(T), arg_pos, term_path).
+:- pred find_suspicious_subterm(list(decl_answer), list(suspect(R)),
+ suspect(R), arg_pos, term_path).
:- mode find_suspicious_subterm(in, in, out, out, out) is semidet.
find_suspicious_subterm([Answer | Answers], Suspects, Suspect, ArgPos,
TermPath) :-
-
(
Answer = suspicious_subterm(Question, ArgPos0, TermPath0),
find_matching_suspects(Question, Suspects, [Match | _], _)
@@ -196,9 +206,9 @@
TermPath)
).
-:- pred follow_suspicious_subterm(S, suspect(T), arg_pos, term_path,
- analyser_response(T), analyser_state(T), analyser_state(T))
- <= mercury_edt(S, T).
+:- pred follow_suspicious_subterm(S, suspect(R), arg_pos, term_path,
+ analyser_response(R), analyser_state(R), analyser_state(R))
+ <= mercury_edt(S, R).
:- mode follow_suspicious_subterm(in, in, in, in, out, in, out) is det.
follow_suspicious_subterm(Store, Suspect, ArgPos, TermPath, Response,
@@ -212,16 +222,16 @@
%
(
SubtermMode = subterm_in,
- remove_suspects(Store, [truth_value(Query, yes)], Response0,
- Analyser0, Analyser)
+ remove_suspects(Store, yes(Origin), [truth_value(Query, yes)],
+ Response0, Analyser0, Analyser)
;
SubtermMode = subterm_out,
- make_new_prime_suspect(Store, Suspect, Response0, Analyser0,
- Analyser)
+ make_new_prime_suspect(Store, yes(Origin), Suspect, Response0,
+ Analyser0, Analyser)
),
(
Origin = output(Node, _, _),
- Response0 = oracle_queries(_)
+ Response0 = oracle_queries(_, MaybeOrigin)
->
%
% Replace all of the queries with just the one which output
@@ -230,7 +240,7 @@
% previous answer available.
%
create_suspect(Store, Node, suspect(_, NodeQuery)),
- Response = oracle_queries([NodeQuery])
+ Response = oracle_queries([NodeQuery], MaybeOrigin)
;
Response = Response0
).
@@ -238,8 +248,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(T)),
- suspect(T)).
+:- pred find_incorrect_suspect(list(decl_answer), list(suspect(R)),
+ suspect(R)).
:- mode find_incorrect_suspect(in, in, out) is semidet.
find_incorrect_suspect([Answer | Answers], Suspects, Child) :-
@@ -255,11 +265,13 @@
% Create a new prime suspect from the given suspect, which is
% assumed to be incorrect.
%
-:- pred make_new_prime_suspect(S, suspect(T), analyser_response(T),
- analyser_state(T), analyser_state(T)) <= mercury_edt(S, T).
-:- mode make_new_prime_suspect(in, in, out, in, out) is det.
+:- 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).
-make_new_prime_suspect(Store, Suspect, Response, Analyser0, Analyser) :-
+make_new_prime_suspect(Store, MaybeOrigin, Suspect, Response,
+ Analyser0, Analyser) :-
get_all_prime_suspects(Analyser0, OldPrimes),
suspect_get_edt_node(Suspect, Tree),
(
@@ -274,7 +286,7 @@
edt_root_e_bug(Store, Tree, EBug),
Response = bug_found(e_bug(EBug))
;
- Response = oracle_queries(Queries)
+ Response = oracle_queries(Queries, MaybeOrigin)
)
;
% The real suspects cannot be found, so we
@@ -289,7 +301,7 @@
% Make a list of previous prime suspects, and include the current
% one if it exists.
%
-:- pred get_all_prime_suspects(analyser_state(T), list(suspect(T))).
+:- pred get_all_prime_suspects(analyser_state(R), list(suspect(R))).
:- mode get_all_prime_suspects(in, out) is det.
get_all_prime_suspects(Analyser, OldPrimes) :-
@@ -302,8 +314,8 @@
OldPrimes = Analyser ^ previous
).
-:- pred make_suspects(S, list(T), list(suspect(T)), list(decl_question))
- <= mercury_edt(S, T).
+:- pred make_suspects(S, list(R), list(suspect(R)), list(decl_question))
+ <= mercury_edt(S, R).
:- mode make_suspects(in, in, out, out) is det.
make_suspects(_, [], [], []).
@@ -315,11 +327,12 @@
% Go through the answers (none of which should be `no') and
% remove the corresponding children from the suspect list.
%
-:- pred remove_suspects(S, list(decl_answer), analyser_response(T),
- analyser_state(T), analyser_state(T)) <= mercury_edt(S, T).
-:- mode remove_suspects(in, in, out, in, out) is det.
+:- 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).
-remove_suspects(Store, [], Response, Analyser, Analyser) :-
+remove_suspects(Store, MaybeOrigin, [], Response, Analyser, Analyser) :-
(
Analyser ^ suspects = []
->
@@ -334,19 +347,19 @@
)
;
list__map(suspect_get_question, Analyser ^ suspects, Queries),
- Response = oracle_queries(Queries)
+ Response = oracle_queries(Queries, MaybeOrigin)
).
-remove_suspects(Store, [Answer | Answers], Response, Analyser0,
- Analyser) :-
-
+remove_suspects(Store, MaybeOrigin, [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, Answers, Response, Analyser1, Analyser)
+ remove_suspects(Store, MaybeOrigin, Answers, Response,
+ Analyser1, Analyser)
;
error("remove_suspects: unexpected incorrect node")
).
@@ -358,28 +371,28 @@
%-----------------------------------------------------------------------------%
-:- type suspect(T)
- ---> suspect(T, decl_question).
+:- type suspect(R)
+ ---> suspect(R, decl_question).
-:- pred create_suspect(S, T, suspect(T)) <= mercury_edt(S, T).
+:- pred create_suspect(S, R, suspect(R)) <= mercury_edt(S, R).
:- mode create_suspect(in, in, out) is det.
-create_suspect(S, T, Suspect) :-
- edt_root_question(S, T, Question),
- Suspect = suspect(T, Question).
+create_suspect(S, R, Suspect) :-
+ edt_root_question(S, R, Question),
+ Suspect = suspect(R, Question).
-:- pred suspect_get_edt_node(suspect(T), T).
+:- pred suspect_get_edt_node(suspect(R), R).
:- mode suspect_get_edt_node(in, out) is det.
suspect_get_edt_node(suspect(Node, _), Node).
-:- pred suspect_get_question(suspect(T), decl_question).
+:- pred suspect_get_question(suspect(R), decl_question).
:- mode suspect_get_question(in, out) is det.
suspect_get_question(suspect(_, Question), Question).
-:- pred find_matching_suspects(decl_question, list(suspect(T)),
- list(suspect(T)), list(suspect(T))).
+:- pred find_matching_suspects(decl_question, list(suspect(R)),
+ list(suspect(R)), list(suspect(R))).
:- mode find_matching_suspects(in, in, out, out) is det.
find_matching_suspects(Question, Suspects, Matches, NoMatches) :-
@@ -390,39 +403,39 @@
%-----------------------------------------------------------------------------%
-:- type prime_suspect(T)
+:- type prime_suspect(R)
---> prime_suspect(
% Incorrect node.
%
- suspect(T),
+ suspect(R),
% Evidence: the oracle said these nodes
% were either correct or inadmissible.
%
- list(suspect(T)),
+ list(suspect(R)),
% Earliest inadmissible child, if there
% have been any at all. This child
% is also included in the list of
% evidence.
%
- maybe(suspect(T))
+ maybe(suspect(R))
).
% Create a prime suspect from a suspect.
%
-:- pred create_prime_suspect(suspect(T), prime_suspect(T)).
+:- pred create_prime_suspect(suspect(R), prime_suspect(R)).
:- 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(T), suspect(T)).
+:- pred prime_suspect_get_suspect(prime_suspect(R), suspect(R)).
:- 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(T), T).
+:- pred prime_suspect_get_edt_node(prime_suspect(R), R).
:- mode prime_suspect_get_edt_node(in, out) is det.
prime_suspect_get_edt_node(prime_suspect(Suspect, _, _), EDT) :-
@@ -432,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(T), list(suspect(T)),
- maybe(suspect(T))).
+:- pred prime_suspect_get_evidence(prime_suspect(R), list(suspect(R)),
+ maybe(suspect(R))).
:- mode prime_suspect_get_evidence(in, out, out) is det.
prime_suspect_get_evidence(prime_suspect(_, E, M), E, M).
@@ -443,8 +456,8 @@
% This predicate will be more interesting when decl_truth
% has three values.
%
-:- pred prime_suspect_add_evidence(prime_suspect(T), suspect(T), decl_truth,
- prime_suspect(T)).
+:- pred prime_suspect_add_evidence(prime_suspect(R), suspect(R), decl_truth,
+ prime_suspect(R)).
:- mode prime_suspect_add_evidence(in, in, in, out) is det.
prime_suspect_add_evidence(Prime0, Suspect, yes, Prime) :-
@@ -454,4 +467,3 @@
prime_suspect_add_evidence(_, _, no, _) :-
error("prime_suspect_add_evidence: not evidence").
-
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.23
diff -u -b -r1.23 declarative_debugger.m
--- browser/declarative_debugger.m 4 Apr 2002 06:00:06 -0000 1.23
+++ browser/declarative_debugger.m 17 Apr 2002 06:06:07 -0000
@@ -21,8 +21,8 @@
:- module mdb__declarative_debugger.
:- interface.
-:- import_module io, list, bool, std_util.
:- import_module mdb__declarative_execution, mdb__program_representation.
+:- import_module io, list, bool, std_util.
% This type represents the possible truth values for nodes
% in the EDT.
@@ -168,13 +168,13 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module require, int, char, string.
:- import_module mdb__declarative_analyser, mdb__declarative_oracle.
+:- import_module require, int, char, string, assoc_list.
:- type diagnoser_state(R)
---> diagnoser(
- analyser_state(edt_node(R)),
- oracle_state
+ analyser_state :: analyser_state(edt_node(R)),
+ oracle_state :: oracle_state
).
:- pred diagnoser_get_analyser(diagnoser_state(R),
@@ -226,10 +226,20 @@
confirm_bug(Bug, Response, Diagnoser0, Diagnoser).
-handle_analyser_response(Store, oracle_queries(Queries), Response,
+handle_analyser_response(Store, oracle_queries(Queries, MaybeOrigin), Response,
Diagnoser0, Diagnoser) -->
-
{ diagnoser_get_oracle(Diagnoser0, Oracle0) },
+ (
+ { MaybeOrigin = yes(Origin) },
+ { debug_origin(Flag) },
+ { Flag > 0 }
+ ->
+ io__write_string("Origin: "),
+ write_origin(wrap(Store), Origin),
+ io__nl
+ ;
+ []
+ ),
query_oracle(Queries, OracleResponse, Oracle0, Oracle),
{ diagnoser_set_oracle(Diagnoser0, Oracle, Diagnoser1) },
handle_oracle_response(Store, OracleResponse, Response, Diagnoser1,
@@ -237,7 +247,6 @@
handle_analyser_response(Store, require_explicit(Tree), Response,
Diagnoser, Diagnoser) -->
-
{
edt_subtree_details(Store, Tree, Event, Seqno),
Response = require_subtree(Event, Seqno)
@@ -250,7 +259,6 @@
handle_oracle_response(Store, oracle_answers(Answers), Response, Diagnoser0,
Diagnoser) -->
-
{ diagnoser_get_analyser(Diagnoser0, Analyser0) },
{ continue_analysis(wrap(Store), Answers, AnalyserResponse,
Analyser0, Analyser) },
@@ -358,11 +366,11 @@
:- mode trace_root_question(in, in, out) is det.
trace_root_question(wrap(Store), dynamic(Ref), Root) :-
- det_edt_node_from_id(Store, Ref, Node),
+ det_edt_return_node_from_id(Store, Ref, Node),
(
Node = fail(_, CallId, RedoId, _),
call_node_from_id(Store, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _),
+ Call = call(_, _, CallAtom, _, _, _, _, _),
get_answers(Store, RedoId, [], Answers),
Root = missing_answer(CallAtom, Answers)
;
@@ -371,7 +379,7 @@
;
Node = excp(_, CallId, _, Exception, _),
call_node_from_id(Store, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _),
+ Call = call(_, _, CallAtom, _, _, _, _, _),
Root = unexpected_exception(CallAtom, Exception)
).
@@ -394,19 +402,19 @@
:- mode trace_root_e_bug(in, in, out) is det.
trace_root_e_bug(wrap(S), dynamic(Ref), Bug) :-
- det_edt_node_from_id(S, Ref, Node),
+ det_edt_return_node_from_id(S, Ref, Node),
(
Node = exit(_, _, _, Atom, Event),
Bug = incorrect_contour(Atom, unit, Event)
;
Node = fail(_, CallId, _, Event),
call_node_from_id(S, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _),
+ Call = call(_, _, CallAtom, _, _, _, _, _),
Bug = partially_uncovered_atom(CallAtom, Event)
;
Node = excp(_, CallId, _, Exception, Event),
call_node_from_id(S, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _),
+ Call = call(_, _, CallAtom, _, _, _, _, _),
Bug = unhandled_exception(CallAtom, Exception, Event)
).
@@ -415,7 +423,7 @@
:- mode trace_children(in, in, out) is semidet.
trace_children(wrap(Store), dynamic(Ref), Children) :-
- det_edt_node_from_id(Store, Ref, Node),
+ det_edt_return_node_from_id(Store, Ref, Node),
(
Node = fail(PrecId, CallId, _, _),
not_at_depth_limit(Store, CallId),
@@ -434,7 +442,7 @@
:- mode not_at_depth_limit(in, in) is semidet.
not_at_depth_limit(Store, Ref) :-
- call_node_from_id(Store, Ref, call(_, _, _, _, _, no, _)).
+ call_node_from_id(Store, Ref, call(_, _, _, _, _, no, _, _)).
:- pred wrong_answer_children(S, R, list(edt_node(R)), list(edt_node(R)))
<= annotated_trace(S, R).
@@ -443,7 +451,7 @@
wrong_answer_children(Store, NodeId, Ns0, Ns) :-
det_trace_node_from_id(Store, NodeId, Node),
(
- ( Node = call(_, _, _, _, _, _, _)
+ ( Node = call(_, _, _, _, _, _, _, _)
; Node = neg(_, _, _)
; Node = cond(_, _, failed)
)
@@ -487,7 +495,7 @@
missing_answer_children(Store, NodeId, Ns0, Ns) :-
det_trace_node_from_id(Store, NodeId, Node),
(
- ( Node = call(_, _, _, _, _, _, _)
+ ( Node = call(_, _, _, _, _, _, _, _)
; Node = neg(_, _, _)
; Node = cond(_, _, failed)
)
@@ -541,7 +549,7 @@
unexpected_exception_children(Store, NodeId, Ns0, Ns) :-
det_trace_node_from_id(Store, NodeId, Node),
(
- ( Node = call(_, _, _, _, _, _, _)
+ ( Node = call(_, _, _, _, _, _, _, _)
; Node = neg(_, _, failed)
; Node = cond(_, _, failed)
)
@@ -583,430 +591,570 @@
% We are given an EDT node, an argument position, and a path to the selected
% subterm. We wish to find the origin of that subterm within the body of the
% given node, or within the body of its parent. We can figure out the mode of
-% the top of the selected subterm; if the mode is `in', the origin could be:
-% - a unification within the body of the parent,
+% the top of the selected subterm.
+%
+% If the mode is `in', the origin could be:
+% - a primitive (unification of foreign_proc) within the body of the
+% parent,
% - an output subterm in a sibling node, or
% - an input subterm of the parent node.
% In this case we look at the contour leading up to the call event associated
-% with the given node. If the mode is `out', the origin could be:
-% - a unification within the body of the call,
+% with the given node. This contour will be wholly within the parent call.
+%
+% If the mode is `out', the origin could be:
+% - a primitive (unification or foreign_proc) within the body of the
+% call,
% - an output subterm of a child of the node, or
% - an input subterm of the node itself.
-% In the case we look at the contour leading up to the exit or exception event
-% associated with the given node.
+% In this case we look at the contour leading up to the exit or exception event
+% associated with the given node. This contour will be wholly within the
+% current call.
%
-% If the contour starts with a neg or cond event, then we also look at the
-% contour leading up to that event (and so on, recursively). We eventually
-% stop when a call event is reached. The goal representation used comes from
-% this call event.
+% Our algorithm for finding the origin has three phases.
%
-% We first make a full pass of the contour(s), matching up the contour events
-% with atomic events in the goal representation, and constructing a list of
-% `atom_info's, information about atomic goals in the contour(s). We then
-% traverse this list, keeping track of the variable which contains the
-% selected subterm, and the location within this variable.
-
-:- pred trace_dependency(wrap(S), edt_node(R), arg_pos, term_path,
- subterm_mode, subterm_origin(edt_node(R)))
- <= annotated_trace(S, R).
-:- mode trace_dependency(in, in, in, in, out, out) is det.
+% In the first phase, we materialize a list of the nodes in the contour.
+%
+% In the second phase, we use this list of nodes to construct a list of the
+% primitive goals along that contour in the body of the relevant procedure,
+% leading up to either the call event (if subterm_mode is `in') or the exit
+% event (if subterm_mode is `out').
+%
+% In the third phase, we traverse the list of primitive goals backwards, from
+% the most recently executed primitive to the earliest one, keeping track of
+% the variable which contains the selected subterm, and the location within
+% this variable.
+
+:- type dependency_chain_start(R)
+ ---> chain_start(
+ start_loc(R),
+ int, % The argument number of the selected
+ % 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.
+ maybe(goal_path),
+ % No if start_loc is cur_goal;
+ % and yes wrapped around the goal path
+ % of the call in the parent procedure
+ % if start_loc is parent_goal.
+ maybe(proc_rep) % The body of the procedure indicated
+ % by start_loc.
+ ).
+
+:- type start_loc(R)
+ ---> cur_goal
+ ; parent_goal(R, trace_node(R)).
+
+:- type goal_and_path ---> goal_and_path(goal_rep, goal_path).
+
+:- type goal_and_path_list == list(goal_and_path).
+
+:- type annotated_primitive(R)
+ ---> primitive(
+ string, % filename
+ int, % line number
+ 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))
+ % if the atomic goal is a call,
+ % the id of the call's exit event
+ ).
+
+:- pred trace_dependency(wrap(S)::in, edt_node(R)::in,
+ arg_pos::in, term_path::in, subterm_mode::out,
+ subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
- det_edt_node_from_id(Store, Ref, Node),
+ find_chain_start(wrap(Store), dynamic(Ref), ArgPos, TermPath,
+ ChainStart),
+ ChainStart = chain_start(StartLoc, ArgNum, NodeId, StartPath,
+ MaybeProcRep),
+ Mode = start_loc_to_subterm_mode(StartLoc),
(
- Node = exit(ExitPrec, CallId, _, ExitAtom, _),
- call_node_from_id(Store, CallId, Call),
- Call = call(CallPrec, _, CallAtom, _, _, _, _),
+ MaybeProcRep = no,
+ Origin = not_found
+ ;
+ MaybeProcRep = yes(ProcRep),
+ det_trace_node_from_id(Store, NodeId, Node),
+ materialize_contour(wrap(Store), dynamic(NodeId), Node,
+ [], Contour0),
(
- trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath)
- ->
- Mode = subterm_in,
- Start = CallPrec
+ StartLoc = parent_goal(CallId, CallNode),
+ Contour = list__append(Contour0,
+ [dynamic(CallId) - CallNode])
;
- trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath)
- ->
- Mode = subterm_out,
- Start = ExitPrec
+ StartLoc = cur_goal,
+ Contour = Contour0
+ ),
+ ProcRep = proc_rep(HeadVars, GoalRep),
+ make_primitive_list(wrap(Store), [goal_and_path(GoalRep, [])],
+ Contour, StartPath, ArgNum, HeadVars, Var,
+ [], Primitives),
+ traverse_primitives(Primitives, Var, TermPath,
+ wrap(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).
+
+find_chain_start(wrap(Store), dynamic(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),
+ ( 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)
+ ; trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath) ->
+ StartLoc = cur_goal,
+ absolute_arg_num(ArgPos, ExitAtom, ArgNum),
+ StartId = ExitPrec,
+ StartPath = no,
+ StartRep = ProcRep
;
- error("trace_dependency: wrong answer subterm unbound")
+ error("find_chain_start: unbound wrong answer term")
)
;
Node = fail(_, CallId, _, _),
call_node_from_id(Store, CallId, Call),
- Call = call(CallPrec, _, CallAtom, _, _, _, _),
- (
- trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath)
- ->
- Mode = subterm_in,
- Start = CallPrec
+ Call = call(CallPrec, _, CallAtom, _, _, _, _, CallPathStr),
+ ( 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)
;
- error(
- "trace_dependency: missing answer subterm unbound")
+ error("find_chain_start: unbound missing answer term")
)
;
Node = excp(_, CallId, _, _, _),
call_node_from_id(Store, CallId, Call),
- Call = call(CallPrec, _, CallAtom, _, _, _, _),
+ Call = call(CallPrec, _, CallAtom, _, _, _, _, CallPathStr),
%
% XXX we don't yet handle tracking of the exception value.
%
- (
- trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath)
- ->
- Mode = subterm_in,
- Start = CallPrec
+ ( 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)
;
- error("trace_dependency: exception subterm unbound")
+ error("find_chain_start: unbound exception term")
)
),
+ ChainStart = chain_start(StartLoc, ArgNum, StartId, StartPath,
+ StartRep).
- contour_foldl2(Store, process_trace_event, Start, next_contour(Store),
- GoalCont, AtomInfo0),
- (
- GoalCont = unknown_goal
- ->
- %
- % There was no goal_rep to match the contour up with, so the
- % origin cannot be found.
- %
- Origin = not_found
+:- pred parent_proc_rep(wrap(S)::in, edt_node(R)::in, maybe(proc_rep)::out)
+ is det <= annotated_trace(S, R).
+
+parent_proc_rep(wrap(Store), dynamic(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
;
- %
- % Use up any remaining goals which are not associated with
- % any events (e.g. unifications).
- %
- process_non_event_goals(GoalCont, MaybeCallArgs, AtomInfo,
- AtomInfo0),
- (
- Mode = subterm_in,
- MaybeCallArgs = yes(CallArgs)
- ->
- list__index1_det(CallArgs, ArgPos, VarRep)
+ % 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).
+
+step_left_to_call(Store, Id, Node, ParentCallId) :-
+ ( Node = call(_, _, _, _, _, _, _, _) ->
+ ParentCallId = Id
;
- Mode = subterm_out,
- MaybeCallArgs = no
- ->
- %
- % Headvars have the same number as their argument
- % position.
- %
- VarRep = ArgPos
+ ( Node = neg(NegPrec, _, _) ->
+ PrevNodeId = NegPrec
;
- error("trace_dependency: contour mismatch")
+ PrevNodeId = step_left_in_contour(Store, Node)
),
- Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+ det_trace_node_from_id(Store, PrevNodeId, PrevNode),
+ step_left_to_call(Store, PrevNodeId, PrevNode, ParentCallId)
).
- % contour_foldl2(Store, Pred, Right, Init, A, B) is analogous to
- % other foldl2 predicates which keep track of two accumulators
- % over a sequence. In this case the sequence is the contour defined
- % by Right, the rightmost event of the contour. The main difference
- % is that instead of supplying the initial accumulator values, the
- % Init closure calculates them from the event at the left boundary
- % of the contour.
- %
- % The mode that we have chosen has the last two arguments of the
- % accumulator predicate (second argument) with the opposite modes to
- % normal. This is so the accumulator predicate can construct a
- % list using the DCG syntax.
- %
-:- pred contour_foldl2(S, pred(R, trace_node(R), A, A, B, B), R,
- pred(trace_node(R), A, B), A, B) <= annotated_trace(S, R).
-:- mode contour_foldl2(in, pred(in, in, in, out, out, in) is det, in,
- pred(in, out, out) is det, out, out) is det.
+:- 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).
-contour_foldl2(Store, ProcessEvent, Ref, Init, A, B) :-
- det_trace_node_from_id(Store, Ref, Node),
- (
- ( Node = call(_, _, _, _, _, _, _)
- ; Node = neg(_, _, _)
- ; Node = cond(_, _, failed)
- )
- ->
- Init(Node, A, B)
+materialize_contour(wrap(Store), NodeId, Node, Nodes0, Nodes) :-
+ ( Node = call(_, _, _, _, _, _, _, _) ->
+ Nodes = Nodes0
;
- Next = step_left_in_contour(Store, Node),
- contour_foldl2(Store, ProcessEvent, Next, Init, A0, B0),
- ProcessEvent(Ref, Node, A0, A, B, B0)
+ ( Node = neg(NegPrec, _, _) ->
+ PrevNodeId = NegPrec
+ ;
+ PrevNodeId = step_left_in_contour(Store, Node)
+ ),
+ det_trace_node_from_id(Store, PrevNodeId, PrevNode),
+ ( Node = then(_, _) ->
+ % The cond node is enough to tell us which way the
+ % if-then-else went; the then node would just
+ % complicate the job of make_primitive_list.
+ Nodes1 = Nodes0
+ ;
+ Nodes1 = [NodeId - Node | Nodes0]
+ ),
+ materialize_contour(wrap(Store), dynamic(PrevNodeId), PrevNode,
+ Nodes1, Nodes)
).
- % This type represents the remainder of a goal after some of it
- % has been executed, like a continuation. We don't actually
- % execute this code, but match it up with the remainder of a contour
- % after some events have been processed.
- %
-:- type goal_cont
- ---> subgoal_cont(
- goal_rep, % A subgoal to execute.
- goal_cont % Code after the subgoal.
- )
- ; conj_cont(
- list(goal_rep), % The rest of a conjunction to execute.
- goal_cont % Code after the conjunction.
- )
- ; ite_cont(
- goal_rep, % Then branch.
- goal_rep, % Else branch.
- goal_cont % Code after the if-then-else.
- )
- ; neg_cont(
- goal_cont % Code after the negation.
- )
- ; return % End of the procedure.
- ; unknown_goal. % We don't have access to the
- % program representation.
-
-:- type atom_info(R)
- ---> call_info(R, goal_rep)
- ; unify_info(goal_rep).
-
-:- pred next_contour(S, trace_node(R), goal_cont, list(atom_info(R)))
- <= annotated_trace(S, R).
-:- mode next_contour(in, in, out, out) is det.
-
-next_contour(Store, Node, Cont, AtomInfo) :-
+:- 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,
+ 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],
+ 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),
+ Contour, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ Goal = disj_rep(Disjs),
+ (
+ Contour = [_ - ContourHeadNode | ContourTail],
+ ( ContourHeadNode = first_disj(_, DisjPathStr)
+ ; ContourHeadNode = later_disj(_, DisjPathStr, _)
+ ),
+ path_from_string_det(DisjPathStr, DisjPath),
+ list__append(Path, PathTail, DisjPath),
+ PathTail = [disj(N)]
+ ->
+ list__index1_det(Disjs, N, Disj),
+ DisjAndPath = goal_and_path(Disj, DisjPath),
+ make_primitive_list(wrap(Store),
+ [DisjAndPath | GoalPaths],
+ ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ error("make_primitive_list: mismatch on disj")
+ )
+ ;
+ Goal = switch_rep(Arms),
+ (
+ Contour = [_ - ContourHeadNode | ContourTail],
+ ContourHeadNode = switch(_, ArmPathStr),
+ path_from_string_det(ArmPathStr, ArmPath),
+ list__append(Path, PathTail, ArmPath),
+ PathTail = [switch(N)]
+ ->
+ list__index1_det(Arms, N, Arm),
+ ArmAndPath = goal_and_path(Arm, ArmPath),
+ make_primitive_list(wrap(Store),
+ [ArmAndPath | GoalPaths],
+ ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ error("make_primitive_list: mismatch on switch")
+ )
+ ;
+ Goal = ite_rep(Cond, Then, Else),
+ (
+ Contour = [_ - ContourHeadNode | ContourTail],
+ ContourHeadNode = cond(_, CondPathStr, _),
+ path_from_string_det(CondPathStr, CondPath),
+ list__append(Path, PathTail, CondPath),
+ PathTail = [ite_cond]
+ ->
+ ThenPath = list__append(Path, [ite_then]),
+ CondAndPath = goal_and_path(Cond, CondPath),
+ ThenAndPath = goal_and_path(Then, ThenPath),
+ make_primitive_list(wrap(Store),
+ [CondAndPath, ThenAndPath | GoalPaths],
+ ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ Contour = [_ - ContourHeadNode | ContourTail],
+ ContourHeadNode = else(_, ElseCondId),
+ cond_node_from_id(Store, ElseCondId, CondNode),
+ CondNode = cond(_, CondPathStr, _),
+ path_from_string_det(CondPathStr, CondPath),
+ list__append(Path, PathTail, CondPath),
+ PathTail = [ite_cond]
+ ->
+ ElsePath = list__append(Path, [ite_else]),
+ ElseAndPath = goal_and_path(Else, ElsePath),
+ make_primitive_list(wrap(Store),
+ [ElseAndPath | GoalPaths],
+ ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ error("make_primitive_list: mismatch on if-then-else")
+ )
+ ;
+ Goal = negation_rep(NegGoal),
+ (
+ Contour = [_ - ContourHeadNode | ContourTail],
+ ContourHeadNode = neg_succ(_, _)
+ ->
+ % The negated goal cannot contribute any bindings.
+ make_primitive_list(wrap(Store), GoalPaths,
+ ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ Contour = [_ - ContourHeadNode | ContourTail],
+ ContourHeadNode = neg(_, _, _)
+ ->
+ % The end of the primitive list is somewhere inside
+ % NegGoal.
+ NegPath = list__append(Path, [neg]),
+ NegAndPath = goal_and_path(NegGoal, NegPath),
+ make_primitive_list(wrap(Store), [NegAndPath],
+ ContourTail, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ error("make_primitive_list: mismatch on negation")
+ )
+ ;
+ Goal = some_rep(InnerGoal, MaybeCut),
+ InnerPath = list__append(Path, [exist(MaybeCut)]),
+ InnerAndPath = goal_and_path(InnerGoal, InnerPath),
+ make_primitive_list(wrap(Store), [InnerAndPath | GoalPaths],
+ Contour, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives0, Primitives)
+ ;
+ Goal = atomic_goal_rep(_, File, Line, BoundVars, AtomicGoal),
+ GeneratesEvent = atomic_goal_generates_event(AtomicGoal),
(
- Node = call(_, _, _, _, _, _, MaybeProc)
- ->
- AtomInfo = [],
+ GeneratesEvent = yes(Args),
(
- MaybeProc = yes(proc_rep(_, Goal))
- ->
- Cont = subgoal_cont(Goal, return)
+ Contour = [ContourHeadId - ContourHeadNode
+ | ContourTail],
+ ContourHeadNode = exit(_, CallId, _, _, _),
+ call_node_from_id(Store, CallId, CallNode),
+ CallNode = call(_,_,_,_,_,_,_, CallPathStr),
+ path_from_string_det(CallPathStr, CallPath),
+ CallPath = Path,
+ \+ (
+ MaybeEnd = yes(EndPath),
+ EndPath = Path
+ )
+ ->
+ Primitive = primitive(File, Line, BoundVars,
+ AtomicGoal, Path, yes(ContourHeadId)),
+ Primitives1 = [Primitive | Primitives0],
+ make_primitive_list(wrap(Store), GoalPaths,
+ ContourTail, MaybeEnd, ArgNum,
+ HeadVars, Var, Primitives1, Primitives)
+ ;
+ Contour = [_ContourHeadId - ContourHeadNode],
+ ContourHeadNode =
+ call(_,_,_,_,_,_,_, CallPathStr),
+ path_from_string_det(CallPathStr, CallPath),
+ CallPath = Path,
+ MaybeEnd = yes(EndPath),
+ EndPath = Path
+ ->
+ list__index1_det(Args, ArgNum, Var),
+ Primitives = Primitives0
+ ;
+ error("make_primitive_list: mismatch on call")
+ )
+ ;
+ GeneratesEvent = no,
+ Primitive = primitive(File, Line, BoundVars,
+ AtomicGoal, Path, no),
+ Primitives1 = [Primitive | Primitives0],
+ make_primitive_list(wrap(Store), GoalPaths,
+ Contour, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives1, Primitives)
+ )
+ ).
+make_primitive_list(_, [], Contour, MaybeEnd, ArgNum, HeadVars, Var,
+ Primitives, Primitives) :-
+ require(unify(Contour, []),
+ "make_primitive_list: nonempty contour at end"),
+ require(unify(MaybeEnd, no),
+ "make_primitive_list: found end when looking for call"),
+ 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,
+ 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,
+ Origin) :-
+ Prim = primitive(File, Line, BoundVars, AtomicGoal, _GoalPath,
+ MaybeNodeId),
+ (
+ AtomicGoal = unify_construct_rep(_CellVar, _Cons, FieldVars),
+ ( list__member(Var0, BoundVars) ->
+ (
+ TermPath0 = [],
+ Origin = primitive(File, Line)
;
- Cont = unknown_goal
+ TermPath0 = [TermPathStep0 | TermPath],
+ list__index1_det(FieldVars, TermPathStep0,
+ Var),
+ traverse_primitives(Prims, Var, TermPath,
+ wrap(Store), ProcRep, Origin)
)
;
- ( Node = neg(Prec, _, _)
- ; Node = cond(Prec, _, _)
+ traverse_primitives(Prims, Var0, TermPath0,
+ wrap(Store), ProcRep, Origin)
)
- ->
- %
- % We continue into the next contour up, since the subterm
- % could have come from there.
- %
- contour_foldl2(Store, process_trace_event, Prec,
- next_contour(Store), Cont, AtomInfo)
;
- error("next_contour: not a contour boundary")
- ).
-
- % Match the goal_cont up with one trace event, leaving a new
- % goal_cont.
- %
-:- pred process_trace_event(R, trace_node(R), goal_cont, goal_cont,
- list(atom_info(R)), list(atom_info(R))).
-:- mode process_trace_event(in, in, in, out, out, in) is det.
-
-process_trace_event(Ref, Event, subgoal_cont(Goal, Cont0), Cont) -->
- process_trace_event_goal(Ref, Event, Goal, Cont0, Cont).
-process_trace_event(Ref, Event, conj_cont([], Cont0), Cont) -->
- process_trace_event(Ref, Event, Cont0, Cont).
-process_trace_event(Ref, Event, conj_cont([G | Gs], Cont0), Cont) -->
- process_trace_event_goal(Ref, Event, G, conj_cont(Gs, Cont0), Cont).
-process_trace_event(_, Event, ite_cont(Then, Else, Cont0), Cont) -->
- {
- Event = then(_, _)
- ->
- Cont = subgoal_cont(Then, Cont0)
+ AtomicGoal = unify_deconstruct_rep(CellVar, _Cons, FieldVars),
+ ( list__member(Var0, BoundVars) ->
+ ( list__nth_member_search(FieldVars, Var0, Pos) ->
+ traverse_primitives(Prims,
+ CellVar, [Pos | TermPath0],
+ wrap(Store), ProcRep, Origin)
;
- Event = else(_, _)
- ->
- Cont = subgoal_cont(Else, Cont0)
+ error("traverse_primitives: bad deconstruct")
+ )
;
- error("process_trace_event: ite mismatch")
- }.
-process_trace_event(_, _, neg_cont(_), _) -->
- { error("process_trace_event: unexpected end of negation") }.
-process_trace_event(_, _, return, _) -->
- { error("process_trace_event: unexpected end of goal") }.
-process_trace_event(_, _, unknown_goal, unknown_goal) -->
- [].
-
-:- pred process_trace_event_goal(R, trace_node(R), goal_rep, goal_cont,
- goal_cont, list(atom_info(R)), list(atom_info(R))).
-:- mode process_trace_event_goal(in, in, in, in, out, out, in) is det.
-
-process_trace_event_goal(Ref, Event, conj_rep([]), Cont0, Cont) -->
- process_trace_event(Ref, Event, Cont0, Cont).
-process_trace_event_goal(Ref, Event, conj_rep([G | Gs]), Cont0, Cont) -->
- process_trace_event_goal(Ref, Event, G, conj_cont(Gs, Cont0), Cont).
-process_trace_event_goal(_, Event, disj_rep(Ds), Cont0, Cont) -->
- { list__index1_det(Ds, disj_event_branch_number(Event), D) },
- { Cont = subgoal_cont(D, Cont0) }.
-process_trace_event_goal(_, Event, switch_rep(As), Cont0, Cont) -->
- { list__index1_det(As, switch_event_branch_number(Event), A) },
- { Cont = subgoal_cont(A, Cont0) }.
-process_trace_event_goal(_, Event, ite_rep(Cond, Then, Else), Cont0, Cont) -->
- {
- Event = cond(_, _, _)
- ->
- Cont = subgoal_cont(Cond, ite_cont(Then, Else, Cont0))
+ traverse_primitives(Prims, Var0, TermPath0,
+ wrap(Store), ProcRep, Origin)
+ )
;
- Event = else(_, _)
- ->
- %
- % The contour stepped over the (failed) condition.
- %
- Cont = subgoal_cont(Else, Cont0)
+ AtomicGoal = unify_assign_rep(ToVar, FromVar),
+ ( list__member(Var0, BoundVars) ->
+ require(unify(Var0, ToVar),
+ "traverse_primitives: bad assign"),
+ traverse_primitives(Prims, FromVar, TermPath0,
+ wrap(Store), ProcRep, Origin)
;
- error("process_trace_event_goal: ite mismatch")
- }.
-process_trace_event_goal(Ref, Event, negation_rep(Goal), Cont0, Cont) -->
- (
- { Event = neg_succ(_, _) }
- ->
- { Cont = Cont0 }
+ traverse_primitives(Prims, Var0, TermPath0,
+ wrap(Store), ProcRep, Origin)
+ )
;
- process_trace_event_goal(Ref, Event, Goal, neg_cont(Cont0),
- Cont)
- ).
-process_trace_event_goal(Ref, Event, some_rep(Goal, _), Cont0, Cont) -->
- process_trace_event_goal(Ref, Event, Goal, Cont0, Cont).
-process_trace_event_goal(Ref, Event, GoalRep, Cont0, Cont) -->
- { GoalRep = atomic_goal_rep(_, _, _, _, AtomicGoal) },
- (
- { atomic_goal_rep_is_call(AtomicGoal, _) }
- ->
- {
- Event = exit(_, _, _, _, _)
- ->
- Cont = Cont0
+ AtomicGoal = pragma_foreign_code_rep(_Args),
+ ( list__member(Var0, BoundVars) ->
+ Origin = primitive(File, Line)
;
- error("process_trace_event_goal: exit mismatch")
- },
- [ call_info(Ref, GoalRep) ]
- ;
- [ unify_info(GoalRep) ],
- process_trace_event(Ref, Event, Cont0, Cont)
- ).
-
-:- pred process_non_event_goals(goal_cont, maybe(list(var_rep)),
- list(atom_info(R)), list(atom_info(R))).
-:- mode process_non_event_goals(in, out, out, in) is det.
-
-process_non_event_goals(subgoal_cont(Goal, Cont), MaybeArgs) -->
- process_non_event_goals_2(Goal, Cont, MaybeArgs).
-process_non_event_goals(conj_cont([], Cont), MaybeArgs) -->
- process_non_event_goals(Cont, MaybeArgs).
-process_non_event_goals(conj_cont([G | Gs], Cont), MaybeArgs) -->
- process_non_event_goals_2(G, conj_cont(Gs, Cont), MaybeArgs).
-process_non_event_goals(ite_cont(_, _, _), _) -->
- { error("process_non_event_goals: ite event expected") }.
-process_non_event_goals(neg_cont(_), _) -->
- { error("process_non_event_goals: neg event expected") }.
-process_non_event_goals(return, no) -->
- [].
-process_non_event_goals(unknown_goal, _) -->
- { error("process_non_event_goals: goal is unknown") }.
-
-:- pred process_non_event_goals_2(goal_rep, goal_cont, maybe(list(var_rep)),
- list(atom_info(R)), list(atom_info(R))).
-:- mode process_non_event_goals_2(in, in, out, out, in) is det.
-
-process_non_event_goals_2(conj_rep([]), Cont, MaybeArgs) -->
- process_non_event_goals(Cont, MaybeArgs).
-process_non_event_goals_2(conj_rep([G | Gs]), Cont, MaybeArgs) -->
- process_non_event_goals_2(G, conj_cont(Gs, Cont), MaybeArgs).
-process_non_event_goals_2(disj_rep(_), _, _) -->
- { error("process_non_event_goals_2: disj event expected") }.
-process_non_event_goals_2(switch_rep(_), _, _) -->
- { error("process_non_event_goals_2: swtc event expected") }.
-process_non_event_goals_2(ite_rep(_, _, _), _, _) -->
- { error("process_non_event_goals_2: cond event expected") }.
-process_non_event_goals_2(negation_rep(Goal), Cont, MaybeArgs) -->
- process_non_event_goals_2(Goal, neg_cont(Cont), MaybeArgs).
-process_non_event_goals_2(some_rep(Goal, _), Cont, MaybeArgs) -->
- process_non_event_goals_2(Goal, Cont, MaybeArgs).
-process_non_event_goals_2(Goal, Cont, MaybeArgs) -->
- { Goal = atomic_goal_rep(_, _, _, _, AtomicGoal) },
- (
- { atomic_goal_rep_is_call(AtomicGoal, Args) }
- ->
- { MaybeArgs = yes(Args) }
- ;
- process_non_event_goals(Cont, MaybeArgs),
- [ unify_info(Goal) ]
- ).
-
- % Scan through the information derived from the contour, and
- % track the location of the selected subterm.
- %
-:- func find_subterm_origin(list(atom_info(R)), var_rep, term_path)
- = subterm_origin(edt_node(R)).
-
-find_subterm_origin([], VarRep, TermPath) = input(VarRep, TermPath).
-find_subterm_origin([unify_info(Goal) | AtomInfo], VarRep, TermPath)
- = Origin :-
- (
- Goal = atomic_goal_rep(_, File, Line, BoundVars, AtomicGoal),
- list__member(VarRep, BoundVars)
- ->
- Origin = find_subterm_origin_unify(File, Line, AtomicGoal,
- AtomInfo, VarRep, TermPath)
+ traverse_primitives(Prims, Var0, TermPath0,
+ wrap(Store), ProcRep, Origin)
+ )
;
- Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
- ).
-find_subterm_origin([call_info(Ref, Goal) | AtomInfo], VarRep, TermPath)
- = Origin :-
- (
- Goal = atomic_goal_rep(_, _, _, BoundVars, AtomicGoal),
- list__member(VarRep, BoundVars)
- ->
- Origin = find_subterm_origin_call(Ref, AtomicGoal, VarRep,
- TermPath)
+ AtomicGoal = unify_simple_test_rep(_LVar, _RVar),
+ ( list__member(Var0, BoundVars) ->
+ error("traverse_primitives: bad test")
+ ;
+ traverse_primitives(Prims, Var0, TermPath0,
+ wrap(Store), ProcRep, Origin)
+ )
+ ;
+ AtomicGoal = higher_order_call_rep(_, Args),
+ traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
+ Var0, TermPath0, wrap(Store), ProcRep, Origin)
+ ;
+ AtomicGoal = method_call_rep(_, _, Args),
+ traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
+ Var0, TermPath0, wrap(Store), ProcRep, Origin)
;
- Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+ 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)
).
-:- func find_subterm_origin_unify(string, int, atomic_goal_rep,
- list(atom_info(R)), var_rep, term_path)
- = subterm_origin(edt_node(R)).
+:- type plain_call_info
+ ---> plain_call_info(
+ file_name :: string,
+ line_number :: int,
+ module_name :: string,
+ pred_name :: string
+ ).
+
+:- pred traverse_call(list(var_rep)::in, maybe(plain_call_info)::in,
+ list(var_rep)::in, maybe(edt_node(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
+ <= annotated_trace(S, R).
-find_subterm_origin_unify(File, Line, unify_construct_rep(_, _, Args),
- AtomInfo, _, TermPath0) = Origin :-
+traverse_call(BoundVars, MaybePlainCallInfo, Args, MaybeNodeId,
+ Prims, Var, TermPath, wrap(Store), ProcRep, Origin) :-
+ ( list__member(Var, BoundVars) ->
+ Pos = find_arg_pos(Args, Var),
(
- TermPath0 = [ArgPos | TermPath],
- list__index1_det(Args, ArgPos, VarRep),
- Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+ MaybeNodeId = yes(NodeId),
+ Origin = output(NodeId, Pos, TermPath)
;
- TermPath0 = [],
- Origin = unification(File, Line)
- ).
-find_subterm_origin_unify(_, _, unify_deconstruct_rep(VarRep, _, Args),
- AtomInfo, VarRep0, TermPath0) = Origin :-
+ MaybeNodeId = no,
(
- list__nth_member_search(Args, VarRep0, ArgPos)
+ MaybePlainCallInfo = yes(PlainCallInfo),
+ PlainCallInfo = plain_call_info(File, Line,
+ ModuleName, PredName),
+ call_is_primitive(ModuleName, PredName)
->
- TermPath = [ArgPos | TermPath0],
- Origin = find_subterm_origin(AtomInfo, VarRep, TermPath)
+ Origin = primitive(File, Line)
;
- error("find_subterm_origin_unify: arg not found")
+ error("traverse_call: no node id")
+ )
+ )
+ ;
+ traverse_primitives(Prims, Var, TermPath,
+ wrap(Store), ProcRep, Origin)
).
-find_subterm_origin_unify(_, _, unify_assign_rep(_, Source), AtomInfo, _,
- TermPath) = find_subterm_origin(AtomInfo, Source, TermPath).
-find_subterm_origin_unify(_, _, unify_simple_test_rep(_, _), _, _, _) = _ :-
- error("find_subterm_origin_unify: unexpected test").
-find_subterm_origin_unify(_, _, pragma_foreign_code_rep(_), _, _, _) = _ :-
- error("find_subterm_origin_unify: unexpected pragma call").
-find_subterm_origin_unify(_, _, higher_order_call_rep(_, _), _, _, _) = _ :-
- error("find_subterm_origin_unify: unexpected ho call").
-find_subterm_origin_unify(_, _, method_call_rep(_, _, _), _, _, _) = _ :-
- error("find_subterm_origin_unify: unexpected method call").
-find_subterm_origin_unify(_, _, plain_call_rep(_, _), _, _, _) = _ :-
- error("find_subterm_origin_unify: unexpected call").
-:- func find_subterm_origin_call(R, atomic_goal_rep, var_rep, term_path)
- = subterm_origin(edt_node(R)).
+%-----------------------------------------------------------------------------%
-find_subterm_origin_call(Ref, Call, VarRep, TermPath) = Origin :-
- (
- atomic_goal_rep_is_call(Call, Args),
- list__nth_member_search(Args, VarRep, ArgPos)
- ->
- Origin = output(dynamic(Ref), ArgPos, TermPath)
+:- pred add_paths_to_conjuncts(list(goal_rep)::in, goal_path::in, int::in,
+ goal_and_path_list::out) is det.
+
+add_paths_to_conjuncts([], _, _, []).
+add_paths_to_conjuncts([Goal | Goals], ParentPath, N,
+ [goal_and_path(Goal, Path) | GoalAndPaths]) :-
+ list__append(ParentPath, [conj(N)], Path),
+ add_paths_to_conjuncts(Goals, ParentPath, N + 1, GoalAndPaths).
+
+%-----------------------------------------------------------------------------%
+
+:- func start_loc_to_subterm_mode(start_loc(R)) = subterm_mode.
+
+start_loc_to_subterm_mode(cur_goal) = subterm_out.
+start_loc_to_subterm_mode(parent_goal(_, _)) = subterm_in.
+
+%-----------------------------------------------------------------------------%
+
+:- func find_arg_pos(list(var_rep), var_rep) = arg_pos.
+
+find_arg_pos(HeadVars, Var) = ArgPos :-
+ find_arg_pos_2(HeadVars, Var, 1, ArgPos).
+
+:- pred find_arg_pos_2(list(var_rep)::in, var_rep::in, int::in, arg_pos::out)
+ is det.
+
+find_arg_pos_2([], _, _, _) :-
+ error("find_arg_pos_2: empty list").
+find_arg_pos_2([HeadVar | HeadVars], Var, Pos, ArgPos) :-
+ ( HeadVar = Var ->
+ ArgPos = any_head_var(Pos)
;
- error("find_subterm_origin_call: arg not found")
+ find_arg_pos_2(HeadVars, Var, Pos + 1, ArgPos)
).
%-----------------------------------------------------------------------------%
@@ -1016,7 +1164,7 @@
:- mode edt_subtree_details(in, in, out, out) is det.
edt_subtree_details(Store, dynamic(Ref), Event, SeqNo) :-
- det_edt_node_from_id(Store, Ref, Node),
+ det_edt_return_node_from_id(Store, Ref, Node),
(
Node = exit(_, Call, _, _, Event)
;
@@ -1024,17 +1172,17 @@
;
Node = excp(_, Call, _, _, Event)
),
- call_node_from_id(Store, Call, call(_, _, _, SeqNo, _, _, _)).
+ call_node_from_id(Store, Call, call(_, _, _, SeqNo, _, _, _, _)).
-:- inst trace_node_edt_node =
+:- inst edt_return_node =
bound( exit(ground, ground, ground, ground, ground)
; fail(ground, ground, ground, ground)
; excp(ground, ground, ground, ground, ground)).
-:- pred det_edt_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
-:- mode det_edt_node_from_id(in, in, out(trace_node_edt_node)) is det.
+:- pred det_edt_return_node_from_id(S::in, R::in,
+ trace_node(R)::out(edt_return_node)) is det <= annotated_trace(S, R).
-det_edt_node_from_id(Store, Ref, Node) :-
+det_edt_return_node_from_id(Store, Ref, Node) :-
(
trace_node_from_id(Store, Ref, Node0),
(
@@ -1047,51 +1195,18 @@
->
Node = Node0
;
- error("det_edt_node_from_id: not an EXIT, FAIL or EXCP node")
+ error("det_edt_return_node_from_id: not a return node")
).
+%-----------------------------------------------------------------------------%
+
:- 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, _) :-
- list__index1_det(Args, ArgPos, yes(_)).
-
-:- func disj_event_branch_number(trace_node(R)) = int.
-
-disj_event_branch_number(Node) = N :-
- (
- (
- Node = first_disj(_, Str)
- ;
- Node = later_disj(_, Str, _)
- ),
- list__last(string__words(is_semicolon, Str), LastStepStr),
- path_step_from_string(LastStepStr, disj(N0))
- ->
- N = N0
- ;
- error("disj_event_branch_number: not a DISJ event")
- ).
-
-:- func switch_event_branch_number(trace_node(R)) = int.
-
-switch_event_branch_number(Node) = N :-
- (
- Node = switch(_, Str),
- list__last(string__words(is_semicolon, Str), LastStepStr),
- path_step_from_string(LastStepStr, switch(N0))
- ->
- N = N0
- ;
- error("switch_event_branch_number: not a SWTC event")
- ).
-
-:- pred is_semicolon(char).
-:- mode is_semicolon(in) is semidet.
-
-is_semicolon(';').
-
-%-----------------------------------------------------------------------------%
+ select_arg_at_pos(ArgPos, Args, ArgInfo),
+ ArgInfo = arg_info(_, _, MaybeArg),
+ MaybeArg = yes(_).
:- pred decl_bug_get_event_number(decl_bug, event_number).
:- mode decl_bug_get_event_number(in, out) is det.
@@ -1107,3 +1222,56 @@
decl_bug_get_event_number(i_bug(IBug), Event) :-
IBug = inadmissible_call(_, _, _, Event).
+%-----------------------------------------------------------------------------%
+
+% :- 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).
+
+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(")")
+ ;
+ io__write(Origin)
+ ).
+
+:- pragma foreign_code("C",
+"
+
+/*
+** The declarative debugger will print diagnostic information about the origins
+** computed by dependency tracking if this flag has a positive value.
+*/
+
+int MR_DD_debug_origin = 0;
+
+").
+
+:- pragma foreign_decl("C",
+"
+extern int MR_DD_debug_origin;
+").
+
+:- pred debug_origin(int::out) is det.
+
+:- pragma foreign_proc("C",
+ debug_origin(Flag::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Flag = MR_DD_debug_origin;
+").
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.16
diff -u -b -r1.16 declarative_execution.m
--- browser/declarative_execution.m 4 Apr 2002 06:00:06 -0000 1.16
+++ browser/declarative_execution.m 16 Apr 2002 09:20:50 -0000
@@ -29,95 +29,152 @@
%
:- type trace_node(R)
---> call(
- R, % Preceding event.
- R, % Last EXIT or REDO event.
- trace_atom, % Atom that was called.
- sequence_number, % Call sequence number.
- event_number, % Trace event number.
- bool, % At the maximum depth?
- maybe(proc_rep) % Body of the called procedure.
+ call_preceding :: R,
+ % Preceding event.
+ call_last_exit_redo :: R,
+ % Last EXIT or REDO event.
+ call_atom :: trace_atom,
+ % Atom that was called.
+ call_seq :: sequence_number,
+ % Call sequence number.
+ call_event :: event_number,
+ % Trace event number.
+ call_at_max_depth :: bool,
+ % At the maximum depth?
+ call_proc_rep :: maybe(proc_rep),
+ % Body of the called procedure.
+ call_goal_path :: goal_path_string
+ % Path for this event *in the
+ % caller*.
)
; exit(
- R, % Preceding event.
- R, % CALL event.
- R, % Previous REDO event, if any.
- trace_atom, % Atom in its final state.
- event_number % Trace event number.
+ exit_preceding :: R,
+ % Preceding event.
+ exit_call :: R,
+ % CALL event.
+ exit_prev_redo :: R,
+ % Previous REDO event, if any.
+ exit_atom :: trace_atom,
+ % Atom in its final state.
+ exit_event :: event_number
+ % Trace event number.
)
; redo(
- R, % Preceding event.
- R % EXIT event.
+ redo_preceding :: R,
+ % Preceding event.
+ redo_exit :: R
+ % EXIT event.
)
; fail(
- R, % Preceding event.
- R, % CALL event.
- R, % Previous REDO event, if any.
- event_number % Trace event number.
+ fail_preceding :: R,
+ % Preceding event.
+ fail_call :: R,
+ % CALL event.
+ fail_redo :: R,
+ % Previous REDO event, if any.
+ fail_event :: event_number
+ % Trace event number.
)
; excp(
- R, % Preceding event.
- R, % Call event.
- R, % Previous redo, if any.
- univ, % Exception thrown.
- event_number % Trace event number.
+ excp_preceding :: R,
+ % Preceding event.
+ excp_call :: R,
+ % Call event.
+ excp_redo :: R,
+ % Previous redo, if any.
+ excp_value :: univ,
+ % Exception thrown.
+ excp_event :: event_number
+ % Trace event number.
)
; switch(
- R, % Preceding event.
- goal_path_string % Path for this event.
+ switch_preceding :: R,
+ % Preceding event.
+ switch_goal_path :: goal_path_string
+ % Path for this event.
)
; first_disj(
- R, % Preceding event.
- goal_path_string % Path for this event.
+ first_disj_preceding :: R,
+ % Preceding event.
+ first_disj_goal_path :: goal_path_string
+ % Path for this event.
)
; later_disj(
- R, % Preceding event.
- goal_path_string, % Path for this event.
- R % Event of the first DISJ.
+ last_disj_preceding :: R,
+ % Preceding event.
+ last_disj_goal_path :: goal_path_string,
+ % Path for this event.
+ last_disj_first :: R
+ % Event of the first DISJ.
)
; cond(
- R, % Preceding event.
- goal_path_string, % Path for this event.
- goal_status % Whether we have reached
+ cond_preceding :: R,
+ % Preceding event.
+ cond_goal_path :: goal_path_string,
+ % Path for this event.
+ cond_status :: goal_status
+ % Whether we have reached
% a THEN or ELSE event.
)
; then(
- R, % Preceding event.
- R % COND event.
+ then_preceding :: R,
+ % Preceding event.
+ then_cond :: R
+ % COND event.
)
; else(
- R, % Preceding event.
- R % COND event.
+ else_preceding :: R,
+ % Preceding event.
+ else_cond :: R
+ % COND event.
)
; neg(
- R, % Preceding event.
- goal_path_string, % Path for this event.
- goal_status % Whether we have reached
+ neg_preceding :: R,
+ % Preceding event.
+ neg_goal_path :: goal_path_string,
+ % Path for this event.
+ neg_status :: goal_status
+ % Whether we have reached
% a NEGS or NEGF event.
)
; neg_succ(
- R, % Preceding event.
- R % NEGE event.
+ neg_succ_preceding :: R,
+ % Preceding event.
+ neg_succ_enter :: R
+ % NEGE event.
)
; neg_fail(
- R, % Preceding event.
- R % NEGE event.
- )
- .
+ neg_fail_preceding :: R,
+ % Preceding event.
+ neg_fail_enter :: R
+ % NEGE event.
+ ).
+
+:- type trace_atom_arg
+ ---> arg_info(
+ prog_visible :: bool,
+ prog_vis_headvar_num :: int,
+ % N, if this is the Nth
+ % programmer visible headvar
+ % (as opposed to a variable
+ % created by the compiler).
+ arg_value :: maybe(univ)
+ ).
:- type trace_atom
---> atom(
- pred_or_func,
+ pred_or_func :: pred_or_func,
+ proc_name :: string,
% Procedure name.
%
- string,
- % Arguments.
- % XXX this representation will not be
- % able to handle partially instantiated
+ atom_args :: list(trace_atom_arg)
+ % The arguments, including the
+ % compiler-generated ones.
+ % XXX This representation can't
+ % handle partially instantiated
% data structures.
- %
- list(maybe(univ))
).
% If the following type is modified, some of the macros in
@@ -178,7 +235,7 @@
:- mode det_trace_node_from_id(in, in, out) is det.
:- inst trace_node_call =
- bound(call(ground, ground, ground, ground, ground,
+ bound(call(ground, ground, ground, ground, ground, ground,
ground, ground)).
:- pred call_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
@@ -253,13 +310,34 @@
%-----------------------------------------------------------------------------%
+:- type which_headvars
+ ---> all_headvars
+ ; only_user_headvars.
+
+:- 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.
+
+:- pred is_user_vis_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.
+
+:- pred absolute_arg_num(arg_pos::in, trace_atom::in, int::out)
+ is det.
+
+%-----------------------------------------------------------------------------%
+
:- implementation.
-:- import_module map, require, store.
+:- import_module int, map, require, store.
+
+%-----------------------------------------------------------------------------%
step_left_in_contour(Store, exit(_, Call, _, _, _)) = Prec :-
- call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _)).
+ call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _, _)).
step_left_in_contour(Store, excp(_, Call, _, _, _)) = Prec :-
- call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _)).
+ call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _, _)).
step_left_in_contour(_, switch(Prec, _)) = Prec.
step_left_in_contour(_, first_disj(Prec, _)) = Prec.
step_left_in_contour(Store, later_disj(_, _, FirstDisj)) = Prec :-
@@ -281,7 +359,7 @@
% The following cases are possibly at the left end of a contour,
% where we cannot step any further.
%
-step_left_in_contour(_, call(_, _, _, _, _, _, _)) = _ :-
+step_left_in_contour(_, call(_, _, _, _, _, _, _, _)) = _ :-
error("step_left_in_contour: unexpected CALL node").
step_left_in_contour(_, neg(Prec, _, Status)) = Next :-
(
@@ -323,7 +401,7 @@
; neg_fail(ground, ground)).
find_prev_contour(Store, fail(_, Call, _, _), OnContour) :-
- call_node_from_id(Store, Call, call(OnContour, _, _, _, _, _, _)).
+ call_node_from_id(Store, Call, call(OnContour, _, _, _, _, _, _, _)).
find_prev_contour(Store, redo(_, Exit), OnContour) :-
exit_node_from_id(Store, Exit, exit(OnContour, _, _, _, _)).
find_prev_contour(Store, neg_fail(_, Neg), OnContour) :-
@@ -332,7 +410,7 @@
% The following cases are at the left end of a contour,
% so there are no previous contours in the same stratum.
%
-find_prev_contour(_, call(_, _, _, _, _, _, _), _) :-
+find_prev_contour(_, call(_, _, _, _, _, _, _, _), _) :-
error("find_prev_contour: reached CALL node").
find_prev_contour(_, cond(_, _, _), _) :-
error("find_prev_contour: reached COND node").
@@ -369,7 +447,7 @@
% The following cases mark the boundary of the stratum,
% so we cannot step any further.
%
-step_in_stratum(_, call(_, _, _, _, _, _, _)) = _ :-
+step_in_stratum(_, call(_, _, _, _, _, _, _, _)) = _ :-
error("step_in_stratum: unexpected CALL node").
step_in_stratum(_, neg(_, _, _)) = _ :-
error("step_in_stratum: unexpected NEGE node").
@@ -382,7 +460,7 @@
->
Redo = redo(Next, _)
;
- call_node_from_id(Store, Call, call(Next, _, _, _, _, _, _))
+ call_node_from_id(Store, Call, call(Next, _, _, _, _, _, _, _))
).
det_trace_node_from_id(Store, NodeId, Node) :-
@@ -397,7 +475,7 @@
call_node_from_id(Store, NodeId, Node) :-
(
trace_node_from_id(Store, NodeId, Node0),
- Node0 = call(_, _, _, _, _, _, _)
+ Node0 = call(_, _, _, _, _, _, _, _)
->
Node = Node0
;
@@ -511,7 +589,7 @@
call_node_get_last_interface(Call) = Last :-
(
- Call = call(_, Last0, _, _, _, _, _)
+ Call = call(_, Last0, _, _, _, _, _, _)
->
Last = Last0
;
@@ -526,7 +604,7 @@
call_node_set_last_interface(Call0, Last) = Call :-
(
- Call0 = call(_, _, _, _, _, _, _)
+ Call0 = call(_, _, _, _, _, _, _, _)
->
Call1 = Call0
;
@@ -590,7 +668,7 @@
:- pragma export(trace_node_port(in) = out,
"MR_DD_trace_node_port").
-trace_node_port(call(_, _, _, _, _, _, _)) = call.
+trace_node_port(call(_, _, _, _, _, _, _, _)) = call.
trace_node_port(exit(_, _, _, _, _)) = exit.
trace_node_port(redo(_, _)) = redo.
trace_node_port(fail(_, _, _, _)) = fail.
@@ -610,7 +688,7 @@
:- pragma export(trace_node_path(in, in) = out,
"MR_DD_trace_node_path").
-trace_node_path(_, call(_, _, _, _, _, _, _)) = "".
+trace_node_path(_, call(_, _, _, _, _, _, _, P)) = P.
trace_node_path(_, exit(_, _, _, _, _)) = "".
trace_node_path(_, redo(_, _)) = "".
trace_node_path(_, fail(_, _, _, _)) = "".
@@ -637,12 +715,12 @@
trace_node_seqno(S, Node, SeqNo) :-
(
- Node = call(_, _, _, SeqNo0, _, _, _)
+ Node = call(_, _, _, SeqNo0, _, _, _, _)
->
SeqNo = SeqNo0
;
trace_node_call(S, Node, Call),
- call_node_from_id(S, Call, call(_, _, _, SeqNo, _, _, _))
+ call_node_from_id(S, Call, call(_, _, _, SeqNo, _, _, _, _))
).
:- pred trace_node_call(trace_node_store, trace_node(trace_node_id),
@@ -719,27 +797,27 @@
%
:- func construct_call_node(trace_node_id, trace_atom, sequence_number,
- event_number, bool) = trace_node(trace_node_id).
-:- pragma export(construct_call_node(in, in, in, in, in) = out,
+ event_number, bool, string) = trace_node(trace_node_id).
+:- pragma export(construct_call_node(in, in, in, in, in, in) = out,
"MR_DD_construct_call_node").
-construct_call_node(Preceding, Atom, SeqNo, EventNo, MaxDepth) = Call :-
- Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth, no),
+construct_call_node(Preceding, Atom, SeqNo, EventNo, MaxDepth, Path) = Call :-
+ Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth,
+ no, Path),
null_trace_node_id(Answer).
:- func construct_call_node_with_goal(trace_node_id, trace_atom,
- sequence_number, event_number, bool, proc_rep)
+ sequence_number, event_number, bool, proc_rep, string)
= trace_node(trace_node_id).
-:- pragma export(construct_call_node_with_goal(in, in, in, in, in, in) = out,
- "MR_DD_construct_call_node_with_goal").
+:- pragma export(construct_call_node_with_goal(in, in, in, in, in, in, in)
+ = out, "MR_DD_construct_call_node_with_goal").
construct_call_node_with_goal(Preceding, Atom, SeqNo, EventNo, MaxDepth,
- ProcRep) = Call :-
+ ProcRep, Path) = Call :-
Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth,
- yes(ProcRep)),
+ yes(ProcRep), Path),
null_trace_node_id(Answer).
-
:- func construct_exit_node(trace_node_id, trace_node_id, trace_node_id,
trace_atom, event_number) = trace_node(trace_node_id).
:- pragma export(construct_exit_node(in, in, in, in, in) = out,
@@ -748,7 +826,6 @@
construct_exit_node(Preceding, Call, MaybeRedo, Atom, EventNo)
= exit(Preceding, Call, MaybeRedo, Atom, EventNo).
-
:- func construct_redo_node(trace_node_id, trace_node_id)
= trace_node(trace_node_id).
:- pragma export(construct_redo_node(in, in) = out,
@@ -756,7 +833,6 @@
construct_redo_node(Preceding, Exit) = redo(Preceding, Exit).
-
:- func construct_fail_node(trace_node_id, trace_node_id, trace_node_id,
event_number) = trace_node(trace_node_id).
:- pragma export(construct_fail_node(in, in, in, in) = out,
@@ -765,7 +841,6 @@
construct_fail_node(Preceding, Call, Redo, EventNo) =
fail(Preceding, Call, Redo, EventNo).
-
:- func construct_excp_node(trace_node_id, trace_node_id, trace_node_id,
univ, event_number) = trace_node(trace_node_id).
:- pragma export(construct_excp_node(in, in, in, in, in) = out,
@@ -774,7 +849,6 @@
construct_excp_node(Preceding, Call, MaybeRedo, Exception, EventNo) =
excp(Preceding, Call, MaybeRedo, Exception, EventNo).
-
:- func construct_switch_node(trace_node_id, goal_path_string)
= trace_node(trace_node_id).
:- pragma export(construct_switch_node(in, in) = out,
@@ -791,7 +865,6 @@
construct_first_disj_node(Preceding, Path) =
first_disj(Preceding, Path).
-
:- func construct_later_disj_node(trace_node_store, trace_node_id,
goal_path_string, trace_node_id) = trace_node(trace_node_id).
:- pragma export(construct_later_disj_node(in, in, in, in) = out,
@@ -807,7 +880,6 @@
PrevDisjNode = later_disj(_, _, FirstDisj)
).
-
:- func construct_cond_node(trace_node_id, goal_path_string)
= trace_node(trace_node_id).
:- pragma export(construct_cond_node(in, in) = out,
@@ -815,7 +887,6 @@
construct_cond_node(Preceding, Path) = cond(Preceding, Path, undecided).
-
:- func construct_then_node(trace_node_id, trace_node_id)
= trace_node(trace_node_id).
:- pragma export(construct_then_node(in, in) = out,
@@ -823,7 +894,6 @@
construct_then_node(Preceding, Cond) = then(Preceding, Cond).
-
:- func construct_else_node(trace_node_id, trace_node_id)
= trace_node(trace_node_id).
:- pragma export(construct_else_node(in, in) = out,
@@ -831,7 +901,6 @@
construct_else_node(Preceding, Cond) = else(Preceding, Cond).
-
:- func construct_neg_node(trace_node_id, goal_path_string)
= trace_node(trace_node_id).
:- pragma export(construct_neg_node(in, in) = out,
@@ -839,7 +908,6 @@
construct_neg_node(Preceding, Path) = neg(Preceding, Path, undecided).
-
:- func construct_neg_succ_node(trace_node_id, trace_node_id)
= trace_node(trace_node_id).
:- pragma export(construct_neg_succ_node(in, in) = out,
@@ -847,7 +915,6 @@
construct_neg_succ_node(Preceding, Neg) = neg_succ(Preceding, Neg).
-
:- func construct_neg_fail_node(trace_node_id, trace_node_id)
= trace_node(trace_node_id).
:- pragma export(construct_neg_fail_node(in, in) = out,
@@ -855,7 +922,6 @@
construct_neg_fail_node(Preceding, Neg) = neg_fail(Preceding, Neg).
-
:- pred null_trace_node_id(trace_node_id).
:- mode null_trace_node_id(out) is det.
@@ -865,21 +931,47 @@
"Id = (MR_Word) NULL;"
).
-
:- func construct_trace_atom(pred_or_func, string, int) = trace_atom.
:- pragma export(construct_trace_atom(in, in, in) = out,
"MR_DD_construct_trace_atom").
construct_trace_atom(PredOrFunc, Functor, Arity) = Atom :-
Atom = atom(PredOrFunc, Functor, Args),
- list__duplicate(Arity, no, Args).
+ list__duplicate(Arity, dummy_arg_info, Args).
+
+:- 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)
+ = atom(C, F, Args) :-
+ Arg = arg_info(c_bool_to_merc_bool(ProgVis), ProgVisNum, yes(Val)),
+ list__replace_nth_det(Args0, Num, Arg, Args).
+
+:- 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)
+ = atom(C, F, Args) :-
+ Arg = arg_info(c_bool_to_merc_bool(ProgVis), ProgVisNum, no),
+ list__replace_nth_det(Args0, Num, Arg, Args).
+
+ % This code converts a C bool (represented as int) to a Mercury bool.
+:- func c_bool_to_merc_bool(int) = bool.
+
+c_bool_to_merc_bool(ProgVis) =
+ ( ProgVis = 0 ->
+ no
+ ;
+ yes
+ ).
-:- func add_trace_atom_arg(trace_atom, int, univ) = trace_atom.
-:- pragma export(add_trace_atom_arg(in, in, in) = out,
- "MR_DD_add_trace_atom_arg").
+ % Create a temporary placeholder until the code MR_decl_make_atom
+ % can fill in all the argument slots.
+:- func dummy_arg_info = trace_atom_arg.
-add_trace_atom_arg(atom(C, F, Args0), Num, Val) = atom(C, F, Args) :-
- list__replace_nth_det(Args0, Num, yes(Val), Args).
+dummy_arg_info = arg_info(no, -1, no).
%-----------------------------------------------------------------------------%
@@ -979,7 +1071,7 @@
%
:- func preceding_node(trace_node(T)) = T.
-preceding_node(call(P, _, _, _, _, _, _)) = P.
+preceding_node(call(P, _, _, _, _, _, _, _)) = P.
preceding_node(exit(P, _, _, _, _)) = P.
preceding_node(redo(P, _)) = P.
preceding_node(fail(P, _, _, _)) = P.
@@ -994,3 +1086,54 @@
preceding_node(neg_succ(P, _)) = P.
preceding_node(neg_fail(P, _)) = P.
+%-----------------------------------------------------------------------------%
+
+maybe_filter_headvars(Which, Args0, Args) :-
+ (
+ Which = all_headvars,
+ Args = Args0
+ ;
+ Which = only_user_headvars,
+ Args = list__filter(is_user_vis_arg, Args0)
+ ).
+
+head_vars_presentation = only_user_headvars.
+
+is_user_vis_arg(arg_info(yes, _, _)).
+
+select_arg_at_pos(ArgPos, Args0, Arg) :-
+ (
+ ArgPos = user_head_var(N),
+ Which = only_user_headvars
+ ;
+ ArgPos = any_head_var(N),
+ Which = all_headvars
+ ),
+ maybe_filter_headvars(Which, Args0, Args),
+ list__index1_det(Args, N, Arg).
+
+absolute_arg_num(any_head_var(ArgNum), _, 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,
+ int::out) is det.
+
+head_var_num_to_arg_num([], _, _, _) :-
+ error("head_var_num_to_arg_num: nonexistent head_var_num").
+head_var_num_to_arg_num([Arg | Args], SearchUserHeadVarNum, CurArgNum,
+ ArgNum) :-
+ Arg = arg_info(UserVis, _, _),
+ (
+ UserVis = no,
+ head_var_num_to_arg_num(Args, SearchUserHeadVarNum,
+ CurArgNum + 1, ArgNum)
+ ;
+ UserVis = yes,
+ ( SearchUserHeadVarNum = 1 ->
+ ArgNum = CurArgNum
+ ;
+ head_var_num_to_arg_num(Args, SearchUserHeadVarNum - 1,
+ CurArgNum + 1, ArgNum)
+ )
+ ).
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.16
diff -u -b -r1.16 declarative_user.m
--- browser/declarative_user.m 4 Mar 2002 19:28:44 -0000 1.16
+++ browser/declarative_user.m 16 Apr 2002 14:23:11 -0000
@@ -95,15 +95,23 @@
{ reverse_and_append(Skipped, [Node | Nodes], Questions) },
query_user_2(Questions, [], Response, User1, User)
;
- { Command = browse(Arg) },
- browse_edt_node(Node, Arg, MaybeMark, User1, User2),
+ { Command = browse(ArgNum) },
+ browse_edt_node(Node, ArgNum, MaybeMark, User1, User2),
(
{ MaybeMark = no },
query_user_2([Node | Nodes], Skipped, Response, User2,
User)
;
{ MaybeMark = yes(Mark) },
- { Answer = suspicious_subterm(Node, Arg, Mark) },
+ { Which = head_vars_presentation },
+ {
+ Which = only_user_headvars,
+ ArgPos = user_head_var(ArgNum)
+ ;
+ Which = all_headvars,
+ ArgPos = any_head_var(ArgNum)
+ },
+ { Answer = suspicious_subterm(Node, ArgPos, Mark) },
{ Response = user_answer(Answer) },
{ User = User2 }
)
@@ -165,17 +173,19 @@
is cc_multi.
browse_atom_argument(Atom, ArgNum, MaybeMark, User0, User) -->
- { Atom = atom(_, _, Args) },
+ { Atom = atom(_, _, Args0) },
+ { maybe_filter_headvars(head_vars_presentation, Args0, Args) },
(
- { list__index1(Args, ArgNum, MaybeArg) },
+ { list__index1(Args, ArgNum, ArgInfo) },
+ { ArgInfo = arg_info(_, _, MaybeArg) },
{ MaybeArg = yes(Arg) }
->
- browse(univ_value(Arg), User0^instr, User0^outstr, MaybeDirs,
- User0^browser, Browser),
+ browse(univ_value(Arg), User0 ^ instr, User0 ^ outstr,
+ MaybeDirs, User0 ^ browser, Browser),
{ maybe_convert_dirs_to_path(MaybeDirs, MaybeMark) },
- { User = User0^browser := Browser }
+ { User = User0 ^ browser := Browser }
;
- io__write_string(User^outstr, "Invalid argument number\n"),
+ io__write_string(User ^ outstr, "Invalid argument number\n"),
{ MaybeMark = no },
{ User = User0 }
).
@@ -214,7 +224,7 @@
:- mode user_help_message(in, di, uo) is det.
user_help_message(User) -->
- io__write_strings(User^outstr, [
+ io__write_strings(User ^ outstr, [
"According to the intended interpretation of the program,",
" answer one of:\n",
"\ty\tyes\t\tthe node is correct\n",
@@ -232,7 +242,7 @@
:- mode user_confirm_bug_help(in, di, uo) is det.
user_confirm_bug_help(User) -->
- io__write_strings(User^outstr, [
+ io__write_strings(User ^ outstr, [
"Answer one of:\n",
"\ty\tyes\t\tconfirm that the suspect is a bug\n",
"\tn\tno\t\tdo not accept that the suspect is a bug\n",
@@ -247,7 +257,7 @@
:- mode get_command(in, out, in, out, di, uo) is det.
get_command(Prompt, Command, User, User) -->
- util__trace_getline(Prompt, Result, User^instr, User^outstr),
+ util__trace_getline(Prompt, Result, User ^ instr, User ^ outstr),
( { Result = ok(String) },
{ string__to_char_list(String, Line) },
{
@@ -259,8 +269,8 @@
}
; { Result = error(Error) },
{ io__error_message(Error, Msg) },
- io__write_string(User^outstr, Msg),
- io__nl(User^outstr),
+ io__write_string(User ^ outstr, Msg),
+ io__nl(User ^ outstr),
{ Command = abort }
; { Result = eof },
{ Command = abort }
@@ -342,17 +352,17 @@
(
{ Solns = [] }
->
- io__write_string(User^outstr, "No solutions.\n")
+ io__write_string(User ^ outstr, "No solutions.\n")
;
- io__write_string(User^outstr, "Solutions:\n"),
+ io__write_string(User ^ outstr, "Solutions:\n"),
list__foldl(write_decl_atom(User, "\t"), Solns)
).
write_decl_question(unexpected_exception(Call, Exception), User) -->
write_decl_atom(User, "Call ", Call),
- io__write_string(User^outstr, "Throws "),
- io__write(User^outstr, include_details_cc, univ_value(Exception)),
- io__nl(User^outstr).
+ io__write_string(User ^ outstr, "Throws "),
+ io__write(User ^ outstr, include_details_cc, univ_value(Exception)),
+ io__nl(User ^ outstr).
:- pred write_decl_bug(decl_bug::in, user_state::in,
io__state::di, io__state::uo) is cc_multi.
@@ -360,25 +370,25 @@
write_decl_bug(e_bug(EBug), User) -->
(
{ EBug = incorrect_contour(Atom, _, _) },
- io__write_string(User^outstr, "Found incorrect contour:\n"),
+ io__write_string(User ^ outstr, "Found incorrect contour:\n"),
write_decl_atom(User, "", Atom)
;
{ EBug = partially_uncovered_atom(Atom, _) },
- io__write_string(User^outstr,
+ io__write_string(User ^ outstr,
"Found partially uncovered atom:\n"),
write_decl_atom(User, "", Atom)
;
{ EBug = unhandled_exception(Atom, Exception, _) },
- io__write_string(User^outstr, "Found unhandled exception:\n"),
+ io__write_string(User ^ outstr, "Found unhandled exception:\n"),
write_decl_atom(User, "", Atom),
- io__write(User^outstr, include_details_cc,
+ io__write(User ^ outstr, include_details_cc,
univ_value(Exception)),
- io__nl(User^outstr)
+ io__nl(User ^ outstr)
).
write_decl_bug(i_bug(IBug), User) -->
{ IBug = inadmissible_call(Parent, _, Call, _) },
- io__write_string(User^outstr, "Found inadmissible call:\n"),
+ io__write_string(User ^ outstr, "Found inadmissible call:\n"),
write_decl_atom(User, "Parent ", Parent),
write_decl_atom(User, "Call ", Call).
@@ -386,7 +396,7 @@
io__state::di, io__state::uo) is cc_multi.
write_decl_atom(User, Indent, Atom) -->
- io__write_string(User^outstr, Indent),
+ io__write_string(User ^ outstr, Indent),
%
% Check whether the atom is likely to fit on one line.
% If it's not, then call the browser to print the term
@@ -394,73 +404,90 @@
% it out directly so that all arguments are put on the
% same line.
%
- { check_decl_atom_size(Indent, Atom, RemSize) },
+ { Which = head_vars_presentation },
+ { check_decl_atom_size(Indent, Which, Atom, RemSize) },
( { RemSize > 0 } ->
- write_decl_atom_direct(User^outstr, Atom)
+ write_decl_atom_direct(User ^ outstr, Atom, Which)
;
- write_decl_atom_limited(Atom, User)
+ write_decl_atom_limited(User, Atom, Which)
).
-:- pred check_decl_atom_size(string, decl_atom, int).
-:- mode check_decl_atom_size(in, in, out) is cc_multi.
+:- pred check_decl_atom_size(string::in, which_headvars::in, decl_atom::in,
+ int::out) is cc_multi.
-check_decl_atom_size(Indent, atom(_, Functor, Args), RemSize) :-
+check_decl_atom_size(Indent, Which, atom(_, Functor, Args), RemSize) :-
decl_atom_size_limit(RemSize0),
string__length(Indent, I),
string__length(Functor, F),
P = 2, % parentheses
RemSize1 = RemSize0 - I - F - P,
- size_left_after_args(Args, RemSize1, RemSize).
+ size_left_after_args(Args, Which, RemSize1, RemSize).
-:- pred size_left_after_args(list(maybe(univ)), int, int).
-:- mode size_left_after_args(in, in, out) is cc_multi.
+:- pred size_left_after_args(list(trace_atom_arg)::in, which_headvars::in,
+ int::in, int::out) is cc_multi.
-size_left_after_args([]) -->
+size_left_after_args([], _) -->
[].
-size_left_after_args([yes(A) | As]) -->
- term_size_left_from_max(A),
- size_left_after_args(As).
-size_left_after_args([no | As]) -->
- size_left_after_args(As).
+size_left_after_args([arg_info(UserVis, _, MaybeUniv) | Args], Which) -->
+ (
+ { MaybeUniv = yes(Univ) },
+ (
+ { Which = only_user_headvars },
+ { UserVis = no }
+ ->
+ % This argument won't be printed.
+ []
+ ;
+ term_size_left_from_max(Univ)
+ )
+ ;
+ { MaybeUniv = no }
+ ),
+ size_left_after_args(Args, Which).
:- pred decl_atom_size_limit(int).
:- mode decl_atom_size_limit(out) is det.
decl_atom_size_limit(79).
-:- pred write_decl_atom_limited(decl_atom::in, user_state::in,
- io__state::di, io__state::uo) is cc_multi.
+:- pred write_decl_atom_limited(user_state::in, decl_atom::in,
+ which_headvars::in, io__state::di, io__state::uo) is cc_multi.
-write_decl_atom_limited(atom(PredOrFunc, Functor, Args), User) -->
- write_decl_atom_category(User^outstr, PredOrFunc),
- io__write_string(User^outstr, Functor),
- io__nl(User^outstr),
+write_decl_atom_limited(User, atom(PredOrFunc, Functor, Args0), Which) -->
+ write_decl_atom_category(User ^ outstr, PredOrFunc),
+ io__write_string(User ^ outstr, Functor),
+ io__nl(User ^ outstr),
+ { maybe_filter_headvars(Which, Args0, Args) },
foldl(print_decl_atom_arg(User), Args).
-:- pred write_decl_atom_category(io__output_stream, pred_or_func, io__state,
- io__state).
-:- mode write_decl_atom_category(in, in, di, uo) is det.
+:- pred write_decl_atom_category(io__output_stream::in, pred_or_func::in,
+ io__state::di, io__state::uo) is det.
write_decl_atom_category(OutStr, predicate) -->
io__write_string(OutStr, "pred ").
write_decl_atom_category(OutStr, function) -->
io__write_string(OutStr, "func ").
-:- pred print_decl_atom_arg(user_state::in, maybe(univ)::in,
+:- pred print_decl_atom_arg(user_state::in, trace_atom_arg::in,
io__state::di, io__state::uo) is cc_multi.
-print_decl_atom_arg(User, yes(Arg)) -->
- io__write_string(User^outstr, "\t"),
- browse__print(univ_value(Arg), User^outstr, print_all, User^browser).
-print_decl_atom_arg(User, no) -->
- io__write_string(User^outstr, "\t_\n").
+print_decl_atom_arg(User, arg_info(_, _, MaybeArg)) -->
+ (
+ { MaybeArg = yes(Arg) },
+ io__write_string(User ^ outstr, "\t"),
+ browse__print(univ_value(Arg), User ^ outstr, print_all,
+ User ^ browser)
+ ;
+ { MaybeArg = no },
+ io__write_string(User ^ outstr, "\t_\n")
+ ).
-:- pred write_decl_atom_direct(io__output_stream, decl_atom,
- io__state, io__state).
-:- mode write_decl_atom_direct(in, in, di, uo) is cc_multi.
+:- pred write_decl_atom_direct(io__output_stream::in, decl_atom::in,
+ which_headvars::in, io__state::di, io__state::uo) is cc_multi.
-write_decl_atom_direct(OutStr, atom(PredOrFunc, Functor, Args)) -->
+write_decl_atom_direct(OutStr, atom(PredOrFunc, Functor, Args0), Which) -->
io__write_string(OutStr, Functor),
+ { maybe_filter_headvars(Which, Args0, Args) },
(
{ Args = [] }
;
@@ -483,14 +510,18 @@
),
io__nl(OutStr).
-:- pred write_decl_atom_arg(io__output_stream, maybe(univ),
+:- pred write_decl_atom_arg(io__output_stream, trace_atom_arg,
io__state, io__state).
:- mode write_decl_atom_arg(in, in, di, uo) is cc_multi.
-write_decl_atom_arg(OutStr, yes(Arg)) -->
- io__write(OutStr, include_details_cc, univ_value(Arg)).
-write_decl_atom_arg(OutStr, no) -->
- io__write_char(OutStr, '_').
+write_decl_atom_arg(OutStr, arg_info(_, _, MaybeArg)) -->
+ (
+ { MaybeArg = yes(Arg) },
+ io__write(OutStr, include_details_cc, univ_value(Arg))
+ ;
+ { MaybeArg = no },
+ io__write_char(OutStr, '_')
+ ).
:- pred get_inputs_and_result(T, list(T), list(T), T).
:- mode get_inputs_and_result(in, in, out, out) is det.
@@ -499,3 +530,4 @@
get_inputs_and_result(A1, [A2 | As], [A1 | Inputs0], Result) :-
get_inputs_and_result(A2, As, Inputs0, Result).
+%-----------------------------------------------------------------------------%
Index: browser/program_representation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/program_representation.m,v
retrieving revision 1.7
diff -u -b -r1.7 program_representation.m
--- browser/program_representation.m 4 Apr 2002 06:00:06 -0000 1.7
+++ browser/program_representation.m 17 Apr 2002 05:51:26 -0000
@@ -33,8 +33,8 @@
:- interface.
-:- import_module list, std_util.
:- import_module mdb__browser_info.
+:- import_module char, list, std_util.
% A representation of the goal we execute. These need to be
% generated statically and stored inside the executable.
@@ -109,16 +109,17 @@
)
; higher_order_call_rep(
var_rep, % the closure to call
- list(var_rep) % arguments
+ list(var_rep) % the call's plain arguments
)
; method_call_rep(
var_rep, % typeclass info var
int, % method number
- list(var_rep) % arguments
+ list(var_rep) % the call's plain arguments
)
; plain_call_rep(
- string, % name of called pred
- list(var_rep) % arguments
+ string, % name of called pred's module
+ string, % name of the called pred
+ list(var_rep) % the call's arguments
).
:- type var_rep == int.
@@ -135,12 +136,16 @@
; erroneous_rep
; failure_rep.
- % If the given atomic goal is a call to a predicate or function
- % (not including the special predicates `unify' and `compare'),
- % then return the list of variables that are passed as arguments.
+ % If the given atomic goal behaves like a call in the sense that it
+ % generates events, then return the list of variables that are passed
+ % as arguments.
%
-:- pred atomic_goal_rep_is_call(atomic_goal_rep, list(var_rep)).
-:- mode atomic_goal_rep_is_call(in, out) is semidet.
+:- func atomic_goal_generates_event(atomic_goal_rep) = maybe(list(var_rep)).
+
+ % call_is_primitive(ModuleName, PredName): succeeds iff a call to the
+ % named predicate behaves like a primitive operation, in the sense that
+ % it does not generate events.
+:- pred call_is_primitive(string::in, string::in) is semidet.
%-----------------------------------------------------------------------------%
@@ -162,24 +167,43 @@
% Does `some G' have a different determinism from plain `G'?
:- type maybe_cut ---> cut ; no_cut.
+:- pred path_from_string_det(string, goal_path).
+:- mode path_from_string_det(in, out) is det.
+
+:- pred path_from_string(string, goal_path).
+:- mode path_from_string(in, out) is semidet.
+
:- pred path_step_from_string(string, goal_path_step).
:- mode path_step_from_string(in, out) is semidet.
- % Head variables are represented by a number from 1..N,
- % where N is the arity.
+:- pred is_path_separator(char).
+:- mode is_path_separator(in) is semidet.
-:- type arg_pos == var_rep.
+ % User-visible head variables are represented by a number from 1..N,
+ % where N is the user-visible arity.
+ %
+ % Both user-visible and compiler-generated head variables can be
+ % referred to via their position in the full list of head variables;
+ % the first head variable is at position 1.
+
+:- type arg_pos
+ ---> user_head_var(int) % Nth in the list of arguments after
+ % filtering out non-user-visible vars.
+ ; any_head_var(int). % Nth in the list of all arguments.
% A particular subterm within a term is represented by a term_path.
% This is the list of argument positions that need to be followed
% in order to travel from the root to the subterm. In contrast to
% goal_paths, this list is in top-down order.
-:- type term_path == list(arg_pos).
+:- type term_path == list(int).
:- pred convert_dirs_to_term_path(list(dir), term_path).
:- mode convert_dirs_to_term_path(in, out) is det.
+ % Returns type_of(_ `with_type` proc_rep), for use in C code.
+:- func proc_rep_type = type_desc.
+
% Returns type_of(_ `with_type` goal_rep), for use in C code.
:- func goal_rep_type = type_desc.
@@ -188,12 +212,55 @@
:- implementation.
:- import_module string, char, require.
-atomic_goal_rep_is_call(pragma_foreign_code_rep(Args), Args).
-atomic_goal_rep_is_call(higher_order_call_rep(_, Args), Args).
-atomic_goal_rep_is_call(method_call_rep(_, _, Args), Args).
-atomic_goal_rep_is_call(plain_call_rep(Name, Args), Args) :-
- Name \= "unify",
- Name \= "compare".
+atomic_goal_generates_event(unify_construct_rep(_, _, _)) = no.
+atomic_goal_generates_event(unify_deconstruct_rep(_, _, _)) = no.
+atomic_goal_generates_event(unify_assign_rep(_, _)) = no.
+atomic_goal_generates_event(unify_simple_test_rep(_, _)) = no.
+atomic_goal_generates_event(pragma_foreign_code_rep(_)) = no.
+atomic_goal_generates_event(higher_order_call_rep(_, Args)) = yes(Args).
+atomic_goal_generates_event(method_call_rep(_, _, Args)) = yes(Args).
+atomic_goal_generates_event(plain_call_rep(ModuleName, PredName, Args)) =
+ ( call_is_primitive(ModuleName, PredName) ->
+ % These calls behave as primitives and do not generate events.
+ no
+ ;
+ yes(Args)
+ ).
+
+call_is_primitive(ModuleName, PredName) :-
+ ModuleName = "builtin",
+ ( PredName = "unify"
+ ; PredName = "compare"
+ ).
+
+convert_dirs_to_term_path([], []).
+convert_dirs_to_term_path([child_num(N) | Dirs], [N | TermPath]) :-
+ convert_dirs_to_term_path(Dirs, TermPath).
+convert_dirs_to_term_path([child_name(_) | _], _) :-
+ error("convert_dirs_to_term_path: not in canonical form").
+convert_dirs_to_term_path([parent | _], _) :-
+ error("convert_dirs_to_term_path: not in canonical form").
+
+:- pragma export(proc_rep_type = out, "ML_proc_rep_type").
+
+proc_rep_type = type_of(_ `with_type` proc_rep).
+
+:- pragma export(goal_rep_type = out, "ML_goal_rep_type").
+
+goal_rep_type = type_of(_ `with_type` goal_rep).
+
+%-----------------------------------------------------------------------------%
+
+path_from_string_det(GoalPathStr, GoalPath) :-
+ ( path_from_string(GoalPathStr, GoalPathPrime) ->
+ GoalPath = GoalPathPrime
+ ;
+ error("path_from_string_det: path_from_string failed")
+ ).
+
+path_from_string(GoalPathStr, GoalPath) :-
+ StepStrs = string__words(is_path_separator, GoalPathStr),
+ list__map(path_step_from_string, StepStrs, GoalPath).
path_step_from_string(String, Step) :-
string__first_char(String, First, Rest),
@@ -217,16 +284,7 @@
path_step_from_string_2('f', "", first).
path_step_from_string_2('l', "", later).
-convert_dirs_to_term_path([], []).
-convert_dirs_to_term_path([child_num(N) | Dirs], [N | TermPath]) :-
- convert_dirs_to_term_path(Dirs, TermPath).
-convert_dirs_to_term_path([child_name(_) | _], _) :-
- error("convert_dirs_to_term_path: not in canonical form").
-convert_dirs_to_term_path([parent | _], _) :-
- error("convert_dirs_to_term_path: not in canonical form").
-
-:- pragma export(goal_rep_type = out, "ML_goal_rep_type").
-goal_rep_type = type_of(_ `with_type` goal_rep).
+is_path_separator(';').
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.13
diff -u -b -r1.13 prog_rep.m
--- compiler/prog_rep.m 17 Apr 2002 03:58:35 -0000 1.13
+++ compiler/prog_rep.m 19 Apr 2002 07:06:49 -0000
@@ -29,6 +29,7 @@
:- implementation.
+:- import_module parse_tree__prog_out.
:- import_module hlds__hlds_data.
:- import_module string, set, std_util, require, term.
@@ -210,9 +211,11 @@
prog_rep__represent_goal_expr(call(PredId, _, Args, _, _, _),
GoalInfo, InstMap0, Info, Rep) :-
module_info_pred_info(Info ^ module_info, PredId, PredInfo),
+ pred_info_module(PredInfo, ModuleSymName),
+ prog_out__sym_name_to_string(ModuleSymName, ModuleName),
pred_info_name(PredInfo, PredName),
list__map(term__var_to_int, Args, ArgsRep),
- AtomicGoalRep = plain_call_rep(PredName, ArgsRep),
+ AtomicGoalRep = plain_call_rep(ModuleName, PredName, ArgsRep),
prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info,
DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.32
diff -u -b -r1.32 Mmakefile
--- tests/debugger/declarative/Mmakefile 19 Dec 2001 15:08:29 -0000 1.32
+++ tests/debugger/declarative/Mmakefile 12 Apr 2002 05:53:18 -0000
@@ -24,6 +24,7 @@
browse_arg \
comp_gen \
deep_warning \
+ dependency \
family \
filter \
func_call \
@@ -54,6 +55,7 @@
MLFLAGS = --trace
MCFLAGS-deep_sub=--trace deep
+MCFLAGS-dependency=--trace rep
MCFLAGS-input_term_dep=--trace rep
MCFLAGS-output_term_dep=--trace rep
MCFLAGS-special_term_dep=--trace rep
@@ -122,6 +124,9 @@
deep_warning.out: deep_warning deep_warning.inp
$(MDB) ./deep_warning < deep_warning.inp > deep_warning.out 2>&1
+
+dependency.out: dependency dependency.inp
+ $(MDB) ./dependency < dependency.inp > dependency.out 2>&1
family.out: family family.inp
$(MDB) ./family < family.inp > family.out 2>&1
Index: tests/debugger/declarative/dependency.exp
===================================================================
RCS file: tests/debugger/declarative/dependency.exp
diff -N tests/debugger/declarative/dependency.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/dependency.exp 19 Apr 2002 06:19:12 -0000
@@ -0,0 +1,104 @@
+ 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].
Index: tests/debugger/declarative/dependency.inp
===================================================================
RCS file: tests/debugger/declarative/dependency.inp
diff -N tests/debugger/declarative/dependency.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/dependency.inp 17 Apr 2002 09:42:54 -0000
@@ -0,0 +1,46 @@
+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
Index: tests/debugger/declarative/dependency.m
===================================================================
RCS file: tests/debugger/declarative/dependency.m
diff -N tests/debugger/declarative/dependency.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/dependency.m 16 Apr 2002 08:13:31 -0000
@@ -0,0 +1,76 @@
+:- 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;
+").
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.47
diff -u -b -r1.47 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 24 Feb 2002 11:53:43 -0000 1.47
+++ trace/mercury_trace_declarative.c 16 Apr 2002 15:05:51 -0000
@@ -234,6 +234,9 @@
MR_decl_make_atom(const MR_Label_Layout *layout, MR_Word *saved_regs,
MR_Trace_Port port);
+static MR_bool
+MR_hlds_var_is_head_var(const MR_Proc_Layout *entry, int hlds_num);
+
static MR_ConstString
MR_decl_atom_name(const MR_Proc_Layout *entry);
@@ -459,8 +462,15 @@
MR_Trace_Node node;
MR_Word atom;
MR_bool at_depth_limit;
- const MR_Label_Layout *layout = event_info->MR_event_sll;
+ const MR_Label_Layout *event_label_layout;
+ const MR_Proc_Layout *event_proc_layout;
+ const MR_Label_Layout *return_label_layout;
MR_Word proc_rep;
+ MR_Stack_Walk_Step_Result result;
+ MR_ConstString problem;
+ MR_String goal_path;
+ MR_Word *base_sp;
+ MR_Word *base_curfr;
if (event_info->MR_call_depth == MR_edt_max_depth) {
at_depth_limit = MR_TRUE;
@@ -468,9 +478,29 @@
at_depth_limit = MR_FALSE;
}
- proc_rep = (MR_Word) layout->MR_sll_entry->MR_sle_proc_rep;
- atom = MR_decl_make_atom(layout, event_info->MR_saved_regs,
+ event_label_layout = event_info->MR_event_sll;
+ event_proc_layout = event_label_layout->MR_sll_entry;
+ proc_rep = (MR_Word) event_proc_layout->MR_sle_proc_rep;
+ atom = MR_decl_make_atom(event_label_layout, event_info->MR_saved_regs,
MR_PORT_CALL);
+ base_sp = MR_saved_sp(event_info->MR_saved_regs);
+ base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
+ result = MR_stack_walk_step(event_proc_layout, &return_label_layout,
+ &base_sp, &base_curfr, &problem);
+
+ /*
+ ** We pass goal_path to Mercury code, which expects its type to be
+ ** MR_String, not MR_ConstString, even though it treats the string as
+ ** constant.
+ */
+
+ if (result == MR_STEP_OK) {
+ goal_path = (MR_String) (MR_Integer)
+ MR_label_goal_path(return_label_layout);
+ } else {
+ goal_path = (MR_String) (MR_Integer) "";
+ }
+
MR_TRACE_CALL_MERCURY(
if (proc_rep) {
node = (MR_Trace_Node)
@@ -478,13 +508,14 @@
(MR_Word) prev, atom,
(MR_Word) event_info->MR_call_seqno,
(MR_Word) event_info->MR_event_number,
- (MR_Word) at_depth_limit, proc_rep);
+ (MR_Word) at_depth_limit, proc_rep,
+ goal_path);
} else {
node = (MR_Trace_Node)
MR_DD_construct_call_node((MR_Word) prev, atom,
(MR_Word) event_info->MR_call_seqno,
(MR_Word) event_info->MR_event_number,
- (MR_Word) at_depth_limit);
+ (MR_Word) at_depth_limit, goal_path);
}
);
@@ -1047,15 +1078,14 @@
MR_ConstString name;
MR_Word arity;
MR_Word atom;
- int i;
- int arg_count;
+ int hv; /* any head variable */
MR_TypeInfoParams type_params;
const MR_Proc_Layout *entry = layout->MR_sll_entry;
- MR_trace_init_point_vars(layout, saved_regs, port, MR_FALSE);
+ MR_trace_init_point_vars(layout, saved_regs, port, MR_TRUE);
name = MR_decl_atom_name(entry);
- if (MR_PROC_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(entry)) {
arity = entry->MR_sle_comp.MR_comp_arity;
pred_or_func = MR_PREDICATE;
} else {
@@ -1066,39 +1096,75 @@
atom = MR_DD_construct_trace_atom(
(MR_Word) pred_or_func,
(MR_String) name,
- (MR_Word) arity);
+ (MR_Word) entry->MR_sle_num_head_vars);
);
- arg_count = MR_trace_var_count();
- for (i = 1; i <= arg_count; i++) {
+ for (hv = 0; hv < entry->MR_sle_num_head_vars; hv++) {
+ int hlds_num;
MR_Word arg;
MR_TypeInfo arg_type;
MR_Word arg_value;
- int arg_pos;
+ MR_bool is_prog_visible_headvar;
const char *problem;
- problem = MR_trace_return_var_info(i, NULL, &arg_type,
+ hlds_num = entry->MR_sle_head_var_nums[hv];
+
+ is_prog_visible_headvar =
+ MR_hlds_var_is_head_var(entry, hlds_num);
+
+ problem = MR_trace_return_hlds_var_info(hlds_num, &arg_type,
&arg_value);
if (problem != NULL) {
- MR_fatal_error(problem);
- }
-
- problem = MR_trace_headvar_num(i, &arg_pos);
- if (problem != NULL) {
- MR_fatal_error(problem);
- }
+ /* this head variable is not live at this port */
+ MR_TRACE_CALL_MERCURY(
+ atom = MR_DD_add_trace_atom_arg_no_value(atom,
+ (MR_Word) hv + 1, hlds_num,
+ is_prog_visible_headvar);
+ );
+ } else {
MR_TRACE_USE_HP(
MR_new_univ_on_hp(arg, arg_type, arg_value);
);
MR_TRACE_CALL_MERCURY(
- atom = MR_DD_add_trace_atom_arg(atom,
- (MR_Word) arg_pos, arg);
+ atom = MR_DD_add_trace_atom_arg_value(atom,
+ (MR_Word) hv + 1, hlds_num,
+ is_prog_visible_headvar, arg);
);
}
+ }
return atom;
+}
+
+static MR_bool
+MR_hlds_var_is_head_var(const MR_Proc_Layout *entry, int hlds_num)
+{
+ MR_ConstString var_name;
+ MR_ConstString prefix;
+ const char *s;
+
+ var_name = MR_hlds_var_name(entry, hlds_num);
+ if (var_name == NULL) {
+ return MR_FALSE;
+ }
+
+ prefix = "HeadVar__";
+ if (! MR_strneq(var_name, prefix, strlen(prefix))) {
+ return MR_FALSE;
+ }
+
+ s = var_name + strlen(prefix);
+ while (*s != '\0') {
+ if (! MR_isdigit(*s)) {
+ return MR_FALSE;
+ }
+
+ s++;
+ }
+
+ return MR_TRUE;
}
static MR_ConstString
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.126
diff -u -b -r1.126 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 9 Apr 2002 12:14:55 -0000 1.126
+++ trace/mercury_trace_internal.c 17 Apr 2002 05:52:11 -0000
@@ -3275,7 +3275,7 @@
"current procedure has no body info\n");
} else {
MR_trace_browse_internal(
- ML_goal_rep_type(),
+ ML_proc_rep_type(),
(MR_Word) entry->MR_sle_proc_rep,
MR_BROWSE_CALLER_PRINT,
MR_BROWSE_DEFAULT_FORMAT);
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.41
diff -u -b -r1.41 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 3 Apr 2002 07:08:22 -0000 1.41
+++ trace/mercury_trace_vars.c 16 Apr 2002 14:57:23 -0000
@@ -652,6 +652,29 @@
}
const char *
+MR_trace_return_hlds_var_info(int hlds_num, MR_TypeInfo *type_info_ptr,
+ MR_Word *value_ptr)
+{
+ int i;
+
+ if (MR_point.MR_point_problem != NULL) {
+ return MR_point.MR_point_problem;
+ }
+
+ for (i = 0; i < MR_point.MR_point_var_count; i++) {
+ if (MR_point.MR_point_vars[i].MR_var_hlds_number == hlds_num) {
+ *type_info_ptr =
+ MR_point.MR_point_vars[i].MR_var_type;
+ *value_ptr =
+ MR_point.MR_point_vars[i].MR_var_value;
+ return NULL;
+ }
+ }
+
+ return "no variable with specified hlds number";
+}
+
+const char *
MR_trace_return_var_info(int var_number, const char **name_ptr,
MR_TypeInfo *type_info_ptr, MR_Word *value_ptr)
{
@@ -1152,6 +1175,31 @@
(*browser)((MR_Word) typeinfo, *value, caller, format);
return NULL;
+}
+
+MR_ConstString
+MR_hlds_var_name(const MR_Proc_Layout *entry, int hlds_var_num)
+{
+ const char *string_table;
+ MR_Integer string_table_size;
+ int offset;
+
+ string_table = entry->MR_sle_module_layout->MR_ml_string_table;
+ string_table_size =
+ entry->MR_sle_module_layout->MR_ml_string_table_size;
+
+ if (hlds_var_num > entry->MR_sle_max_named_var_num) {
+ /* this value is a compiler-generated variable */
+ return NULL;
+ }
+
+ /* variable number 1 is stored at offset 0 */
+ offset = entry->MR_sle_used_var_names[hlds_var_num - 1];
+ if (offset > string_table_size) {
+ MR_fatal_error("array bounds error on string table");
+ }
+
+ return string_table + offset;
}
MR_Completer_List *
Index: trace/mercury_trace_vars.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.h,v
retrieving revision 1.19
diff -u -b -r1.19 mercury_trace_vars.h
--- trace/mercury_trace_vars.h 11 Mar 2002 19:45:48 -0000 1.19
+++ trace/mercury_trace_vars.h 16 Apr 2002 14:56:49 -0000
@@ -2,7 +2,9 @@
** Copyright (C) 1999-2002 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
-**
+*/
+
+/*
** This module looks after the debugger's information about the variables
** that are live at a given program point.
**
@@ -107,6 +109,17 @@
extern const char *MR_trace_list_vars(FILE *out);
/*
+** Return as a side effect the type and value of the value 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.
+*/
+
+extern const char * MR_trace_return_hlds_var_info(int hlds_num,
+ MR_TypeInfo *type_info_ptr,
+ MR_Word *value_ptr);
+
+/*
** Return as a side effect the name, type and value of the specified
** variable in the specified locations, except those which are NULL.
** Variable number n must be in the range 1..MR_trace_var_count().
@@ -200,7 +213,18 @@
MR_Word *base_sp, MR_Word *base_curfr,
int ancestor_level, MR_bool print_optionals);
-/* A Readline completer for variable names. */
+/*
+** Return the name (if any) of the variable with the given HLDS variable number
+** in the procedure indicated by the first argument.
+*/
+
+extern MR_ConstString MR_hlds_var_name(const MR_Proc_Layout *entry,
+ int hlds_var_num);
+
+/*
+** A Readline completer for variable names.
+*/
+
extern MR_Completer_List *MR_trace_var_completer(const char *word,
size_t word_len);
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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