[m-rev.] for review: I/O actions in the declarative debugger
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri May 10 17:15:38 AEST 2002
For review by Mark.
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.
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.
trace/mercury_trace_declarative.c:
When invoking the front end, pass to it the required I/O action map.
Cache this map, so that reinvocation of the back end (to materialize
previously virtual parts of the annotated trace) do not require its
reconstruction.
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 9 May 2002 04:45:51 -0000
@@ -13,7 +13,8 @@
:- module mdb__declarative_analyser.
:- interface.
:- import_module mdb__declarative_debugger, mdb__program_representation.
-:- import_module list, std_util.
+:- import_module mdb__io_action.
+:- import_module list, map, 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
@@ -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(map(int, io_action), 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(map(int, io_action), 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,26 @@
:- type analyser_state(T).
-:- pred analyser_state_init(analyser_state(T)).
-:- mode analyser_state_init(out) is det.
+:- pred analyser_state_init(map(int, io_action)::in,
+ analyser_state(T)::out) is det.
+
+:- pred analyser_state_replace_io_map(map(int, io_action)::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 +192,10 @@
%
priority_suspects :: list(decl_question(T)),
+ % This field allows us to map I/O action
+ % numbers to the actions themselves.
+ io_action_map :: map(int, io_action),
+
% 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 +205,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 +270,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 +301,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 +317,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 +347,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 +419,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(map(int, io_action)::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 9 May 2002 05:01:17 -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, map, 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,20 +181,30 @@
:- 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(map(int, io_action)::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.
+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.
get_decl_question_node(unexpected_exception(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,25 @@
"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,
+ map(int, io_action)::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, 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, IoActionMap, Response, State0, State) -->
+ { 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 +402,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 +413,95 @@
%
:- type wrap(S) ---> wrap(S).
-:- pred trace_root_question(wrap(S), edt_node(R), decl_question(edt_node(R)))
+%-----------------------------------------------------------------------------%
+
+:- func exit_node_decl_atom(map(int, io_action)::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(map(int, io_action), 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(map(int, io_action)::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(map(int, io_action)::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(map(int, io_action)::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 +515,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 +528,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 +538,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 +553,7 @@
error("wrong_answer_children: exception handling not supported")
;
(
- Node = exit(_, _, _, _, _)
+ Node = exit(_, _, _, _, _, _)
->
%
% Add a child for this node.
@@ -519,7 +582,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 +598,7 @@
"missing_answer_children: exception handling not supported")
;
(
- ( Node = exit(_, _, _, _, _)
+ ( Node = exit(_, _, _, _, _, _)
; Node = fail(_, _, _, _)
)
->
@@ -573,7 +636,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 +647,7 @@
Ns = Ns0
;
(
- ( Node = exit(_, _, _, _, _)
+ ( Node = exit(_, _, _, _, _, _)
; Node = excp(_, _, _, _, _)
)
->
@@ -726,7 +789,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 +831,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 +862,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 +875,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 +892,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 +1036,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 +1054,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 +1254,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 +1275,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 9 May 2002 05:26:27 -0000
@@ -0,0 +1,66 @@
+%-----------------------------------------------------------------------------%
+% 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, std_util.
+
+:- type io_action
+ ---> io_action(
+ io_action_proc_name :: string,
+ io_action_pf :: pred_or_func,
+ io_action_args :: list(univ)
+ ).
+
+:- pred io_action_to_synthetic_term(io_action::in, string::out,
+ list(univ)::out, bool::out) is det.
+
+:- implementation.
+
+:- import_module require, int, map.
+
+io_action_to_synthetic_term(IoAction, ProcName, Args, IsFunc) :-
+ IoAction = io_action(ProcName, PredFunc, Args),
+ (
+ PredFunc = predicate,
+ IsFunc = no
+ ;
+ PredFunc = function,
+ IsFunc = yes
+ ).
+
+:- pred init_io_action_map(map(int, io_action)::out) is det.
+:- pragma export(init_io_action_map(out), "MR_DD_init_io_action_map").
+
+init_io_action_map(map__init).
+
+:- pred update_io_action_map(int::in, string::in, bool::in, list(univ)::in,
+ map(int, io_action)::in, map(int, io_action)::out) is det.
+:- pragma export(update_io_action_map(in, in, in, in, in, out),
+ "MR_DD_update_io_action_map").
+
+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).
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
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 9 May 2002 06:07:47 -0000
@@ -108,8 +108,9 @@
** 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 if the user, when asked whether he/she wants to perform
+** the retry anyway, says yes.
*/
typedef enum {
@@ -121,7 +122,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 9 May 2002 06:08:58 -0000
@@ -47,6 +47,7 @@
#include "mdb.declarative_debugger.h"
#include "mdb.declarative_execution.h"
+#include "mdb.io_action.h"
#ifdef MR_HIGHLEVEL_CODE
#include "mercury.std_util.h"
#else
@@ -117,6 +118,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
@@ -225,6 +227,8 @@
MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info,
MR_Event_Details *event_details);
+static MR_Word MR_trace_construct_io_actions(MR_Unsigned start,
+ MR_Unsigned end);
static MR_Code *MR_decl_handle_bug_found(MR_Unsigned event,
MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info,
@@ -463,13 +467,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 +511,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 +1298,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 +1320,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;
@@ -1348,6 +1355,7 @@
MR_Unsigned final_event;
MR_Unsigned topmost_seqno;
MercuryFile stream;
+ MR_Word io_action_map;
event_details->MR_call_seqno = MR_trace_call_seqno;
event_details->MR_call_depth = MR_trace_call_depth;
@@ -1386,8 +1394,12 @@
MR_trace_enabled = MR_TRUE;
}
+ io_action_map = MR_trace_construct_io_actions(MR_edt_start_io_counter,
+ MR_io_tabling_counter);
+
MR_TRACE_CALL_MERCURY(
- MR_DD_decl_diagnosis(MR_trace_node_store, root, &response,
+ MR_DD_decl_diagnosis(MR_trace_node_store, root, io_action_map,
+ &response,
MR_trace_front_end_state,
&MR_trace_front_end_state
);
@@ -1426,6 +1438,48 @@
return MR_trace_event_internal(cmd, MR_TRUE, event_info);
}
+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_Word MR_io_action_map_cache_map;
+
+static MR_Word
+MR_trace_construct_io_actions(MR_Unsigned start, MR_Unsigned end)
+{
+ MR_Word io_action_map;
+ MR_Unsigned cur;
+ MR_ConstString procname;
+ MR_Word is_func;
+ MR_Word args;
+ MR_ConstString problem;
+
+ if (MR_io_action_map_cache_is_valid
+ && MR_io_action_map_cache_start <= start
+ && end <= MR_io_action_map_cache_end)
+ {
+ return MR_io_action_map_cache_map;
+ }
+
+ MR_DD_init_io_action_map(&io_action_map);
+ for (cur = start; cur < end; cur++) {
+ problem = MR_trace_get_action(cur, &procname, &is_func, &args);
+ if (problem != NULL) {
+ MR_fatal_error("MR_trace_construct_io_actions: cannot get IO action");
+ }
+
+ MR_DD_update_io_action_map((MR_Integer) cur,
+ (MR_String) (MR_Integer) procname, is_func, args,
+ io_action_map, &io_action_map);
+ }
+
+ MR_io_action_map_cache_is_valid = MR_TRUE;
+ MR_io_action_map_cache_start = start;
+ MR_io_action_map_cache_end = end;
+ MR_io_action_map_cache_map = io_action_map;
+
+ return io_action_map;
+}
+
static MR_Code *
MR_decl_handle_bug_found(MR_Unsigned bug_event, MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info, MR_Event_Details *event_details)
@@ -1443,8 +1497,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 7 May 2002 09:26:44 -0000
@@ -818,8 +818,8 @@
}
const char *
-MR_trace_browse_action(FILE *out, int action_number, MR_GoalBrowser browser,
- MR_Browse_Caller_Type caller, MR_Browse_Format format)
+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;
@@ -870,6 +870,28 @@
}
MR_free(type_params);
+
+ *proc_name_ptr = proc_name;
+ *is_func_ptr = is_func;
+ *arg_list_ptr = arg_list;
+ return NULL;
+}
+
+const char *
+MR_trace_browse_action(FILE *out, int action_number, MR_GoalBrowser browser,
+ MR_Browse_Caller_Type caller, MR_Browse_Format format)
+{
+ MR_ConstString proc_name;
+ MR_Word is_func;
+ MR_Word arg_list;
+ const char *problem;
+
+ problem = MR_trace_get_action(action_number, &proc_name,
+ &is_func, &arg_list);
+ if (problem != NULL) {
+ return problem;
+ }
+
(*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 7 May 2002 09:26:17 -0000
@@ -137,10 +137,24 @@
extern const char *MR_trace_headvar_num(int n, int *num);
/*
+** 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);
+
+/*
** Print the call of the current level as a goal.
**
** 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 +167,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 +186,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 +202,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 +217,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 +228,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