[m-rev.] for review: dependency tracking
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Apr 23 13:46:07 AEST 2002
On 23-Apr-2002, Mark Brown <dougl at cs.mu.OZ.AU> wrote:
> This completes this round of reviewing.
Here is updated full diff.
Zoltan.
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 22 Apr 2002 05:03:51 -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
@@ -64,9 +64,11 @@
; 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 (unification or inlined foreign_proc)
+ % that constructed it.
%
- ; unification(string, int)
+ ; primitive_op(string, int)
% The origin could not be found due to missing
% information.
@@ -114,6 +116,12 @@
analyser_state(T), analyser_state(T)) <= mercury_edt(S, T).
:- mode continue_analysis(in, in, out, in, out) is det.
+ % Return information within the analyser state that is intended for
+ % debugging the declarative debugger itself.
+ %
+:- pred debug_analyser_state(analyser_state(T)::in,
+ maybe(subterm_origin(T))::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -137,15 +145,19 @@
% Previous prime suspects.
%
- previous :: list(suspect(T))
+ previous :: list(suspect(T)),
+
+ debug_origin :: maybe(subterm_origin(T))
).
-analyser_state_init(analyser(no, [], [])).
+analyser_state_init(analyser(no, [], [], no)).
+
+debug_analyser_state(Analyser, Analyser ^ debug_origin).
start_analysis(Store, Tree, Response, Analyser0, Analyser) :-
make_suspects(Store, [Tree], Suspects, Queries),
get_all_prime_suspects(Analyser0, OldPrimes),
- Analyser = analyser(no, Suspects, OldPrimes),
+ Analyser = analyser(no, Suspects, OldPrimes, no),
Response = oracle_queries(Queries).
continue_analysis(Store, Answers, Response, Analyser0, Analyser) :-
@@ -160,18 +172,19 @@
%
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, Suspect, Response,
+ Analyser0, Analyser)
;
- remove_suspects(Store, Answers, Response, Analyser0, Analyser)
+ remove_suspects(Store, Answers, Response,
+ Analyser0, Analyser)
).
% Find an answer which is a suspicious subterm, and find the
@@ -183,7 +196,6 @@
find_suspicious_subterm([Answer | Answers], Suspects, Suspect, ArgPos,
TermPath) :-
-
(
Answer = suspicious_subterm(Question, ArgPos0, TermPath0),
find_matching_suspects(Question, Suspects, [Match | _], _)
@@ -196,9 +208,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,
@@ -213,12 +225,13 @@
(
SubtermMode = subterm_in,
remove_suspects(Store, [truth_value(Query, yes)], Response0,
- Analyser0, Analyser)
+ Analyser0, Analyser1)
;
SubtermMode = subterm_out,
- make_new_prime_suspect(Store, Suspect, Response0, Analyser0,
- Analyser)
+ make_new_prime_suspect(Store, Suspect, Response0,
+ Analyser0, Analyser1)
),
+ Analyser = Analyser1 ^ debug_origin := yes(Origin),
(
Origin = output(Node, _, _),
Response0 = oracle_queries(_)
@@ -255,11 +268,12 @@
% 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, suspect(T)::in,
+ analyser_response(T)::out, analyser_state(T)::in,
+ analyser_state(T)::out) is det <= mercury_edt(S, T).
-make_new_prime_suspect(Store, Suspect, Response, Analyser0, Analyser) :-
+make_new_prime_suspect(Store, Suspect, Response,
+ Analyser0, Analyser) :-
get_all_prime_suspects(Analyser0, OldPrimes),
suspect_get_edt_node(Suspect, Tree),
(
@@ -284,7 +298,7 @@
MaybePrime = no,
Response = require_explicit(Tree)
),
- Analyser = analyser(MaybePrime, Suspects, OldPrimes).
+ Analyser = analyser(MaybePrime, Suspects, OldPrimes, no).
% Make a list of previous prime suspects, and include the current
% one if it exists.
@@ -315,9 +329,9 @@
% 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, list(decl_answer)::in,
+ analyser_response(T)::out, analyser_state(T)::in,
+ analyser_state(T)::out) is det <= mercury_edt(S, T).
remove_suspects(Store, [], Response, Analyser, Analyser) :-
(
@@ -337,16 +351,15 @@
Response = oracle_queries(Queries)
).
-remove_suspects(Store, [Answer | Answers], Response, Analyser0,
- Analyser) :-
-
+remove_suspects(Store, [Answer | Answers], Response, Analyser0, Analyser) :-
(
Answer = truth_value(_, yes)
->
find_matching_suspects(get_decl_question(Answer),
Analyser0 ^ suspects, _, Suspects),
Analyser1 = Analyser0 ^ suspects := Suspects,
- remove_suspects(Store, Answers, Response, Analyser1, Analyser)
+ remove_suspects(Store, Answers, Response,
+ Analyser1, Analyser)
;
error("remove_suspects: unexpected incorrect node")
).
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 23 Apr 2002 02:53:21 -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),
@@ -210,34 +210,44 @@
{ start_analysis(wrap(Store), dynamic(NodeId), AnalyserResponse,
Analyser0, Analyser) },
{ diagnoser_set_analyser(Diagnoser0, Analyser, Diagnoser1) },
- handle_analyser_response(Store, AnalyserResponse, Response,
- Diagnoser1, Diagnoser).
+ { debug_analyser_state(Analyser, MaybeOrigin) },
+ handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
+ Response, Diagnoser1, Diagnoser).
:- pred handle_analyser_response(S::in, analyser_response(edt_node(R))::in,
- diagnoser_response::out,
+ maybe(subterm_origin(edt_node(R)))::in, diagnoser_response::out,
diagnoser_state(R)::in, diagnoser_state(R)::out,
io__state::di, io__state::uo) is cc_multi <= annotated_trace(S, R).
-handle_analyser_response(_, no_suspects, no_bug_found, D, D) -->
+handle_analyser_response(_, no_suspects, _, no_bug_found, D, D) -->
io__write_string("No bug found.\n").
-handle_analyser_response(_, bug_found(Bug), Response, Diagnoser0,
+handle_analyser_response(_, bug_found(Bug), _, Response, Diagnoser0,
Diagnoser) -->
confirm_bug(Bug, Response, Diagnoser0, Diagnoser).
-handle_analyser_response(Store, oracle_queries(Queries), Response,
+handle_analyser_response(Store, oracle_queries(Queries), MaybeOrigin, Response,
Diagnoser0, Diagnoser) -->
-
{ diagnoser_get_oracle(Diagnoser0, Oracle0) },
+ debug_origin(Flag),
+ (
+ { MaybeOrigin = yes(Origin) },
+ { 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,
Diagnoser).
-handle_analyser_response(Store, require_explicit(Tree), Response,
+handle_analyser_response(Store, require_explicit(Tree), _, Response,
Diagnoser, Diagnoser) -->
-
{
edt_subtree_details(Store, Tree, Event, Seqno),
Response = require_subtree(Event, Seqno)
@@ -250,13 +260,13 @@
handle_oracle_response(Store, oracle_answers(Answers), Response, Diagnoser0,
Diagnoser) -->
-
{ diagnoser_get_analyser(Diagnoser0, Analyser0) },
{ continue_analysis(wrap(Store), Answers, AnalyserResponse,
Analyser0, Analyser) },
{ diagnoser_set_analyser(Diagnoser0, Analyser, Diagnoser1) },
- handle_analyser_response(Store, AnalyserResponse, Response,
- Diagnoser1, Diagnoser).
+ { debug_analyser_state(Analyser, MaybeOrigin) },
+ handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
+ Response, Diagnoser1, Diagnoser).
handle_oracle_response(_, no_oracle_answers, no_bug_found, D, D) -->
[].
@@ -358,11 +368,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 +381,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 +404,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 +425,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 +444,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 +453,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 +497,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 +551,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 +593,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 node preceding the exit
+ % node, if start_loc is cur_goal
+ % and the id of the node preceding the
+ % call node if start_loc is
+ % parent_goal.
+ maybe(goal_path),
+ % No if start_loc is cur_goal;
+ % and yes wrapped around the goal path
+ % 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(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(Store, 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(Store, 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, [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(Store, [goal_and_path(GoalRep, [])],
+ Contour, StartPath, ArgNum, HeadVars, Var,
+ [], Primitives),
+ traverse_primitives(Primitives, Var, TermPath,
+ Store, ProcRep, Origin)
+ ).
+
+:- pred find_chain_start(S::in, R::in, arg_pos::in, term_path::in,
+ dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
+
+find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart) :-
+ det_edt_return_node_from_id(Store, Ref, Node),
+ (
+ Node = exit(_, CallId, _, ExitAtom, _),
+ call_node_from_id(Store, CallId, CallNode),
+ CallAtom = CallNode ^ call_atom,
+ ( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
+ find_chain_start_inside(Store, CallId, CallNode,
+ ArgPos, ChainStart)
+ ; trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath) ->
+ find_chain_start_outside(CallNode, Node, ArgPos,
+ ChainStart)
;
- 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_node_from_id(Store, CallId, CallNode),
+ CallAtom = CallNode ^ call_atom,
+ ( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
+ find_chain_start_inside(Store, CallId, CallNode,
+ ArgPos, ChainStart)
;
- 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_node_from_id(Store, CallId, CallNode),
+ CallAtom = CallNode ^ call_atom,
%
% XXX we don't yet handle tracking of the exception value.
%
- (
- trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath)
- ->
- Mode = subterm_in,
- Start = CallPrec
- ;
- error("trace_dependency: exception subterm unbound")
+ ( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
+ find_chain_start_inside(Store, CallId, CallNode,
+ ArgPos, ChainStart)
+ ;
+ error("find_chain_start: unbound exception term")
)
- ),
+ ).
- 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 find_chain_start_inside(S::in, R::in,
+ trace_node(R)::in(trace_node_call), arg_pos::in,
+ dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
+
+find_chain_start_inside(Store, CallId, CallNode, ArgPos, ChainStart) :-
+ CallNode = call(CallPrecId, _, CallAtom, _, _, _, _, CallPathStr),
+ path_from_string_det(CallPathStr, CallPath),
+ StartLoc = parent_goal(CallId, CallNode),
+ absolute_arg_num(ArgPos, CallAtom, ArgNum),
+ StartId = CallPrecId,
+ StartPath = yes(CallPath),
+ parent_proc_rep(Store, CallId, StartRep),
+ ChainStart = chain_start(StartLoc, ArgNum, StartId, StartPath,
+ StartRep).
+
+:- pred find_chain_start_outside(trace_node(R)::in(trace_node_call),
+ trace_node(R)::in(trace_node_exit), arg_pos::in,
+ dependency_chain_start(R)::out) is det.
+
+find_chain_start_outside(CallNode, ExitNode, ArgPos, ChainStart) :-
+ StartLoc = cur_goal,
+ ExitAtom = ExitNode ^ exit_atom,
+ absolute_arg_num(ArgPos, ExitAtom, ArgNum),
+ StartId = ExitNode ^ exit_preceding,
+ StartPath = no,
+ StartRep = CallNode ^ call_proc_rep,
+ ChainStart = chain_start(StartLoc, ArgNum, StartId,
+ StartPath, StartRep).
+
+:- pred parent_proc_rep(S::in, R::in, maybe(proc_rep)::out)
+ is det <= annotated_trace(S, R).
+
+parent_proc_rep(Store, CallId, ProcRep) :-
+ call_node_from_id(Store, CallId, Call),
+ Call = call(CallPrecId, _, _, _, _, _, _, _),
+ ( trace_node_from_id(Store, CallPrecId, CallPrecNode) ->
+ step_left_to_call(Store, CallPrecNode, ParentCallNode),
+ ProcRep = ParentCallNode ^ 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, trace_node(R)::in,
+ trace_node(R)::out(trace_node_call)) is det <= annotated_trace(S, R).
+
+step_left_to_call(Store, Node, ParentCallNode) :-
+ ( Node = call(_, _, _, _, _, _, _, _) ->
+ ParentCallNode = Node
;
- 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, PrevNode, ParentCallNode)
).
- % 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(S::in, R::in, trace_node(R)::in,
+ assoc_list(R, trace_node(R))::in, assoc_list(R, trace_node(R))::out)
+ is det <= annotated_trace(S, R).
-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(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(Store, 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(S::in, goal_and_path_list::in,
+ assoc_list(R, trace_node(R))::in, maybe(goal_path)::in,
+ int::in, list(var_rep)::in, var_rep::out,
+ list(annotated_primitive(R))::in, list(annotated_primitive(R))::out)
+ is det <= annotated_trace(S, R).
+
+make_primitive_list(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(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(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(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(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(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(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(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(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(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(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, 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, 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_op(File, Line)
;
- Cont = unknown_goal
+ TermPath0 = [TermPathStep0 | TermPath],
+ list__index1_det(FieldVars, TermPathStep0,
+ Var),
+ traverse_primitives(Prims, Var, TermPath,
+ Store, ProcRep, Origin)
)
;
- ( Node = neg(Prec, _, _)
- ; Node = cond(Prec, _, _)
+ traverse_primitives(Prims, Var0, TermPath0,
+ 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],
+ 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,
+ 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,
+ 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,
+ 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_op(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,
+ 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,
+ Store, ProcRep, Origin)
+ )
+ ;
+ AtomicGoal = higher_order_call_rep(_, Args),
+ traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
+ Var0, TermPath0, Store, ProcRep, Origin)
+ ;
+ AtomicGoal = method_call_rep(_, _, Args),
+ traverse_call(BoundVars, no, Args, MaybeNodeId, Prims,
+ Var0, TermPath0, 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, 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(R)::in,
+ list(annotated_primitive(R))::in, var_rep::in, term_path::in,
+ 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, 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(dynamic(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_op(File, Line)
;
- error("find_subterm_origin_unify: arg not found")
+ error("traverse_call: no node id")
+ )
+ )
+ ;
+ traverse_primitives(Prims, Var, TermPath, 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 +1166,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 +1174,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 +1197,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 +1224,49 @@
decl_bug_get_event_number(i_bug(IBug), Event) :-
IBug = inadmissible_call(_, _, _, Event).
+%-----------------------------------------------------------------------------%
+
+:- 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, io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ debug_origin(Flag::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Flag = MR_DD_debug_origin;
+ IO = IO0;
+").
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 23 Apr 2002 01:47:57 -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.
+ later_disj_preceding :: R,
+ % Preceding event.
+ later_disj_goal_path :: goal_path_string,
+ % Path for this event.
+ later_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 chosen_head_vars_presentation = which_headvars.
+
+:- pred is_user_visible_arg(trace_atom_arg::in) is semidet.
+
+:- pred select_arg_at_pos(arg_pos::in, list(trace_atom_arg)::in,
+ trace_atom_arg::out) is det.
+
+:- 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,9 @@
:- pragma export(trace_node_path(in, in) = out,
"MR_DD_trace_node_path").
-trace_node_path(_, call(_, _, _, _, _, _, _)) = "".
+% XXX fix the returned path for interface events other than calls.
+
+trace_node_path(_, call(_, _, _, _, _, _, _, P)) = P.
trace_node_path(_, exit(_, _, _, _, _)) = "".
trace_node_path(_, redo(_, _)) = "".
trace_node_path(_, fail(_, _, _, _)) = "".
@@ -637,12 +717,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 +799,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 +828,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 +835,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 +843,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 +851,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 +867,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 +882,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 +889,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 +896,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 +903,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 +910,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 +917,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 +924,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 +933,54 @@
"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(trace_atom, int, univ) = trace_atom.
-:- pragma export(add_trace_atom_arg(in, in, in) = out,
- "MR_DD_add_trace_atom_arg").
+ % add_trace_atom_arg_value(Atom0, ArgNum, HldsNum, ProgVis, Val):
+ % Register the fact that argument number ArgNum in Atom is the HLDS
+ % variable whose number is HldsNum and whose value is Val. ProgVis
+ % is a C boolean, which is true iff variable HldsNum is a user visible
+ % variable.
+:- func add_trace_atom_arg_value(trace_atom, int, int, int, univ) = trace_atom.
+:- pragma export(add_trace_atom_arg_value(in, in, in, in, in) = out,
+ "MR_DD_add_trace_atom_arg_value").
+
+add_trace_atom_arg_value(atom(C, F, Args0), ArgNum, HldsNum, ProgVis, Val)
+ = atom(C, F, Args) :-
+ Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, yes(Val)),
+ list__replace_nth_det(Args0, ArgNum, Arg, Args).
+
+ % Like add_trace_atom_arg_value, except that the specified variable
+ % has no value (i.e. it is not bound).
+:- func add_trace_atom_arg_no_value(trace_atom, int, int, int) = trace_atom.
+:- pragma export(add_trace_atom_arg_no_value(in, in, in, in) = out,
+ "MR_DD_add_trace_atom_arg_no_value").
+
+add_trace_atom_arg_no_value(atom(C, F, Args0), ArgNum, HldsNum, ProgVis)
+ = atom(C, F, Args) :-
+ Arg = arg_info(c_bool_to_merc_bool(ProgVis), HldsNum, no),
+ list__replace_nth_det(Args0, ArgNum, Arg, Args).
+
+ % This code converts a C bool (represented as int) to a Mercury bool.
+:- func c_bool_to_merc_bool(int) = bool.
+
+c_bool_to_merc_bool(ProgVis) =
+ ( ProgVis = 0 ->
+ no
+ ;
+ yes
+ ).
+
+ % 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 +1080,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 +1095,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_visible_arg, Args0)
+ ).
+
+chosen_head_vars_presentation = only_user_headvars.
+
+is_user_visible_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 23 Apr 2002 01:48:19 -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 = chosen_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(chosen_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 = chosen_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 23 Apr 2002 01:35:56 -0000
@@ -420,7 +420,7 @@
continue;
}
- /* variable number 1 is stored at offset 0 */
+ /* the offset of variable number 1 is stored at index 0 */
offset = entry->MR_sle_used_var_names[var_num - 1];
if (offset > string_table_size) {
MR_fatal_error("array bounds error on string table");
@@ -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 23 Apr 2002 01:40:41 -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 variable with the
+** specified HLDS number, in the specified locations, all of which must be
+** non-NULL. If the variable isn't live or isn't known, return a non-null
+** string giving the problem.
+*/
+
+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