[m-rev.] for review: I/O actions in the declarative debugger
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon May 13 02:29:50 AEST 2002
On 12-May-2002, Zoltan Somogyi <zs at cs.mu.OZ.AU> wrote:
> > Storing Mercury values in C global variables is tricky to get right,
> > especially in the presence of accurate GC, and so should be avoided
> > where possible.
>
> I'll look into it.
I have avoided storing Mercury data in C global variables. Since Mark has
mailed me saying he hasn't start his substantive review yet, here is
the updated log message and full diff. A relative diff is available
in ~/zs/mer/ws15/INTERDIFF.
Zoltan.
Make I/O actions known to the declarative debugger. The debugger doesn't do
anything with them yet beyond asking about their correctness.
browser/io_action.m:
New module for representing I/O actions, and for constructing the map
from I/O action numbers to the actions themselves.
browser/mdb.m:
Include the new module.
browser/declarative_analysis.m:
Make the map from I/O action numbers to the actions themselves part
of the analyzer state, since conversions from annotated trace nodes
to EDT nodes may now require this information.
browser/declarative_execution.m:
Store the current value of the I/O action counter with each call and
exit node. The list of I/O actions associated with the atom of the exit
node is given by the I/O actions whose counters lie between these two
values (initial inclusive, final exclusive).
browser/declarative_debugger.m:
browser/declarative_oracle.m:
Distinguish atoms associated with exit nodes from atoms associated with
call nodes, since the former, but not the latter, now have a list of
I/O actions associated with them.
browser/declarative_user.m:
Add mechanisms for printing and browsing the I/O actions associated
with EDT nodes and bugs.
runtime/mercury_trace_base.[ch]:
Move the code for finding an I/O action here from the file
mercury_trace_declarative.c, for use by browser/io_action.m.
runtime/mercury_layout_util.[ch]:
Move a utility function here from mercury_trace_declarative.c,
for use by the code moved to mercury_trace_base.c.
trace/mercury_trace_declarative.c:
When invoking the front end, pass to it the boundaries of the required
I/O action map. Cache these boundaries, so we can tell the front end
when reinvocation of the back end (to materialize previously virtual
parts of the annotated trace) do not require the reconstruction of the
map.
trace/mercury_trace_vars.[ch]:
Separate out the code for finding an I/O action from the code for
browsing it, for use in mercury_trace_declarative.c.
Note places where the implementation does not live up to the
documentation.
trace/mercury_trace.[ch]:
Add a parameter to MR_trace_retry that allows retries to cross I/O
actions without asking the user if this is OK.
trace/mercury_trace_internal.c:
trace/mercury_trace_external.c:
Pass MR_FALSE as this new parameter to MR_trace_retry.
tests/debugger/declarative/tabled_read_decl.{m,inp,exp}:
A slightly modified copy of the tests/debugger/tabled_read_decl test
case, to check the declarative debugger's handling of goals with I/O
actions.
tests/debugger/declarative/Mmakefile:
Enable the new test case.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.11
diff -u -b -r1.11 declarative_analyser.m
--- browser/declarative_analyser.m 30 Apr 2002 07:08:00 -0000 1.11
+++ browser/declarative_analyser.m 12 May 2002 09:44:36 -0000
@@ -13,6 +13,7 @@
:- module mdb__declarative_analyser.
:- interface.
:- import_module mdb__declarative_debugger, mdb__program_representation.
+:- import_module mdb__io_action.
:- import_module list, std_util.
% This typeclass defines how EDTs may be accessed by this module.
@@ -38,13 +39,13 @@
% Gives the root node of an EDT.
%
- pred edt_root_question(S, T, decl_question(T)),
- mode edt_root_question(in, in, out) is det,
+ pred edt_root_question(io_action_map, S, T, decl_question(T)),
+ mode edt_root_question(in, in, in, out) is det,
% If this node is an e_bug, then find the bug.
%
- pred edt_root_e_bug(S, T, decl_e_bug),
- mode edt_root_e_bug(in, in, out) is det,
+ pred edt_root_e_bug(io_action_map, S, T, decl_e_bug),
+ mode edt_root_e_bug(in, in, in, out) is det,
% Gives the list of children of a tree. If the tree is
% represented implicitly, then the procedure fails.
@@ -115,23 +116,25 @@
:- type analyser_state(T).
-:- pred analyser_state_init(analyser_state(T)).
-:- mode analyser_state_init(out) is det.
+:- pred analyser_state_init(io_action_map::in, analyser_state(T)::out) is det.
+
+:- pred analyser_state_replace_io_map(io_action_map::in,
+ analyser_state(T)::in, analyser_state(T)::out) is det.
% Perform analysis on the given EDT, which may be a new tree
% to diagnose, or a sub-tree that was required to be made
% explicit.
%
-:- pred start_analysis(S, T, analyser_response(T), analyser_state(T),
- analyser_state(T)) <= mercury_edt(S, T).
-:- mode start_analysis(in, in, out, in, out) is det.
+:- pred start_analysis(S::in, T::in, analyser_response(T)::out,
+ analyser_state(T)::in, analyser_state(T)::out) is det
+ <= mercury_edt(S, T).
% Continue analysis after the oracle has responded with some
% answers.
%
-:- pred continue_analysis(S, list(decl_answer(T)), analyser_response(T),
- analyser_state(T), analyser_state(T)) <= mercury_edt(S, T).
-:- mode continue_analysis(in, in, out, in, out) is det.
+:- pred continue_analysis(S::in, list(decl_answer(T))::in,
+ analyser_response(T)::out, analyser_state(T)::in,
+ analyser_state(T)::out) is det <= mercury_edt(S, T).
% Return information within the analyser state that is intended for
% debugging the declarative debugger itself.
@@ -188,6 +191,10 @@
%
priority_suspects :: list(decl_question(T)),
+ % This field allows us to map I/O action
+ % numbers to the actions themselves.
+ io_action_map :: io_action_map,
+
% This field is present only to make it easier
% to debug the dependency tracking algorithm;
% if bound to yes, it records the result of
@@ -197,14 +204,20 @@
debug_origin :: maybe(subterm_origin(T))
).
-analyser_state_init(analyser(no, [], [], [], [], no)).
+analyser_state_init(IoActionMap,
+ analyser(no, [], [], [], [], IoActionMap, no)).
+
+analyser_state_replace_io_map(IoActionMap, Analyser0, Analyser) :-
+ Analyser = Analyser0 ^ io_action_map := IoActionMap.
debug_analyser_state(Analyser, Analyser ^ debug_origin).
start_analysis(Store, Tree, Response, Analyser0, Analyser) :-
get_all_prime_suspects(Analyser0, OldPrimes),
- edt_root_question(Store, Tree, Question),
- Analyser = analyser(no, OldPrimes, [Question], [], [], no),
+ IoActionMap = Analyser0 ^ io_action_map,
+ edt_root_question(IoActionMap, Store, Tree, Question),
+ Analyser = analyser(no, OldPrimes, [Question], [], [], IoActionMap,
+ no),
decide_analyser_response(Store, Analyser, Response).
continue_analysis(Store, Answers, Response, Analyser0, Analyser) :-
@@ -256,7 +269,9 @@
OriginSuspect = get_decl_question_node(S)
)
->
- edt_root_question(Store, OriginSuspect, OriginQuestion),
+ IoActionMap = Analyser2 ^ io_action_map,
+ edt_root_question(IoActionMap, Store, OriginSuspect,
+ OriginQuestion),
Analyser = Analyser2 ^ priority_suspects := [OriginQuestion]
;
Analyser = Analyser2
@@ -285,7 +300,9 @@
->
create_prime_suspect(Suspect, Prime),
MaybePrime = yes(Prime),
- list__map(edt_root_question(Store), Children, SuspectRoots),
+ IoActionMap = Analyser0 ^ io_action_map,
+ list__map(edt_root_question(IoActionMap, Store), Children,
+ SuspectRoots),
SuspectParents = []
;
% The real suspects cannot be found, so we are
@@ -299,7 +316,7 @@
SuspectParents = [Suspect]
),
Analyser = analyser(MaybePrime, OldPrimes, SuspectRoots,
- SuspectParents, [], no).
+ SuspectParents, [], Analyser0 ^ io_action_map, no).
:- pred decide_analyser_response(S::in, analyser_state(T)::in,
analyser_response(T)::out) is det <= mercury_edt(S, T).
@@ -329,7 +346,9 @@
(
Analyser ^ maybe_prime = yes(Prime)
->
- prime_suspect_get_e_bug(Store, Prime, EBug),
+ IoActionMap = Analyser ^ io_action_map,
+ prime_suspect_get_e_bug(IoActionMap, Store, Prime,
+ EBug),
Response = bug_found(e_bug(EBug))
;
Response = no_suspects
@@ -399,13 +418,12 @@
prime_suspect_get_suspect(prime_suspect(Suspect, _, _), Suspect).
-:- pred prime_suspect_get_e_bug(S, prime_suspect(T), decl_e_bug)
- <= mercury_edt(S, T).
-:- mode prime_suspect_get_e_bug(in, in, out) is det.
+:- pred prime_suspect_get_e_bug(io_action_map::in, S::in, prime_suspect(T)::in,
+ decl_e_bug::out) is det <= mercury_edt(S, T).
-prime_suspect_get_e_bug(Store, Prime, EBug) :-
+prime_suspect_get_e_bug(IoActionMap, Store, Prime, EBug) :-
prime_suspect_get_suspect(Prime, Suspect),
- edt_root_e_bug(Store, Suspect, EBug).
+ edt_root_e_bug(IoActionMap, Store, Suspect, EBug).
% Get all the suspects who are children of the prime suspect,
% and who are deemed correct or inadmissible. Maybe get
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.26
diff -u -b -r1.26 declarative_debugger.m
--- browser/declarative_debugger.m 30 Apr 2002 07:08:00 -0000 1.26
+++ browser/declarative_debugger.m 12 May 2002 09:45:12 -0000
@@ -22,7 +22,8 @@
:- module mdb__declarative_debugger.
:- interface.
:- import_module mdb__declarative_execution, mdb__program_representation.
-:- import_module io, list, bool, std_util.
+:- import_module mdb__io_action.
+:- import_module io, bool, list, std_util.
% This type represents the possible truth values for nodes
% in the EDT.
@@ -54,18 +55,18 @@
:- type decl_e_bug
---> incorrect_contour(
- decl_atom, % The head of the clause, in its
+ final_decl_atom,% The head of the clause, in its
% final state of instantiation.
decl_contour, % The path taken through the body.
event_number % The exit event.
)
; partially_uncovered_atom(
- decl_atom, % The called atom, in its initial
+ init_decl_atom, % The called atom, in its initial
% state.
event_number % The fail event.
)
; unhandled_exception(
- decl_atom, % The called atom, in its initial
+ init_decl_atom, % The called atom, in its initial
% state.
decl_exception, % The exception thrown.
event_number % The excp event.
@@ -73,11 +74,11 @@
:- type decl_i_bug
---> inadmissible_call(
- decl_atom, % The parent atom, in its initial
+ init_decl_atom, % The parent atom, in its initial
% state.
decl_position, % The location of the call in the
% parent's body.
- decl_atom, % The inadmissible child, in its
+ init_decl_atom, % The inadmissible child, in its
% initial state.
event_number % The call event.
).
@@ -101,7 +102,7 @@
% The second argument is the atom in its final
% state of instantiatedness (ie. at the EXIT event).
%
- ---> wrong_answer(T, decl_atom)
+ ---> wrong_answer(T, final_decl_atom)
% The node is a suspected missing answer. The
% first argument is the EDT node the question came
@@ -110,7 +111,7 @@
% CALL event), and the third argument is the list
% of solutions.
%
- ; missing_answer(T, decl_atom, list(decl_atom))
+ ; missing_answer(T, init_decl_atom, list(final_decl_atom))
% The node is a possibly unexpected exception.
% The first argument is the EDT node the question
@@ -118,7 +119,7 @@
% its initial state of instantiation, and the third
% argument is the exception thrown.
%
- ; unexpected_exception(T, decl_atom, decl_exception).
+ ; unexpected_exception(T, init_decl_atom, decl_exception).
:- type decl_answer(T)
% The oracle knows the truth value of this node.
@@ -135,7 +136,20 @@
%
:- func get_decl_question_node(decl_question(T)) = T.
-:- type decl_atom == trace_atom.
+:- type some_decl_atom
+ ---> init(init_decl_atom)
+ ; final(final_decl_atom).
+
+:- type init_decl_atom
+ ---> init_decl_atom(
+ init_atom :: trace_atom
+ ).
+
+:- type final_decl_atom
+ ---> final_decl_atom(
+ final_atom :: trace_atom,
+ final_io_actions :: list(io_action)
+ ).
:- type decl_exception == univ.
@@ -167,19 +181,29 @@
:- type diagnoser_state(R).
-:- pred diagnoser_state_init(io__input_stream, io__output_stream,
- diagnoser_state(R)).
-:- mode diagnoser_state_init(in, in, out) is det.
+:- pred diagnoser_state_init(io_action_map::in, io__input_stream::in,
+ io__output_stream::in, diagnoser_state(R)::out) is det.
:- pred diagnosis(S::in, 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).
+:- pred unravel_decl_atom(some_decl_atom::in, trace_atom::out,
+ list(io_action)::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mdb__declarative_analyser, mdb__declarative_oracle.
-:- import_module require, int, char, string, assoc_list.
+:- import_module require, int, char, string, assoc_list, map.
+
+unravel_decl_atom(DeclAtom, TraceAtom, IoActions) :-
+ (
+ DeclAtom = init(init_decl_atom(TraceAtom)),
+ IoActions = []
+ ;
+ DeclAtom = final(final_decl_atom(TraceAtom, IoActions))
+ ).
get_decl_question_node(wrong_answer(Node, _)) = Node.
get_decl_question_node(missing_answer(Node, _, _)) = Node.
@@ -216,8 +240,8 @@
diagnoser_set_oracle(diagnoser(A, _), B, diagnoser(A, B)).
-diagnoser_state_init(InStr, OutStr, Diagnoser) :-
- analyser_state_init(Analyser),
+diagnoser_state_init(IoActionMap, InStr, OutStr, Diagnoser) :-
+ analyser_state_init(IoActionMap, Analyser),
oracle_state_init(InStr, OutStr, Oracle),
Diagnoser = diagnoser(Analyser, Oracle).
@@ -321,21 +345,32 @@
"MR_DD_decl_diagnosis_state_init").
diagnoser_state_init_store(InStr, OutStr, Diagnoser) :-
- diagnoser_state_init(InStr, OutStr, Diagnoser).
+ diagnoser_state_init(map__init, InStr, OutStr, Diagnoser).
% Export a monomorphic version of diagnosis/9, to make it
% easier to call from C code.
%
:- pred diagnosis_store(trace_node_store::in, trace_node_id::in,
- diagnoser_response::out, diagnoser_state(trace_node_id)::in,
+ int::in, int::in, int::in, diagnoser_response::out,
+ diagnoser_state(trace_node_id)::in,
diagnoser_state(trace_node_id)::out, io__state::di, io__state::uo)
is cc_multi.
-:- pragma export(diagnosis_store(in, in, out, in, out, di, uo),
+:- pragma export(diagnosis_store(in, in, in, in, in, out, in, out, di, uo),
"MR_DD_decl_diagnosis").
-diagnosis_store(Store, Node, Response, State0, State) -->
- diagnosis(Store, Node, Response, State0, State).
+diagnosis_store(Store, Node, UseOldIoActionMap, IoActionStart, IoActionEnd,
+ Response, State0, State) -->
+ ( { UseOldIoActionMap > 0 } ->
+ { State1 = State0 }
+ ;
+ make_io_action_map(IoActionStart, IoActionEnd, IoActionMap),
+ { Analyser0 = State0 ^ analyser_state },
+ { analyser_state_replace_io_map(IoActionMap,
+ Analyser0, Analyser1) },
+ { State1 = State0 ^ analyser_state := Analyser1 }
+ ),
+ diagnosis(Store, Node, Response, State1, State).
% Export some predicates so that C code can interpret the
% diagnoser response.
@@ -374,8 +409,8 @@
:- instance mercury_edt(wrap(S), edt_node(R)) <= annotated_trace(S, R)
where [
- pred(edt_root_question/3) is trace_root_question,
- pred(edt_root_e_bug/3) is trace_root_e_bug,
+ pred(edt_root_question/4) is trace_root_question,
+ pred(edt_root_e_bug/4) is trace_root_e_bug,
pred(edt_children/3) is trace_children,
pred(edt_dependency/6) is trace_dependency
].
@@ -385,61 +420,94 @@
%
:- type wrap(S) ---> wrap(S).
-:- pred trace_root_question(wrap(S), edt_node(R), decl_question(edt_node(R)))
+%-----------------------------------------------------------------------------%
+
+:- func exit_node_decl_atom(io_action_map::in, S::in,
+ trace_node(R)::in(trace_node_exit)) = (final_decl_atom::out) is det
<= annotated_trace(S, R).
-:- mode trace_root_question(in, in, out) is det.
-trace_root_question(wrap(Store), dynamic(Ref), Root) :-
+exit_node_decl_atom(IoActionMap, Store, ExitNode) = DeclAtom :-
+ ExitAtom = ExitNode ^ exit_atom,
+ CallId = ExitNode ^ exit_call,
+ call_node_from_id(Store, CallId, Call),
+ CallIoSeq = Call ^ call_io_seq_num,
+ ExitIoSeq = ExitNode ^ exit_io_seq_num,
+ IoActions = make_io_actions(IoActionMap, CallIoSeq, ExitIoSeq),
+ DeclAtom = final_decl_atom(ExitAtom, IoActions).
+
+:- func call_node_decl_atom(S, R) = init_decl_atom <= annotated_trace(S, R).
+
+call_node_decl_atom(Store, CallId) = DeclAtom :-
+ call_node_from_id(Store, CallId, CallNode),
+ CallAtom = CallNode ^ call_atom,
+ DeclAtom = init_decl_atom(CallAtom).
+
+:- func make_io_actions(io_action_map, int, int) = list(io_action).
+
+make_io_actions(IoActionMap, InitIoSeq, ExitIoSeq) =
+ ( InitIoSeq = ExitIoSeq ->
+ []
+ ;
+ [map__lookup(IoActionMap, InitIoSeq) |
+ make_io_actions(IoActionMap, InitIoSeq + 1, ExitIoSeq)]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred trace_root_question(io_action_map::in, wrap(S)::in, edt_node(R)::in,
+ decl_question(edt_node(R))::out) is det <= annotated_trace(S, R).
+
+trace_root_question(IoActionMap, wrap(Store), dynamic(Ref), Root) :-
det_edt_return_node_from_id(Store, Ref, Node),
(
Node = fail(_, CallId, RedoId, _),
- call_node_from_id(Store, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _, _),
- get_answers(Store, RedoId, [], Answers),
- Root = missing_answer(dynamic(Ref), CallAtom, Answers)
- ;
- Node = exit(_, _, _, ExitAtom, _),
- Root = wrong_answer(dynamic(Ref), ExitAtom)
+ DeclAtom = call_node_decl_atom(Store, CallId),
+ get_answers(IoActionMap, Store, RedoId, [], Answers),
+ Root = missing_answer(dynamic(Ref), DeclAtom, Answers)
+ ;
+ Node = exit(_, _, _, _, _, _),
+ DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
+ Root = wrong_answer(dynamic(Ref), DeclAtom)
;
Node = excp(_, CallId, _, Exception, _),
- call_node_from_id(Store, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _, _),
- Root = unexpected_exception(dynamic(Ref), CallAtom, Exception)
+ DeclAtom = call_node_decl_atom(Store, CallId),
+ Root = unexpected_exception(dynamic(Ref), DeclAtom, Exception)
).
-:- pred get_answers(S, R, list(decl_atom), list(decl_atom))
+:- pred get_answers(io_action_map::in, S::in, R::in,
+ list(final_decl_atom)::in, list(final_decl_atom)::out) is det
<= annotated_trace(S, R).
-:- mode get_answers(in, in, in, out) is det.
-get_answers(Store, RedoId, As0, As) :-
+get_answers(IoActionMap, Store, RedoId, DeclAtoms0, DeclAtoms) :-
(
maybe_redo_node_from_id(Store, RedoId, redo(_, ExitId))
->
- exit_node_from_id(Store, ExitId, exit(_, _, NextId, Atom, _)),
- get_answers(Store, NextId, [Atom | As0], As)
+ exit_node_from_id(Store, ExitId, ExitNode),
+ NextId = ExitNode ^ exit_prev_redo,
+ DeclAtom = exit_node_decl_atom(IoActionMap, Store, ExitNode),
+ get_answers(IoActionMap, Store, NextId,
+ [DeclAtom | DeclAtoms0], DeclAtoms)
;
- As = As0
+ DeclAtoms = DeclAtoms0
).
-:- pred trace_root_e_bug(wrap(S), edt_node(R), decl_e_bug)
- <= annotated_trace(S, R).
-:- mode trace_root_e_bug(in, in, out) is det.
+:- pred trace_root_e_bug(io_action_map::in, wrap(S)::in, edt_node(R)::in,
+ decl_e_bug::out) is det <= annotated_trace(S, R).
-trace_root_e_bug(wrap(S), dynamic(Ref), Bug) :-
- det_edt_return_node_from_id(S, Ref, Node),
+trace_root_e_bug(IoActionMap, wrap(Store), dynamic(Ref), Bug) :-
+ det_edt_return_node_from_id(Store, Ref, Node),
(
- Node = exit(_, _, _, Atom, Event),
- Bug = incorrect_contour(Atom, unit, Event)
+ Node = exit(_, _, _, _, Event, _),
+ DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
+ Bug = incorrect_contour(DeclAtom, unit, Event)
;
Node = fail(_, CallId, _, Event),
- call_node_from_id(S, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _, _),
- Bug = partially_uncovered_atom(CallAtom, Event)
+ DeclAtom = call_node_decl_atom(Store, CallId),
+ Bug = partially_uncovered_atom(DeclAtom, Event)
;
Node = excp(_, CallId, _, Exception, Event),
- call_node_from_id(S, CallId, Call),
- Call = call(_, _, CallAtom, _, _, _, _, _),
- Bug = unhandled_exception(CallAtom, Exception, Event)
+ DeclAtom = call_node_decl_atom(Store, CallId),
+ Bug = unhandled_exception(DeclAtom, Exception, Event)
).
:- pred trace_children(wrap(S), edt_node(R), list(edt_node(R)))
@@ -453,7 +521,7 @@
not_at_depth_limit(Store, CallId),
missing_answer_children(Store, PrecId, [], Children)
;
- Node = exit(PrecId, CallId, _, _, _),
+ Node = exit(PrecId, CallId, _, _, _, _),
not_at_depth_limit(Store, CallId),
wrong_answer_children(Store, PrecId, [], Children)
;
@@ -466,7 +534,8 @@
:- 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, CallNode),
+ CallNode ^ call_at_max_depth = no.
:- pred wrong_answer_children(S, R, list(edt_node(R)), list(edt_node(R)))
<= annotated_trace(S, R).
@@ -475,7 +544,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)
)
@@ -490,7 +559,7 @@
error("wrong_answer_children: exception handling not supported")
;
(
- Node = exit(_, _, _, _, _)
+ Node = exit(_, _, _, _, _, _)
->
%
% Add a child for this node.
@@ -519,7 +588,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)
)
@@ -535,7 +604,7 @@
"missing_answer_children: exception handling not supported")
;
(
- ( Node = exit(_, _, _, _, _)
+ ( Node = exit(_, _, _, _, _, _)
; Node = fail(_, _, _, _)
)
->
@@ -573,7 +642,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)
)
@@ -584,7 +653,7 @@
Ns = Ns0
;
(
- ( Node = exit(_, _, _, _, _)
+ ( Node = exit(_, _, _, _, _, _)
; Node = excp(_, _, _, _, _)
)
->
@@ -726,7 +795,7 @@
find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart) :-
det_edt_return_node_from_id(Store, Ref, Node),
(
- Node = exit(_, CallId, _, ExitAtom, _),
+ Node = exit(_, CallId, _, ExitAtom, _, _),
call_node_from_id(Store, CallId, CallNode),
CallAtom = CallNode ^ call_atom,
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
@@ -768,7 +837,9 @@
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),
+ CallPrecId = CallNode ^ call_preceding,
+ CallAtom = CallNode ^ call_atom,
+ CallPathStr = CallNode ^ call_goal_path,
path_from_string_det(CallPathStr, CallPath),
StartLoc = parent_goal(CallId, CallNode),
absolute_arg_num(ArgPos, CallAtom, ArgNum),
@@ -797,7 +868,7 @@
parent_proc_rep(Store, CallId, ProcRep) :-
call_node_from_id(Store, CallId, Call),
- Call = call(CallPrecId, _, _, _, _, _, _, _),
+ CallPrecId = Call ^ call_preceding,
( trace_node_from_id(Store, CallPrecId, CallPrecNode) ->
step_left_to_call(Store, CallPrecNode, ParentCallNode),
ProcRep = ParentCallNode ^ call_proc_rep
@@ -810,7 +881,7 @@
trace_node(R)::out(trace_node_call)) is det <= annotated_trace(S, R).
step_left_to_call(Store, Node, ParentCallNode) :-
- ( Node = call(_, _, _, _, _, _, _, _) ->
+ ( Node = call(_, _, _, _, _, _, _, _, _) ->
ParentCallNode = Node
;
( Node = neg(NegPrec, _, _) ->
@@ -827,7 +898,7 @@
is det <= annotated_trace(S, R).
materialize_contour(Store, NodeId, Node, Nodes0, Nodes) :-
- ( Node = call(_, _, _, _, _, _, _, _) ->
+ ( Node = call(_, _, _, _, _, _, _, _, _) ->
Nodes = Nodes0
;
( Node = neg(NegPrec, _, _) ->
@@ -971,9 +1042,9 @@
(
Contour = [ContourHeadId - ContourHeadNode
| ContourTail],
- ContourHeadNode = exit(_, CallId, _, _, _),
+ CallId = ContourHeadNode ^ exit_call,
call_node_from_id(Store, CallId, CallNode),
- CallNode = call(_,_,_,_,_,_,_, CallPathStr),
+ CallPathStr = CallNode ^ call_goal_path,
path_from_string_det(CallPathStr, CallPath),
CallPath = Path,
\+ (
@@ -989,8 +1060,7 @@
HeadVars, Var, Primitives1, Primitives)
;
Contour = [_ContourHeadId - ContourHeadNode],
- ContourHeadNode =
- call(_,_,_,_,_,_,_, CallPathStr),
+ CallPathStr = ContourHeadNode ^ call_goal_path,
path_from_string_det(CallPathStr, CallPath),
CallPath = Path,
MaybeEnd = yes(EndPath),
@@ -1190,16 +1260,17 @@
edt_subtree_details(Store, dynamic(Ref), Event, SeqNo) :-
det_edt_return_node_from_id(Store, Ref, Node),
(
- Node = exit(_, Call, _, _, Event)
+ Node = exit(_, Call, _, _, Event, _)
;
Node = fail(_, Call, _, Event)
;
Node = excp(_, Call, _, _, Event)
),
- call_node_from_id(Store, Call, call(_, _, _, SeqNo, _, _, _, _)).
+ call_node_from_id(Store, Call, CallNode),
+ SeqNo = CallNode ^ call_seq.
:- inst edt_return_node =
- bound( exit(ground, ground, ground, ground, ground)
+ bound( exit(ground, ground, ground, ground, ground, ground)
; fail(ground, ground, ground, ground)
; excp(ground, ground, ground, ground, ground)).
@@ -1210,7 +1281,7 @@
(
trace_node_from_id(Store, Ref, Node0),
(
- Node0 = exit(_, _, _, _, _)
+ Node0 = exit(_, _, _, _, _, _)
;
Node0 = fail(_, _, _, _)
;
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.18
diff -u -b -r1.18 declarative_execution.m
--- browser/declarative_execution.m 24 Apr 2002 17:43:56 -0000 1.18
+++ browser/declarative_execution.m 9 May 2002 04:54:52 -0000
@@ -16,8 +16,8 @@
:- module mdb__declarative_execution.
:- interface.
+:- import_module mdb__program_representation, mdb__util.
:- import_module list, std_util, string, io, bool.
-:- import_module mdb__util, mdb__program_representation.
% This type represents a port in the annotated trace.
% The type R is the type of references to other nodes
@@ -43,9 +43,13 @@
% At the maximum depth?
call_proc_rep :: maybe(proc_rep),
% Body of the called procedure.
- call_goal_path :: goal_path_string
+ call_goal_path :: goal_path_string,
% Path for this event *in the
% caller*.
+ call_io_seq_num :: int
+ % The I/O action sequence
+ % number at the time of the
+ % call.
)
; exit(
exit_preceding :: R,
@@ -56,8 +60,12 @@
% Previous REDO event, if any.
exit_atom :: trace_atom,
% Atom in its final state.
- exit_event :: event_number
+ exit_event :: event_number,
% Trace event number.
+ exit_io_seq_num :: int
+ % The I/O action sequence
+ % number at the time of the
+ % exit.
)
; redo(
redo_preceding :: R,
@@ -241,9 +249,8 @@
:- pred det_trace_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
:- mode det_trace_node_from_id(in, in, out) is det.
-:- inst trace_node_call =
- bound(call(ground, ground, ground, ground, ground, ground,
- ground, ground)).
+:- inst trace_node_call = bound(call(ground, ground, ground, ground,
+ ground, ground, ground, ground, ground)).
:- pred call_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
:- mode call_node_from_id(in, in, out(trace_node_call)) is det.
@@ -256,7 +263,8 @@
:- pred maybe_redo_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
:- mode maybe_redo_node_from_id(in, in, out(trace_node_redo)) is semidet.
-:- inst trace_node_exit = bound(exit(ground, ground, ground, ground, ground)).
+:- inst trace_node_exit = bound(exit(ground, ground, ground, ground,
+ ground, ground)).
:- pred exit_node_from_id(S, R, trace_node(R)) <= annotated_trace(S, R).
:- mode exit_node_from_id(in, in, out(trace_node_exit)) is det.
@@ -341,10 +349,12 @@
%-----------------------------------------------------------------------------%
-step_left_in_contour(Store, exit(_, Call, _, _, _)) = Prec :-
- call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _, _)).
+step_left_in_contour(Store, exit(_, Call, _, _, _, _)) = Prec :-
+ call_node_from_id(Store, Call, CallNode),
+ Prec = CallNode ^ call_preceding.
step_left_in_contour(Store, excp(_, Call, _, _, _)) = Prec :-
- call_node_from_id(Store, Call, call(Prec, _, _, _, _, _, _, _)).
+ call_node_from_id(Store, Call, CallNode),
+ Prec = CallNode ^ call_preceding.
step_left_in_contour(_, switch(Prec, _)) = Prec.
step_left_in_contour(_, first_disj(Prec, _)) = Prec.
step_left_in_contour(Store, later_disj(_, _, FirstDisj)) = Prec :-
@@ -366,7 +376,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 :-
(
@@ -408,30 +418,33 @@
; 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, CallNode),
+ OnContour = CallNode ^ call_preceding.
find_prev_contour(Store, redo(_, Exit), OnContour) :-
- exit_node_from_id(Store, Exit, exit(OnContour, _, _, _, _)).
+ exit_node_from_id(Store, Exit, ExitNode),
+ OnContour = ExitNode ^ exit_preceding.
find_prev_contour(Store, neg_fail(_, Neg), OnContour) :-
neg_node_from_id(Store, Neg, neg(OnContour, _, _)).
%
% 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").
find_prev_contour(_, neg(_, _, _), _) :-
error("find_prev_contour: reached NEGE node").
-step_in_stratum(Store, exit(_, Call, MaybeRedo, _, _)) =
+step_in_stratum(Store, exit(_, Call, MaybeRedo, _, _, _)) =
step_over_redo_or_call(Store, Call, MaybeRedo).
step_in_stratum(Store, fail(_, Call, MaybeRedo, _)) =
step_over_redo_or_call(Store, Call, MaybeRedo).
step_in_stratum(Store, excp(_, Call, MaybeRedo, _, _)) =
step_over_redo_or_call(Store, Call, MaybeRedo).
step_in_stratum(Store, redo(_, Exit)) = Next :-
- exit_node_from_id(Store, Exit, exit(Next, _, _, _, _)).
+ exit_node_from_id(Store, Exit, ExitNode),
+ Next = ExitNode ^ exit_preceding.
step_in_stratum(_, switch(Next, _)) = Next.
step_in_stratum(_, first_disj(Next, _)) = Next.
step_in_stratum(_, later_disj(Next, _, _)) = Next.
@@ -454,7 +467,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").
@@ -467,7 +480,8 @@
->
Redo = redo(Next, _)
;
- call_node_from_id(Store, Call, call(Next, _, _, _, _, _, _, _))
+ call_node_from_id(Store, Call, CallNode),
+ Next = CallNode ^ call_preceding
).
det_trace_node_from_id(Store, NodeId, Node) :-
@@ -482,7 +496,7 @@
call_node_from_id(Store, NodeId, Node) :-
(
trace_node_from_id(Store, NodeId, Node0),
- Node0 = call(_, _, _, _, _, _, _, _)
+ Node0 = call(_, _, _, _, _, _, _, _, _)
->
Node = Node0
;
@@ -502,7 +516,7 @@
exit_node_from_id(Store, NodeId, Node) :-
(
trace_node_from_id(Store, NodeId, Node0),
- Node0 = exit(_, _, _, _, _)
+ Node0 = exit(_, _, _, _, _, _)
->
Node = Node0
;
@@ -596,7 +610,7 @@
call_node_get_last_interface(Call) = Last :-
(
- Call = call(_, Last0, _, _, _, _, _, _)
+ Call = call(_, Last0, _, _, _, _, _, _, _)
->
Last = Last0
;
@@ -611,7 +625,7 @@
call_node_set_last_interface(Call0, Last) = Call :-
(
- Call0 = call(_, _, _, _, _, _, _, _)
+ Call0 = call(_, _, _, _, _, _, _, _, _)
->
Call1 = Call0
;
@@ -675,8 +689,8 @@
:- pragma export(trace_node_port(in) = out,
"MR_DD_trace_node_port").
-trace_node_port(call(_, _, _, _, _, _, _, _)) = call.
-trace_node_port(exit(_, _, _, _, _)) = exit.
+trace_node_port(call(_, _, _, _, _, _, _, _, _)) = call.
+trace_node_port(exit(_, _, _, _, _, _)) = exit.
trace_node_port(redo(_, _)) = redo.
trace_node_port(fail(_, _, _, _)) = fail.
trace_node_port(excp(_, _, _, _, _)) = exception.
@@ -697,8 +711,8 @@
% XXX fix the returned path for interface events other than calls.
-trace_node_path(_, call(_, _, _, _, _, _, _, P)) = P.
-trace_node_path(_, exit(_, _, _, _, _)) = "".
+trace_node_path(_, call(_, _, _, _, _, _, _, P, _)) = P.
+trace_node_path(_, exit(_, _, _, _, _, _)) = "".
trace_node_path(_, redo(_, _)) = "".
trace_node_path(_, fail(_, _, _, _)) = "".
trace_node_path(_, excp(_, _, _, _, _)) = "".
@@ -724,12 +738,13 @@
trace_node_seqno(S, Node, SeqNo) :-
(
- Node = call(_, _, _, SeqNo0, _, _, _, _)
+ SeqNo0 = Node ^ call_seq
->
SeqNo = SeqNo0
;
trace_node_call(S, Node, Call),
- call_node_from_id(S, Call, call(_, _, _, SeqNo, _, _, _, _))
+ call_node_from_id(S, Call, CallNode),
+ SeqNo = CallNode ^ call_seq
).
:- pred trace_node_call(trace_node_store, trace_node(trace_node_id),
@@ -738,9 +753,10 @@
:- pragma export(trace_node_call(in, in, out), "MR_DD_trace_node_call").
-trace_node_call(_, exit(_, Call, _, _, _), Call).
+trace_node_call(_, exit(_, Call, _, _, _, _), Call).
trace_node_call(S, redo(_, Exit), Call) :-
- exit_node_from_id(S, Exit, exit(_, Call, _, _, _)).
+ exit_node_from_id(S, Exit, ExitNode),
+ Call = ExitNode ^ exit_call.
trace_node_call(_, fail(_, Call, _, _), Call).
trace_node_call(_, excp(_, Call, _, _, _), Call).
@@ -806,34 +822,35 @@
%
:- func construct_call_node(trace_node_id, trace_atom, sequence_number,
- event_number, bool, string) = trace_node(trace_node_id).
-:- pragma export(construct_call_node(in, in, in, in, in, in) = out,
+ event_number, bool, string, int) = trace_node(trace_node_id).
+:- pragma export(construct_call_node(in, in, in, in, in, in, in) = out,
"MR_DD_construct_call_node").
-construct_call_node(Preceding, Atom, SeqNo, EventNo, MaxDepth, Path) = Call :-
+construct_call_node(Preceding, Atom, SeqNo, EventNo, MaxDepth, Path, IoSeqNum)
+ = Call :-
Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth,
- no, Path),
+ no, Path, IoSeqNum),
null_trace_node_id(Answer).
:- func construct_call_node_with_goal(trace_node_id, trace_atom,
- sequence_number, event_number, bool, proc_rep, string)
+ sequence_number, event_number, bool, proc_rep, string, int)
= trace_node(trace_node_id).
-:- pragma export(construct_call_node_with_goal(in, in, in, in, in, in, in)
+:- pragma export(construct_call_node_with_goal(in, 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, Path) = Call :-
+ ProcRep, Path, IoSeqNum) = Call :-
Call = call(Preceding, Answer, Atom, SeqNo, EventNo, MaxDepth,
- yes(ProcRep), Path),
+ yes(ProcRep), Path, IoSeqNum),
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,
+ trace_atom, event_number, int) = trace_node(trace_node_id).
+:- pragma export(construct_exit_node(in, in, in, in, in, in) = out,
"MR_DD_construct_exit_node").
-construct_exit_node(Preceding, Call, MaybeRedo, Atom, EventNo)
- = exit(Preceding, Call, MaybeRedo, Atom, EventNo).
+construct_exit_node(Preceding, Call, MaybeRedo, Atom, EventNo, IoSeqNum)
+ = exit(Preceding, Call, MaybeRedo, Atom, EventNo, IoSeqNum).
:- func construct_redo_node(trace_node_id, trace_node_id)
= trace_node(trace_node_id).
@@ -1087,8 +1104,8 @@
%
:- func preceding_node(trace_node(T)) = T.
-preceding_node(call(P, _, _, _, _, _, _, _)) = P.
-preceding_node(exit(P, _, _, _, _)) = P.
+preceding_node(call(P, _, _, _, _, _, _, _, _)) = P.
+preceding_node(exit(P, _, _, _, _, _)) = P.
preceding_node(redo(P, _)) = P.
preceding_node(fail(P, _, _, _)) = P.
preceding_node(excp(P, _, _, _, _)) = P.
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.13
diff -u -b -r1.13 declarative_oracle.m
--- browser/declarative_oracle.m 2 May 2002 07:44:02 -0000 1.13
+++ browser/declarative_oracle.m 7 May 2002 09:43:10 -0000
@@ -154,28 +154,30 @@
% case that the user supplies a truth value for a
% "wrong answer" node.
%
- map_cc(decl_atom, decl_truth),
+ kb_ground_map :: map_cc(final_decl_atom, decl_truth),
% Mapping from call atoms to their solution sets.
% The sets in this map are all complete---but they may
% contain wrong answers.
%
- map_cc(decl_atom, set(decl_atom)),
+ kb_complete_map :: map_cc(init_decl_atom, final_decl_atoms),
% Mapping from call atoms to their solution sets.
% The sets in this map are all incomplete---there
% exists a correct solution which is not in the set.
%
- map_cc(decl_atom, set(decl_atom)),
+ kb_incomplete_map :: map_cc(init_decl_atom, final_decl_atoms),
% Mapping from call atoms to information about which
% exceptions are possible or impossible.
%
- map_cc(decl_atom, known_exceptions)
+ kb_exceptions_map :: map_cc(init_decl_atom, known_exceptions)
).
:- type map_cc(K, V) == tree234_cc(K, V).
+:- type final_decl_atoms == set(final_decl_atom).
+
:- type known_exceptions
---> known_excp(
set(univ), % Possible exceptions.
@@ -191,45 +193,49 @@
tree234_cc__init(N),
tree234_cc__init(X).
-:- pred get_kb_ground_map(oracle_kb, map_cc(decl_atom, decl_truth)).
+:- pred get_kb_ground_map(oracle_kb, map_cc(final_decl_atom, decl_truth)).
:- mode get_kb_ground_map(in, out) is det.
get_kb_ground_map(oracle_kb(Map, _, _, _), Map).
-:- pred set_kb_ground_map(oracle_kb, map_cc(decl_atom, decl_truth), oracle_kb).
+:- pred set_kb_ground_map(oracle_kb, map_cc(final_decl_atom, decl_truth),
+ oracle_kb).
:- mode set_kb_ground_map(in, in, out) is det.
set_kb_ground_map(oracle_kb(_, Y, N, X), G, oracle_kb(G, Y, N, X)).
-:- pred get_kb_complete_map(oracle_kb, map_cc(decl_atom, set(decl_atom))).
+:- pred get_kb_complete_map(oracle_kb,
+ map_cc(init_decl_atom, set(final_decl_atom))).
:- mode get_kb_complete_map(in, out) is det.
get_kb_complete_map(oracle_kb(_, Map, _, _), Map).
-:- pred set_kb_complete_map(oracle_kb, map_cc(decl_atom, set(decl_atom)),
- oracle_kb).
+:- pred set_kb_complete_map(oracle_kb,
+ map_cc(init_decl_atom, set(final_decl_atom)), oracle_kb).
:- mode set_kb_complete_map(in, in, out) is det.
set_kb_complete_map(oracle_kb(G, _, N, X), Y, oracle_kb(G, Y, N, X)).
-:- pred get_kb_incomplete_map(oracle_kb, map_cc(decl_atom, set(decl_atom))).
+:- pred get_kb_incomplete_map(oracle_kb,
+ map_cc(init_decl_atom, set(final_decl_atom))).
:- mode get_kb_incomplete_map(in, out) is det.
get_kb_incomplete_map(oracle_kb(_, _, Map, _), Map).
-:- pred set_kb_incomplete_map(oracle_kb, map_cc(decl_atom, set(decl_atom)),
- oracle_kb).
+:- pred set_kb_incomplete_map(oracle_kb,
+ map_cc(init_decl_atom, set(final_decl_atom)), oracle_kb).
:- mode set_kb_incomplete_map(in, in, out) is det.
set_kb_incomplete_map(oracle_kb(G, Y, _, X), N, oracle_kb(G, Y, N, X)).
-:- pred get_kb_exceptions_map(oracle_kb, map_cc(decl_atom, known_exceptions)).
+:- pred get_kb_exceptions_map(oracle_kb,
+ map_cc(init_decl_atom, known_exceptions)).
:- mode get_kb_exceptions_map(in, out) is det.
get_kb_exceptions_map(oracle_kb(_, _, _, Map), Map).
-:- pred set_kb_exceptions_map(oracle_kb, map_cc(decl_atom, known_exceptions),
- oracle_kb).
+:- pred set_kb_exceptions_map(oracle_kb,
+ map_cc(init_decl_atom, known_exceptions), oracle_kb).
:- mode set_kb_exceptions_map(in, in, out) is det.
set_kb_exceptions_map(oracle_kb(G, Y, N, _), X, oracle_kb(G, Y, N, X)).
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.19
diff -u -b -r1.19 declarative_user.m
--- browser/declarative_user.m 6 May 2002 08:01:47 -0000 1.19
+++ browser/declarative_user.m 9 May 2002 06:27:36 -0000
@@ -45,7 +45,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module mdb__browser_info, mdb__browse, mdb__util.
+:- import_module mdb__browser_info, mdb__browse, mdb__io_action, mdb__util.
:- import_module mdb__declarative_execution, mdb__program_representation.
:- import_module std_util, char, string, bool, int, deconstruct.
@@ -99,8 +99,10 @@
RestartedQuestions) },
query_user(RestartedQuestions, Response, User1, User)
;
- { Command = browse(ArgNum) },
- browse_edt_node(Question, ArgNum, MaybeMark, User1, User2),
+ { Command = browse_arg(ArgNum) },
+ { edt_node_trace_atom(Question, TraceAtom) },
+ browse_atom_argument(TraceAtom, ArgNum, MaybeMark,
+ User1, User2),
(
{ MaybeMark = no },
query_user_2([Question | Questions], Skipped, Response,
@@ -120,6 +122,14 @@
{ User = User2 }
)
;
+ { Command = browse_io(ActionNum) },
+ { edt_node_io_actions(Question, IoActions) },
+ % We don't have code yet to trace a marked I/O action.
+ browse_chosen_io_action(IoActions, ActionNum, _MaybeMark,
+ User1, User2),
+ query_user_2([Question | Questions], Skipped, Response,
+ User2, User)
+ ;
{ Command = abort },
{ Response = abort_diagnosis },
{ User = User1 }
@@ -142,39 +152,74 @@
decl_question_prompt(missing_answer(_, _, _), "Complete? ").
decl_question_prompt(unexpected_exception(_, _, _), "Expected? ").
-:- pred browse_edt_node(decl_question(T)::in, int::in, maybe(term_path)::out,
- user_state::in, user_state::out, io__state::di, io__state::uo)
- is cc_multi.
+:- pred edt_node_trace_atom(decl_question(T)::in, trace_atom::out) is det.
-browse_edt_node(Node, ArgNum, MaybeMark, User0, User) -->
- {
- Node = wrong_answer(_, Atom)
- ;
- Node = missing_answer(_, Atom, _)
- ;
- Node = unexpected_exception(_, Atom, _)
- },
- browse_atom_argument(Atom, ArgNum, MaybeMark, User0, User).
+edt_node_trace_atom(wrong_answer(_, FinalDeclAtom),
+ FinalDeclAtom ^ final_atom).
+edt_node_trace_atom(missing_answer(_, InitDeclAtom, _),
+ InitDeclAtom ^ init_atom).
+edt_node_trace_atom(unexpected_exception(_, InitDeclAtom, _),
+ InitDeclAtom ^ init_atom).
+
+:- pred edt_node_io_actions(decl_question(T)::in, list(io_action)::out) is det.
+
+edt_node_io_actions(wrong_answer(_, FinalDeclAtom),
+ FinalDeclAtom ^ final_io_actions).
+edt_node_io_actions(missing_answer(_, _, _), []).
+edt_node_io_actions(unexpected_exception(_, _, _), []).
+
+:- pred decl_bug_trace_atom(decl_bug::in, trace_atom::out) is det.
+
+decl_bug_trace_atom(e_bug(incorrect_contour(FinalDeclAtom, _, _)),
+ FinalDeclAtom ^ final_atom).
+decl_bug_trace_atom(e_bug(partially_uncovered_atom(InitDeclAtom, _)),
+ InitDeclAtom ^ init_atom).
+decl_bug_trace_atom(e_bug(unhandled_exception(InitDeclAtom, _, _)),
+ InitDeclAtom ^ init_atom).
+decl_bug_trace_atom(i_bug(inadmissible_call(_, _, InitDeclAtom, _)),
+ InitDeclAtom ^ init_atom).
+
+:- pred decl_bug_io_actions(decl_bug::in, list(io_action)::out) is det.
+
+decl_bug_io_actions(e_bug(incorrect_contour(FinalDeclAtom, _, _)),
+ FinalDeclAtom ^ final_io_actions).
+decl_bug_io_actions(e_bug(partially_uncovered_atom(_, _)), []).
+decl_bug_io_actions(e_bug(unhandled_exception(_, _, _)), []).
+decl_bug_io_actions(i_bug(inadmissible_call(_, _, _, _)), []).
-:- pred browse_decl_bug(decl_bug::in, int::in, user_state::in, user_state::out,
+:- pred browse_chosen_io_action(list(io_action)::in, int::in,
+ maybe(term_path)::out, user_state::in, user_state::out,
io__state::di, io__state::uo) is cc_multi.
-browse_decl_bug(Bug, ArgNum, User0, User) -->
- {
- Bug = e_bug(EBug),
- (
- EBug = incorrect_contour(Atom, _, _)
- ;
- EBug = partially_uncovered_atom(Atom, _)
- ;
- EBug = unhandled_exception(Atom, _, _)
- )
+browse_chosen_io_action(IoActions, ActionNum, MaybeMark, User0, User) -->
+ ( { list__index1(IoActions, ActionNum, IoAction) } ->
+ browse_io_action(IoAction, MaybeMark, User0, User)
;
- Bug = i_bug(inadmissible_call(_, _, Atom, _))
- },
+ io__write_string("No such IO action.\n"),
+ { MaybeMark = no },
+ { User = User0 }
+ ).
+
+:- pred browse_io_action(io_action::in, maybe(term_path)::out,
+ user_state::in, user_state::out, io__state::di, io__state::uo)
+ is cc_multi.
+
+browse_io_action(IoAction, MaybeMark, User0, User) -->
+ { io_action_to_synthetic_term(IoAction, ProcName, Args, IsFunc) },
+ browse_synthetic(ProcName, Args, IsFunc, User0 ^ instr, User0 ^ outstr,
+ MaybeDirs, User0 ^ browser, Browser),
+ { maybe_convert_dirs_to_path(MaybeDirs, MaybeMark) },
+ { User = User0 ^ browser := Browser }.
+
+:- pred browse_decl_bug_arg(decl_bug::in, int::in,
+ user_state::in, user_state::out, io__state::di, io__state::uo)
+ is cc_multi.
+
+browse_decl_bug_arg(Bug, ArgNum, User0, User) -->
+ { decl_bug_trace_atom(Bug, Atom) },
browse_atom_argument(Atom, ArgNum, _, User0, User).
-:- pred browse_atom_argument(decl_atom::in, int::in, maybe(term_path)::out,
+:- pred browse_atom_argument(trace_atom::in, int::in, maybe(term_path)::out,
user_state::in, user_state::out, io__state::di, io__state::uo)
is cc_multi.
@@ -220,7 +265,9 @@
; inadmissible % The node is inadmissible.
; skip % The user has no answer.
; restart % Ask the skipped questions again.
- ; browse(int) % Browse the nth argument before
+ ; browse_arg(int) % Browse the nth argument before
+ % answering.
+ ; browse_io(int) % Browse the nth IO action before
% answering.
; abort % Abort this diagnosis session.
; help % Request help before answering.
@@ -296,6 +343,7 @@
cmd_handler("no", one_word_cmd(no)).
cmd_handler("in", one_word_cmd(inadmissible)).
cmd_handler("inadmissible", one_word_cmd(inadmissible)).
+cmd_handler("io", browse_io_cmd).
cmd_handler("s", one_word_cmd(skip)).
cmd_handler("skip", one_word_cmd(skip)).
cmd_handler("r", one_word_cmd(restart)).
@@ -305,17 +353,22 @@
cmd_handler("?", one_word_cmd(help)).
cmd_handler("h", one_word_cmd(help)).
cmd_handler("help", one_word_cmd(help)).
-cmd_handler("b", browse_cmd).
-cmd_handler("browse", browse_cmd).
+cmd_handler("b", browse_arg_cmd).
+cmd_handler("browse", browse_arg_cmd).
:- func one_word_cmd(user_command::in, list(string)::in) = (user_command::out)
is semidet.
one_word_cmd(Cmd, []) = Cmd.
-:- func browse_cmd(list(string)::in) = (user_command::out) is semidet.
+:- func browse_arg_cmd(list(string)::in) = (user_command::out) is semidet.
+
+browse_arg_cmd([Arg]) = browse_arg(ArgNum) :-
+ string__to_int(Arg, ArgNum).
+
+:- func browse_io_cmd(list(string)::in) = (user_command::out) is semidet.
-browse_cmd([Arg]) = browse(ArgNum) :-
+browse_io_cmd([Arg]) = browse_io(ArgNum) :-
string__to_int(Arg, ArgNum).
%-----------------------------------------------------------------------------%
@@ -339,9 +392,16 @@
{ Response = abort_diagnosis },
{ User = User1 }
;
- { Command = browse(Arg) }
+ { Command = browse_arg(ArgNum) }
+ ->
+ browse_decl_bug_arg(Bug, ArgNum, User1, User2),
+ user_confirm_bug(Bug, Response, User2, User)
+ ;
+ { Command = browse_io(ActionNum) }
->
- browse_decl_bug(Bug, Arg, User1, User2),
+ { decl_bug_io_actions(Bug, IoActions) },
+ browse_chosen_io_action(IoActions, ActionNum, _MaybeMark,
+ User1, User2),
user_confirm_bug(Bug, Response, User2, User)
;
user_confirm_bug_help(User1),
@@ -357,21 +417,21 @@
io__state::di, io__state::uo) is cc_multi.
write_decl_question(wrong_answer(_, Atom), User) -->
- write_decl_atom(User, "", Atom).
+ write_decl_final_atom(User, "", Atom).
write_decl_question(missing_answer(_, Call, Solns), User) -->
- write_decl_atom(User, "Call ", Call),
+ write_decl_init_atom(User, "Call ", Call),
(
{ Solns = [] }
->
io__write_string(User ^ outstr, "No solutions.\n")
;
io__write_string(User ^ outstr, "Solutions:\n"),
- list__foldl(write_decl_atom(User, "\t"), Solns)
+ list__foldl(write_decl_final_atom(User, "\t"), Solns)
).
write_decl_question(unexpected_exception(_, Call, Exception), User) -->
- write_decl_atom(User, "Call ", Call),
+ write_decl_init_atom(User, "Call ", Call),
io__write_string(User ^ outstr, "Throws "),
io__write(User ^ outstr, include_details_cc, univ_value(Exception)),
io__nl(User ^ outstr).
@@ -383,16 +443,16 @@
(
{ EBug = incorrect_contour(Atom, _, _) },
io__write_string(User ^ outstr, "Found incorrect contour:\n"),
- write_decl_atom(User, "", Atom)
+ write_decl_final_atom(User, "", Atom)
;
{ EBug = partially_uncovered_atom(Atom, _) },
io__write_string(User ^ outstr,
"Found partially uncovered atom:\n"),
- write_decl_atom(User, "", Atom)
+ write_decl_init_atom(User, "", Atom)
;
{ EBug = unhandled_exception(Atom, Exception, _) },
io__write_string(User ^ outstr, "Found unhandled exception:\n"),
- write_decl_atom(User, "", Atom),
+ write_decl_init_atom(User, "", Atom),
io__write(User ^ outstr, include_details_cc,
univ_value(Exception)),
io__nl(User ^ outstr)
@@ -401,13 +461,25 @@
write_decl_bug(i_bug(IBug), User) -->
{ IBug = inadmissible_call(Parent, _, Call, _) },
io__write_string(User ^ outstr, "Found inadmissible call:\n"),
- write_decl_atom(User, "Parent ", Parent),
- write_decl_atom(User, "Call ", Call).
+ write_decl_atom(User, "Parent ", init(Parent)),
+ write_decl_atom(User, "Call ", init(Call)).
-:- pred write_decl_atom(user_state::in, string::in, decl_atom::in,
+:- pred write_decl_init_atom(user_state::in, string::in, init_decl_atom::in,
io__state::di, io__state::uo) is cc_multi.
-write_decl_atom(User, Indent, Atom) -->
+write_decl_init_atom(User, Indent, InitAtom) -->
+ write_decl_atom(User, Indent, init(InitAtom)).
+
+:- pred write_decl_final_atom(user_state::in, string::in, final_decl_atom::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+write_decl_final_atom(User, Indent, FinalAtom) -->
+ write_decl_atom(User, Indent, final(FinalAtom)).
+
+:- pred write_decl_atom(user_state::in, string::in, some_decl_atom::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+write_decl_atom(User, Indent, DeclAtom) -->
io__write_string(User ^ outstr, Indent),
%
% Check whether the atom is likely to fit on one line.
@@ -416,19 +488,23 @@
% it out directly so that all arguments are put on the
% same line.
%
+ { unravel_decl_atom(DeclAtom, TraceAtom, IoActions) },
{ Which = chosen_head_vars_presentation },
- { check_decl_atom_size(Indent, Which, Atom, RemSize) },
- ( { RemSize > 0 } ->
- write_decl_atom_direct(User ^ outstr, Atom, Which)
+ { check_trace_atom_size(Indent, Which, TraceAtom, RemSize) },
+ (
+ { RemSize > 0 },
+ { IoActions = [] }
+ ->
+ write_decl_atom_direct(User ^ outstr, TraceAtom, Which)
;
- write_decl_atom_limited(User, Atom, Which)
+ write_decl_atom_limited(User, DeclAtom, Which)
).
-:- pred check_decl_atom_size(string::in, which_headvars::in, decl_atom::in,
+:- pred check_trace_atom_size(string::in, which_headvars::in, trace_atom::in,
int::out) is cc_multi.
-check_decl_atom_size(Indent, Which, atom(_, Functor, Args), RemSize) :-
- decl_atom_size_limit(RemSize0),
+check_trace_atom_size(Indent, Which, atom(_, Functor, Args), RemSize) :-
+ trace_atom_size_limit(RemSize0),
string__length(Indent, I),
string__length(Functor, F),
P = 2, % parentheses
@@ -457,20 +533,48 @@
),
size_left_after_args(Args, Which).
-:- pred decl_atom_size_limit(int).
-:- mode decl_atom_size_limit(out) is det.
+:- pred trace_atom_size_limit(int).
+:- mode trace_atom_size_limit(out) is det.
-decl_atom_size_limit(79).
+trace_atom_size_limit(79).
-:- pred write_decl_atom_limited(user_state::in, decl_atom::in,
+:- pred write_decl_atom_limited(user_state::in, some_decl_atom::in,
which_headvars::in, io__state::di, io__state::uo) is cc_multi.
-write_decl_atom_limited(User, atom(PredOrFunc, Functor, Args0), Which) -->
+write_decl_atom_limited(User, DeclAtom, Which) -->
+ { unravel_decl_atom(DeclAtom, TraceAtom, IoActions) },
+ { TraceAtom = atom(PredOrFunc, Functor, Args0) },
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).
+ list__foldl(print_decl_atom_arg(User), Args),
+ { list__length(IoActions, NumIoActions) },
+ ( { NumIoActions = 0 } ->
+ []
+ ;
+ ( { NumIoActions = 1 } ->
+ io__write_string(User ^ outstr, "1 io action:")
+ ;
+ io__write_int(User ^ outstr, NumIoActions),
+ io__write_string(User ^ outstr, " io actions:")
+ ),
+ ( { NumIoActions < 6 } ->
+ io__nl(User ^ outstr),
+ list__foldl(print_io_action(User), IoActions)
+ ;
+ io__write_string(User ^ outstr, " too many to show"),
+ io__nl(User ^ outstr)
+ )
+ ).
+
+:- pred print_io_action(user_state::in, io_action::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+print_io_action(User, IoAction) -->
+ { io_action_to_synthetic_term(IoAction, ProcName, Args, IsFunc) },
+ browse__print_synthetic(ProcName, Args, IsFunc, User ^ outstr,
+ print_all, User ^ browser).
:- pred write_decl_atom_category(io__output_stream::in, pred_or_func::in,
io__state::di, io__state::uo) is det.
@@ -494,7 +598,7 @@
io__write_string(User ^ outstr, "\t_\n")
).
-:- pred write_decl_atom_direct(io__output_stream::in, decl_atom::in,
+:- pred write_decl_atom_direct(io__output_stream::in, trace_atom::in,
which_headvars::in, io__state::di, io__state::uo) is cc_multi.
write_decl_atom_direct(OutStr, atom(PredOrFunc, Functor, Args0), Which) -->
Index: browser/io_action.m
===================================================================
RCS file: browser/io_action.m
diff -N browser/io_action.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ browser/io_action.m 12 May 2002 09:47:00 -0000
@@ -0,0 +1,104 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 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.
+%-----------------------------------------------------------------------------%
+%
+% File: io_action.m
+% Author: zs.
+%
+% This module defines the representation of I/O actions used by the
+% declarative debugger.
+
+%-----------------------------------------------------------------------------%
+
+:- module mdb__io_action.
+
+:- interface.
+
+:- import_module mdb__util.
+:- import_module bool, list, map, std_util, io.
+
+:- type io_action
+ ---> io_action(
+ io_action_proc_name :: string,
+ io_action_pf :: pred_or_func,
+ io_action_args :: list(univ)
+ ).
+
+:- type io_seq_num == int.
+:- type io_action_map == map(io_seq_num, io_action).
+
+:- pred make_io_action_map(int::in, int::in, io_action_map::out,
+ io__state::di, io__state::uo) is det.
+
+:- pred io_action_to_synthetic_term(io_action::in, string::out,
+ list(univ)::out, bool::out) is det.
+
+:- implementation.
+
+:- import_module require, int.
+
+io_action_to_synthetic_term(IoAction, ProcName, Args, IsFunc) :-
+ IoAction = io_action(ProcName, PredFunc, Args),
+ (
+ PredFunc = predicate,
+ IsFunc = no
+ ;
+ PredFunc = function,
+ IsFunc = yes
+ ).
+
+make_io_action_map(Start, End, IoActionMap) -->
+ make_io_action_map_2(Start, End, map__init, IoActionMap).
+
+:- pred make_io_action_map_2(int::in, int::in,
+ io_action_map::in, io_action_map::out, io__state::di, io__state::uo)
+ is det.
+
+make_io_action_map_2(Cur, End, IoActionMap0, IoActionMap) -->
+ ( { Cur = End } ->
+ { IoActionMap = IoActionMap0 }
+ ;
+ pickup_io_action(Cur, ProcName, IsFunc, Args),
+ { update_io_action_map(Cur, ProcName, IsFunc, Args,
+ IoActionMap0, IoActionMap1) },
+ make_io_action_map_2(Cur + 1, End, IoActionMap1, IoActionMap)
+ ).
+
+:- pred update_io_action_map(int::in, string::in, bool::in, list(univ)::in,
+ io_action_map::in, io_action_map::out) is det.
+
+update_io_action_map(IoActionNum, ProcName, IsFunc, Args,
+ IoActionMap0, IoActionMap) :-
+ (
+ IsFunc = no,
+ PredFunc = predicate
+ ;
+ IsFunc = yes,
+ PredFunc = function
+ ),
+ IoAction = io_action(ProcName, PredFunc, Args),
+ map__det_insert(IoActionMap0, IoActionNum, IoAction, IoActionMap).
+
+:- pred pickup_io_action(int::in, string::out, bool::out, list(univ)::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ pickup_io_action(SeqNum::in, ProcName::out, IsFunc::out, Args::out,
+ S0::di, S::uo),
+ [thread_safe, promise_pure],
+"{
+ const char *problem;
+ const char *proc_name;
+
+ problem = MR_trace_get_action(SeqNum, &proc_name, &IsFunc, &Args);
+ if (problem != NULL) {
+ MR_fatal_error(""pickup_io_action: MR_trace_get_action"");
+ }
+
+ /* cast away const */
+ ProcName = (MR_String) (MR_Integer) proc_name;
+
+ S = S0;
+}").
Index: browser/mdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/mdb.m,v
retrieving revision 1.6
diff -u -b -r1.6 mdb.m
--- browser/mdb.m 2 May 2002 07:44:02 -0000 1.6
+++ browser/mdb.m 9 May 2002 04:12:17 -0000
@@ -16,7 +16,7 @@
:- include_module interactive_query.
:- include_module debugger_interface, collect_lib.
:- include_module declarative_debugger, declarative_execution.
-:- include_module program_representation.
+:- include_module program_representation, io_action.
:- implementation.
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
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
Index: runtime/mercury_layout_util.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_layout_util.c,v
retrieving revision 1.28
diff -u -b -r1.28 mercury_layout_util.c
--- runtime/mercury_layout_util.c 27 Mar 2002 07:35:34 -0000 1.28
+++ runtime/mercury_layout_util.c 12 May 2002 09:40:21 -0000
@@ -706,3 +706,28 @@
(*MR_io_stdout_stream)(&stdout_stream);
(*MR_io_print_to_stream)((MR_Word) type_info, stdout_stream, value);
}
+
+void
+MR_generate_proc_name_from_layout(const MR_Proc_Layout *proc_layout,
+ MR_ConstString *proc_name_ptr, int *arity_ptr, MR_Word *is_func_ptr)
+{
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(proc_layout)) {
+ *proc_name_ptr = proc_layout->MR_sle_proc_id.
+ MR_proc_comp.MR_comp_pred_name;
+ *arity_ptr = proc_layout->MR_sle_proc_id.
+ MR_proc_comp.MR_comp_arity;
+ *is_func_ptr = MR_BOOL_NO;
+ } else {
+ *proc_name_ptr = proc_layout->MR_sle_proc_id.
+ MR_proc_user.MR_user_name;
+ *arity_ptr = proc_layout->MR_sle_proc_id.
+ MR_proc_user.MR_user_arity;
+ if (proc_layout->MR_sle_proc_id.MR_proc_user.
+ MR_user_pred_or_func == MR_FUNCTION)
+ {
+ *is_func_ptr = MR_BOOL_YES;
+ } else {
+ *is_func_ptr = MR_BOOL_NO;
+ }
+ }
+}
Index: runtime/mercury_layout_util.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_layout_util.h,v
retrieving revision 1.19
diff -u -b -r1.19 mercury_layout_util.h
--- runtime/mercury_layout_util.h 27 Mar 2002 07:35:35 -0000 1.19
+++ runtime/mercury_layout_util.h 12 May 2002 09:39:30 -0000
@@ -152,4 +152,15 @@
extern void MR_write_variable(MR_TypeInfo type_info, MR_Word value);
+/*
+** Return the name of a procedure specified by the given proc layout in three
+** pieces: the name of the procedure in *proc_name_ptr, its arity in
+** *arity_ptr, and a boolean that is true iff procedure is a function
+** in *is_func_ptr,
+*/
+
+extern void MR_generate_proc_name_from_layout(const MR_Proc_Layout
+ *proc_layout, MR_ConstString *proc_name_ptr,
+ int *arity_ptr, MR_Word *is_func_ptr);
+
#endif /* MERCURY_LAYOUT_UTIL_H */
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.41
diff -u -b -r1.41 mercury_trace_base.c
--- runtime/mercury_trace_base.c 18 Feb 2002 07:01:21 -0000 1.41
+++ runtime/mercury_trace_base.c 12 May 2002 09:37:19 -0000
@@ -22,6 +22,7 @@
#include "mercury_engine.h"
#include "mercury_wrapper.h"
#include "mercury_misc.h"
+#include "mercury_layout_util.h" /* for MR_generate_proc_name_from_layout */
#include "mercury_runtime_util.h" /* for strerror() on some systems */
#include "mercury_signal.h" /* for MR_setup_signal() */
#include <signal.h> /* for SIGINT */
@@ -336,6 +337,66 @@
(long) MR_trace_event_number);
write(fd, buf, strlen(buf));
}
+}
+
+const char *
+MR_trace_get_action(int action_number, MR_ConstString *proc_name_ptr,
+ MR_Word *is_func_ptr, MR_Word *arg_list_ptr)
+{
+ const MR_Table_Io_Decl *table_io_decl;
+ const MR_Proc_Layout *proc_layout;
+ MR_ConstString proc_name;
+ MR_Word is_func;
+ MR_Word arg_list;
+ MR_Word arg;
+ int filtered_arity;
+ int arity;
+ int hv;
+ MR_TrieNode answer_block_trie;
+ MR_Word *answer_block;
+ MR_TypeInfo *type_params;
+ MR_TypeInfo type_info;
+
+ if (! (MR_io_tabling_start <= action_number
+ && action_number < MR_io_tabling_counter_hwm))
+ {
+ return "I/O action number not in range";
+ }
+
+ MR_DEBUG_NEW_TABLE_START_INT(answer_block_trie,
+ (MR_TrieNode) &MR_io_tabling_pointer,
+ MR_io_tabling_start, action_number);
+ answer_block = answer_block_trie->MR_answerblock;
+
+ if (answer_block == NULL) {
+ return "I/O action number not in range";
+ }
+
+ table_io_decl = (const MR_Table_Io_Decl *) answer_block[0];
+ proc_layout = table_io_decl->MR_table_io_decl_proc;
+ filtered_arity = table_io_decl->MR_table_io_decl_filtered_arity;
+
+ MR_generate_proc_name_from_layout(proc_layout, &proc_name, &arity,
+ &is_func);
+
+ type_params = MR_materialize_answer_block_type_params(
+ table_io_decl->MR_table_io_decl_type_params,
+ answer_block, filtered_arity);
+
+ arg_list = MR_list_empty();
+ for (hv = filtered_arity; hv >= 1; hv--) {
+ type_info = MR_create_type_info(type_params,
+ table_io_decl->MR_table_io_decl_ptis[hv - 1]);
+ MR_new_univ_on_hp(arg, type_info, answer_block[hv]);
+ arg_list = MR_list_cons(arg, arg_list);
+ }
+
+ MR_free(type_params);
+
+ *proc_name_ptr = proc_name;
+ *is_func_ptr = is_func;
+ *arg_list_ptr = arg_list;
+ return NULL;
}
static MR_Word MR_trace_exception_value = (MR_Word) NULL;
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.22
diff -u -b -r1.22 mercury_trace_base.h
--- runtime/mercury_trace_base.h 18 Feb 2002 07:01:21 -0000 1.22
+++ runtime/mercury_trace_base.h 12 May 2002 09:39:04 -0000
@@ -187,6 +187,19 @@
extern void MR_tracing_not_enabled(void);
/*
+** Return the details of I/O action <action_number> in three pieces:
+** the name of the I/O action procedure in *proc_name_ptr, a boolean that is
+** true iff procedure is a function in *is_func_ptr, and a Mercury
+** representation of the argument list (minus the IO state arguments)
+** in *arg_list_ptr.
+*/
+
+extern const char
+ *MR_trace_get_action(int action_number,
+ MR_ConstString *proc_name_ptr, MR_Word *is_func_ptr,
+ MR_Word *arg_list_ptr);
+
+/*
** These functions allow library/exceptions.m to tell the debuggers
** which exception has been thrown.
*/
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.36
diff -u -b -r1.36 Mmakefile
--- tests/debugger/declarative/Mmakefile 2 May 2002 07:44:02 -0000 1.36
+++ tests/debugger/declarative/Mmakefile 9 May 2002 05:59:49 -0000
@@ -44,6 +44,7 @@
queens \
small \
special_term_dep \
+ tabled_read_decl \
throw
# The following should not be run in `debug' grades.
@@ -62,6 +63,7 @@
MCFLAGS-input_term_dep=--trace rep
MCFLAGS-output_term_dep=--trace rep
MCFLAGS-special_term_dep=--trace rep
+MCFLAGS-tabled_read_decl=--trace rep --trace-table-io-decl
MCFLAGS-untraced_subgoal_sub=--trace minimum
ifneq "$(findstring .debug,$(GRADE))" ""
@@ -192,6 +194,10 @@
special_term_dep.out: special_term_dep special_term_dep.inp
$(MDB) ./special_term_dep < special_term_dep.inp \
> special_term_dep.out 2>&1
+
+tabled_read_decl.out: tabled_read_decl tabled_read_decl.inp
+ $(MDB) ./tabled_read_decl < tabled_read_decl.inp \
+ > tabled_read_decl.out 2>&1
# We need to pipe the output through sed to avoid hard-coding dependencies on
# particular line numbers in the standard library source code.
Index: tests/debugger/declarative/tabled_read_decl.exp
===================================================================
RCS file: tests/debugger/declarative/tabled_read_decl.exp
diff -N tests/debugger/declarative/tabled_read_decl.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/tabled_read_decl.exp 9 May 2002 07:08:55 -0000
@@ -0,0 +1,57 @@
+ 1: 1 1 CALL pred tabled_read_decl:main/2-0 (det) tabled_read_decl.m:17
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> table_io start
+io tabling started
+mdb> break tabled_read_decl__test
+ 0: + stop interface pred tabled_read_decl:test/4-0 (det)
+mdb> continue
+ 11: 4 3 CALL pred tabled_read_decl:test/4-0 (det)
+mdb> finish -n
+ 52: 4 3 EXIT pred tabled_read_decl:test/4-0 (det)
+mdb> print
+test('<<c_pointer>>', 1123, '_', state('<<c_pointer>>'))
+mdb> dd
+pred test
+ '<<c_pointer>>'
+ 1123
+ _
+ state('<<c_pointer>>')
+4 io actions:
+read_char_code('<<c_pointer>>', 49)
+read_char_code('<<c_pointer>>', 50)
+read_char_code('<<c_pointer>>', 51)
+read_char_code('<<c_pointer>>', 10)
+Valid? no
+pred test_2
+ '<<c_pointer>>'
+ 1
+ 1123
+ _
+ state('<<c_pointer>>')
+4 io actions:
+read_char_code('<<c_pointer>>', 49)
+read_char_code('<<c_pointer>>', 50)
+read_char_code('<<c_pointer>>', 51)
+read_char_code('<<c_pointer>>', 10)
+Valid? yes
+Found incorrect contour:
+pred test
+ '<<c_pointer>>'
+ 1123
+ _
+ state('<<c_pointer>>')
+4 io actions:
+read_char_code('<<c_pointer>>', 49)
+read_char_code('<<c_pointer>>', 50)
+read_char_code('<<c_pointer>>', 51)
+read_char_code('<<c_pointer>>', 10)
+Is this a bug? yes
+ 52: 4 3 EXIT pred tabled_read_decl:test/4-0 (det)
+mdb> c -n -S
+1123
+1456
+1789
Index: tests/debugger/declarative/tabled_read_decl.inp
===================================================================
RCS file: tests/debugger/declarative/tabled_read_decl.inp
diff -N tests/debugger/declarative/tabled_read_decl.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/tabled_read_decl.inp 9 May 2002 06:26:30 -0000
@@ -0,0 +1,13 @@
+echo on
+register --quiet
+context none
+table_io start
+break tabled_read_decl__test
+continue
+finish -n
+print
+dd
+no
+yes
+yes
+c -n -S
Index: tests/debugger/declarative/tabled_read_decl.m
===================================================================
RCS file: tests/debugger/declarative/tabled_read_decl.m
diff -N tests/debugger/declarative/tabled_read_decl.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/tabled_read_decl.m 9 May 2002 06:23:48 -0000
@@ -0,0 +1,136 @@
+% We define our own I/O primitives, in case the library was compiled without
+% IO tabling.
+
+:- module tabled_read_decl.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module list, char, int.
+
+main -->
+ tabled_read_decl__open_input("tabled_read_decl.data", Res, Stream),
+ ( { Res = 0 } ->
+ tabled_read_decl__part_1(Stream),
+ tabled_read_decl__part_2(Stream)
+ ;
+ io__write_string("could not open tabled_read.data\n")
+ ).
+
+:- pred tabled_read_decl__part_1(c_pointer::in, io__state::di, io__state::uo)
+ is det.
+
+tabled_read_decl__part_1(Stream) -->
+ tabled_read_decl__test(Stream, A),
+ tabled_read_decl__write_int(A),
+ tabled_read_decl__poly_test(Stream, ['a', 'b', 'c'], B),
+ tabled_read_decl__write_int(B).
+
+:- pred tabled_read_decl__part_2(c_pointer::in, io__state::di, io__state::uo)
+ is det.
+
+tabled_read_decl__part_2(Stream) -->
+ tabled_read_decl__test(Stream, A),
+ tabled_read_decl__write_int(A).
+
+:- pred tabled_read_decl__test(c_pointer::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+tabled_read_decl__test(Stream, N) -->
+ % BUG: the 1 should be 0
+ tabled_read_decl__test_2(Stream, 1, N).
+
+:- pred tabled_read_decl__test_2(c_pointer::in, int::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+tabled_read_decl__test_2(Stream, SoFar, N) -->
+ tabled_read_decl__read_char_code(Stream, CharCode),
+ (
+ { char__to_int(Char, CharCode) },
+ { char__is_digit(Char) },
+ { char__digit_to_int(Char, CharInt) }
+ ->
+ tabled_read_decl__test_2(Stream, SoFar * 10 + CharInt, N)
+ ;
+ { N = SoFar }
+ ).
+
+:- pred tabled_read_decl__poly_test(c_pointer::in, T::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+tabled_read_decl__poly_test(Stream, Unused, N) -->
+ % BUG: the 1 should be 0
+ tabled_read_decl__poly_test_2(Stream, Unused, 1, N).
+
+:- pred tabled_read_decl__poly_test_2(c_pointer::in, T::in, int::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+tabled_read_decl__poly_test_2(Stream, Unused, SoFar, N) -->
+ tabled_read_decl__poly_read_char_code(Stream, Unused, CharCode),
+ (
+ { char__to_int(Char, CharCode) },
+ { char__is_digit(Char) },
+ { char__digit_to_int(Char, CharInt) }
+ ->
+ tabled_read_decl__poly_test_2(Stream, Unused,
+ SoFar * 10 + CharInt, N)
+ ;
+ { N = SoFar }
+ ).
+
+:- pragma c_header_code("#include <stdio.h>").
+
+:- pred tabled_read_decl__open_input(string::in, int::out, c_pointer::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_decl__open_input(FileName::in, Res::out, Stream::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ Stream = (MR_Word) fopen((const char *) FileName, ""r"");
+ Res = Stream? 0 : -1;
+ IO = IO0;
+").
+
+:- pred tabled_read_decl__read_char_code(c_pointer::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_decl__read_char_code(Stream::in, CharCode::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ CharCode = getc((FILE *) Stream);
+ IO = IO0;
+").
+
+:- pred tabled_read_decl__poly_read_char_code(c_pointer::in, T::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_decl__poly_read_char_code(Stream::in, Unused::in,
+ CharCode::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ /* ignore Unused */
+ CharCode = getc((FILE *) Stream);
+ IO = IO0;
+").
+
+:- pred tabled_read_decl__write_int(int::in, io__state::di, io__state::uo)
+ is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_decl__write_int(N::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"{
+ printf(""%d\\n"", (int) N);
+ IO = IO0;
+}").
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.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.50
diff -u -b -r1.50 mercury_trace.c
--- trace/mercury_trace.c 17 Apr 2002 06:10:12 -0000 1.50
+++ trace/mercury_trace.c 9 May 2002 06:06:14 -0000
@@ -497,8 +497,8 @@
MR_Retry_Result
MR_trace_retry(MR_Event_Info *event_info, MR_Event_Details *event_details,
- int ancestor_level, const char **problem, FILE *in_fp, FILE *out_fp,
- MR_Code **jumpaddr)
+ int ancestor_level, MR_bool unconditional_allow_io,
+ const char **problem, FILE *in_fp, FILE *out_fp, MR_Code **jumpaddr)
{
MR_Word *base_sp;
MR_Word *base_curfr;
@@ -632,7 +632,7 @@
}
}
- if (has_io_state) {
+ if (has_io_state && !unconditional_allow_io) {
if (in_fp != NULL && out_fp != NULL) {
MR_bool allow_retry;
char *answer;
Index: trace/mercury_trace.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.h,v
retrieving revision 1.25
diff -u -b -r1.25 mercury_trace.h
--- trace/mercury_trace.h 18 Feb 2002 07:01:28 -0000 1.25
+++ trace/mercury_trace.h 12 May 2002 07:25:07 -0000
@@ -108,8 +108,11 @@
** information.
**
** Retry across I/O is unsafe in general, at least for now. It is therefore
-** only allowed if in_fp and out_fp are both non-NULL, and if the user, when
-** asked whether he/she wants to perform the retry anyway, says yes.
+** allowed only
+**
+** - if unconditional_allow_io is TRUE, or
+** - if in_fp and out_fp are both non-NULL, and the user, when asked whether
+** he/she wants to perform the retry anyway, says yes.
*/
typedef enum {
@@ -121,7 +124,9 @@
extern MR_Retry_Result MR_trace_retry(MR_Event_Info *event_info,
MR_Event_Details *event_details,
- int ancestor_level, const char **problem,
+ int ancestor_level,
+ MR_bool unconditional_allow_io,
+ const char **problem,
FILE *in_fp, FILE *out_fp,
MR_Code **jumpaddr);
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.50
diff -u -b -r1.50 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 9 May 2002 05:23:45 -0000 1.50
+++ trace/mercury_trace_declarative.c 12 May 2002 13:57:43 -0000
@@ -117,6 +117,7 @@
static MR_Unsigned MR_edt_last_event;
static MR_bool MR_edt_inside;
static MR_Unsigned MR_edt_start_seqno;
+static MR_Unsigned MR_edt_start_io_counter;
/*
** The declarative debugger ignores modules that were not compiled with
@@ -463,13 +464,14 @@
(MR_Word) event_info->MR_call_seqno,
(MR_Word) event_info->MR_event_number,
(MR_Word) at_depth_limit, proc_rep,
- goal_path);
+ goal_path, MR_io_tabling_counter);
} 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, goal_path);
+ (MR_Word) at_depth_limit, goal_path,
+ MR_io_tabling_counter);
}
);
@@ -506,7 +508,8 @@
(MR_Word) call);
node = (MR_Trace_Node) MR_DD_construct_exit_node(
(MR_Word) prev, (MR_Word) call, last_interface,
- atom, (MR_Word) event_info->MR_event_number);
+ atom, (MR_Word) event_info->MR_event_number,
+ MR_io_tabling_counter);
MR_DD_call_node_set_last_interface((MR_Word) call,
(MR_Word) node);
);
@@ -1292,8 +1295,8 @@
/*
** Go back to an event before the topmost call.
*/
- retry_result = MR_trace_retry(event_info, event_details, 0, &problem,
- NULL, NULL, jumpaddr);
+ retry_result = MR_trace_retry(event_info, event_details, 0, MR_TRUE,
+ &problem, NULL, NULL, jumpaddr);
if (retry_result != MR_RETRY_OK_DIRECT) {
if (retry_result == MR_RETRY_ERROR) {
return problem;
@@ -1314,6 +1317,7 @@
MR_edt_last_event = event;
MR_edt_inside = MR_FALSE;
MR_edt_start_seqno = seqno;
+ MR_edt_start_io_counter = MR_io_tabling_counter;
MR_edt_max_depth = maxdepth;
MR_trace_current_node = (MR_Trace_Node) NULL;
@@ -1337,6 +1341,10 @@
return NULL;
}
+static MR_bool MR_io_action_map_cache_is_valid = MR_FALSE;
+static MR_Unsigned MR_io_action_map_cache_start;
+static MR_Unsigned MR_io_action_map_cache_end;
+
static MR_Code *
MR_decl_diagnosis(MR_Trace_Node root, MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info, MR_Event_Details *event_details)
@@ -1348,6 +1356,9 @@
MR_Unsigned final_event;
MR_Unsigned topmost_seqno;
MercuryFile stream;
+ MR_Integer use_old_io_map;
+ MR_Unsigned io_start;
+ MR_Unsigned io_end;
event_details->MR_call_seqno = MR_trace_call_seqno;
event_details->MR_call_depth = MR_trace_call_depth;
@@ -1386,8 +1397,27 @@
MR_trace_enabled = MR_TRUE;
}
+ io_start = MR_edt_start_io_counter;
+ io_end = MR_io_tabling_counter;
+
+ if (MR_io_action_map_cache_is_valid
+ && MR_io_action_map_cache_start <= io_start
+ && io_end <= MR_io_action_map_cache_end)
+ {
+ use_old_io_map = MR_TRUE;
+ io_start = MR_io_action_map_cache_start;
+ io_end = MR_io_action_map_cache_end;
+ } else {
+ use_old_io_map = MR_FALSE;
+
+ MR_io_action_map_cache_is_valid = MR_TRUE;
+ MR_io_action_map_cache_start = io_start;
+ MR_io_action_map_cache_end = io_end;
+ }
+
MR_TRACE_CALL_MERCURY(
- MR_DD_decl_diagnosis(MR_trace_node_store, root, &response,
+ MR_DD_decl_diagnosis(MR_trace_node_store, root, use_old_io_map,
+ io_start, io_end, &response,
MR_trace_front_end_state,
&MR_trace_front_end_state
);
@@ -1443,8 +1473,8 @@
MR_print_stack_regs(stdout, event_info->MR_saved_regs);
MR_print_succip_reg(stdout, event_info->MR_saved_regs);
#endif
- retry_result = MR_trace_retry(event_info, event_details, 0, &problem,
- NULL, NULL, &jumpaddr);
+ retry_result = MR_trace_retry(event_info, event_details, 0, MR_TRUE,
+ &problem, NULL, NULL, &jumpaddr);
#ifdef MR_DEBUG_RETRY
MR_print_stack_regs(stdout, event_info->MR_saved_regs);
MR_print_succip_reg(stdout, event_info->MR_saved_regs);
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.64
diff -u -b -r1.64 mercury_trace_external.c
--- trace/mercury_trace_external.c 24 Feb 2002 11:53:44 -0000 1.64
+++ trace/mercury_trace_external.c 9 May 2002 06:09:49 -0000
@@ -622,7 +622,7 @@
"REQUEST_RETRY\n");
}
retry_result = MR_trace_retry(event_info,
- &event_details, 0, &message,
+ &event_details, 0, MR_FALSE, &message,
NULL, NULL, &jumpaddr);
if (retry_result == MR_RETRY_OK_DIRECT) {
MR_send_message_to_socket("ok");
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.128
diff -u -b -r1.128 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 23 Apr 2002 11:23:30 -0000 1.128
+++ trace/mercury_trace_internal.c 9 May 2002 06:09:34 -0000
@@ -1596,7 +1596,7 @@
}
result = MR_trace_retry(event_info, event_details,
- ancestor_level, &problem,
+ ancestor_level, MR_FALSE, &problem,
MR_mdb_in, MR_mdb_out, jumpaddr);
switch (result) {
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.42
diff -u -b -r1.42 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 23 Apr 2002 08:52:45 -0000 1.42
+++ trace/mercury_trace_vars.c 12 May 2002 09:31:31 -0000
@@ -112,9 +112,6 @@
MR_bool print_optionals);
static int MR_trace_compare_var_details(const void *arg1,
const void *arg2);
-static void MR_generate_proc_name_from_layout(const MR_Proc_Layout
- *proc_layout, MR_ConstString *proc_name_ptr,
- int *arity_ptr, MR_Word *is_func_ptr);
static const char * MR_trace_browse_one_path(FILE *out,
MR_Var_Spec var_spec, char *path,
MR_Browser browser,
@@ -730,31 +727,6 @@
return NULL;
}
-static void
-MR_generate_proc_name_from_layout(const MR_Proc_Layout *proc_layout,
- MR_ConstString *proc_name_ptr, int *arity_ptr, MR_Word *is_func_ptr)
-{
- if (MR_PROC_LAYOUT_COMPILER_GENERATED(proc_layout)) {
- *proc_name_ptr = proc_layout->MR_sle_proc_id.
- MR_proc_comp.MR_comp_pred_name;
- *arity_ptr = proc_layout->MR_sle_proc_id.
- MR_proc_comp.MR_comp_arity;
- *is_func_ptr = MR_BOOL_NO;
- } else {
- *proc_name_ptr = proc_layout->MR_sle_proc_id.
- MR_proc_user.MR_user_name;
- *arity_ptr = proc_layout->MR_sle_proc_id.
- MR_proc_user.MR_user_arity;
- if (proc_layout->MR_sle_proc_id.MR_proc_user.
- MR_user_pred_or_func == MR_FUNCTION)
- {
- *is_func_ptr = MR_BOOL_YES;
- } else {
- *is_func_ptr = MR_BOOL_NO;
- }
- }
-}
-
/*
** The following declaration allocates a cell to a typeinfo even if though
** its arity is zero. This wastes a word of space but avoids depending on the
@@ -821,55 +793,17 @@
MR_trace_browse_action(FILE *out, int action_number, MR_GoalBrowser browser,
MR_Browse_Caller_Type caller, MR_Browse_Format format)
{
- const MR_Table_Io_Decl *table_io_decl;
- const MR_Proc_Layout *proc_layout;
MR_ConstString proc_name;
MR_Word is_func;
MR_Word arg_list;
- MR_Word arg;
- int filtered_arity;
- int arity;
- int hv;
- MR_TrieNode answer_block_trie;
- MR_Word *answer_block;
- MR_TypeInfo *type_params;
- MR_TypeInfo type_info;
-
- if (! (MR_io_tabling_start <= action_number
- && action_number < MR_io_tabling_counter_hwm))
- {
- return "I/O action number not in range";
- }
-
- MR_DEBUG_NEW_TABLE_START_INT(answer_block_trie,
- (MR_TrieNode) &MR_io_tabling_pointer,
- MR_io_tabling_start, action_number);
- answer_block = answer_block_trie->MR_answerblock;
-
- if (answer_block == NULL) {
- return "I/O action number not in range";
- }
-
- table_io_decl = (const MR_Table_Io_Decl *) answer_block[0];
- proc_layout = table_io_decl->MR_table_io_decl_proc;
- filtered_arity = table_io_decl->MR_table_io_decl_filtered_arity;
-
- MR_generate_proc_name_from_layout(proc_layout, &proc_name, &arity,
- &is_func);
-
- type_params = MR_materialize_answer_block_type_params(
- table_io_decl->MR_table_io_decl_type_params,
- answer_block, filtered_arity);
+ const char *problem;
- arg_list = MR_list_empty();
- for (hv = filtered_arity; hv >= 1; hv--) {
- type_info = MR_create_type_info(type_params,
- table_io_decl->MR_table_io_decl_ptis[hv - 1]);
- MR_new_univ_on_hp(arg, type_info, answer_block[hv]);
- arg_list = MR_list_cons(arg, arg_list);
+ problem = MR_trace_get_action(action_number, &proc_name,
+ &is_func, &arg_list);
+ if (problem != NULL) {
+ return problem;
}
- MR_free(type_params);
(*browser)(proc_name, arg_list, is_func, caller, format);
return NULL;
}
Index: trace/mercury_trace_vars.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.h,v
retrieving revision 1.20
diff -u -b -r1.20 mercury_trace_vars.h
--- trace/mercury_trace_vars.h 23 Apr 2002 08:52:46 -0000 1.20
+++ trace/mercury_trace_vars.h 12 May 2002 09:06:31 -0000
@@ -141,6 +141,8 @@
**
** The goal is printed to the given file if the file pointer is non-NULL.
** The goal is printed by giving it to the specified browser.
+**
+** XXX Actually, the "out" parameter is currently ignored.
*/
extern const char *MR_trace_browse_one_goal(FILE *out,
@@ -153,6 +155,8 @@
**
** The goal is printed to the given file if the file pointer is non-NULL.
** The goal is printed by giving it to the specified browser.
+**
+** XXX Actually, the "out" parameter is currently ignored.
*/
extern const char *MR_trace_browse_action(FILE *out, int action_number,
@@ -170,6 +174,8 @@
** The values are printed by giving them to the specified browser.
** The last argument governs whether this function returns an error
** if the given variable specification is ambiguous.
+**
+** XXX Actually, the "out" parameter is currently ignored by the browser.
*/
extern const char *MR_trace_parse_browse_one(FILE *out, char *word_spec,
@@ -184,6 +190,8 @@
** The values are printed by giving them to the specified browser.
** The last argument governs whether this function returns an error
** if the given variable specification is ambiguous.
+**
+** XXX Actually, the "out" parameter is currently ignored by the browser.
*/
extern const char *MR_trace_browse_one(FILE *out, MR_Var_Spec var_spec,
@@ -197,6 +205,8 @@
** point. The variables names are printed directly to the given file, but
** only if the given file pointer is not NULL; the variable values are
** printed by calling the given browser function on them.
+**
+** XXX Actually, the "out" parameter is currently ignored by the browser.
*/
extern const char *MR_trace_browse_all(FILE *out, MR_Browser browser,
@@ -206,6 +216,8 @@
** Sets the current set of variables to be ones live at the program point
** referred to by level_layout, base_sp and base_curfr arguments, and then
** prints them all.
+**
+** XXX Actually, the "out" parameter is currently ignored by the browser.
*/
extern const char *MR_trace_browse_all_on_level(FILE *out,
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