[m-rev.] diff: avoid unifying questions in the declarative debugger
Mark Brown
dougl at cs.mu.OZ.AU
Tue Apr 30 17:05:06 AEST 2002
Hi,
The following is a step towards supporting declarative debugging of
higher order code. I'm going to commit this now, because I need to in
order to test the next part of the change which I am currently working
on. Any review comments would still be most welcome, though.
Cheers,
Mark.
Estimated hours taken: 24
Branches: main
Change the definitions of decl_question and decl_answer in the declarative
debugger. Each question now contains a reference to the EDT node that
generated the question, and each answer contains the reference from the
question it applies to. Previously, the answers referred to the questions
themselves.
This change means that the analyser no longer needs to unify questions
to determine what to do with an answer. The reason we need to avoid
this is that questions may contain higher order terms, and these will
cause a runtime abort if unified. Also, by using our new approach it is
possible to simplify the analyser in a number of ways.
This is the first part of a larger change to support declarative debugging
of higher order code. The main task remaining is to avoid using comparison
of questions in the oracle. But this will require a different approach
than the one taken here, because the oracle is interested in the value of
the question, not just the identity of it.
browser/declarative_*.m:
Propagate the effect of the changes to decl_question and decl_answer.
Fix some comments which are out of date, and elaborate on some others
which don't give enough information.
browser/declarative_analyser.m:
Remove the definition of the suspect/1 type. Its main purpose
was to associate a question with its EDT node, but this is no
longer required. Update the places that used suspect(T) to instead
use either decl_question(T) or just T, as appropriate.
Separate out the code which calculates the analyser response. This
requires adding some fields to the analyser state, but this in turn
means that the processing of answers can be greatly simplified.
This should also make implementing more sophisticated search
strategies possible, which is something we want to do in the
future.
browser/declarative_debugger.m:
Make the changes to the two exported types. Export a function which
extracts the EDT node from the question.
browser/declarative_oracle.m:
browser/declarative_user.m:
Add a type parameter to oracle_response and user_response, similarly
to the change to the other types.
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/dependency2.exp:
tests/debugger/declarative/dependency2.inp:
tests/debugger/declarative/dependency2.m:
A test case, which tests for a bug I encountered when developing
this change.
tests/debugger/declarative/family.exp:
Because of the change to the way the analyser matches up the answers
with the EDT, a different but equally valid instance of the same bug
is chosen in part of this test case. Update the expected output to
reflect this.
Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.10
diff -u -r1.10 declarative_analyser.m
--- browser/declarative_analyser.m 24 Apr 2002 17:43:56 -0000 1.10
+++ browser/declarative_analyser.m 30 Apr 2002 06:56:54 -0000
@@ -38,7 +38,7 @@
% Gives the root node of an EDT.
%
- pred edt_root_question(S, T, decl_question),
+ pred edt_root_question(S, T, decl_question(T)),
mode edt_root_question(in, in, out) is det,
% If this node is an e_bug, then find the bug.
@@ -106,7 +106,7 @@
% The analyser desires answers to any of a list
% of queries.
%
- ; oracle_queries(list(decl_question))
+ ; oracle_queries(list(decl_question(T)))
% The analyser requires the given implicit sub-tree
% to be made explicit.
@@ -129,7 +129,7 @@
% Continue analysis after the oracle has responded with some
% answers.
%
-:- pred continue_analysis(S, list(decl_answer), analyser_response(T),
+:- 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.
@@ -144,9 +144,17 @@
:- implementation.
:- import_module std_util, bool, require.
- % The analyser state represents a set of suspects. We
- % consider one incorrect node at a time, and store its suspect
- % children.
+ % The analyser state records all of the information that needs
+ % to be remembered across multiple invocations of the analyser.
+ % This includes information about the current set of suspects
+ % in the EDT, that is, the smallest set of EDT nodes which,
+ % together with the prime suspect, is known to contain at least
+ % one bug.
+ %
+ % Note that sometimes we represent a suspect by the question
+ % generated from it. We can extract the actual suspect from
+ % this question. We do this in order to avoid recreating the
+ % question repreatedly, for each call to the oracle.
%
:- type analyser_state(T)
---> analyser(
@@ -154,15 +162,31 @@
% This is the most recent node that the
% oracle has said is incorrect.
%
- maybe_prime :: maybe(prime_suspect(T)),
+ maybe_prime :: maybe(prime_suspect(T)),
- % Current suspects.
+ % Previous prime suspects.
%
- suspects :: list(suspect(T)),
+ previous :: list(T),
- % Previous prime suspects.
+ % Nodes in the EDT which are the roots of
+ % subtrees which contain suspects. Every
+ % suspect in the EDT is either in one of
+ % these lists, or is the descendent of a
+ % node in one of these lists.
+ %
+ % Nodes whose descendents are suspects
+ % which are represented implicitly in the
+ % EDT are in the second list.
%
- previous :: list(suspect(T)),
+ suspect_roots :: list(decl_question(T)),
+ suspect_parents :: list(T),
+
+ % Suspects which, for whatever reason, are
+ % deemed to be particularly suspicious.
+ % For example, the node which is the origin
+ % of a suspicious subterm.
+ %
+ priority_suspects :: list(decl_question(T)),
% This field is present only to make it easier
% to debug the dependency tracking algorithm;
@@ -170,259 +194,176 @@
% the invocation of that algorithm on the last
% analysis step.
%
- debug_origin :: maybe(subterm_origin(T))
+ debug_origin :: maybe(subterm_origin(T))
).
-analyser_state_init(analyser(no, [], [], no)).
+analyser_state_init(analyser(no, [], [], [], [], no)).
debug_analyser_state(Analyser, Analyser ^ debug_origin).
start_analysis(Store, Tree, Response, Analyser0, Analyser) :-
- make_suspects(Store, [Tree], Suspects, Queries),
get_all_prime_suspects(Analyser0, OldPrimes),
- Analyser = analyser(no, Suspects, OldPrimes, no),
- Response = oracle_queries(Queries).
+ edt_root_question(Store, Tree, Question),
+ Analyser = analyser(no, OldPrimes, [Question], [], [], no),
+ decide_analyser_response(Store, Analyser, Response).
continue_analysis(Store, Answers, Response, Analyser0, Analyser) :-
- %
- % Check for suspicious subterms before anything else. The oracle
- % is unlikely to answer with one of these unless it thinks it is
- % particularly significant, which is why we check these first.
- %
- % After that check for incorrect suspects. Leave the correct
- % suspects until last, since these generally prune the search space
- % by the least amount.
- %
- Suspects = Analyser0 ^ suspects,
- (
- find_suspicious_subterm(Answers, Suspects,
- Suspect, ArgPos, TermPath)
- ->
- follow_suspicious_subterm(Store, Suspect, ArgPos, TermPath,
- Response, Analyser0, Analyser)
- ;
- find_incorrect_suspect(Answers, Suspects, Suspect)
- ->
- make_new_prime_suspect(Store, Suspect, Response,
- Analyser0, Analyser)
- ;
- remove_suspects(Store, Answers, Response,
- Analyser0, Analyser)
- ).
+ list__foldl(process_answer(Store), Answers, Analyser0, Analyser),
+ decide_analyser_response(Store, Analyser, Response).
- % Find an answer which is a suspicious subterm, and find the
- % suspect that corresponds to it, or else fail.
- %
-:- pred find_suspicious_subterm(list(decl_answer), list(suspect(T)),
- suspect(T), arg_pos, term_path).
-:- mode find_suspicious_subterm(in, in, out, out, out) is semidet.
-
-find_suspicious_subterm([Answer | Answers], Suspects, Suspect, ArgPos,
- TermPath) :-
- (
- Answer = suspicious_subterm(Question, ArgPos0, TermPath0),
- find_matching_suspects(Question, Suspects, [Match | _], _)
- ->
- Suspect = Match,
- ArgPos = ArgPos0,
- TermPath = TermPath0
- ;
- find_suspicious_subterm(Answers, Suspects, Suspect, ArgPos,
- TermPath)
- ).
+:- pred process_answer(S::in, decl_answer(T)::in, analyser_state(T)::in,
+ analyser_state(T)::out) is det <= mercury_edt(S, T).
-:- pred follow_suspicious_subterm(S, suspect(R), arg_pos, term_path,
- analyser_response(R), analyser_state(R), analyser_state(R))
- <= mercury_edt(S, R).
-:- mode follow_suspicious_subterm(in, in, in, in, out, in, out) is det.
+process_answer(Store, truth_value(Suspect, yes), Analyser0, Analyser) :-
+ assert_suspect_is_correct(Store, Suspect, Analyser0, Analyser).
-follow_suspicious_subterm(Store, Suspect, ArgPos, TermPath, Response,
- Analyser0, Analyser) :-
+process_answer(Store, truth_value(Suspect, no), Analyser0, Analyser) :-
+ assert_suspect_is_wrong(Store, Suspect, Analyser0, Analyser).
- Suspect = suspect(Tree, Query),
- edt_dependency(Store, Tree, ArgPos, TermPath, SubtermMode, Origin),
+process_answer(Store, Answer, Analyser0, Analyser) :-
+ Answer = suspicious_subterm(Suspect, ArgPos, TermPath),
+ edt_dependency(Store, Suspect, ArgPos, TermPath, SubtermMode, Origin),
%
% If the selected subterm has mode `in' then we infer that the node
% is correct, otherwise we infer that it is wrong.
%
(
SubtermMode = subterm_in,
- remove_suspects(Store, [truth_value(Query, yes)], Response0,
- Analyser0, Analyser1)
+ assert_suspect_is_correct(Store, Suspect, Analyser0, Analyser1)
;
SubtermMode = subterm_out,
- make_new_prime_suspect(Store, Suspect, Response0,
- Analyser0, Analyser1)
+ assert_suspect_is_wrong(Store, Suspect, Analyser0, Analyser1)
),
- Analyser = Analyser1 ^ debug_origin := yes(Origin),
+ Analyser2 = Analyser1 ^ debug_origin := yes(Origin),
+ %
+ % If the origin of the subterm was an output of one of the children,
+ % we flag that child as a priority suspect. At the moment, we only
+ % follow the suspicious subterm down one level, and we first make
+ % sure that the origin is one of the existing suspects. In future,
+ % we intend to implement more sophisticated search strategies which
+ % make more use of the term dependencies.
+ %
+ % If the origin of the subterm was an input of the parent, we can't
+ % do anything useful yet. This is because, since we step down one
+ % level at a time, the parent node is the prime suspect and is thus
+ % known to be wrong. Therefore we can't infer anything useful from
+ % a suspicious input.
+ %
(
- Origin = output(Node, _, _),
- Response0 = oracle_queries(_)
+ Origin = output(OriginSuspect, _, _),
+ some [S] (
+ list__member(S, Analyser2 ^ suspect_roots),
+ OriginSuspect = get_decl_question_node(S)
+ )
->
- %
- % Replace all of the queries with just the one which output
- % the subterm. We may wind up asking the full list later,
- % including this query, but the oracle should have the
- % previous answer available.
- %
- create_suspect(Store, Node, suspect(_, NodeQuery)),
- Response = oracle_queries([NodeQuery])
+ edt_root_question(Store, OriginSuspect, OriginQuestion),
+ Analyser = Analyser2 ^ priority_suspects := [OriginQuestion]
;
- Response = Response0
+ Analyser = Analyser2
).
- % Find an answer which is `no' and find the suspect that
- % corresponds to it from the given list, or else fail.
- %
-:- pred find_incorrect_suspect(list(decl_answer), list(suspect(T)),
- suspect(T)).
-:- mode find_incorrect_suspect(in, in, out) is semidet.
+%-----------------------------------------------------------------------------%
-find_incorrect_suspect([Answer | Answers], Suspects, Child) :-
- (
- Answer = truth_value(Question, no),
- find_matching_suspects(Question, Suspects, [Match | _], _)
- ->
- Match = Child
- ;
- find_incorrect_suspect(Answers, Suspects, Child)
- ).
+:- pred assert_suspect_is_correct(S::in, T::in, analyser_state(T)::in,
+ analyser_state(T)::out) is det <= mercury_edt(S, T).
- % Create a new prime suspect from the given suspect, which is
- % assumed to be incorrect.
- %
-:- pred make_new_prime_suspect(S::in, suspect(T)::in,
- analyser_response(T)::out, analyser_state(T)::in,
+assert_suspect_is_correct(_Store, Suspect, Analyser0, Analyser) :-
+ Suspects0 = Analyser0 ^ suspect_roots,
+ delete_suspect(Suspects0, Suspect, Suspects),
+ Analyser1 = Analyser0 ^ suspect_roots := Suspects,
+ PrioritySuspects0 = Analyser1 ^ priority_suspects,
+ delete_suspect(PrioritySuspects0, Suspect, PrioritySuspects),
+ Analyser = Analyser1 ^ priority_suspects := PrioritySuspects.
+
+:- pred assert_suspect_is_wrong(S::in, T::in, analyser_state(T)::in,
analyser_state(T)::out) is det <= mercury_edt(S, T).
-make_new_prime_suspect(Store, Suspect, Response,
- Analyser0, Analyser) :-
+assert_suspect_is_wrong(Store, Suspect, Analyser0, Analyser) :-
get_all_prime_suspects(Analyser0, OldPrimes),
- suspect_get_edt_node(Suspect, Tree),
(
- edt_children(Store, Tree, Children)
+ edt_children(Store, Suspect, Children)
->
create_prime_suspect(Suspect, Prime),
MaybePrime = yes(Prime),
- make_suspects(Store, Children, Suspects, Queries),
- (
- Queries = []
- ->
- edt_root_e_bug(Store, Tree, EBug),
- Response = bug_found(e_bug(EBug))
- ;
- Response = oracle_queries(Queries)
- )
+ list__map(edt_root_question(Store), Children, SuspectRoots),
+ SuspectParents = []
;
- % The real suspects cannot be found, so we
- % just use the empty list.
+ % The real suspects cannot be found, so we are
+ % going to need to request a subtree. In the
+ % meantime, we leave the prime suspect field empty.
+ % The root of the requested subtree will become the
+ % prime suspect when the analyser is next called.
%
- Suspects = [],
MaybePrime = no,
- Response = require_explicit(Tree)
+ SuspectRoots = [],
+ SuspectParents = [Suspect]
),
- Analyser = analyser(MaybePrime, Suspects, OldPrimes, no).
+ Analyser = analyser(MaybePrime, OldPrimes, SuspectRoots,
+ SuspectParents, [], no).
- % Make a list of previous prime suspects, and include the current
- % one if it exists.
- %
-:- pred get_all_prime_suspects(analyser_state(T), list(suspect(T))).
-:- mode get_all_prime_suspects(in, out) is det.
+:- pred decide_analyser_response(S::in, analyser_state(T)::in,
+ analyser_response(T)::out) is det <= mercury_edt(S, T).
-get_all_prime_suspects(Analyser, OldPrimes) :-
+decide_analyser_response(Store, Analyser, Response) :-
+ %
+ % If any subtrees need to be made explicit, then request this
+ % for the first one.
+ %
+ % Otherwise, check whether there are any suspects at all. If not,
+ % we may have found a bug.
+ %
+ % Otherwise, ask the oracle about the priority suspects and the
+ % ordinary suspects, in that order.
+ %
(
- Analyser ^ maybe_prime = yes(Prime)
+ Analyser ^ suspect_parents = [RequiredTree | _]
->
- prime_suspect_get_suspect(Prime, Suspect),
- OldPrimes = [Suspect | Analyser ^ previous]
+ Response = require_explicit(RequiredTree)
;
- OldPrimes = Analyser ^ previous
- ).
-
-:- pred make_suspects(S, list(T), list(suspect(T)), list(decl_question))
- <= mercury_edt(S, T).
-:- mode make_suspects(in, in, out, out) is det.
-
-make_suspects(_, [], [], []).
-make_suspects(Store, [Tree | Trees], [Suspect | Ss], [Query | Qs]) :-
- create_suspect(Store, Tree, Suspect),
- Suspect = suspect(_, Query),
- make_suspects(Store, Trees, Ss, Qs).
-
- % Go through the answers (none of which should be `no') and
- % remove the corresponding children from the suspect list.
- %
-:- pred remove_suspects(S::in, list(decl_answer)::in,
- analyser_response(T)::out, analyser_state(T)::in,
- analyser_state(T)::out) is det <= mercury_edt(S, T).
-
-remove_suspects(Store, [], Response, Analyser, Analyser) :-
- (
- Analyser ^ suspects = []
+ Analyser ^ suspect_roots = []
->
+ %
+ % If there is a prime suspect, it is the bug. Otherwise,
+ % we throw up our hands and end the analysis.
+ %
(
Analyser ^ maybe_prime = yes(Prime)
->
- prime_suspect_get_edt_node(Prime, Tree),
- edt_root_e_bug(Store, Tree, EBug),
+ prime_suspect_get_e_bug(Store, Prime, EBug),
Response = bug_found(e_bug(EBug))
;
Response = no_suspects
)
;
- list__map(suspect_get_question, Analyser ^ suspects, Queries),
- Response = oracle_queries(Queries)
+ list__append(Analyser ^ priority_suspects,
+ Analyser ^ suspect_roots, Questions),
+ Response = oracle_queries(Questions)
).
-remove_suspects(Store, [Answer | Answers], Response, Analyser0, Analyser) :-
+ % Make a list of previous prime suspects, and include the current
+ % one if it exists.
+ %
+:- pred get_all_prime_suspects(analyser_state(T), list(T)).
+:- mode get_all_prime_suspects(in, out) is det.
+
+get_all_prime_suspects(Analyser, OldPrimes) :-
(
- Answer = truth_value(_, yes)
+ Analyser ^ maybe_prime = yes(Prime)
->
- find_matching_suspects(get_decl_question(Answer),
- Analyser0 ^ suspects, _, Suspects),
- Analyser1 = Analyser0 ^ suspects := Suspects,
- remove_suspects(Store, Answers, Response,
- Analyser1, Analyser)
+ prime_suspect_get_suspect(Prime, Suspect),
+ OldPrimes = [Suspect | Analyser ^ previous]
;
- error("remove_suspects: unexpected incorrect node")
+ OldPrimes = Analyser ^ previous
).
-:- func get_decl_question(decl_answer) = decl_question.
+:- pred delete_suspect(list(decl_question(T)), T, list(decl_question(T))).
+:- mode delete_suspect(in, in, out) is det.
-get_decl_question(truth_value(Q, _)) = Q.
-get_decl_question(suspicious_subterm(Q, _, _)) = Q.
-
-%-----------------------------------------------------------------------------%
-
-:- type suspect(T)
- ---> suspect(T, decl_question).
-
-:- pred create_suspect(S, T, suspect(T)) <= mercury_edt(S, T).
-:- mode create_suspect(in, in, out) is det.
-
-create_suspect(S, T, Suspect) :-
- edt_root_question(S, T, Question),
- Suspect = suspect(T, Question).
-
-:- pred suspect_get_edt_node(suspect(T), T).
-:- mode suspect_get_edt_node(in, out) is det.
-
-suspect_get_edt_node(suspect(Node, _), Node).
-
-:- pred suspect_get_question(suspect(T), decl_question).
-:- mode suspect_get_question(in, out) is det.
-
-suspect_get_question(suspect(_, Question), Question).
-
-:- pred find_matching_suspects(decl_question, list(suspect(T)),
- list(suspect(T)), list(suspect(T))).
-:- mode find_matching_suspects(in, in, out, out) is det.
-
-find_matching_suspects(Question, Suspects, Matches, NoMatches) :-
- P = (pred(S::in) is semidet :-
- suspect_get_question(S, Question)
- ),
- list__filter(P, Suspects, Matches, NoMatches).
+delete_suspect(Suspects0, Target, Suspects) :-
+ Filter = (pred(S::in) is semidet :-
+ Target \= get_decl_question_node(S)
+ ),
+ list__filter(Filter, Suspects0, Suspects).
%-----------------------------------------------------------------------------%
@@ -430,46 +371,47 @@
---> prime_suspect(
% Incorrect node.
%
- suspect(T),
+ T,
% Evidence: the oracle said these nodes
% were either correct or inadmissible.
%
- list(suspect(T)),
+ list(T),
% Earliest inadmissible child, if there
% have been any at all. This child
% is also included in the list of
% evidence.
%
- maybe(suspect(T))
+ maybe(T)
).
% Create a prime suspect from a suspect.
%
-:- pred create_prime_suspect(suspect(T), prime_suspect(T)).
+:- pred create_prime_suspect(T, prime_suspect(T)).
:- mode create_prime_suspect(in, out) is det.
create_prime_suspect(Suspect, Prime) :-
Prime = prime_suspect(Suspect, [], no).
-:- pred prime_suspect_get_suspect(prime_suspect(T), suspect(T)).
+:- pred prime_suspect_get_suspect(prime_suspect(T), T).
:- mode prime_suspect_get_suspect(in, out) is det.
prime_suspect_get_suspect(prime_suspect(Suspect, _, _), Suspect).
-:- pred prime_suspect_get_edt_node(prime_suspect(T), T).
-:- mode prime_suspect_get_edt_node(in, out) is det.
-
-prime_suspect_get_edt_node(prime_suspect(Suspect, _, _), EDT) :-
- suspect_get_edt_node(Suspect, EDT).
+:- 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.
+
+prime_suspect_get_e_bug(Store, Prime, EBug) :-
+ prime_suspect_get_suspect(Prime, Suspect),
+ edt_root_e_bug(Store, Suspect, EBug).
% Get all the suspects who are children of the prime suspect,
% and who are deemed correct or inadmissible. Maybe get
% the earliest inadmissible child (if there was one).
%
-:- pred prime_suspect_get_evidence(prime_suspect(T), list(suspect(T)),
- maybe(suspect(T))).
+:- pred prime_suspect_get_evidence(prime_suspect(T), list(T), maybe(T)).
:- mode prime_suspect_get_evidence(in, out, out) is det.
prime_suspect_get_evidence(prime_suspect(_, E, M), E, M).
@@ -479,7 +421,7 @@
% This predicate will be more interesting when decl_truth
% has three values.
%
-:- pred prime_suspect_add_evidence(prime_suspect(T), suspect(T), decl_truth,
+:- pred prime_suspect_add_evidence(prime_suspect(T), T, decl_truth,
prime_suspect(T)).
:- mode prime_suspect_add_evidence(in, in, in, out) is det.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.25
diff -u -r1.25 declarative_debugger.m
--- browser/declarative_debugger.m 24 Apr 2002 17:43:56 -0000 1.25
+++ browser/declarative_debugger.m 30 Apr 2002 06:56:58 -0000
@@ -87,43 +87,53 @@
:- type decl_contour == unit.
:- type decl_position == unit.
- % Values of this type represent goal behaviour. This representation
- % is used by the front end (in this module), as well as the
- % oracle and user interface.
+ % 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
- % The node is a suspected wrong answer. The
- % argument is the atom in its final state of
- % instantiatedness (ie. at the EXIT event).
+:- type decl_question(T)
+ % 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 (ie. at the EXIT event).
%
- ---> wrong_answer(decl_atom)
+ ---> wrong_answer(T, decl_atom)
% The node is a suspected missing answer. The
- % first argument is the atom in its initial state
- % of instantiatedness (ie. at the CALL event),
- % and the second argument is the list of solutions.
+ % first argument is the EDT node the question came
+ % from. The second argument is the atom in its
+ % initial state of instantiatedness (ie. at the
+ % CALL event), and the third argument is the list
+ % of solutions.
%
- ; missing_answer(decl_atom, list(decl_atom))
+ ; missing_answer(T, decl_atom, list(decl_atom))
% The node is a possibly unexpected exception.
- % The first argument is the atom in its initial
- % state of instantiation, and the second argument
- % is the exception thrown.
+ % 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.
%
- ; unexpected_exception(decl_atom, decl_exception).
+ ; unexpected_exception(T, decl_atom, decl_exception).
- % These are the possible answers that the oracle can give.
- %
-:- type decl_answer
+:- type decl_answer(T)
% The oracle knows the truth value of this node.
%
- ---> truth_value(decl_question, decl_truth)
+ ---> truth_value(T, decl_truth)
% The oracle does not say anything about the truth
% value, but is suspicious of the subterm at the
% given term_path and arg_pos.
%
- ; suspicious_subterm(decl_question, arg_pos, term_path).
+ ; suspicious_subterm(T, arg_pos, term_path).
+
+ % Extract the EDT node from a question.
+ %
+:- func get_decl_question_node(decl_question(T)) = T.
:- type decl_atom == trace_atom.
@@ -171,6 +181,12 @@
:- import_module mdb__declarative_analyser, mdb__declarative_oracle.
:- import_module require, int, char, string, assoc_list.
+get_decl_question_node(wrong_answer(Node, _)) = Node.
+get_decl_question_node(missing_answer(Node, _, _)) = Node.
+get_decl_question_node(unexpected_exception(Node, _, _)) = Node.
+
+%-----------------------------------------------------------------------------%
+
:- type diagnoser_state(R)
---> diagnoser(
analyser_state :: analyser_state(edt_node(R)),
@@ -253,7 +269,7 @@
Response = require_subtree(Event, Seqno)
}.
-:- pred handle_oracle_response(S::in, oracle_response::in,
+:- pred handle_oracle_response(S::in, oracle_response(edt_node(R))::in,
diagnoser_response::out,
diagnoser_state(R)::in, diagnoser_state(R)::out,
io__state::di, io__state::uo) is cc_multi <= annotated_trace(S, R).
@@ -369,7 +385,7 @@
%
:- type wrap(S) ---> wrap(S).
-:- pred trace_root_question(wrap(S), edt_node(R), decl_question)
+:- pred trace_root_question(wrap(S), edt_node(R), decl_question(edt_node(R)))
<= annotated_trace(S, R).
:- mode trace_root_question(in, in, out) is det.
@@ -380,15 +396,15 @@
call_node_from_id(Store, CallId, Call),
Call = call(_, _, CallAtom, _, _, _, _, _),
get_answers(Store, RedoId, [], Answers),
- Root = missing_answer(CallAtom, Answers)
+ Root = missing_answer(dynamic(Ref), CallAtom, Answers)
;
Node = exit(_, _, _, ExitAtom, _),
- Root = wrong_answer(ExitAtom)
+ Root = wrong_answer(dynamic(Ref), ExitAtom)
;
Node = excp(_, CallId, _, Exception, _),
call_node_from_id(Store, CallId, Call),
Call = call(_, _, CallAtom, _, _, _, _, _),
- Root = unexpected_exception(CallAtom, Exception)
+ Root = unexpected_exception(dynamic(Ref), CallAtom, Exception)
).
:- pred get_answers(S, R, list(decl_atom), list(decl_atom))
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.11
diff -u -r1.11 declarative_oracle.m
--- browser/declarative_oracle.m 28 Jan 2002 07:20:09 -0000 1.11
+++ browser/declarative_oracle.m 30 Apr 2002 06:56:59 -0000
@@ -30,8 +30,8 @@
% A response that the oracle gives to a query about the
% truth of an EDT node.
%
-:- type oracle_response
- ---> oracle_answers(list(decl_answer))
+:- type oracle_response(T)
+ ---> oracle_answers(list(decl_answer(T)))
; no_oracle_answers
; abort_diagnosis.
@@ -51,7 +51,7 @@
% state is threaded through so its contents can be updated after
% user responses.
%
-:- pred query_oracle(list(decl_question)::in, oracle_response::out,
+:- pred query_oracle(list(decl_question(T))::in, oracle_response(T)::out,
oracle_state::in, oracle_state::out, io__state::di, io__state::uo)
is cc_multi.
@@ -67,17 +67,17 @@
:- import_module mdb__declarative_user, mdb__util.
:- import_module bool, std_util, map, set, require.
-query_oracle(Queries, Response, Oracle0, Oracle) -->
+query_oracle(Questions, Response, Oracle0, Oracle) -->
{ get_oracle_kb(Oracle0, KB0) },
- { list__filter_map(query_oracle_kb(KB0), Queries, Answers) },
+ { list__filter_map(query_oracle_kb(KB0), Questions, Answers) },
(
{ Answers = [] }
->
{ get_oracle_user(Oracle0, User0) },
- query_user(Queries, UserResponse, User0, User),
+ query_user(Questions, UserResponse, User0, User),
{
- UserResponse = user_answer(Answer),
- assert_oracle_kb(Answer, KB0, KB),
+ UserResponse = user_answer(Question, Answer),
+ assert_oracle_kb(Question, Answer, KB0, KB),
Response = oracle_answers([Answer])
;
UserResponse = no_user_answer,
@@ -234,16 +234,16 @@
%-----------------------------------------------------------------------------%
-:- pred query_oracle_kb(oracle_kb, decl_question, decl_answer).
+:- pred query_oracle_kb(oracle_kb, decl_question(T), decl_answer(T)).
:- mode query_oracle_kb(in, in, out) is semidet.
-query_oracle_kb(KB, Node, truth_value(Node, Truth)) :-
- Node = wrong_answer(Atom),
+query_oracle_kb(KB, Question, truth_value(Node, Truth)) :-
+ Question = wrong_answer(Node, Atom),
get_kb_ground_map(KB, Map),
map__search(Map, Atom, Truth).
-query_oracle_kb(KB, Node, truth_value(Node, Truth)) :-
- Node = missing_answer(Call, Solns),
+query_oracle_kb(KB, Question, truth_value(Node, Truth)) :-
+ Question = missing_answer(Node, Call, Solns),
set__list_to_set(Solns, Ss),
get_kb_complete_map(KB, CMap),
(
@@ -258,8 +258,8 @@
Truth = no
).
-query_oracle_kb(KB, Node, truth_value(Node, Truth)) :-
- Node = unexpected_exception(Call, Exception),
+query_oracle_kb(KB, Question, truth_value(Node, Truth)) :-
+ Question = unexpected_exception(Node, Call, Exception),
get_kb_exceptions_map(KB, XMap),
map__search(XMap, Call, known_excp(Possible, Impossible)),
(
@@ -276,17 +276,19 @@
% case, since the user will never be asked questions which
% the knowledge base knows anything about.
%
-:- pred assert_oracle_kb(decl_answer, oracle_kb, oracle_kb).
-:- mode assert_oracle_kb(in, in, out) is det.
+:- pred assert_oracle_kb(decl_question(T), decl_answer(T), oracle_kb,
+ oracle_kb).
+:- mode assert_oracle_kb(in, in, in, out) is det.
-assert_oracle_kb(suspicious_subterm(_, _, _), KB, KB).
+assert_oracle_kb(_, suspicious_subterm(_, _, _), KB, KB).
-assert_oracle_kb(truth_value(wrong_answer(Atom), Truth), KB0, KB) :-
+assert_oracle_kb(wrong_answer(_, Atom), truth_value(_, Truth), KB0, KB) :-
get_kb_ground_map(KB0, Map0),
map__det_insert(Map0, Atom, Truth, Map),
set_kb_ground_map(KB0, Map, KB).
-assert_oracle_kb(truth_value(missing_answer(Call, Solns), yes), KB0, KB) :-
+assert_oracle_kb(missing_answer(_, Call, Solns), truth_value(_, yes),
+ KB0, KB) :-
get_kb_complete_map(KB0, Map0),
set__list_to_set(Solns, Ss0),
(
@@ -302,7 +304,7 @@
),
set_kb_complete_map(KB0, Map, KB).
-assert_oracle_kb(truth_value(missing_answer(Call, Solns), no), KB0, KB) :-
+assert_oracle_kb(missing_answer(_, Call, Solns), truth_value(_, no), KB0, KB) :-
get_kb_incomplete_map(KB0, Map0),
set__list_to_set(Solns, Ss),
%
@@ -312,9 +314,8 @@
map__set(Map0, Call, Ss, Map),
set_kb_incomplete_map(KB0, Map, KB).
-assert_oracle_kb(truth_value(unexpected_exception(Call, Exception), Truth),
- KB0, KB) :-
-
+assert_oracle_kb(unexpected_exception(_, Call, Exception),
+ truth_value(_, Truth), KB0, KB) :-
get_kb_exceptions_map(KB0, Map0),
(
map__search(Map0, Call, known_excp(Possible0, Impossible0))
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.17
diff -u -r1.17 declarative_user.m
--- browser/declarative_user.m 23 Apr 2002 08:52:34 -0000 1.17
+++ browser/declarative_user.m 30 Apr 2002 06:57:02 -0000
@@ -17,8 +17,8 @@
:- import_module mdb__declarative_debugger.
:- import_module list, io.
-:- type user_response
- ---> user_answer(decl_answer)
+:- type user_response(T)
+ ---> user_answer(decl_question(T), decl_answer(T))
; no_user_answer
; abort_diagnosis.
@@ -32,7 +32,7 @@
% and is asked to respond about the truth of the node in the
% intended interpretation.
%
-:- pred query_user(list(decl_question)::in, user_response::out,
+:- pred query_user(list(decl_question(T))::in, user_response(T)::out,
user_state::in, user_state::out, io__state::di, io__state::uo)
is cc_multi.
@@ -62,45 +62,49 @@
%-----------------------------------------------------------------------------%
-query_user(Nodes, Response, User0, User) -->
- query_user_2(Nodes, [], Response, User0, User).
+query_user(Questions, Response, User0, User) -->
+ query_user_2(Questions, [], Response, User0, User).
-:- pred query_user_2(list(decl_question)::in, list(decl_question)::in,
- user_response::out, user_state::in, user_state::out,
+:- pred query_user_2(list(decl_question(T))::in, list(decl_question(T))::in,
+ user_response(T)::out, user_state::in, user_state::out,
io__state::di, io__state::uo) is cc_multi.
query_user_2([], _, no_user_answer, User, User) -->
[].
-query_user_2([Node | Nodes], Skipped, Response, User0, User) -->
- write_decl_question(Node, User0),
- { decl_question_prompt(Node, Question) },
- get_command(Question, Command, User0, User1),
+query_user_2([Question | Questions], Skipped, Response, User0, User) -->
+ write_decl_question(Question, User0),
+ { Node = get_decl_question_node(Question) },
+ { decl_question_prompt(Question, Prompt) },
+ get_command(Prompt, Command, User0, User1),
(
{ Command = yes },
- { Response = user_answer(truth_value(Node, yes)) },
+ { Response = user_answer(Question, truth_value(Node, yes)) },
{ User = User1 }
;
{ Command = no },
- { Response = user_answer(truth_value(Node, no)) },
+ { Response = user_answer(Question, truth_value(Node, no)) },
{ User = User1 }
;
{ Command = inadmissible },
io__write_string("Sorry, not implemented,\n"),
- query_user_2([Node | Nodes], Skipped, Response, User1, User)
+ query_user_2([Question | Questions], Skipped, Response,
+ User1, User)
;
{ Command = skip },
- query_user_2(Nodes, [Node | Skipped], Response, User1, User)
+ query_user_2(Questions, [Question | Skipped], Response,
+ User1, User)
;
{ Command = restart },
- { reverse_and_append(Skipped, [Node | Nodes], Questions) },
- query_user_2(Questions, [], Response, User1, User)
+ { reverse_and_append(Skipped, [Question | Questions],
+ RestartedQuestions) },
+ query_user(RestartedQuestions, Response, User1, User)
;
{ Command = browse(ArgNum) },
- browse_edt_node(Node, ArgNum, MaybeMark, User1, User2),
+ browse_edt_node(Question, ArgNum, MaybeMark, User1, User2),
(
{ MaybeMark = no },
- query_user_2([Node | Nodes], Skipped, Response, User2,
- User)
+ query_user_2([Question | Questions], Skipped, Response,
+ User2, User)
;
{ MaybeMark = yes(Mark) },
{ Which = chosen_head_vars_presentation },
@@ -112,7 +116,7 @@
ArgPos = any_head_var(ArgNum)
},
{ Answer = suspicious_subterm(Node, ArgPos, Mark) },
- { Response = user_answer(Answer) },
+ { Response = user_answer(Question, Answer) },
{ User = User2 }
)
;
@@ -122,31 +126,33 @@
;
{ Command = help },
user_help_message(User1),
- query_user_2([Node | Nodes], Skipped, Response, User1, User)
+ query_user_2([Question | Questions], Skipped, Response,
+ User1, User)
;
{ Command = illegal_command },
io__write_string("Unknown command, 'h' for help.\n"),
- query_user_2([Node | Nodes], Skipped, Response, User1, User)
+ query_user_2([Question | Questions], Skipped, Response,
+ User1, User)
).
-:- pred decl_question_prompt(decl_question, string).
+:- pred decl_question_prompt(decl_question(T), string).
:- mode decl_question_prompt(in, out) is det.
-decl_question_prompt(wrong_answer(_), "Valid? ").
-decl_question_prompt(missing_answer(_, _), "Complete? ").
-decl_question_prompt(unexpected_exception(_, _), "Expected? ").
+decl_question_prompt(wrong_answer(_, _), "Valid? ").
+decl_question_prompt(missing_answer(_, _, _), "Complete? ").
+decl_question_prompt(unexpected_exception(_, _, _), "Expected? ").
-:- pred browse_edt_node(decl_question::in, int::in, maybe(term_path)::out,
+:- 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.
browse_edt_node(Node, ArgNum, MaybeMark, User0, User) -->
{
- Node = wrong_answer(Atom)
+ Node = wrong_answer(_, Atom)
;
- Node = missing_answer(Atom, _)
+ Node = missing_answer(_, Atom, _)
;
- Node = unexpected_exception(Atom, _)
+ Node = unexpected_exception(_, Atom, _)
},
browse_atom_argument(Atom, ArgNum, MaybeMark, User0, User).
@@ -341,13 +347,13 @@
% Display the node in user readable form on the current
% output stream.
%
-:- pred write_decl_question(decl_question::in, user_state::in,
+:- pred write_decl_question(decl_question(T)::in, user_state::in,
io__state::di, io__state::uo) is cc_multi.
-write_decl_question(wrong_answer(Atom), User) -->
+write_decl_question(wrong_answer(_, Atom), User) -->
write_decl_atom(User, "", Atom).
-write_decl_question(missing_answer(Call, Solns), User) -->
+write_decl_question(missing_answer(_, Call, Solns), User) -->
write_decl_atom(User, "Call ", Call),
(
{ Solns = [] }
@@ -358,7 +364,7 @@
list__foldl(write_decl_atom(User, "\t"), Solns)
).
-write_decl_question(unexpected_exception(Call, Exception), User) -->
+write_decl_question(unexpected_exception(_, Call, Exception), User) -->
write_decl_atom(User, "Call ", Call),
io__write_string(User ^ outstr, "Throws "),
io__write(User ^ outstr, include_details_cc, univ_value(Exception)),
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.34
diff -u -r1.34 Mmakefile
--- tests/debugger/declarative/Mmakefile 29 Apr 2002 08:22:06 -0000 1.34
+++ tests/debugger/declarative/Mmakefile 30 Apr 2002 06:57:25 -0000
@@ -25,6 +25,7 @@
comp_gen \
deep_warning \
dependency \
+ dependency2 \
family \
filter \
func_call \
@@ -56,6 +57,7 @@
MCFLAGS-deep_sub=--trace deep
MCFLAGS-dependency=--trace rep
+MCFLAGS-dependency2=--trace rep
MCFLAGS-input_term_dep=--trace rep
MCFLAGS-output_term_dep=--trace rep
MCFLAGS-special_term_dep=--trace rep
@@ -127,6 +129,9 @@
dependency.out: dependency dependency.inp
$(MDB) ./dependency < dependency.inp > dependency.out 2>&1
+
+dependency2.out: dependency2 dependency2.inp
+ $(MDB) ./dependency2 < dependency2.inp > dependency2.out 2>&1
family.out: family family.inp
$(MDB) ./family < family.inp > family.out 2>&1
Index: tests/debugger/declarative/dependency2.exp
===================================================================
RCS file: tests/debugger/declarative/dependency2.exp
diff -N tests/debugger/declarative/dependency2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/dependency2.exp 30 Apr 2002 06:57:25 -0000
@@ -0,0 +1,33 @@
+ 1: 1 1 CALL pred dependency:main/2-0 (cc_multi) dependency.m:11
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break test
+ 0: + stop interface pred dependency:test/1-0 (cc_multi)
+mdb> continue
+ 4: 3 2 CALL pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
+mdb> finish
+ 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
+mdb> dd
+test([1, 3, 6, 1, 3])
+Valid? browse 1
+browser> ^2^1
+browser> mark
+Origin: output(r, any_head_var(4), [1])
+r(1, [3, 4], 3 - 4)
+Valid? browse 2
+browser> print
+[3, 4]
+browser> mark
+Origin: primitive_op("dependency.m", 29)
+p(1)
+Valid? yes
+Origin: primitive_op("dependency.m", 29)
+q(no)
+Valid? yes
+Found incorrect contour:
+test([1, 3, 6, 1, 3])
+Is this a bug? yes
+ 18: 3 2 EXIT pred dependency:test/1-0 (cc_multi) dependency.m:19 (dependency.m:13)
+mdb> continue
+[1, 3, 6, 1, 3].
Index: tests/debugger/declarative/dependency2.inp
===================================================================
RCS file: tests/debugger/declarative/dependency2.inp
diff -N tests/debugger/declarative/dependency2.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/dependency2.inp 30 Apr 2002 06:57:25 -0000
@@ -0,0 +1,16 @@
+echo on
+register --quiet
+break test
+continue
+finish
+dd
+browse 1
+^2^1
+mark
+browse 2
+print
+mark
+yes
+yes
+yes
+continue
Index: tests/debugger/declarative/dependency2.m
===================================================================
RCS file: tests/debugger/declarative/dependency2.m
diff -N tests/debugger/declarative/dependency2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/dependency2.m 30 Apr 2002 06:57:26 -0000
@@ -0,0 +1,76 @@
+:- module dependency2.
+
+:- interface.
+
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+:- import_module bool, int, list, require, std_util.
+
+main -->
+ { turn_on_origin_debug },
+ { test(L) },
+ io__write(L),
+ io__write_string(".\n").
+
+:- pred test(list(int)::out) is cc_multi.
+
+test(L) :-
+ p(U),
+ ( U = 1 ->
+ A = 1
+ ;
+ A = U
+ ),
+ q(V),
+ (
+ V = no,
+ r(A, [3, 4], BX),
+ BX = B - _
+ ;
+ V = yes,
+ B = 4
+ ),
+ AB = {A, B},
+ (
+ A = 2,
+ C = 5,
+ D = []
+ ;
+ C = 6,
+ AB = {Aprime, Bprime},
+ D = [Aprime, Bprime]
+ ),
+ L = [A, B, C | D].
+
+:- pred p(int::out) is det.
+
+p(1).
+
+:- pred q(bool::out) is det.
+
+q(no).
+
+:- pred r(int::in, list(T)::in, pair(T)::out) is det.
+
+r(A, L, BX) :-
+ (
+ A = 1,
+ L = [E1, E2 | _]
+ ->
+ BX = E1 - E2
+ ;
+ error("r: bad input")
+ ).
+
+:- pred turn_on_origin_debug is det.
+
+:- pragma foreign_proc("C",
+ turn_on_origin_debug,
+ [will_not_call_mercury, promise_pure],
+"
+ extern int MR_DD_debug_origin;
+
+ MR_DD_debug_origin = 1;
+").
Index: tests/debugger/declarative/family.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/family.exp,v
retrieving revision 1.1
diff -u -r1.1 family.exp
--- tests/debugger/declarative/family.exp 1 Oct 2000 17:03:37 -0000 1.1
+++ tests/debugger/declarative/family.exp 30 Apr 2002 06:57:26 -0000
@@ -67,7 +67,7 @@
Found partially uncovered atom:
common_father(_, _)
Is this a bug? yes
- 348: 59 4 FAIL pred family:common_father/2-0 (nondet) family.m:58 (family.m:77)
+ 401: 70 4 FAIL pred family:common_father/2-0 (nondet) family.m:58 (family.m:77)
mdb> continue
530: 2 2 EXIT pred family:half_siblings/2-0 (nondet) family.m:82 (family.m:9)
mdb> continue
@@ -83,5 +83,5 @@
Found partially uncovered atom:
common_father(_, _)
Is this a bug? yes
- 86: 15 4 FAIL pred family:common_father/2-0 (nondet) family.m:58 (family.m:77)
+ 401: 70 4 FAIL pred family:common_father/2-0 (nondet) family.m:58 (family.m:77)
mdb> quit -y
--------------------------------------------------------------------------
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