mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 06:47:17 +00:00
519d8f9508
Estimated hours taken: 12
Branches: main
Fix a bug in the handling of I/O actions by the debugger: the procedural
debugger didn't implement the documented commands for printing I/O actions.
Also implement some new variants of the print commands to make it easier
to print I/O actions.
Also track down and pinpoint a bug that caused the declarative debugger
to ask questions from *outside* the tree it was asked to debug, as shown
by this example from a new test case compiled in a decldebug grade (so that
the library, and thus io.read, gets compiled with deep, not shallow tracing):
-----------------------------------------------------------------------------
mdb ./io_read_bug
1: 1 1 CALL pred io_read_bug.main/2-0 (cc_multi) io_read_bug.m:22
I/O tabling started.
mdb> g 4
Please input the number of queens and a period:
4: 3 2 CALL pred io.read/3-0 (det) io.m:4240 (io_read_bug.m:24)
mdb> f
5.
513: 3 2 EXIT pred io.read/3-0 (det) io.m:4240 (io_read_bug.m:24)
mdb> dd
[1, 3, 5, 2, 4]
main(_, _)
31 tabled IO actions: too many to show
Valid?
-----------------------------------------------------------------------------
browser/declarative_tree.m:
Put an XXX at the spot of the second bug.
browser/declarative_analyser.m:
browser/declarative_debugger.m:
Change the formatting of some code to give consistent and more
meaningful names to some arguments, and to make switches easier
to read. There are no algorithmic changes.
runtime/mercury_trace_base.[ch]:
Move the code for disabling/enabling deep profiling to the code that
does disabling/enabling of I/O actions, to put all relevant actions
for entering and leaving Mercury code together.
Note the similarity of MR_turn_debug_off/MR_turn_debug_back_on
with MR_TRACE_CALL_MERCURY, and make the similarity even greater
by adding the code for disabling/enabling deep profiling to
MR_TRACE_CALL_MERCURY (without which the deep profiler data structures
would have been screwed up by the declarative debugger).
Add a const qualifier to an argument.
trace/mercury_trace_cmd_browsing.c:
Fix the first bug: update the code of the "print" and "browse" mdb
commands to implement their documented capabilities with respect to
printing I/O actions.
Add a new capability: "print io" (or "print action") will now print
a bunch of I/O actions, starting with the first available one, and on
successive invocations will print successive bunches. This is an easy
way to print all I/O actions (without being overwhelmed by a huge
printout if there are too many).
Add a new capability: "print io limits" will now print the numbers of
the first and last I/O actions.
doc/user_guide.texi:
Document the new capabilities.
trace/mercury_trace_declarative.c:
Fix the second bug: disable debugging and then restore the old state
around calls to Mercury code from the declarative debugger.
My guess is that the bug was introduced when we gave declarative
debugging its own trace function; the one it used to share with
the procedural debugger still does the same disable/restore pair.
trace/mercury_trace_internal.c:
Delete the code now moved to mercury_trace_base.c.
trace/mercury_trace_util.[ch]:
Add a utility function for use by the new code in
mercury_trace_cmd_browsing.c, and increase robustness by more
precise representation of unsigned values.
trace/mercury_trace_cmd_dd.c:
Cosmetic fixes.
tests/debugger/declarative/tabled_read_decl.m:
Update this test case to our current coding standards. There are no
changes in the code.
tests/debugger/declarative/tabled_read_decl.{inp,out}:
Test the bug fixes by printing out a bunch of I/O actions.
tests/debugger/declarative/builtin_call_rep.exp:
Update this expected output file to conform for my recent change to
procedure representations.
tests/debugger/declarative/io_read_bug.{m,inp,exp}:
A new test case that exposes the second bug above. The .inp file
exposes the bug; the .exp file is a dummy.
tests/debugger/declarative/Mmakefile:
Add the new test case, but don't enable it yet.
tests/debugger/print_io_actions.{m,inp,exp,data}:
A new test case to test the new "print io" variant of the print
command.
tests/debugger/Mmakefile:
tests/debugger/Mercury.options:
Enable the new test case.
tests/EXPECT_FAIL_TESTS.asm_fast.gc.decldebug:
Expect the big_array_from_list test to fail in decldebug grades,
since we in that grade we can never get tail recursion, even in the
standard library.
910 lines
35 KiB
Mathematica
910 lines
35 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1999-2007 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: declarative_debugger.m.
|
|
% Author: Mark Brown.
|
|
%
|
|
% This module has two main purposes:
|
|
% - to define the interface between the front and back ends of
|
|
% a Mercury declarative debugger, and
|
|
% - to implement a front end.
|
|
%
|
|
% The interface is defined by a procedure that can be called from
|
|
% the back end to perform diagnosis, and a typeclass which represents
|
|
% a declarative view of execution used by the front end.
|
|
%
|
|
% The front end implemented in this module analyses the EDT it is
|
|
% passed to diagnose a bug.
|
|
%
|
|
% Because Mercury modules are able to be compiled with different levels
|
|
% of tracing, the trace sequences generated by the back end, and passed
|
|
% to the front end as "annotated traces", can include or exclude certain
|
|
% types of events. This front end is able to cope with some variation in
|
|
% the trace events produced, but there are some basic requirements on
|
|
% trace sequences which the back end must meet:
|
|
%
|
|
% 1) if there are any events from a certain class (e.g. interface
|
|
% events, negation events, disj events) then we require all events
|
|
% of that class;
|
|
%
|
|
% 2) if there are any disj events, we require all negation events
|
|
% and if-then-else events.
|
|
%
|
|
% 3) the sub-term dependency tracking algorithm requires the proc
|
|
% representation and all the internal events for any call through
|
|
% which it must track a sub-term. Child interface events however
|
|
% may be omitted (as long as each CALL which is present has all its
|
|
% corresponding REDOs, EXIT, FAIL or EXCP event(s) and vica versa).
|
|
%
|
|
% The backend will only build a portion of the annotated trace at a time
|
|
% (down to a specified depth limit). The front end can request that more
|
|
% of the annotated trace be built so it can be analysed. The front end can
|
|
% either request that the subtree rooted at a particular node whose children
|
|
% haven't been materialized be built (down to a certain depth limit), or that
|
|
% nodes above the topmost materialized node be materialized. In the first case
|
|
% the require_subtree response is sent to the backend and in the latter case
|
|
% the require_supertree response is sent to the backend. We use the term
|
|
% "supertree" to mean a tree which strictly contains the currently materialized
|
|
% portion of the annotated trace, although the backend will not materialize
|
|
% nodes which already exist in the current annotated trace when materializing
|
|
% a supertree.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module mdb.declarative_debugger.
|
|
:- interface.
|
|
|
|
:- import_module mdb.browser_info.
|
|
:- import_module mdb.declarative_analyser.
|
|
:- import_module mdb.declarative_execution.
|
|
:- import_module mdb.declarative_tree.
|
|
:- import_module mdb.help.
|
|
:- import_module mdb.io_action.
|
|
:- import_module mdb.term_rep.
|
|
:- import_module mdbcomp.program_representation.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module unit.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This type represents the possible truth values for nodes
|
|
% in the EDT.
|
|
%
|
|
:- type decl_truth
|
|
---> truth_correct
|
|
; truth_erroneous
|
|
; truth_inadmissible.
|
|
|
|
% This type represents the possible responses to being
|
|
% asked to confirm that a node is a bug.
|
|
%
|
|
:- type decl_confirmation
|
|
---> confirm_bug
|
|
; overrule_bug
|
|
; abort_diagnosis.
|
|
|
|
% This type represents the bugs which can be diagnosed.
|
|
% The parameter of the constructor is the type of EDT nodes.
|
|
%
|
|
:- type decl_bug
|
|
---> e_bug(decl_e_bug)
|
|
% An EDT whose root node is incorrect,
|
|
% but whose children are all correct.
|
|
|
|
; i_bug(decl_i_bug).
|
|
% An EDT whose root node is incorrect, and which has no incorrect
|
|
% children but at least one inadmissible one.
|
|
|
|
:- type decl_e_bug
|
|
---> incorrect_contour(
|
|
init_decl_atom, % The head of the clause, in its
|
|
% inital state of instantiation.
|
|
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(
|
|
init_decl_atom, % The called atom, in its initial state.
|
|
event_number % The fail event.
|
|
)
|
|
; unhandled_exception(
|
|
init_decl_atom, % The called atom, in its initial state.
|
|
decl_exception, % The exception thrown.
|
|
event_number % The excp event.
|
|
).
|
|
|
|
:- type decl_i_bug
|
|
---> inadmissible_call(
|
|
init_decl_atom, % The parent atom, in its initial state.
|
|
decl_position, % The location of the call in the parent body.
|
|
init_decl_atom, % The inadmissible child, in its initial state.
|
|
event_number % The call event.
|
|
).
|
|
|
|
:- type decl_contour == list(final_decl_atom).
|
|
|
|
% XXX not yet implemented.
|
|
%
|
|
:- type decl_position == unit.
|
|
|
|
% Values of the following two types represent questions from the
|
|
% analyser to the oracle about some aspect of program behaviour,
|
|
% and responses from the oracle, respectively. In both cases the
|
|
% type parameter is for the type of EDT nodes -- each question and
|
|
% answer keeps a reference to the node which generated it, so that
|
|
% the analyser is able to figure out what to do when the answer
|
|
% arrives back from the oracle.
|
|
%
|
|
:- type decl_question(T)
|
|
---> wrong_answer(T, init_decl_atom, final_decl_atom)
|
|
% The node is a suspected wrong answer. The first argument
|
|
% is the EDT node the question came from. The second argument
|
|
% is the atom in its final state of instantiatedness (i.e.
|
|
% at the EXIT event).
|
|
|
|
; missing_answer(T, init_decl_atom, list(final_decl_atom))
|
|
% The node is a suspected missing answer. The first argument
|
|
% is the EDT node the question came from. The second argument
|
|
% is the atom in its initial state of instantiatedness (i.e.
|
|
% at the CALL event), and the third argument is the list
|
|
% of solutions.
|
|
|
|
; unexpected_exception(T, init_decl_atom, decl_exception).
|
|
% The node is a possibly unexpected exception. The first argument
|
|
% is the EDT node the question came from. The second argument
|
|
% is the atom in its initial state of instantiation, and the third
|
|
% argument is the exception thrown.
|
|
|
|
:- type decl_answer(T)
|
|
---> truth_value(T, decl_truth)
|
|
% The oracle knows the truth value of this node.
|
|
|
|
; suspicious_subterm(T, arg_pos, term_path, how_track_subterm,
|
|
should_assert_invalid)
|
|
% The oracle does not say anything about the truth value,
|
|
% but is suspicious of the subterm at the given term_path
|
|
% and arg_pos.
|
|
|
|
; ignore(T)
|
|
% This node should be ignored. It cannot contain a bug
|
|
% but its children may or may not contain a bug.
|
|
|
|
; skip(T).
|
|
% The oracle has deferred answering this question.
|
|
|
|
% Answers that are known by the oracle without having to consult the
|
|
% user, such as answers stored in the knowledge base or answers about
|
|
% trusted predicates. mdb.declarative_oracle.answer_known/3 returns
|
|
% answers of this subtype.
|
|
%
|
|
:- inst known_answer
|
|
---> truth_value(ground, ground)
|
|
; ignore(ground).
|
|
|
|
% The evidence that a certain node is a bug. This consists of the
|
|
% smallest set of questions whose answers are sufficient to
|
|
% diagnose that bug.
|
|
%
|
|
:- type decl_evidence(T) == list(decl_question(T)).
|
|
|
|
% Extract the EDT node from a question.
|
|
%
|
|
:- func get_decl_question_node(decl_question(T)) = T.
|
|
|
|
% Get the atom the question relates to.
|
|
%
|
|
:- func get_decl_question_atom(decl_question(_)) = 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 :: maybe(io_action_range)
|
|
).
|
|
|
|
:- type decl_exception == term_rep.
|
|
|
|
% The diagnoser eventually responds with a value of this type
|
|
% after it is called.
|
|
%
|
|
:- type diagnoser_response(R)
|
|
---> bug_found(event_number)
|
|
% There was a bug found and confirmed. The event number
|
|
% is for a call port (inadmissible call), an exit port
|
|
% (incorrect contour), a fail port (partially uncovered atom),
|
|
% or an exception port (unhandled exception).
|
|
|
|
; symptom_found(event_number)
|
|
% There was another symptom of incorrect behaviour found;
|
|
% this symptom will be closer, in a sense, to the location of
|
|
% a bug.
|
|
|
|
; no_bug_found
|
|
% There was no symptom found, or the diagnoser aborted
|
|
% before finding a bug.
|
|
|
|
; require_subtree(
|
|
% The analyser requires the back end to reproduce part
|
|
% of the annotated trace, with a greater depth bound.
|
|
|
|
% The event number and sequence number are for the final event
|
|
% required (the first event required is the call event with
|
|
% the same sequence number).
|
|
require_subtree_final_event :: event_number,
|
|
require_subtree_seqno :: sequence_number,
|
|
|
|
% The node preceding the call node. This is needed so the
|
|
% root of the new tree has the correct preceding node.
|
|
require_subtree_call_preceding_node :: R,
|
|
|
|
% The maximum depth to build the new subtree to.
|
|
require_subtree_max_depth :: int
|
|
)
|
|
|
|
; require_supertree(event_number, sequence_number).
|
|
% The analyser requires events before and after the current set
|
|
% of materialized events to be generated. The given event should be
|
|
% the topmost final event of the currently materialized portion
|
|
% of the EDT.
|
|
|
|
:- type diagnoser_state(R).
|
|
|
|
% diagnoser_state_init(InputStream, OutputStream, Browser,
|
|
% HelpSystem, Diagnoser):
|
|
%
|
|
% Initialise a new diagnoser with the given properties.
|
|
%
|
|
:- pred diagnoser_state_init(io.input_stream::in,
|
|
io.output_stream::in, browser_info.browser_persistent_state::in,
|
|
help.system::in, diagnoser_state(R)::out) is det.
|
|
|
|
:- pred diagnosis(S::in, analysis_type(edt_node(R))::in,
|
|
diagnoser_response(R)::out,
|
|
diagnoser_state(R)::in, diagnoser_state(R)::out,
|
|
browser_info.browser_persistent_state::in,
|
|
browser_info.browser_persistent_state::out,
|
|
io::di, io::uo) is cc_multi <= annotated_trace(S, R).
|
|
|
|
:- pred unravel_decl_atom(some_decl_atom::in, trace_atom::out,
|
|
maybe(io_action_range)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The diagnoser generates exceptions of the following type.
|
|
%
|
|
:- type diagnoser_exception
|
|
---> internal_error(
|
|
string, % predicate/function name
|
|
string % error message
|
|
)
|
|
; io_error(
|
|
string, % predicate/function name
|
|
string % error message
|
|
)
|
|
; unimplemented_feature(
|
|
string % feature that is NYI
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdb.declarative_edt.
|
|
:- import_module mdb.declarative_oracle.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.rtti_access.
|
|
|
|
:- import_module bool.
|
|
:- import_module exception.
|
|
:- import_module int.
|
|
:- import_module string.
|
|
:- import_module univ.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
unravel_decl_atom(DeclAtom, TraceAtom, MaybeIoActions) :-
|
|
(
|
|
DeclAtom = init(init_decl_atom(TraceAtom)),
|
|
MaybeIoActions = no
|
|
;
|
|
DeclAtom = final(final_decl_atom(TraceAtom, MaybeIoActions))
|
|
).
|
|
|
|
get_decl_question_node(wrong_answer(Node, _, _)) = Node.
|
|
get_decl_question_node(missing_answer(Node, _, _)) = Node.
|
|
get_decl_question_node(unexpected_exception(Node, _, _)) = Node.
|
|
|
|
get_decl_question_atom(wrong_answer(_, _, final_decl_atom(Atom, _))) = Atom.
|
|
get_decl_question_atom(missing_answer(_, init_decl_atom(Atom), _)) = Atom.
|
|
get_decl_question_atom(unexpected_exception(_, init_decl_atom(Atom), _)) =
|
|
Atom.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type diagnoser_state(R)
|
|
---> diagnoser(
|
|
analyser_state :: analyser_state(edt_node(R)),
|
|
oracle_state :: oracle_state,
|
|
|
|
% The diagnoser state before the previous oracle answer
|
|
% (if there oracle has given any answers yet).
|
|
previous_diagnoser :: maybe(diagnoser_state(R))
|
|
).
|
|
|
|
diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
|
|
analyser_state_init(Analyser),
|
|
oracle_state_init(InStr, OutStr, Browser, HelpSystem, Oracle),
|
|
Diagnoser = diagnoser(Analyser, Oracle, no).
|
|
|
|
:- pred push_diagnoser(diagnoser_state(R)::in, diagnoser_state(R)::out) is det.
|
|
|
|
push_diagnoser(!Diagnoser) :-
|
|
!:Diagnoser = !.Diagnoser ^ previous_diagnoser := yes(!.Diagnoser).
|
|
|
|
:- pred pop_diagnoser(diagnoser_state(R)::in, diagnoser_state(R)::out)
|
|
is semidet.
|
|
|
|
pop_diagnoser(!Diagnoser) :-
|
|
LatestOracle = !.Diagnoser ^ oracle_state,
|
|
!.Diagnoser ^ previous_diagnoser = yes(!:Diagnoser),
|
|
LastPushedOracle = !.Diagnoser ^ oracle_state,
|
|
update_revised_knowledge_base(LastPushedOracle, LatestOracle, Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle.
|
|
|
|
diagnosis(Store, AnalysisType, Response, !Diagnoser, !Browser, !IO) :-
|
|
mdb.declarative_oracle.set_browser_state(!.Browser, !.Diagnoser ^
|
|
oracle_state, Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
|
|
try_io(diagnosis_2(Store, AnalysisType, !.Diagnoser), Result, !IO),
|
|
(
|
|
Result = succeeded({Response, !:Diagnoser})
|
|
;
|
|
Result = exception(UnivException),
|
|
( univ_to_type(UnivException, DiagnoserException) ->
|
|
handle_diagnoser_exception(DiagnoserException, Response,
|
|
!Diagnoser, !IO)
|
|
;
|
|
rethrow(Result)
|
|
)
|
|
),
|
|
!:Browser = mdb.declarative_oracle.get_browser_state(
|
|
!.Diagnoser ^ oracle_state).
|
|
|
|
:- pred diagnosis_2(S::in, analysis_type(edt_node(R))::in,
|
|
diagnoser_state(R)::in,
|
|
{diagnoser_response(R), diagnoser_state(R)}::out,
|
|
io::di, io::uo) is cc_multi <= annotated_trace(S, R).
|
|
|
|
diagnosis_2(Store, AnalysisType, Diagnoser0, {Response, Diagnoser}, !IO) :-
|
|
Analyser0 = Diagnoser0 ^ analyser_state,
|
|
start_or_resume_analysis(wrap(Store), Diagnoser0 ^ oracle_state,
|
|
AnalysisType, AnalyserResponse, Analyser0, Analyser),
|
|
Diagnoser1 = Diagnoser0 ^ analyser_state := Analyser,
|
|
debug_analyser_state(Analyser, MaybeOrigin),
|
|
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
|
|
Response, Diagnoser1, Diagnoser, !IO).
|
|
|
|
:- pred handle_analyser_response(S::in, analyser_response(edt_node(R))::in,
|
|
maybe(subterm_origin(edt_node(R)))::in, diagnoser_response(R)::out,
|
|
diagnoser_state(R)::in, diagnoser_state(R)::out,
|
|
io::di, io::uo) is cc_multi <= annotated_trace(S, R).
|
|
|
|
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
|
|
DiagnoserResponse, !Diagnoser, !IO) :-
|
|
(
|
|
AnalyserResponse = analyser_response_no_suspects,
|
|
DiagnoserResponse = no_bug_found,
|
|
io.write_string("No bug found.\n", !IO)
|
|
;
|
|
AnalyserResponse = analyser_response_bug_found(Bug, Evidence),
|
|
confirm_bug(Store, Bug, Evidence, DiagnoserResponse, !Diagnoser, !IO)
|
|
;
|
|
AnalyserResponse = analyser_response_oracle_question(Question),
|
|
Oracle0 = !.Diagnoser ^ oracle_state,
|
|
debug_origin(Flag, !IO),
|
|
(
|
|
MaybeOrigin = yes(Origin),
|
|
Flag > 0
|
|
->
|
|
io.write_string("Origin: ", !IO),
|
|
write_origin(wrap(Store), Origin, !IO),
|
|
io.nl(!IO)
|
|
;
|
|
true
|
|
),
|
|
query_oracle(Question, OracleResponse, FromUser, Oracle0, Oracle, !IO),
|
|
(
|
|
FromUser = yes,
|
|
oracle_response_undoable(OracleResponse)
|
|
->
|
|
push_diagnoser(!Diagnoser)
|
|
;
|
|
true
|
|
),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
|
|
handle_oracle_response(Store, OracleResponse, DiagnoserResponse,
|
|
!Diagnoser, !IO)
|
|
;
|
|
AnalyserResponse = analyser_response_require_explicit_subtree(Node),
|
|
edt_subtree_details(Store, Node, Event, Seqno, CallPreceding),
|
|
( trace_implicit_tree_info(wrap(Store), Node, ImplicitTreeInfo) ->
|
|
ImplicitTreeInfo = implicit_tree_info(IdealDepth)
|
|
;
|
|
throw(internal_error("handle_analyser_response",
|
|
"subtree requested for node which is not an implicit root"))
|
|
),
|
|
DiagnoserResponse = require_subtree(Event, Seqno, CallPreceding,
|
|
IdealDepth)
|
|
;
|
|
AnalyserResponse = analyser_response_require_explicit_supertree(Node),
|
|
edt_subtree_details(Store, Node, Event, Seqno, _),
|
|
DiagnoserResponse = require_supertree(Event, Seqno)
|
|
;
|
|
AnalyserResponse = analyser_response_revise(Question),
|
|
Oracle0 = !.Diagnoser ^ oracle_state,
|
|
revise_oracle(Question, Oracle0, Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
|
|
handle_analyser_response(Store,
|
|
analyser_response_oracle_question(Question), no, DiagnoserResponse,
|
|
!Diagnoser, !IO)
|
|
).
|
|
|
|
:- pred handle_oracle_response(S::in, oracle_response(edt_node(R))::in,
|
|
diagnoser_response(R)::out, diagnoser_state(R)::in,
|
|
diagnoser_state(R)::out, io::di, io::uo) is cc_multi
|
|
<= annotated_trace(S, R).
|
|
|
|
handle_oracle_response(Store, OracleResponse, DiagnoserResponse, !Diagnoser,
|
|
!IO) :-
|
|
(
|
|
OracleResponse = oracle_response_answer(Answer),
|
|
Analyser0 = !.Diagnoser ^ analyser_state,
|
|
continue_analysis(wrap(Store), !.Diagnoser ^ oracle_state, Answer,
|
|
AnalyserResponse, Analyser0, Analyser),
|
|
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
|
|
debug_analyser_state(Analyser, MaybeOrigin),
|
|
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
|
|
DiagnoserResponse, !Diagnoser, !IO)
|
|
;
|
|
OracleResponse = oracle_response_show_info(OutStream),
|
|
Analyser = !.Diagnoser ^ analyser_state,
|
|
show_info(wrap(Store), OutStream, Analyser, !IO),
|
|
( reask_last_question(wrap(Store), Analyser, AnalyserResponse0) ->
|
|
AnalyserResponse = AnalyserResponse0
|
|
;
|
|
throw(internal_error("handle_oracle_response",
|
|
"no last question when got show_info request"))
|
|
),
|
|
debug_analyser_state(Analyser, MaybeOrigin),
|
|
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
|
|
DiagnoserResponse, !Diagnoser, !IO)
|
|
;
|
|
OracleResponse = oracle_response_change_search(Mode),
|
|
Analyser0 = !.Diagnoser ^ analyser_state,
|
|
Oracle = !.Diagnoser ^ oracle_state,
|
|
change_search_mode(wrap(Store), Oracle, Mode, Analyser0, Analyser,
|
|
AnalyserResponse),
|
|
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
|
|
debug_analyser_state(Analyser, MaybeOrigin),
|
|
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
|
|
DiagnoserResponse, !Diagnoser, !IO)
|
|
;
|
|
OracleResponse = oracle_response_undo,
|
|
( pop_diagnoser(!.Diagnoser, PoppedDiagnoser) ->
|
|
!:Diagnoser = PoppedDiagnoser
|
|
;
|
|
OutStream = mdb.declarative_oracle.get_user_output_stream(
|
|
!.Diagnoser ^ oracle_state),
|
|
io.write_string(OutStream, "Undo stack empty.\n", !IO)
|
|
),
|
|
(
|
|
reask_last_question(wrap(Store), !.Diagnoser ^ analyser_state,
|
|
AnalyserResponse0)
|
|
->
|
|
AnalyserResponse = AnalyserResponse0
|
|
;
|
|
throw(internal_error("handle_oracle_response",
|
|
"no last question when got undo request"))
|
|
),
|
|
debug_analyser_state(!.Diagnoser ^ analyser_state, MaybeOrigin),
|
|
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
|
|
DiagnoserResponse, !Diagnoser, !IO)
|
|
;
|
|
OracleResponse = oracle_response_exit_diagnosis(Node),
|
|
edt_subtree_details(Store, Node, Event, _, _),
|
|
DiagnoserResponse = symptom_found(Event)
|
|
;
|
|
OracleResponse = oracle_response_abort_diagnosis,
|
|
DiagnoserResponse = no_bug_found,
|
|
io.write_string("Diagnosis aborted.\n", !IO)
|
|
).
|
|
|
|
:- pred confirm_bug(S::in, decl_bug::in, decl_evidence(T)::in,
|
|
diagnoser_response(R)::out, diagnoser_state(R)::in,
|
|
diagnoser_state(R)::out, io::di, io::uo) is cc_multi
|
|
<= annotated_trace(S, R).
|
|
|
|
confirm_bug(Store, Bug, Evidence, Response, !Diagnoser, !IO) :-
|
|
Oracle0 = !.Diagnoser ^ oracle_state,
|
|
oracle_confirm_bug(Bug, Evidence, Confirmation, Oracle0, Oracle, !IO),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
|
|
(
|
|
Confirmation = confirm_bug,
|
|
decl_bug_get_event_number(Bug, Event),
|
|
Response = bug_found(Event)
|
|
;
|
|
Confirmation = overrule_bug,
|
|
overrule_bug(Store, Response, !Diagnoser, !IO)
|
|
;
|
|
Confirmation = abort_diagnosis,
|
|
Response = no_bug_found
|
|
).
|
|
|
|
:- pred overrule_bug(S::in, diagnoser_response(R)::out, diagnoser_state(R)::in,
|
|
diagnoser_state(R)::out, io::di, io::uo) is cc_multi
|
|
<= annotated_trace(S, R).
|
|
|
|
overrule_bug(Store, Response, Diagnoser0, Diagnoser, !IO) :-
|
|
Analyser0 = Diagnoser0 ^ analyser_state,
|
|
revise_analysis(wrap(Store), AnalyserResponse, Analyser0, Analyser),
|
|
Diagnoser1 = Diagnoser0 ^ analyser_state := Analyser,
|
|
debug_analyser_state(Analyser, MaybeOrigin),
|
|
handle_analyser_response(Store, AnalyserResponse, MaybeOrigin,
|
|
Response, Diagnoser1, Diagnoser, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Export a monomorphic version of diagnosis_state_init/4, to
|
|
% make it easier to call from C code.
|
|
%
|
|
:- pred diagnoser_state_init_store(io.input_stream::in, io.output_stream::in,
|
|
browser_info.browser_persistent_state::in, help.system::in,
|
|
diagnoser_state(trace_node_id)::out) is det.
|
|
|
|
:- pragma foreign_export("C", diagnoser_state_init_store(in, in, in, in, out),
|
|
"MR_DD_decl_diagnosis_state_init").
|
|
|
|
diagnoser_state_init_store(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
|
|
diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser).
|
|
|
|
% Set the testing flag of the user_state in the given diagnoser.
|
|
%
|
|
:- pred set_diagnoser_testing_flag(bool::in,
|
|
diagnoser_state(trace_node_id)::in,
|
|
diagnoser_state(trace_node_id)::out) is det.
|
|
|
|
:- pragma foreign_export("C", set_diagnoser_testing_flag(in, in, out),
|
|
"MR_DD_decl_set_diagnoser_testing_flag").
|
|
|
|
set_diagnoser_testing_flag(Testing, !Diagnoser) :-
|
|
Oracle0 = !.Diagnoser ^ oracle_state,
|
|
set_oracle_testing_flag(Testing, Oracle0, Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle.
|
|
|
|
:- pred set_fallback_search_mode(trace_node_store::in,
|
|
mdb.declarative_analyser.search_mode::in,
|
|
diagnoser_state(trace_node_id)::in,
|
|
diagnoser_state(trace_node_id)::out) is det.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.set_fallback_search_mode(in, in, in, out),
|
|
"MR_DD_decl_set_fallback_search_mode").
|
|
|
|
set_fallback_search_mode(Store, SearchMode, !Diagnoser) :-
|
|
Analyser0 = !.Diagnoser ^ analyser_state,
|
|
mdb.declarative_analyser.set_fallback_search_mode(wrap(Store),
|
|
SearchMode, Analyser0, Analyser),
|
|
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser.
|
|
|
|
:- pred reset_knowledge_base(
|
|
diagnoser_state(trace_node_id)::in,
|
|
diagnoser_state(trace_node_id)::out) is det.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.reset_knowledge_base(in, out),
|
|
"MR_DD_decl_reset_knowledge_base").
|
|
|
|
reset_knowledge_base(!Diagnoser) :-
|
|
Oracle0 = !.Diagnoser ^ oracle_state,
|
|
reset_oracle_knowledge_base(Oracle0, Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle.
|
|
|
|
:- func top_down_search_mode = mdb.declarative_analyser.search_mode.
|
|
|
|
top_down_search_mode = mdb.declarative_analyser.top_down_search_mode.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.top_down_search_mode = out,
|
|
"MR_DD_decl_top_down_search_mode").
|
|
|
|
:- func divide_and_query_search_mode = mdb.declarative_analyser.search_mode.
|
|
|
|
divide_and_query_search_mode =
|
|
mdb.declarative_analyser.divide_and_query_search_mode.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.divide_and_query_search_mode = out,
|
|
"MR_DD_decl_divide_and_query_search_mode").
|
|
|
|
:- func suspicion_divide_and_query_search_mode =
|
|
mdb.declarative_analyser.search_mode.
|
|
|
|
suspicion_divide_and_query_search_mode =
|
|
mdb.declarative_analyser.suspicion_divide_and_query_search_mode.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.suspicion_divide_and_query_search_mode = out,
|
|
"MR_DD_decl_suspicion_divide_and_query_search_mode").
|
|
|
|
% Export a monomorphic version of diagnosis/10 that passes a newly
|
|
% materialized tree for use with the C backend code.
|
|
%
|
|
:- pred diagnosis_new_tree(trace_node_store::in, trace_node_id::in,
|
|
diagnoser_response(trace_node_id)::out,
|
|
diagnoser_state(trace_node_id)::in, diagnoser_state(trace_node_id)::out,
|
|
browser_info.browser_persistent_state::in,
|
|
browser_info.browser_persistent_state::out, io::di, io::uo) is cc_multi.
|
|
|
|
:- pragma foreign_export("C",
|
|
diagnosis_new_tree(in, in, out, in, out, in, out, di, uo),
|
|
"MR_DD_decl_diagnosis_new_tree").
|
|
|
|
diagnosis_new_tree(Store, Node, Response, !State, !Browser, !IO) :-
|
|
diagnosis(Store, new_tree(dynamic(Node)), Response, !State, !Browser, !IO).
|
|
|
|
% Export a monomorphic version of diagnosis/10 that requests the
|
|
% continuation of a previously suspended declarative debugging session.
|
|
%
|
|
:- pred diagnosis_resume_previous(trace_node_store::in,
|
|
diagnoser_response(trace_node_id)::out,
|
|
diagnoser_state(trace_node_id)::in, diagnoser_state(trace_node_id)::out,
|
|
browser_info.browser_persistent_state::in,
|
|
browser_info.browser_persistent_state::out, io::di, io::uo) is cc_multi.
|
|
|
|
:- pragma foreign_export("C",
|
|
diagnosis_resume_previous(in, out, in, out, in, out, di, uo),
|
|
"MR_DD_decl_diagnosis_resume_previous").
|
|
|
|
diagnosis_resume_previous(Store, Response, !State, !Browser, !IO) :-
|
|
diagnosis(Store, resume_previous, Response, !State, !Browser, !IO).
|
|
|
|
% Export some predicates so that C code can interpret the
|
|
% diagnoser response.
|
|
%
|
|
:- pred diagnoser_bug_found(diagnoser_response(trace_node_id)::in,
|
|
event_number::out) is semidet.
|
|
|
|
:- pragma foreign_export("C", diagnoser_bug_found(in, out),
|
|
"MR_DD_diagnoser_bug_found").
|
|
|
|
diagnoser_bug_found(bug_found(Event), Event).
|
|
|
|
:- pred diagnoser_symptom_found(diagnoser_response(trace_node_id)::in,
|
|
event_number::out) is semidet.
|
|
|
|
:- pragma foreign_export("C", diagnoser_symptom_found(in, out),
|
|
"MR_DD_diagnoser_symptom_found").
|
|
|
|
diagnoser_symptom_found(symptom_found(Event), Event).
|
|
|
|
:- pred diagnoser_no_bug_found(diagnoser_response(trace_node_id)::in)
|
|
is semidet.
|
|
|
|
:- pragma foreign_export("C", diagnoser_no_bug_found(in),
|
|
"MR_DD_diagnoser_no_bug_found").
|
|
|
|
diagnoser_no_bug_found(no_bug_found).
|
|
|
|
:- pred diagnoser_require_subtree(diagnoser_response(trace_node_id)::in,
|
|
event_number::out, sequence_number::out, trace_node_id::out, int::out)
|
|
is semidet.
|
|
|
|
:- pragma foreign_export("C",
|
|
diagnoser_require_subtree(in, out, out, out, out),
|
|
"MR_DD_diagnoser_require_subtree").
|
|
|
|
diagnoser_require_subtree(require_subtree(Event, SeqNo, CallPreceding,
|
|
MaxDepth), Event, SeqNo, CallPreceding, MaxDepth).
|
|
|
|
:- pred diagnoser_require_supertree(diagnoser_response(trace_node_id)::in,
|
|
event_number::out, sequence_number::out) is semidet.
|
|
|
|
:- pragma foreign_export("C",
|
|
diagnoser_require_supertree(in, out, out),
|
|
"MR_DD_diagnoser_require_supertree").
|
|
|
|
diagnoser_require_supertree(require_supertree(Event, SeqNo), Event, SeqNo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Adds a trusted module to the given diagnoser.
|
|
%
|
|
:- pred add_trusted_module(string::in, diagnoser_state(trace_node_id)::in,
|
|
diagnoser_state(trace_node_id)::out) is det.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.add_trusted_module(in, in, out),
|
|
"MR_DD_decl_add_trusted_module").
|
|
|
|
add_trusted_module(ModuleName, Diagnoser0, Diagnoser) :-
|
|
SymModuleName = string_to_sym_name(ModuleName),
|
|
add_trusted_module(SymModuleName, Diagnoser0 ^ oracle_state, Oracle),
|
|
Diagnoser = Diagnoser0 ^ oracle_state := Oracle.
|
|
|
|
% Adds a trusted predicate/function to the given diagnoser.
|
|
%
|
|
:- pred add_trusted_pred_or_func(proc_layout::in,
|
|
diagnoser_state(trace_node_id)::in,
|
|
diagnoser_state(trace_node_id)::out) is det.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.add_trusted_pred_or_func(in, in, out),
|
|
"MR_DD_decl_add_trusted_pred_or_func").
|
|
|
|
add_trusted_pred_or_func(ProcLayout, !Diagnoser) :-
|
|
add_trusted_pred_or_func(ProcLayout, !.Diagnoser ^ oracle_state, Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle.
|
|
|
|
:- pred trust_standard_library(diagnoser_state(trace_node_id)::in,
|
|
diagnoser_state(trace_node_id)::out) is det.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.trust_standard_library(in, out),
|
|
"MR_DD_decl_trust_standard_library").
|
|
|
|
trust_standard_library(!Diagnoser) :-
|
|
declarative_oracle.trust_standard_library(!.Diagnoser ^ oracle_state,
|
|
Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle.
|
|
|
|
:- pred remove_trusted(int::in, diagnoser_state(trace_node_id)::in,
|
|
diagnoser_state(trace_node_id)::out) is semidet.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.remove_trusted(in, in, out),
|
|
"MR_DD_decl_remove_trusted").
|
|
|
|
remove_trusted(N, !Diagnoser) :-
|
|
remove_trusted(N, !.Diagnoser ^ oracle_state, Oracle),
|
|
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle.
|
|
|
|
% get_trusted_list(Diagnoser, MDBCommandFormat, String).
|
|
% Return a string listing the trusted objects for Diagnoser.
|
|
% If MDBCommandFormat is true then returns the list so that it can be
|
|
% run as a series of mdb `trust' commands. Otherwise returns them
|
|
% in a format suitable for display only.
|
|
%
|
|
:- pred get_trusted_list(diagnoser_state(trace_node_id)::in, bool::in,
|
|
string::out) is det.
|
|
|
|
:- pragma foreign_export("C",
|
|
mdb.declarative_debugger.get_trusted_list(in, in, out),
|
|
"MR_DD_decl_get_trusted_list").
|
|
|
|
get_trusted_list(Diagnoser, MDBCommandFormat, List) :-
|
|
get_trusted_list(Diagnoser ^ oracle_state, MDBCommandFormat, List).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred handle_diagnoser_exception(diagnoser_exception::in,
|
|
diagnoser_response(R)::out, diagnoser_state(R)::in,
|
|
diagnoser_state(R)::out, io::di, io::uo) is det.
|
|
|
|
handle_diagnoser_exception(internal_error(Loc, Msg), Response, !Diagnoser,
|
|
!IO) :-
|
|
io.stderr_stream(StdErr, !IO),
|
|
io.write_string(StdErr, "An internal error has occurred; " ++
|
|
"diagnosis will be aborted. Debugging\n" ++
|
|
"message follows:\n" ++ Loc ++ ": " ++ Msg ++ "\n" ++
|
|
"Please report bugs to mercury-bugs@cs.mu.oz.au.\n", !IO),
|
|
% Reset the analyser, in case it was left in an inconsistent state.
|
|
reset_analyser(!.Diagnoser ^ analyser_state, Analyser),
|
|
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
|
|
Response = no_bug_found.
|
|
|
|
handle_diagnoser_exception(io_error(Loc, Msg), Response, !Diagnoser, !IO) :-
|
|
io.stderr_stream(StdErr, !IO),
|
|
io.write_string(StdErr, "I/O error: " ++ Loc ++ ": " ++ Msg ++ ".\n" ++
|
|
"Diagnosis will be aborted.\n", !IO),
|
|
% Reset the analyser, in case it was left in an inconsistent state.
|
|
reset_analyser(!.Diagnoser ^ analyser_state, Analyser),
|
|
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
|
|
Response = no_bug_found.
|
|
|
|
handle_diagnoser_exception(unimplemented_feature(Feature), Response,
|
|
!Diagnoser, !IO) :-
|
|
io.write_string("Sorry, the diagnosis cannot continue because " ++
|
|
"it requires support for\n" ++
|
|
"the following: " ++ Feature ++ ".\n" ++
|
|
"The debugger is a work in progress, and this is not " ++
|
|
"supported in the\ncurrent version.\n", !IO),
|
|
% Reset the analyser, in case it was left in an inconsistent state.
|
|
reset_analyser(!.Diagnoser ^ analyser_state, Analyser),
|
|
!:Diagnoser = !.Diagnoser ^ analyser_state := Analyser,
|
|
Response = no_bug_found.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred decl_bug_get_event_number(decl_bug::in, event_number::out) is det.
|
|
|
|
decl_bug_get_event_number(e_bug(EBug), Event) :-
|
|
(
|
|
EBug = incorrect_contour(_, _, _, Event)
|
|
;
|
|
EBug = partially_uncovered_atom(_, Event)
|
|
;
|
|
EBug = unhandled_exception(_, _, Event)
|
|
).
|
|
decl_bug_get_event_number(i_bug(IBug), Event) :-
|
|
IBug = inadmissible_call(_, _, _, Event).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred write_origin(wrap(S)::in, subterm_origin(edt_node(R))::in,
|
|
io::di, io::uo) is det <= annotated_trace(S, R).
|
|
|
|
write_origin(wrap(Store), Origin, !IO) :-
|
|
( Origin = origin_output(dynamic(NodeId), ArgPos, TermPath) ->
|
|
exit_node_from_id(Store, NodeId, ExitNode),
|
|
ProcLayout = get_proc_layout_from_label_layout(ExitNode ^ exit_label),
|
|
ProcLabel = get_proc_label_from_layout(ProcLayout),
|
|
ProcName = get_proc_name(ProcLabel),
|
|
io.write_string("output(", !IO),
|
|
io.write_string(ProcName, !IO),
|
|
io.write_string(", ", !IO),
|
|
io.write(ArgPos, !IO),
|
|
io.write_string(", ", !IO),
|
|
io.write(TermPath, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
io.write(Origin, !IO)
|
|
).
|
|
|
|
:- pragma foreign_code("C",
|
|
"
|
|
|
|
/*
|
|
** The declarative debugger will print diagnostic information about the origins
|
|
** computed by dependency tracking if this flag has a positive value.
|
|
*/
|
|
|
|
int MR_DD_debug_origin = 0;
|
|
|
|
").
|
|
|
|
:- pragma foreign_decl("C",
|
|
"
|
|
extern int MR_DD_debug_origin;
|
|
").
|
|
|
|
:- pred debug_origin(int::out, io::di, io::uo) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
debug_origin(Flag::out, IO0::di, IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io],
|
|
"
|
|
Flag = MR_DD_debug_origin;
|
|
IO = IO0;
|
|
").
|
|
debug_origin(_, !IO) :-
|
|
private_builtin.sorry("declarative_debugger.debug_origin").
|