[m-rev.] For review: allow declarative debugger to search upward from initial symptom
Ian MacLarty
maclarty at cs.mu.OZ.AU
Mon Nov 29 22:42:50 AEDT 2004
For review by anyone.
Estimated hours taken: 50
Branches: main
Allow declarative debugger to search nodes above the node where the initial
`dd' command was given. If the user asserts that the node at which the `dd'
command was given is correct or inadmissible then the declaratibe debugger will
ask questions about ancestors of the node at which the `dd' command was given.
The declarative debugger will only say it cannot find a bug if the user asserts
that the main/2 (or whatever the topmost traced call is) call is correct or
inadmissible.
This is useful when you've found an inadmissible node in the procedural
debugger, but you're not sure where the erroneous ancestor is.
Fix bug in sub-term dependency tracking when tracking an input sub-term: If the
sub-term was bound by a primitive operation then the next question was about
the child of the node in which the sub-term was bound, instead of the node
itself.
Add --depth-step-size option to mdb `dd' command. This allows the user to
specify the depth of each materialized portion of the EDT.
browser/declarative_analyser.m
Allow analyser to request an explicit supertree from the diagnoser
and respond correctly once an explicit subtree has been generated.
When the primitive operation that binds a sub-term is found, the
suspect_id of the node containing the primitive op is now returned, so
handle this by asking the next question about the node containing the
primitive op if its status is unknown.
Stop tracking the sub-term if it is an input and we encounter an
erroneous node.
Remove previous_roots field from analyser_state. It is not
needed because this information is now kept in the search space.
browser/declarative_debugger.m
Add new diagnoser response to tell backend to generate an explicit
supertree.
browser/declarative_edt.m
Add methods to mercury_edt typeclass to get the parent of an EDT node,
tell if two nodes refer to the same event and tell if a node is the
topmost node (usually the 1st call to main/2).
Make find_subterm_origin return the suspect in which a primitive
operation was executed.
Add predicate to incorporate a new explicit supertree into the search
space.
Add predicate to tell the analyser when it's okay to stop tracking
a sub-term.
Fix bug in find_subterm_origin so it doesn't report a child as the
binding node when it should be the parent. Also replace duplicated
code in find_subterm_origin with new predicate resolve_origin.
Add extend_search_space_upwards predicate which attempts to add an
extra node to the top of the search space.
If a status is changed from erroneous to correct or vica versa then
mark the suspects which were eliminated from the search space by
the original status as unknown.
browser/declarative_execution.m
Rename call_last_exit_redo to call_last_interface, since excp and fail
nodes can also go here.
browser/declarative_tree.m
Add implementations for new methods from mercury_edt typeclass.
doc/user_guide.texi
Document --depth-step-size dd option.
Remove duplicate save command documentation.
Add a comment about new functionality.
tests/debugger/declarative/Mmakefile
tests/debugger/declarative/mapinit.exp
tests/debugger/declarative/mapinit.inp
Use standardized event printing for mapinit test.
tests/debugger/declarative/app.exp
tests/debugger/declarative/app.inp
tests/debugger/declarative/revise_2.exp
tests/debugger/declarative/revise_2.inp
Changed expected output and input because the bug search now continues
in the ancestors of the node the original `dd' command was given in.
tests/debugger/declarative/catch.exp
XXX still trying to work out why this has changed. Now getting a
"reached unknown label" warning, though otherwise the output is the
same.
tests/debugger/declarative/explicit_subtree.exp
tests/debugger/declarative/explicit_subtree.exp2
tests/debugger/declarative/explicit_subtree.inp
tests/debugger/declarative/explicit_subtree.inp2
tests/debugger/declarative/explicit_subtree.m
Modify this test to also test generation of an explicit supertree.
trace/mercury_trace_declarative.c
If requested to generate a supertree then retry to a node
above the current top most node and collect events down to the
current top most node.
Interactively retry accross IO when building the annotated trace.
This is more user friendly than simply aborting if untabled IO is
encountered.
trace/mercury_trace_declarative.h
Export MR_edt_depth_step_size so it can be set with the
--depth-step-size dd option.
trace/mercury_trace_internal.c
Add --depth-step-size option for `dd' command.
Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.16
diff -u -r1.16 declarative_analyser.m
--- browser/declarative_analyser.m 19 Nov 2004 11:54:16 -0000 1.16
+++ browser/declarative_analyser.m 29 Nov 2004 06:36:40 -0000
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1999-2004 The University of Melbourne.
+% Copyright (C) 1999-2003 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.
%-----------------------------------------------------------------------------%
@@ -29,7 +29,7 @@
% There are no suspects left, and no incorrect
% nodes have been found.
---> no_suspects
-
+
% A suspect who is guilty, along with the evidence
% against the suspect.
; bug_found(decl_bug, decl_evidence(T))
@@ -39,8 +39,12 @@
% The analyser requires the given implicit sub-tree
% to be made explicit.
- ; require_explicit(T)
-
+ ; require_explicit_subtree(T)
+
+ % The analyser requires an explicit tree above the
+ % root of an existing explicit tree.
+ ; require_explicit_supertree(T)
+
% The analyser would like the oracle to re-ask the user
% this question and then for analysis to continue.
; revise(decl_question(T)).
@@ -89,7 +93,7 @@
:- import_module mdb.declarative_edt.
:- import_module mdbcomp.program_representation.
-:- import_module bool, exception, string, map, int, counter, array, list.
+:- import_module exception, string, map, int, counter, array, list.
% Describes what search strategy is being used by the analyser and the
% state of the search.
@@ -110,25 +114,30 @@
% a binary search between this node and the root of the
% search space (the binary search will only come into
% effect if the oracle asserts the suspect is correct
- % or inadmissible). The arguments of this field give
- % the atom and subterm position in that atom where the
- % search got up to if it needs to stop to wait for an
- % explicit subtree to be generated. The last argument
- % is the last suspect on the dependency chain whose
- % status was unknown. Initially this is no, but as the
- % sub-term is tracked to where is was initially bound
- % (which could be above or below the node where it was
- % marked incorrect), the most recent node through which
- % the subterm was tracked that has a status of
- % `unknown' is stored in this field. This is then used
- % as the next question if the node that bound the
- % subterm is trusted or in an excluded part of the
- % search tree.
+ % or inadmissible).
%
; follow_subterm_end(
+ %
+ % The following 3 args give the position the
+ % sub-term tracking algorithm has got up to if
+ % it needs to stop to wait for an explicit
+ % sub/super-tree to be generated.
+ %
suspect_id,
arg_pos,
term_path,
+
+ % The last suspect on the dependency chain
+ % whose status was unknown. Initially this is
+ % no, but as the sub-term is tracked to where
+ % it was initially bound (which could be above
+ % or below the node where it was marked
+ % incorrect), the most recent node through
+ % which the sub-term was tracked that has a
+ % status of `unknown' is stored in this field.
+ % This is then used as the next question if the
+ % node that bound the sub-term is trusted or in
+ % an excluded part of the search tree.
maybe(suspect_id)
)
@@ -155,7 +164,8 @@
%
:- type search_response
---> question(suspect_id)
- ; require_explicit(suspect_id).
+ ; require_explicit_subtree(suspect_id)
+ ; require_explicit_supertree.
% The analyser state records all of the information that needs
% to be remembered across multiple invocations of the analyser.
@@ -166,20 +176,12 @@
% Information about the EDT nodes relevent to
% the bug search.
search_space :: search_space(T),
-
- % Previous roots of the search space. These
- % will be revisited if the analysis is
- % revised (for instance when the user
- % overrules a bug found by the analyser).
- previous_roots :: list(suspect_id),
- % This is set to yes when an explicit subtree
- % needs to be generated. The suspect_id of the
- % suspect in the search space is stored here so
- % we know which node in the search space to
- % update once the explicit subtree has been
- % generated.
- require_explicit :: maybe(suspect_id),
+ % This is set to yes when an explicit tree
+ % needs to be generated.
+ % The maybe argument says what type of explicit
+ % tree needs to be generated.
+ require_explicit :: maybe(explicit_tree_type),
% The method currently being employed to search
% the search space for questions for the
@@ -205,12 +207,22 @@
debug_origin :: maybe(subterm_origin(T))
).
+:- type explicit_tree_type
+
+ % Generate an explicit subtree for the implicit root
+ % referenced by the suspect_id.
+ ---> explicit_subtree(suspect_id)
+
+ % Generate a new explicit tree above the current
+ % explicit tree.
+ ; explicit_supertree.
+
analyser_state_init(IoActionMap, Analyser) :-
- Analyser = analyser(empty_search_space, [], no, top_down, no,
+ Analyser = analyser(empty_search_space, no, top_down, no,
IoActionMap, no).
reset_analyser(!Analyser) :-
- !:Analyser = analyser(empty_search_space, [], no, top_down, no,
+ !:Analyser = analyser(empty_search_space, no, top_down, no,
!.Analyser ^ io_action_map, no).
analyser_state_replace_io_map(IoActionMap, !Analyser) :-
@@ -218,12 +230,20 @@
debug_analyser_state(Analyser, Analyser ^ debug_origin).
-start_or_resume_analysis(Store, Tree, Response, !Analyser) :-
+start_or_resume_analysis(Store, Node, Response, !Analyser) :-
MaybeRequireExplicit = !.Analyser ^ require_explicit,
(
- MaybeRequireExplicit = yes(SuspectId),
- incorporate_explicit_subtree(SuspectId, Tree,
- !.Analyser ^ search_space, SearchSpace),
+ MaybeRequireExplicit = yes(TreeType),
+ SearchSpace0 = !.Analyser ^ search_space,
+ (
+ TreeType = explicit_supertree,
+ incorporate_explicit_supertree(Store, Node,
+ SearchSpace0, SearchSpace)
+ ;
+ TreeType = explicit_subtree(SuspectId),
+ incorporate_explicit_subtree(SuspectId, Node,
+ SearchSpace0, SearchSpace)
+ ),
!:Analyser = !.Analyser ^ search_space := SearchSpace,
!:Analyser = !.Analyser ^ require_explicit := no,
decide_analyser_response(Store, Response, !Analyser)
@@ -234,11 +254,12 @@
% start of a new declarative debugging session.
%
reset_analyser(!Analyser),
- initialise_search_space(Tree, SearchSpace),
+ initialise_search_space(Node, SearchSpace),
!:Analyser = !.Analyser ^ search_space := SearchSpace,
- root_det(SearchSpace, RootId),
- !:Analyser = !.Analyser ^ last_search_question := yes(RootId),
- edt_question(!.Analyser ^ io_action_map, Store, Tree,
+ topmost_det(SearchSpace, TopMostId),
+ !:Analyser = !.Analyser ^ last_search_question :=
+ yes(TopMostId),
+ edt_question(!.Analyser ^ io_action_map, Store, Node,
Question),
Response = revise(Question)
).
@@ -246,7 +267,13 @@
continue_analysis(Store, Answer, Response, !Analyser) :-
(
!.Analyser ^ last_search_question = yes(SuspectId),
- process_answer(Store, Answer, SuspectId, !Analyser)
+ check_search_space_consistency(!.Analyser ^ search_space,
+ "BEFORE " ++ string(Answer) ++ " suspectid = "
+ ++ string(SuspectId)),
+ process_answer(Store, Answer, SuspectId, !Analyser),
+ check_search_space_consistency(!.Analyser ^ search_space,
+ "AFTER " ++ string(Answer) ++ " suspectid = "
+ ++ string(SuspectId))
;
!.Analyser ^ last_search_question = no,
throw(internal_error("continue_analysis",
@@ -280,8 +307,6 @@
process_answer(_, truth_value(_, erroneous), SuspectId, !Analyser) :-
assert_suspect_is_erroneous(SuspectId, !.Analyser ^ search_space,
SearchSpace),
- PreviousRoots = !.Analyser ^ previous_roots,
- !:Analyser = !.Analyser ^ previous_roots := [SuspectId| PreviousRoots],
!:Analyser = !.Analyser ^ search_space := SearchSpace.
process_answer(Store, suspicious_subterm(Node, ArgPos, TermPath), SuspectId,
@@ -303,47 +328,31 @@
;
Mode = subterm_out,
assert_suspect_is_erroneous(SuspectId,
- !.Analyser ^ search_space, SearchSpace),
- !:Analyser = !.Analyser ^ previous_roots :=
- [SuspectId | !.Analyser ^ previous_roots]
+ !.Analyser ^ search_space, SearchSpace)
),
!:Analyser = !.Analyser ^ search_space := SearchSpace,
!:Analyser = !.Analyser ^ search_mode := follow_subterm_end(SuspectId,
ArgPos, TermPath, no).
revise_analysis(Store, Response, !Analyser) :-
- %
- % The head of previous_roots in the analyser is just the
- % current root of the search space, so we make the second element in
- % previous_roots the new root, make everything below it
- % unknown and re-query the current root. If there's only one previous
- % root (the current root) then we make it and all its descendents
- % unknown and re-query it. If there are no previous roots then we give
- % up the search.
- %
+ SearchSpace = !.Analyser ^ search_space,
(
- !.Analyser ^ previous_roots = [Current | PreviousRoots],
- (
- PreviousRoots = [LastRoot | _],
- revise_suspect(LastRoot, !.Analyser ^ search_space,
- SearchSpace0),
- assert_suspect_is_erroneous(LastRoot, SearchSpace0,
- SearchSpace1)
- ;
- PreviousRoots = [],
- revise_suspect(Current, !.Analyser ^ search_space,
- SearchSpace1)
- ),
- edt_question(!.Analyser ^ io_action_map, Store,
- get_edt_node(SearchSpace1, Current), Question),
+ root(SearchSpace, RootId)
+ ->
+ Node = get_edt_node(!.Analyser ^ search_space, RootId),
+ edt_question(!.Analyser ^ io_action_map, Store, Node,
+ Question),
Response = revise(Question),
+ revise_root(SearchSpace, SearchSpace1),
!:Analyser = !.Analyser ^ search_space := SearchSpace1,
- !:Analyser = !.Analyser ^ previous_roots := PreviousRoots,
- !:Analyser = !.Analyser ^ search_mode := top_down,
- !:Analyser = !.Analyser ^ last_search_question := yes(Current)
+ !:Analyser = !.Analyser ^ last_search_question := yes(RootId),
+ !:Analyser = !.Analyser ^ search_mode := top_down
;
- !.Analyser ^ previous_roots = [],
- Response = no_suspects
+ %
+ % There must be a root, since a bug was found (and is now
+ % being revised).
+ %
+ throw(internal_error("revise_analysis", "no root"))
).
:- pred decide_analyser_response(S::in, analyser_response(T)::out,
@@ -351,32 +360,61 @@
is det <= mercury_edt(S, T).
decide_analyser_response(Store, Response, !Analyser) :-
- SearchSpace0 = !.Analyser ^ search_space,
- root_det(SearchSpace0, RootId),
- (
- no_more_questions(Store, SearchSpace0, SearchSpace1,
- CorrectDescendents, InadmissibleChildren)
- ->
+ some [!SearchSpace] (
+ !:SearchSpace = !.Analyser ^ search_space,
(
- suspect_erroneous(SearchSpace1, RootId)
+ root(!.SearchSpace, RootId),
+ suspect_is_bug(Store, RootId, !SearchSpace,
+ CorrectDescendents, InadmissibleChildren)
->
+ !:Analyser = !.Analyser ^ search_space :=
+ !.SearchSpace,
bug_response(Store, !.Analyser ^ io_action_map,
- SearchSpace1, RootId,
+ !.SearchSpace, RootId,
[RootId | CorrectDescendents],
- InadmissibleChildren, Response),
- !:Analyser = !.Analyser ^ search_space := SearchSpace1
-
+ InadmissibleChildren, Response)
;
- revise_analysis(Store, Response, !Analyser)
+ are_unknown_suspects(!.SearchSpace)
+ ->
+ search(Store, !SearchSpace, !.Analyser ^ search_mode,
+ NewMode, SearchResponse),
+ !:Analyser = !.Analyser ^ search_space :=
+ !.SearchSpace,
+ !:Analyser = !.Analyser ^ search_mode := NewMode,
+ handle_search_response(Store, SearchResponse,
+ !Analyser, Response)
+ ;
+ %
+ % Try to extend the search space upwards. If this
+ % fails and we're not at the topmost traced node, then
+ % request that an explicit supertree be generated.
+ %
+ (
+ extend_search_space_upwards(Store,
+ !SearchSpace)
+ ->
+ !:Analyser = !.Analyser ^ search_space :=
+ !.SearchSpace,
+ decide_analyser_response(Store, Response,
+ !Analyser)
+ ;
+ topmost_det(!.SearchSpace, TopMostId),
+ TopMostNode = get_edt_node(!.SearchSpace,
+ TopMostId),
+ (
+ edt_topmost_node(Store, TopMostNode)
+ ->
+ % We can't look any higher.
+ Response = no_suspects
+ ;
+ Response = require_explicit_supertree(
+ TopMostNode),
+ !:Analyser = !.Analyser ^
+ require_explicit := yes(
+ explicit_supertree)
+ )
+ )
)
- ;
- % Search the search space for questions for the oracle.
- search(Store, SearchSpace0, SearchSpace,
- !.Analyser ^ search_mode, NewMode, SearchResponse),
- !:Analyser = !.Analyser ^ search_mode := NewMode,
- !:Analyser = !.Analyser ^ search_space := SearchSpace,
- handle_search_response(Store, SearchResponse, !Analyser,
- Response)
).
:- pred handle_search_response(S::in, search_response::in,
@@ -412,11 +450,19 @@
),
!:Analyser = !.Analyser ^ last_search_question := yes(SuspectId).
-handle_search_response(_, require_explicit(SuspectId), !Analyser,
+handle_search_response(_, require_explicit_subtree(SuspectId), !Analyser,
Response) :-
- !:Analyser = !.Analyser ^ require_explicit := yes(SuspectId),
- Response = require_explicit(get_edt_node(!.Analyser ^ search_space,
- SuspectId)).
+ !:Analyser = !.Analyser ^ require_explicit := yes(explicit_subtree(
+ SuspectId)),
+ Node = get_edt_node(!.Analyser ^ search_space, SuspectId),
+ Response = require_explicit_subtree(Node).
+
+handle_search_response(_, require_explicit_supertree, !Analyser, Response) :-
+ !:Analyser = !.Analyser ^ require_explicit := yes(explicit_supertree),
+ SearchSpace = !.Analyser ^ search_space,
+ topmost_det(SearchSpace, TopMostId),
+ TopMost = get_edt_node(SearchSpace, TopMostId),
+ Response = require_explicit_supertree(TopMost).
% bug_response(Store, IoActionMap, SearchSpace, BugId, Evidence,
% InadmissibleChildren, Response)
@@ -475,9 +521,19 @@
search_response::out, search_mode::out) is det <= mercury_edt(S, T).
top_down_search(Store, !SearchSpace, Response, NewMode) :-
- root_det(!.SearchSpace, RootId),
+ %
+ % If there's no root yet (because the oracle hasn't asserted any nodes
+ % are erroneous yet, then use the topmost suspect as a starting point.
+ %
+ (
+ root(!.SearchSpace, RootId)
+ ->
+ Start = RootId
+ ;
+ topmost_det(!.SearchSpace, Start)
+ ),
(
- first_unknown_descendent(Store, RootId,
+ first_unknown_descendent(Store, Start,
!.SearchSpace, SearchSpace1, MaybeDescendent)
->
SearchSpace1 = !:SearchSpace,
@@ -513,59 +569,67 @@
(
pick_implicit_root(Store, !.SearchSpace, ImplicitRoot)
->
- Response = require_explicit(ImplicitRoot),
+ Response = require_explicit_subtree(ImplicitRoot),
NewMode = top_down
;
throw(internal_error("top_down_search",
- "first_unknown_descendent requires an explicit"
- ++" subtree to be generated, but "++
- "pick_implicit_root couldn't find an implicit"
- ++" root to generate an explicit subtree from"))
+ "first_unknown_descendent requires an "
+ ++ "explicit subtree to be generated, but "
+ ++ "pick_implicit_root couldn't find an "
+ ++ "implicit root to generate an "
+ ++ "explicit subtree from"))
)
).
:- pred follow_subterm_end_search(S::in, search_space(T)::in,
search_space(T)::out, maybe(suspect_id)::in, suspect_id::in,
- arg_pos::in, term_path::in, search_mode::out, search_response::out)
- is det <= mercury_edt(S, T).
+ arg_pos::in, term_path::in, search_mode::out,
+ search_response::out) is det <= mercury_edt(S, T).
follow_subterm_end_search(Store, !SearchSpace, LastUnknown, SuspectId, ArgPos,
TermPath, NewMode, SearchResponse) :-
find_subterm_origin(Store, SuspectId, ArgPos, TermPath, !SearchSpace,
FindOriginResponse),
- root_det(!.SearchSpace, RootId),
(
- FindOriginResponse = primitive_op(_, _),
+ FindOriginResponse = primitive_op(PrimitiveOpId, _, _),
%
% XXX In future the filename and line number of the primitive
% operation could be printed out if the node in which the
% primitive operation occured turned out to be a bug.
%
(
- LastUnknown = yes(Unknown),
- SearchResponse = question(Unknown),
- setup_binary_search(!.SearchSpace, RootId, Unknown,
+ suspect_unknown(!.SearchSpace, PrimitiveOpId)
+ ->
+ SearchResponse = question(PrimitiveOpId),
+ setup_binary_search(!.SearchSpace, PrimitiveOpId,
NewMode)
;
- LastUnknown = no,
- top_down_search(Store, !SearchSpace,
- SearchResponse, NewMode)
+ (
+ LastUnknown = yes(Unknown),
+ SearchResponse = question(Unknown),
+ setup_binary_search(!.SearchSpace,
+ Unknown, NewMode)
+ ;
+ LastUnknown = no,
+ top_down_search(Store, !SearchSpace,
+ SearchResponse, NewMode)
+ )
)
;
FindOriginResponse = not_found,
(
LastUnknown = yes(Unknown),
SearchResponse = question(Unknown),
- setup_binary_search(!.SearchSpace, RootId, Unknown,
- NewMode)
+ setup_binary_search(!.SearchSpace,
+ Unknown, NewMode)
;
LastUnknown = no,
top_down_search(Store, !SearchSpace,
SearchResponse, NewMode)
)
;
- FindOriginResponse = require_explicit,
- SearchResponse = require_explicit(SuspectId),
+ FindOriginResponse = require_explicit_subtree,
+ SearchResponse = require_explicit_subtree(SuspectId),
%
% Record the current position of the search so
% we can continue where we left off once the explicit
@@ -574,6 +638,11 @@
NewMode = follow_subterm_end(SuspectId, ArgPos, TermPath,
LastUnknown)
;
+ FindOriginResponse = require_explicit_supertree,
+ SearchResponse = require_explicit_supertree,
+ NewMode = follow_subterm_end(SuspectId, ArgPos, TermPath,
+ LastUnknown)
+ ;
FindOriginResponse = origin(OriginId, OriginArgPos,
OriginTermPath),
(
@@ -583,27 +652,61 @@
;
NewLastUnknown = LastUnknown
),
- %
- % This recursive call will not lead to an infinite loop because
- % eventually either the sub-term will be bound (and
- % find_subterm_origin will respond with primitive_op/2) or
- % there will be insufficient tracing information to continue
- % (and find_subterm_origin will respond with not_found).
- %
- follow_subterm_end_search(Store, !SearchSpace,
- NewLastUnknown, OriginId, OriginArgPos,
- OriginTermPath, NewMode, SearchResponse)
+ (
+ %
+ % Check if it's worth continuing tracking the sub-term.
+ % We want to stop if we enter a portion of the search
+ % space known not to contain the bug from which we
+ % can't return (like if we come across an erroneous
+ % node where the sub-term is an input).
+ %
+ give_up_subterm_tracking(!.SearchSpace, OriginId)
+ ->
+ (
+ LastUnknown = yes(Unknown),
+ SearchResponse = question(Unknown),
+ setup_binary_search(!.SearchSpace,
+ Unknown, NewMode)
+ ;
+ LastUnknown = no,
+ top_down_search(Store, !SearchSpace,
+ SearchResponse, NewMode)
+ )
+ ;
+ %
+ % This recursive call will not lead to an infinite loop
+ % because eventually either the sub-term will be bound
+ % (and find_subterm_origin will respond with
+ % primitive_op/2) or there will be insufficient tracing
+ % information to continue (and find_subterm_origin will
+ % respond with not_found).
+ %
+ follow_subterm_end_search(Store, !SearchSpace,
+ NewLastUnknown, OriginId, OriginArgPos,
+ OriginTermPath, NewMode,
+ SearchResponse)
+ )
).
- % setup_binary_search(SearchSpace, TopId, BottomId, Response,
- % SearchMode).
- % Sets up the search mode to do a binary search between BottomId
- % and TopId.
+ % setup_binary_search(SearchSpace, SuspectId, Response, SearchMode).
+ % Sets up the search mode to do a binary search between SuspectId
+ % and either the root of the search space if a suspect has
+ % previously been marked erroneous, or the topmost node if no suspect
+ % has yet been marked erroneous.
%
:- pred setup_binary_search(search_space(T)::in, suspect_id::in,
- suspect_id::in, search_mode::out) is det.
+ search_mode::out) is det.
-setup_binary_search(SearchSpace, TopId, BottomId, SearchMode) :-
+setup_binary_search(SearchSpace, SuspectId, SearchMode) :-
+ (
+ root(SearchSpace, RootId)
+ ->
+ TopId = RootId,
+ BottomId = SuspectId
+ ;
+ topmost_det(SearchSpace, TopId),
+ BottomId = SuspectId
+ ),
(
get_path(SearchSpace, BottomId, TopId, Path)
->
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.42
diff -u -r1.42 declarative_debugger.m
--- browser/declarative_debugger.m 19 Nov 2004 11:54:16 -0000 1.42
+++ browser/declarative_debugger.m 26 Nov 2004 03:49:35 -0000
@@ -16,7 +16,7 @@
% 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. It does this by a simple top-down search.
+% 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
@@ -31,6 +31,25 @@
%
% 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.
%
%-----------------------------------------------------------------------------%
@@ -228,7 +247,14 @@
% needed so the root of the new tree can have the
% correct preceding node.
%
- ; require_subtree(event_number, sequence_number, R).
+ ; require_subtree(event_number, sequence_number, R)
+
+ % 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.
+ %
+ ; require_supertree(event_number, sequence_number).
:- type diagnoser_state(R).
@@ -407,11 +433,16 @@
handle_oracle_response(Store, OracleResponse, Response, !Diagnoser,
!IO).
-handle_analyser_response(Store, require_explicit(Tree), _, Response,
- Diagnoser, Diagnoser, !IO) :-
- edt_subtree_details(Store, Tree, Event, Seqno, CallPreceding),
+handle_analyser_response(Store, require_explicit_subtree(Node), _,
+ Response, Diagnoser, Diagnoser, !IO) :-
+ edt_subtree_details(Store, Node, Event, Seqno, CallPreceding),
Response = require_subtree(Event, Seqno, CallPreceding).
+handle_analyser_response(Store, require_explicit_supertree(Node), _,
+ Response, Diagnoser, Diagnoser, !IO) :-
+ edt_subtree_details(Store, Node, Event, Seqno, _),
+ Response = require_supertree(Event, Seqno).
+
handle_analyser_response(Store, revise(Question), _, Response, !Diagnoser, !IO)
:-
Oracle0 = !.Diagnoser ^ oracle_state,
@@ -543,8 +574,17 @@
:- pragma export(diagnoser_require_subtree(in, out, out, out),
"MR_DD_diagnoser_require_subtree").
-diagnoser_require_subtree(require_subtree(Event, SeqNo, CallPreceding), Event,
- SeqNo, CallPreceding).
+diagnoser_require_subtree(require_subtree(Event, SeqNo, CallPreceding),
+ Event, SeqNo, CallPreceding).
+
+:- pred diagnoser_require_supertree(diagnoser_response(trace_node_id),
+ event_number, sequence_number).
+:- mode diagnoser_require_supertree(in, out, out) is semidet.
+
+:- pragma export(diagnoser_require_supertree(in, out, out),
+ "MR_DD_diagnoser_require_supertree").
+
+diagnoser_require_supertree(require_supertree(Event, SeqNo), Event, SeqNo).
%-----------------------------------------------------------------------------%
Index: browser/declarative_edt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_edt.m,v
retrieving revision 1.1
diff -u -r1.1 declarative_edt.m
--- browser/declarative_edt.m 19 Nov 2004 11:54:16 -0000 1.1
+++ browser/declarative_edt.m 29 Nov 2004 08:04:17 -0000
@@ -29,7 +29,12 @@
% particular search algorithm.
%
% By convention nodes in the search space are referred to as `suspects', while
-% nodes in the EDT are referred to as `EDT nodes', or just `nodes'.
+% nodes in the EDT are referred to as `EDT nodes', or just `nodes'.
+%
+% Also we use the term "root" to refer to the root of the smallest subtree in
+% the search space that must contain a bug based on the answers received so
+% far and the term "topmost" for the suspect in the search space with the
+% lowest depth.
%
:- module mdb.declarative_edt.
@@ -85,6 +90,17 @@
%
pred edt_children(S::in, T::in, list(T)::out) is semidet,
+ % Return a parent of an EDT node. Using the annotated trace to
+ % generate the EDT there may be more than one parent of a given
+ % node (see the comment above trace_last_parent/3 in
+ % declarative_tree.m). This member is required to
+ % deterministically pick one if this is the case. Fails if the
+ % node is the root of the initial explicit portion of the EDT,
+ % or the root of a portion of the EDT generated as an explicit
+ % supertree.
+ %
+ pred edt_parent(S::in, T::in, T::out) is semidet,
+
% Given a subterm of a tree, find the mode of that subterm
% and the origin of it amongst the parent, siblings or
% children.
@@ -100,7 +116,17 @@
% Succeeds if the Node is the root of an implicit subtree.
% Fails otherwise.
%
- pred edt_is_implicit_root(S::in, T::in) is semidet
+ pred edt_is_implicit_root(S::in, T::in) is semidet,
+
+ % True if the two nodes are the same even if one may
+ % be represented implicitly and the other explicitly.
+ %
+ pred edt_same_nodes(S::in, T::in, T::in) is semidet,
+
+ % True if it is not possible to materialize any nodes
+ % above the given node.
+ %
+ pred edt_topmost_node(S::in, T::in) is semidet
].
:- type subterm_mode
@@ -161,7 +187,8 @@
%
:- func empty_search_space = search_space(T).
- % Creates a new search space containing just the one EDT node.
+ % Creates a new search space containing just the one EDT node with
+ % an initial status of unknown.
%
:- pred initialise_search_space(T::in, search_space(T)::out) is det.
@@ -175,21 +202,21 @@
%
:- pred root(search_space(T)::in, suspect_id::out) is semidet.
- % Returns the root but throws an exception if the search space is
- % empty.
+ % Return the top most suspect in the search space and throw an
+ % exception if the search space is empty.
%
-:- pred root_det(search_space(T)::in, suspect_id::out) is det.
+:- pred topmost_det(search_space(T)::in, suspect_id::out) is det.
- % no_more_questions(Store, !SearchSpace, CorrectDescendents,
- % InadmissibleChildren).
- % Succeeds if the root of the search space has only correct,
+ % suspect_is_bug(Store, SuspectId, !SearchSpace, CorrectDescendents,
+ % InadmissibleChildren)
+ % Succeeds if the given suspect is erroneous and has only correct,
% inadmissible, pruned or ignored descendents. The direct children of
% the root who are inadmissible are placed in InadmissibleChildren.
% CorrectDescendents is all the correct and inadmissible
- % descendents of the root.
+ % descendents of the suspect.
%
-:- pred no_more_questions(S::in, search_space(T)::in, search_space(T)::out,
- list(suspect_id)::out, list(suspect_id)::out)
+:- pred suspect_is_bug(S::in, suspect_id::in, search_space(T)::in,
+ search_space(T)::out, list(suspect_id)::out, list(suspect_id)::out)
is semidet <= mercury_edt(S, T).
% children(Store, SuspectId, !SearchSpace, Children).
@@ -237,7 +264,7 @@
% find_subterm_origin(Store, SuspectId, ArgPos, TermPath, !SearchSpace,
% Response).
% Finds the origin of the subterm given by SuspectId, ArgPos and
- % TermPath in its immediate neighbors. If the children of a suspect
+ % TermPath in its immediate neighbours. If the children of a suspect
% are required then they'll be added to the search space, unless an
% explicit subtree is required in which case the appropriate response
% is returned (see definition of find_origin_response type below).
@@ -259,15 +286,20 @@
% The subterm was bound by a primitive operation inside
% the suspect. The arguments are the filename and line
% number of primitive op that bound the subterm.
- ; primitive_op(string, int)
+ ; primitive_op(suspect_id, string, int)
% The suspect is the root of an implicit subtree and
% the origin lies in one of it's children.
- ; require_explicit.
+ ; require_explicit_subtree
+
+ % The suspect is the root of the topmost explicit
+ % EDT and the origin lies in an ancestor. A new
+ % supertree needs to be generated.
+ ; require_explicit_supertree.
% Returns the depth of the suspect in the EDT.
%
-:- pred depth(suspect_id::in, search_space(T)::in, int::out) is det.
+:- func suspect_depth(search_space(T), suspect_id) = int.
% travel_up(SearchSpace, SuspectId, N, AncestorId).
% True iff AncestorId is the Nth ancestor of SuspectId in SearchSpace.
@@ -277,15 +309,25 @@
% incorporate_explicit_subtree(SuspectId, Node, !SearchSpace).
% Replaces the EDT node referenced by SuspectId with Node.
+ %
:- pred incorporate_explicit_subtree(suspect_id::in, T::in,
search_space(T)::in, search_space(T)::out) is det.
- % Makes the given suspect the root of the search space and also changes
- % it and all it's descendent's status to unknown (except for skipped
- % and ignored nodes which are left as is).
+ % incorporate_explicit_supertree(Store, Node, !SearchSpace).
+ % Node should be the implicit root in a newly generated supertree
+ % that represents the topmost node of the current search space.
+ % Node's parent will be inserted at the top of the search space.
+ %
+:- pred incorporate_explicit_supertree(S::in, T::in, search_space(T)::in,
+ search_space(T)::out) is det <= mercury_edt(S, T).
+
+ % extend_search_space_upwards(Store, !SearchSpace).
+ % Attempts to add the parent of the current topmost node to the
+ % search space. Fails if this is not possible because an explicit
+ % supertree is required.
%
-:- pred revise_suspect(suspect_id::in, search_space(T)::in,
- search_space(T)::out) is det.
+:- pred extend_search_space_upwards(S::in, search_space(T)::in,
+ search_space(T)::out) is semidet <= mercury_edt(S, T).
% Return the EDT node corresponding to the suspect_id.
%
@@ -368,11 +410,32 @@
:- pred suspect_correct_or_inadmissible(search_space(T)::in, suspect_id::in)
is semidet.
+ % When tracking a sub-term, should we give up if we reach the given
+ % suspect, because the binding node must lie in a portion of
+ % the tree we've already eliminated?
+ %
+:- pred give_up_subterm_tracking(search_space(T)::in, suspect_id::in)
+ is semidet.
+
+ % Are there any unknown or skipped suspects in the search space?
+ %
+:- pred are_unknown_suspects(search_space(T)::in) is semidet.
+
+ % Mark the root and it's non-ignored children as unknown.
+ % Throws an exception if the search space doesn't have a root.
+ %
+:- pred revise_root(search_space(T)::in, search_space(T)::out) is det.
+
+ % Check the consistency of the search space and throw an exception
+ % if it's not consistent. Used for debugging.
+ %
+:- pred check_search_space_consistency(search_space(T)::in, string::in) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module exception, map, int, counter, std_util, string, bool.
+:- import_module exception, map, int, counter, std_util, string, bool, bimap.
% A suspect is an edt node with some additional information relevant
% to the bug search.
@@ -392,6 +455,11 @@
status :: suspect_status,
% The depth of the suspect in the EDT.
+ % Initially the depth of the topmost node will
+ % be zero, however if a new explicit supertree
+ % is generated and added to the search space,
+ % we allow the depth of the new topmost node
+ % to be negative.
depth :: int,
% The children of the suspect. If this is
@@ -421,15 +489,19 @@
:- type search_space(T)
---> search_space(
- % The root of the (potentially) buggy subtree
- % in the search space. The search space root
- % will be the last suspect marked erroneous,
- % except for when the search first starts and
- % the oracle hasn't asserted any suspects are
- % erroneous, or when the root of the EDT is
- % revised (so its erroneous status is reset).
+ % The root of the subtree in the search space
+ % that contains a bug, based on the answers
+ % received so far. The search space root
+ % will be the last suspect marked erroneous,
+ % or no if no suspects have been marked
+ % erroneous yet.
root :: maybe(suspect_id),
+ % The topmost node of all the nodes in the
+ % search space. Will be no if the search
+ % space is empty.
+ topmost :: maybe(suspect_id),
+
% Counter for generating suspect_ids.
suspect_id_counter :: counter,
@@ -444,42 +516,50 @@
% A map of roots of implicit subtrees in the
% EDT to explicit subtrees.
- implicit_roots_to_explicit_roots :: map(T, T)
+ % We use a bimap so we can also find the
+ % implicit root given an explicit root.
+ %
+ implicit_roots_to_explicit_roots :: bimap(T, T),
+
+ % How many skipped or unknown suspects are in
+ % the search space?
+ unknown_count :: int,
+
+ % How many suspects in the search space have
+ % we not explored the children of whos children
+ % might be worth exploring? (i.e. we don't
+ % include unexplored children of correct,
+ % inadmissible or pruned suspects)
+ unexplored_leaves :: int
).
-empty_search_space = search_space(no, counter.init(0), counter.init(0),
- map.init, map.init).
+empty_search_space = search_space(no, no, counter.init(0), counter.init(0),
+ map.init, bimap.init, 0, 0).
root(SearchSpace, RootId) :- SearchSpace ^ root = yes(RootId).
-root_det(SearchSpace, RootId) :-
+topmost_det(SearchSpace, TopMostId) :-
(
- SearchSpace ^ root = yes(Id),
- RootId = Id
+ SearchSpace ^ topmost = yes(Id),
+ TopMostId = Id
;
- SearchSpace ^ root = no,
- throw(internal_error("root_det", "search space empty"))
+ SearchSpace ^ topmost = no,
+ throw(internal_error("topmost_det", "search space empty"))
).
-no_more_questions(Store, !SearchSpace, CorrectDescendents,
+are_unknown_suspects(SearchSpace) :- SearchSpace ^ unknown_count > 0.
+are_unknown_suspects(SearchSpace) :- SearchSpace ^ unexplored_leaves > 0.
+
+suspect_is_bug(Store, SuspectId, !SearchSpace, CorrectDescendents,
InadmissibleChildren) :-
- root_det(!.SearchSpace, RootId),
- !.SearchSpace ^ root = yes(RootId),
- \+ suspect_is_questionable(!.SearchSpace, RootId),
- (
- suspect_in_buggy_subtree(!.SearchSpace, RootId)
- ->
- children(Store, RootId, !SearchSpace, Children),
- non_ignored_descendents(Store, Children, !SearchSpace,
- Descendents),
- filter(suspect_correct_or_inadmissible(!.SearchSpace),
- Descendents, CorrectDescendents, []),
- filter(suspect_inadmissible(!.SearchSpace), Children,
- InadmissibleChildren)
- ;
- CorrectDescendents = [],
- InadmissibleChildren = []
- ).
+ suspect_erroneous(!.SearchSpace, SuspectId),
+ children(Store, SuspectId, !SearchSpace, Children),
+ non_ignored_descendents(Store, Children, !SearchSpace,
+ Descendents),
+ filter(suspect_correct_or_inadmissible(!.SearchSpace),
+ Descendents, CorrectDescendents, []),
+ filter(suspect_inadmissible(!.SearchSpace), Children,
+ InadmissibleChildren).
suspect_correct_or_inadmissible(SearchSpace, SuspectId) :-
lookup_suspect(SearchSpace, SuspectId, Suspect),
@@ -523,7 +603,7 @@
% Succeeds if we haven't got an answer from the oracle about this
% suspect, and haven't been able to infer anything about this suspect
- % from other oracle answers?
+ % from other oracle answers.
%
:- pred suspect_is_questionable(search_space(T)::in, suspect_id::in)
is semidet.
@@ -593,59 +673,125 @@
in_buggy_subtree(in_erroneous_subtree_complement, no).
in_buggy_subtree(unknown, yes).
-
- % Should the suspect's status be propogated to it's children when the
- % children are added to the search space?
+ % What status should be assigned to children of a node with the given
+ % status, when the children are being added to the search space?
%
-:- pred propogate_status_to_children(suspect_status::in, bool::out) is det.
+:- func new_child_status(suspect_status) = suspect_status.
-propogate_status_to_children(ignored, no).
-propogate_status_to_children(skipped(_), no).
-propogate_status_to_children(correct, no).
-propogate_status_to_children(erroneous, no).
-propogate_status_to_children(inadmissible, no).
-propogate_status_to_children(pruned, yes).
-propogate_status_to_children(in_erroneous_subtree_complement, yes).
-propogate_status_to_children(unknown, no).
+new_child_status(ignored) = unknown.
+new_child_status(skipped(_)) = unknown.
+new_child_status(correct) = pruned.
+new_child_status(erroneous) = unknown.
+new_child_status(inadmissible) = pruned.
+new_child_status(pruned) = pruned.
+new_child_status(in_erroneous_subtree_complement) =
+ in_erroneous_subtree_complement.
+new_child_status(unknown) = unknown.
+
+ % What status should be assigned to the parent of a node with the given
+ % status, when the parent is being added to the search space?
+ %
+:- func new_parent_status(suspect_status) = suspect_status.
+
+new_parent_status(ignored) = unknown.
+new_parent_status(skipped(_)) = unknown.
+new_parent_status(correct) = unknown.
+new_parent_status(erroneous) = in_erroneous_subtree_complement.
+new_parent_status(inadmissible) = unknown.
+new_parent_status(pruned) = pruned.
+new_parent_status(in_erroneous_subtree_complement) =
+ in_erroneous_subtree_complement.
+new_parent_status(unknown) = unknown.
+
+give_up_subterm_tracking(SearchSpace, SuspectId) :-
+ Status = get_status(SearchSpace, SuspectId),
+ (Status = erroneous ; Status = in_erroneous_subtree_complement).
-assert_suspect_is_correct(SuspectId, !SearchSpace) :-
+ % Mark the suspect as correct or inadmissible.
+ %
+:- pred assert_suspect_is_valid(suspect_status::in, suspect_id::in,
+ search_space(T)::in, search_space(T)::out) is det.
+
+assert_suspect_is_valid(Status, SuspectId, !SearchSpace) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
map.set(!.SearchSpace ^ store, SuspectId, Suspect ^ status :=
- correct, Store),
+ Status, Store),
!:SearchSpace = !.SearchSpace ^ store := Store,
+ adjust_unknown_count(yes(Suspect ^ status), Status, !SearchSpace),
(
Suspect ^ children = yes(Children),
- list.foldl(trickle_status(pruned), Children,
+ list.foldl(trickle_status(pruned, [correct, inadmissible]),
+ Children, !SearchSpace)
+ ;
+ Suspect ^ children = no,
+ adjust_unexplored_leaves(yes(Suspect ^ status), Status,
!SearchSpace)
+ ),
+ %
+ % If the suspect was erroneous or excluded because of another erronoeus
+ % suspect, then we should update the complement of the subtree rooted
+ % at the suspect to unknown.
+ %
+ (
+ excluded_complement(Suspect ^ status, yes)
+ ->
+ perculate_status(unknown, [erroneous], SuspectId, Lowest,
+ !SearchSpace),
+ %
+ % Update the root to the next lowest erroneous suspect.
+ %
+ (
+ suspect_erroneous(!.SearchSpace, Lowest)
+ ->
+ !:SearchSpace = !.SearchSpace ^ root := yes(Lowest)
+ ;
+ !:SearchSpace = !.SearchSpace ^ root := no
+ )
;
- Suspect ^ children = no
+ true
).
+assert_suspect_is_inadmissible(SuspectId, !SearchSpace) :-
+ assert_suspect_is_valid(inadmissible, SuspectId, !SearchSpace).
+
+assert_suspect_is_correct(SuspectId, !SearchSpace) :-
+ assert_suspect_is_valid(correct, SuspectId, !SearchSpace).
+
assert_suspect_is_erroneous(SuspectId, !SearchSpace) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
map.set(!.SearchSpace ^ store, SuspectId, Suspect ^ status :=
erroneous, Store),
!:SearchSpace = !.SearchSpace ^ store := Store,
- exclude_complement(SuspectId, !SearchSpace),
- !:SearchSpace = !.SearchSpace ^ root := yes(SuspectId).
-
-assert_suspect_is_inadmissible(SuspectId, !SearchSpace) :-
- lookup_suspect(!.SearchSpace, SuspectId, Suspect),
- map.set(!.SearchSpace ^ store, SuspectId, Suspect ^ status :=
- inadmissible, Store),
- !:SearchSpace = !.SearchSpace ^ store := Store,
+ adjust_unknown_count(yes(Suspect ^ status), erroneous, !SearchSpace),
(
- Suspect ^ children = yes(Children),
- list.foldl(trickle_status(pruned), Children,
+ Suspect ^ children = no,
+ adjust_unexplored_leaves(yes(Suspect ^ status), erroneous,
!SearchSpace)
;
- Suspect ^ children = no
- ).
+ Suspect ^ children = yes(Children),
+ %
+ % If the suspect was correct, inadmissible or pruned then we
+ % should make all the descendents unknown again.
+ %
+ (
+ excluded_subtree(Suspect ^ status, yes)
+ ->
+ list.foldl(trickle_status(unknown,
+ [correct, inadmissible]), Children,
+ !SearchSpace)
+ ;
+ true
+ )
+ ),
+ perculate_status(in_erroneous_subtree_complement, [erroneous],
+ SuspectId, _, !SearchSpace),
+ !:SearchSpace = !.SearchSpace ^ root := yes(SuspectId).
ignore_suspect(SuspectId, !SearchSpace) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
map.set(!.SearchSpace ^ store, SuspectId, Suspect ^ status :=
ignored, Store),
+ adjust_unknown_count(yes(Suspect ^ status), ignored, !SearchSpace),
!:SearchSpace = !.SearchSpace ^ store := Store.
skip_suspect(SuspectId, !SearchSpace) :-
@@ -656,9 +802,29 @@
skipped(N), Store),
!:SearchSpace = !.SearchSpace ^ store := Store.
-depth(SuspectId, SearchSpace, Depth) :-
- lookup_suspect(SearchSpace, SuspectId, Suspect),
- Suspect ^ depth = Depth.
+revise_root(!SearchSpace) :-
+ (
+ !.SearchSpace ^ root = yes(RootId),
+ force_trickle_status(unknown, [correct, inadmissible],
+ RootId, Leaves, !SearchSpace),
+ list.foldl(force_trickle_status(unknown, [correct,
+ inadmissible]), Leaves, !SearchSpace),
+ perculate_status(unknown, [erroneous], RootId, Lowest,
+ !SearchSpace),
+ (
+ suspect_erroneous(!.SearchSpace, Lowest)
+ ->
+ !:SearchSpace = !.SearchSpace ^ root := yes(Lowest)
+ ;
+ !:SearchSpace = !.SearchSpace ^ root := no
+ )
+ ;
+ !.SearchSpace ^ root = no,
+ throw(internal_error("revise_root", "no root"))
+ ).
+
+suspect_depth(SearchSpace, SuspectId) = Suspect ^ depth :-
+ lookup_suspect(SearchSpace, SuspectId, Suspect).
travel_up(SearchSpace, StartId, Distance, FinishId) :-
(
@@ -674,50 +840,95 @@
find_subterm_origin(Store, SuspectId, ArgPos, TermPath, !SearchSpace,
Response) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
- Node = Suspect ^ edt_node,
- edt_dependency(Store, Node, ArgPos, TermPath, Mode, Origin),
+ ImplicitToExplicit = !.SearchSpace ^
+ implicit_roots_to_explicit_roots,
+ % The node in the search space will be the explicit version.
+ ExplicitNode = Suspect ^ edt_node,
+ edt_subterm_mode(Store, ExplicitNode, ArgPos, TermPath, Mode),
+ %
+ % If the mode is input then the origin will be in the parent or a
+ % sibling. In either case we need access to the parent EDT node, so
+ % if the node is at the top of a generated explicit subtree we must use
+ % the implicit root instead, so the dependency tracking algorithm
+ % has access to the node's parent and siblings in the EDT.
+ %
(
- Origin = primitive_op(FileName, LineNo),
- Response = primitive_op(FileName, LineNo)
- ;
- Origin = not_found,
- Response = not_found
+ Mode = subterm_in,
+ bimap.search(ImplicitToExplicit, ImplicitNode, ExplicitNode)
+ ->
+ Node = ImplicitNode
;
- Origin = input(InputArgPos, InputTermPath),
+ Node = ExplicitNode
+ ),
+ (
+ Mode = subterm_in,
(
- Mode = subterm_in,
+ Suspect ^ parent = yes(ParentId),
+ resolve_origin(Store, Node, ArgPos, TermPath,
+ ParentId, !SearchSpace, Response)
+ ;
+ Suspect ^ parent = no,
(
- Suspect ^ parent = yes(ParentId),
- Response = origin(ParentId, InputArgPos,
- InputTermPath)
+ extend_search_space_upwards(Store,
+ !SearchSpace)
+ ->
+ topmost_det(!.SearchSpace, NewRootId),
+ resolve_origin(Store, Node, ArgPos,
+ TermPath, NewRootId, !SearchSpace,
+ Response)
;
- Suspect ^ parent = no,
- % Origin lies above the root of the search
- % space, so return not_found.
- Response = not_found
+ Response = require_explicit_supertree
)
- ;
- Mode = subterm_out,
- Response = origin(SuspectId, InputArgPos,
- InputTermPath)
)
;
+ Mode = subterm_out,
+ resolve_origin(Store, Node, ArgPos,
+ TermPath, SuspectId, !SearchSpace,
+ Response)
+ ).
+
+ % resolve_origin(Store, Node, ArgPos, TermPath, SuspectId,
+ % !SearchSpace, Response).
+ % Find the origin of the subterm in Node and report the origin as
+ % SuspectId if the origin is a primitive op or an input and as the
+ % appropriate child of SuspectId if the origin is an output. SuspectId
+ % should point to the parent of Node if the mode of the sub-term is
+ % input and should point to Node itself if the mode of the sub-term is
+ % output.
+ %
+:- pred resolve_origin(S::in, T::in, arg_pos::in, term_path::in,
+ suspect_id::in, search_space(T)::in, search_space(T)::out,
+ find_origin_response::out) is det <= mercury_edt(S, T).
+
+resolve_origin(Store, Node, ArgPos, TermPath, SuspectId, !SearchSpace,
+ Response) :-
+ edt_dependency(Store, Node, ArgPos, TermPath, _, Origin),
+ (
+ Origin = primitive_op(FileName, LineNo),
+ Response = primitive_op(SuspectId, FileName, LineNo)
+ ;
+ Origin = not_found,
+ Response = not_found
+ ;
+ Origin = input(InputArgPos, InputTermPath),
+ Response = origin(SuspectId, InputArgPos, InputTermPath)
+ ;
Origin = output(OriginNode, OutputArgPos, OutputTermPath),
(
- map.search(
- !.SearchSpace^implicit_roots_to_explicit_roots,
- OriginNode, ExplicitNode)
+ bimap.search(!.SearchSpace ^
+ implicit_roots_to_explicit_roots, OriginNode,
+ ExplicitNode)
->
ExplicitOrigin = ExplicitNode
;
ExplicitOrigin = OriginNode
),
(
- Mode = subterm_in,
- get_siblings(!.SearchSpace, SuspectId, Siblings),
+ children(Store, SuspectId, !SearchSpace, Children)
+ ->
(
- find_edt_node_in_suspect_list(Siblings,
- ExplicitOrigin, !.SearchSpace,
+ find_edt_node_in_suspect_list(Children,
+ ExplicitOrigin, !.SearchSpace,
OriginId)
->
Response = origin(OriginId, OutputArgPos,
@@ -728,28 +939,7 @@
"not in siblings"))
)
;
- Mode = subterm_out,
- (
- children(Store, SuspectId, !.SearchSpace,
- SearchSpace1, Children)
- ->
- !:SearchSpace = SearchSpace1,
- (
- find_edt_node_in_suspect_list(Children,
- ExplicitOrigin, !.SearchSpace,
- OriginId)
- ->
- Response = origin(OriginId,
- OutputArgPos, OutputTermPath)
- ;
- throw(internal_error(
- "find_subterm_origin",
- "output origin for output "++
- "subterm not in children"))
- )
- ;
- Response = require_explicit
- )
+ Response = require_explicit_subtree
)
).
@@ -787,64 +977,253 @@
"couldn't find suspect"))
).
- % Sets the status of a node and all it's descendents to the given
- % status. If a descendent already has the status then trickle_status
- % assumes all it's descendents already have the same status and won't
- % bother updating them.
+ % trickle_status(Status, StopStatusSet, SuspectId, Leaves,
+ % !SearchSpace).
+ % Sets the status of SuspectId and all it's descendents to Status.
+ % If a descendent (including the suspect) already has a status in
+ % StopStatusSet then trickle_status won't update any further
+ % descendents. The list of all the children of the lowest updated
+ % suspects is returned in Leaves.
%
-:- pred trickle_status(suspect_status::in, suspect_id::in, search_space(T)::in,
- search_space(T)::out) is det.
+:- pred trickle_status(suspect_status::in, list(suspect_status)::in,
+ suspect_id::in, list(suspect_id)::out,
+ search_space(T)::in, search_space(T)::out) is det.
+
+ % An accumulator version of trickle_status.
+ %
+trickle_status(Status, StopStatusSet, SuspectId, Leaves, !SearchSpace) :-
+ trickle_status(Status, StopStatusSet, SuspectId, [], Leaves,
+ !SearchSpace).
+
+ % A version of trickle_status which doesn't return Leaves.
+ %
+:- pred trickle_status(suspect_status::in, list(suspect_status)::in,
+ suspect_id::in, search_space(T)::in, search_space(T)::out) is det.
+
+trickle_status(Status, StopStatusSet, SuspectId, !SearchSpace) :-
+ trickle_status(Status, StopStatusSet, SuspectId, _,
+ !SearchSpace).
-trickle_status(Status, SuspectId, !SearchSpace) :-
+:- pred trickle_status(suspect_status::in, list(suspect_status)::in,
+ suspect_id::in, list(suspect_id)::in, list(suspect_id)::out,
+ search_space(T)::in, search_space(T)::out) is det.
+
+trickle_status(Status, StopStatusSet, SuspectId, !Leaves, !SearchSpace) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
(
- Suspect ^ status \= Status
+ \+ member(Suspect ^ status, StopStatusSet)
->
map.set(!.SearchSpace ^ store, SuspectId,
Suspect ^ status := Status, Store),
!:SearchSpace = !.SearchSpace ^ store := Store,
(
Suspect ^ children = yes(Children),
- list.foldl(trickle_status(Status), Children,
+ list.foldl2(trickle_status(Status, StopStatusSet),
+ Children, !Leaves, !SearchSpace)
+ ;
+ Suspect ^ children = no,
+ adjust_unexplored_leaves(yes(Suspect ^ status), Status,
!SearchSpace)
+ ),
+ adjust_unknown_count(yes(Suspect ^ status), Status,
+ !SearchSpace)
+ ;
+ !:Leaves = [SuspectId | !.Leaves]
+ ).
+
+ % force_trickle_status is like trickle_status, except that
+ % the given suspect's status will be changed no matter what its current
+ % status.
+ %
+:- pred force_trickle_status(suspect_status::in, list(suspect_status)::in,
+ suspect_id::in, search_space(T)::in, search_space(T)::out) is det.
+
+force_trickle_status(Status, StopStatusSet, SuspectId, !SearchSpace) :-
+ force_trickle_status(Status, StopStatusSet, SuspectId, _,
+ !SearchSpace).
+
+:- pred force_trickle_status(suspect_status::in, list(suspect_status)::in,
+ suspect_id::in, list(suspect_id)::out,
+ search_space(T)::in, search_space(T)::out) is det.
+
+force_trickle_status(Status, StopStatusSet, SuspectId, Leaves, !SearchSpace) :-
+ lookup_suspect(!.SearchSpace, SuspectId, Suspect),
+ map.set(!.SearchSpace ^ store, SuspectId,
+ Suspect ^ status := Status, Store),
+ !:SearchSpace = !.SearchSpace ^ store := Store,
+ (
+ Suspect ^ children = yes(Children),
+ list.foldl2(trickle_status(Status, StopStatusSet),
+ Children, [], Leaves, !SearchSpace)
+ ;
+ Suspect ^ children = no,
+ adjust_unexplored_leaves(yes(Suspect ^ status), Status,
+ !SearchSpace),
+ Leaves = []
+ ),
+ adjust_unknown_count(yes(Suspect ^ status), Status, !SearchSpace).
+
+ % Increments or decremenets the unknown suspect count after a status
+ % change. The 1st argument should be the previous status of the
+ % changed suspect or no if a new suspect is being added and the 2nd
+ % argument should be the suspect's new status.
+ %
+:- pred adjust_unknown_count(maybe(suspect_status)::in, suspect_status::in,
+ search_space(T)::in, search_space(T)::out) is det.
+
+adjust_unknown_count(MaybeOldStatus, NewStatus, !SearchSpace) :-
+ (
+ MaybeOldStatus = yes(OldStatus),
+ questionable(OldStatus, yes),
+ questionable(NewStatus, no)
+ ->
+ !:SearchSpace = !.SearchSpace ^ unknown_count :=
+ !.SearchSpace ^ unknown_count - 1
+ ;
+ questionable(NewStatus, yes),
+ (
+ MaybeOldStatus = no
+ ;
+ MaybeOldStatus = yes(OldStatus),
+ questionable(OldStatus, no)
+ )
+ ->
+ !:SearchSpace = !.SearchSpace ^ unknown_count :=
+ !.SearchSpace ^ unknown_count + 1
+ ;
+ true
+ ).
+
+ % Increments or decremenets the unexplored leaves count after a status
+ % change. The 1st argument should be the previous status of the
+ % changed suspect or no if a new suspect is being added and the 2nd
+ % argument should be the suspect's new status. The changed suspect
+ % should be a leaf node (i.e. have its children field set to no).
+ %
+:- pred adjust_unexplored_leaves(maybe(suspect_status)::in, suspect_status::in,
+ search_space(T)::in, search_space(T)::out) is det.
+
+adjust_unexplored_leaves(MaybeOldStatus, NewStatus, !SearchSpace) :-
+ (
+ MaybeOldStatus = yes(OldStatus),
+ in_buggy_subtree(OldStatus, yes),
+ in_buggy_subtree(NewStatus, no)
+ ->
+ !:SearchSpace = !.SearchSpace ^ unexplored_leaves :=
+ !.SearchSpace ^ unexplored_leaves - 1
+ ;
+ in_buggy_subtree(NewStatus, yes),
+ (
+ MaybeOldStatus = no
;
- Suspect ^ children = no
+ MaybeOldStatus = yes(OldStatus),
+ in_buggy_subtree(OldStatus, no)
)
+ ->
+ !:SearchSpace = !.SearchSpace ^ unexplored_leaves :=
+ !.SearchSpace ^ unexplored_leaves + 1
+ ;
+ true
+ ).
+
+ % Decrement the unexplored leaves count if the given status indicates
+ % that the suspect is in a potentially buggy part of the search space.
+ %
+:- pred decrement_unexplored_leaves(suspect_status::in,
+ search_space(T)::in, search_space(T)::out) is det.
+
+decrement_unexplored_leaves(OldStatus, !SearchSpace) :-
+ (
+ in_buggy_subtree(OldStatus, yes)
+ ->
+ !:SearchSpace = !.SearchSpace ^ unexplored_leaves :=
+ !.SearchSpace ^ unexplored_leaves - 1
;
true
).
- % Marks all suspects not in the subtree with the given suspect
- % as the root as in_erroneous_subtree_complement.
+check_search_space_consistency(SearchSpace, Context) :-
+ (
+ SearchSpace ^ unknown_count \= calc_num_unknown(SearchSpace)
+ ->
+ throw(internal_error("check_search_space_consistency",
+ "unknown count incorrect. search space follows.\n"
+ ++ string(SearchSpace) ++ "\n Context is:\n" ++
+ Context))
+ ;
+ SearchSpace ^ unexplored_leaves \= calc_num_unexplored(
+ SearchSpace)
+ ->
+ throw(internal_error("check_search_space_consistency",
+ "unexplored leaves incorrect. search space follows.\n"
+ ++ string(SearchSpace) ++ "\n Context is:\n" ++
+ Context))
+ ;
+ true
+ ).
+
+ % Work out the number of unknown suspects in the search space.
+ % Used for assertion checking.
+:- func calc_num_unknown(search_space(T)) = int.
+
+calc_num_unknown(SearchSpace) = NumUnknown :-
+ Suspects = map.values(SearchSpace ^ store),
+ list.filter(
+ ( pred(suspect(_, _, Status, _, _)::in) is semidet :-
+ questionable(Status, yes)
+ ), Suspects, Questionable),
+ NumUnknown = list.length(Questionable).
+
+ % Work out the number of suspects with unexplored children.
+ % Used for assertion checking.
+:- func calc_num_unexplored(search_space(T)) = int.
+
+calc_num_unexplored(SearchSpace) = NumUnexplored :-
+ Suspects = map.values(SearchSpace ^ store),
+ list.filter(
+ ( pred(suspect(_, _, Status, _, no)::in) is semidet :-
+ in_buggy_subtree(Status, yes)
+ ), Suspects, Unexplored),
+ NumUnexplored = list.length(Unexplored).
+
+ % perculate_status(Status, StopStatusSet, SuspectId, Lowest,
+ % !SearchSpace)
+ % Marks all suspects not in the subtree rooted at SuspectId
+ % with Status. If an ancestor of SuspectId has a status in
+ % StopStatusSet, then perculation will not progress passed this
+ % ancestor. The lowest ancestor of SuspectId with a status in
+ % StopStatusSet is returned in Lowest. If there are no ancestors
+ % with a status in StopStatusSet then Lowest will be the topmost
+ % suspect.
%
-:- pred exclude_complement(suspect_id::in, search_space(T)::in,
- search_space(T)::out) is det.
+:- pred perculate_status(suspect_status::in, list(suspect_status)::in,
+ suspect_id::in, suspect_id::out,
+ search_space(T)::in, search_space(T)::out) is det.
-exclude_complement(SuspectId, !SearchSpace) :-
+perculate_status(Status, StopStatusSet, SuspectId, Lowest, !SearchSpace) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
- Status = get_status(!.SearchSpace, SuspectId),
(
- Status \= in_erroneous_subtree_complement
+ Suspect ^ parent = yes(ParentId)
->
+ get_siblings(!.SearchSpace, SuspectId, Siblings),
+ list.foldl(trickle_status(Status, StopStatusSet), Siblings,
+ !SearchSpace),
+ lookup_suspect(!.SearchSpace, ParentId, Parent),
(
- Suspect ^ parent = yes(ParentId)
+ \+ list.member(Parent ^ status, StopStatusSet)
->
- get_siblings(!.SearchSpace, SuspectId, Siblings),
- list.foldl(trickle_status(
- in_erroneous_subtree_complement),
- Siblings, !SearchSpace),
- exclude_complement(ParentId, !SearchSpace),
- lookup_suspect(!.SearchSpace, ParentId, Parent),
+ perculate_status(Status, StopStatusSet, ParentId,
+ Lowest, !SearchSpace),
map.set(!.SearchSpace ^ store, ParentId,
- Parent ^ status :=
- in_erroneous_subtree_complement, Store),
- !:SearchSpace = !.SearchSpace ^ store := Store,
- !:SearchSpace = !.SearchSpace ^ root := yes(SuspectId)
+ Parent ^ status := Status, Store),
+ adjust_unknown_count(yes(Parent ^ status), Status,
+ !SearchSpace),
+ !:SearchSpace = !.SearchSpace ^ store := Store
;
- true
+ Lowest = ParentId
)
;
- true
+ Lowest = SuspectId
).
% Find the siblings of a suspect in the search space. This does not
@@ -895,7 +1274,8 @@
!:SearchSpace = !.SearchSpace ^ suspect_id_counter := Counter,
map.set(!.SearchSpace ^ store, SuspectId,
Suspect ^ children := yes(Children), Store),
- !:SearchSpace = !.SearchSpace ^ store := Store.
+ !:SearchSpace = !.SearchSpace ^ store := Store,
+ decrement_unexplored_leaves(Suspect ^ status, !SearchSpace).
:- pred add_children_2(list(T)::in, suspect_id::in, suspect_status::in,
int::in, search_space(T)::in, search_space(T)::out, counter::in,
@@ -905,63 +1285,179 @@
add_children_2([EDTChild | EDTChildren], SuspectId, Status, Depth,
!SearchSpace, !Counter, Children) :-
- (
- allocate(NextId, !Counter),
- map.det_insert(!.SearchSpace ^ store, NextId,
- suspect(yes(SuspectId), EDTChild, Status, Depth,
- no), Store),
- !:SearchSpace = !.SearchSpace ^ store := Store,
- add_children_2(EDTChildren, SuspectId, Status, Depth,
- !SearchSpace, !Counter, OtherChildren),
- Children = [NextId | OtherChildren]
- ).
+ allocate(NextId, !Counter),
+ map.det_insert(!.SearchSpace ^ store, NextId,
+ suspect(yes(SuspectId), EDTChild, Status, Depth,
+ no), Store),
+ !:SearchSpace = !.SearchSpace ^ store := Store,
+ adjust_unknown_count(no, Status, !SearchSpace),
+ adjust_unexplored_leaves(no, Status, !SearchSpace),
+ add_children_2(EDTChildren, SuspectId, Status, Depth,
+ !SearchSpace, !Counter, OtherChildren),
+ Children = [NextId | OtherChildren].
initialise_search_space(Node, SearchSpace) :-
map.set(init, 0, suspect(no, Node, unknown, 0, no), SuspectStore),
- SearchSpace = search_space(yes(0), counter.init(1),
- counter.init(0), SuspectStore, map.init).
+ SearchSpace = search_space(no, yes(0), counter.init(1),
+ counter.init(0), SuspectStore, bimap.init, 1, 1).
incorporate_explicit_subtree(SuspectId, Node, !SearchSpace) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
map.set(!.SearchSpace ^ store, SuspectId, Suspect ^ edt_node := Node,
Store),
!:SearchSpace = !.SearchSpace ^ store := Store,
- map.set(!.SearchSpace ^ implicit_roots_to_explicit_roots,
+ bimap.set(!.SearchSpace ^ implicit_roots_to_explicit_roots,
Suspect ^ edt_node, Node, ImplicitToExplicit),
!:SearchSpace =
!.SearchSpace ^ implicit_roots_to_explicit_roots :=
ImplicitToExplicit.
-
-revise_suspect(SuspectId, !SearchSpace) :-
- !:SearchSpace = !.SearchSpace ^ root := yes(SuspectId),
- revise_suspects(SuspectId, !SearchSpace).
-:- pred revise_suspects(suspect_id::in, search_space(T)::in,
- search_space(T)::out) is det.
-
-revise_suspects(SuspectId, !SearchSpace) :-
- lookup_suspect(!.SearchSpace, SuspectId, Suspect),
- Status = Suspect ^ status,
+incorporate_explicit_supertree(Store, Node, !SearchSpace) :-
+ topmost_det(!.SearchSpace, OldTopMostId),
(
- ( Status = ignored ; Status = skipped(_) ; Status = unknown )
+ edt_parent(Store, Node, Parent)
->
- true
+ insert_new_topmost_node(Store, Parent, !SearchSpace),
+ %
+ % Node implicitly represents the root of the old search space,
+ % which we already have an explicit version of, so we link
+ % the two by placing an entry in
+ % implicit_roots_to_explicit_roots.
+ %
+ bimap.set(!.SearchSpace ^ implicit_roots_to_explicit_roots,
+ Node, get_edt_node(!.SearchSpace, OldTopMostId),
+ ImplicitToExplicit),
+ !:SearchSpace =
+ !.SearchSpace ^ implicit_roots_to_explicit_roots :=
+ ImplicitToExplicit
+ ;
+ throw(internal_error("incorporate_explicit_supertree",
+ "no parent"))
+ ).
+
+extend_search_space_upwards(Store, !SearchSpace) :-
+ topmost_det(!.SearchSpace, OldTopMostId),
+ edt_parent(Store, get_edt_node(!.SearchSpace, OldTopMostId),
+ NewTopMost),
+ insert_new_topmost_node(Store, NewTopMost, !SearchSpace).
+
+ % Add the given EDT node to the top of the search space. The given
+ % node should be the parent of the current topmost node in the search
+ % space.
+ %
+:- pred insert_new_topmost_node(S::in, T::in,
+ search_space(T)::in, search_space(T)::out)
+ is det <= mercury_edt(S, T).
+
+insert_new_topmost_node(Store, NewTopMostEDTNode, !SearchSpace) :-
+ (
+ edt_children(Store, NewTopMostEDTNode, EDTChildren)
+ ->
+ topmost_det(!.SearchSpace, OldTopMostId),
+ lookup_suspect(!.SearchSpace, OldTopMostId, OldTopMost),
+ (
+ %
+ % One of the children of the new top most node will be
+ % the old topmost node so filter it out so it isn't
+ % added twice.
+ %
+ find_node_in_list(Store, EDTChildren,
+ OldTopMost ^ edt_node, Pos),
+ list.split_list(Pos - 1, EDTChildren, LeftChildren,
+ [_ | RightChildren])
+ ->
+ %
+ % Insert the new topmost node.
+ %
+ NewTopMostStatus = new_parent_status(
+ OldTopMost ^ status),
+ NewTopMostDepth = OldTopMost ^ depth - 1,
+ NewTopMost = suspect(no, NewTopMostEDTNode,
+ NewTopMostStatus, NewTopMostDepth, no),
+ some [!Counter, !SuspectStore] (
+ !:Counter = !.SearchSpace ^ suspect_id_counter,
+ counter.allocate(NewTopMostId, !Counter),
+ !:SearchSpace =
+ !.SearchSpace ^ suspect_id_counter :=
+ !.Counter,
+ !:SuspectStore = !.SearchSpace ^ store,
+ map.set(!.SuspectStore, NewTopMostId,
+ NewTopMost, !:SuspectStore),
+ !:SearchSpace = !.SearchSpace ^ store :=
+ !.SuspectStore
+ ),
+ SiblingStatus = new_child_status(NewTopMostStatus),
+ add_children(append(LeftChildren, RightChildren),
+ NewTopMostId, SiblingStatus, !SearchSpace,
+ ChildrenIds),
+
+ %
+ % Adjust the unexplored leaves count since the new top
+ % most node was added with no children.
+ %
+ adjust_unexplored_leaves(no, NewTopMostStatus,
+ !SearchSpace),
+
+ %
+ % Now add the old topmost node as a child to the new
+ % topmost node.
+ %
+ (
+ list.split_list(Pos - 1, ChildrenIds,
+ LeftChildrenIds, RightChildrenIds)
+ ->
+ append(LeftChildrenIds, [OldTopMostId |
+ RightChildrenIds],
+ NewTopMostChildrenIds)
+ ;
+ throw(internal_error("insert_new_topmost_node",
+ "invalid position"))
+ ),
+ some [!SuspectStore] (
+ !:SuspectStore = !.SearchSpace ^ store,
+ map.set(!.SuspectStore, NewTopMostId,
+ NewTopMost ^ children :=
+ yes(NewTopMostChildrenIds),
+ !:SuspectStore),
+ map.set(!.SuspectStore, OldTopMostId,
+ OldTopMost ^ parent :=
+ yes(NewTopMostId),
+ !:SuspectStore),
+ !:SearchSpace = !.SearchSpace ^ store :=
+ !.SuspectStore
+ ),
+ !:SearchSpace = !.SearchSpace ^ topmost :=
+ yes(NewTopMostId),
+
+ adjust_unknown_count(no, NewTopMostStatus,
+ !SearchSpace)
+ ;
+ throw(internal_error("insert_new_topmost_node",
+ "couldn't find event number"))
+ )
+
;
- map.set(!.SearchSpace ^ store, SuspectId,
- Suspect ^ status := unknown, Store),
- !:SearchSpace = !.SearchSpace ^ store := Store
- ),
+ throw(internal_error("insert_new_topmost_node",
+ "couldn't get new topmost node's children"))
+ ).
+
+:- pred find_node_in_list(S::in, list(T)::in, T::in,
+ int::out) is semidet <= mercury_edt(S, T).
+
+find_node_in_list(Store, [Node | Nodes], NodeToMatch, Pos) :-
(
- Suspect ^ children = yes(Children),
- foldl(revise_suspects, Children, !SearchSpace)
+ edt_same_nodes(Store, Node, NodeToMatch)
+ ->
+ Pos = 1
;
- Suspect ^ children = no
+ find_node_in_list(Store, Nodes, NodeToMatch, TailPos),
+ Pos = TailPos + 1
).
get_edt_node(SearchSpace, SuspectId) = Node :-
lookup_suspect(SearchSpace, SuspectId, Suspect),
Node = Suspect ^ edt_node.
-
+
% Return the status of the suspect.
:- func get_status(search_space(T), suspect_id) = suspect_status.
@@ -980,15 +1476,9 @@
;
Suspect ^ children = no,
edt_children(Store, Suspect ^ edt_node, EDTChildren),
- (
- propogate_status_to_children(Suspect ^ status, yes)
- ->
- add_children(EDTChildren, SuspectId, Suspect ^ status,
- !SearchSpace, Children)
- ;
- add_children(EDTChildren, SuspectId, unknown,
- !SearchSpace, Children)
- )
+ NewStatus = new_child_status(Suspect ^ status),
+ add_children(EDTChildren, SuspectId, NewStatus,
+ !SearchSpace, Children)
).
% non_ignored_descendents(Store, SuspectIds, !SearchSpace,
@@ -1020,15 +1510,15 @@
append(Descendents1, Descendents2, Descendents).
choose_skipped_suspect(SearchSpace, Skipped) :-
- SearchSpace ^ root = yes(RootId),
+ SearchSpace ^ topmost = yes(TopMostId),
% XXX This can be done more efficiently, but I don't think this
% predicate will be called too often.
- map.foldl(least_skipped(SearchSpace), SearchSpace ^ store, RootId,
+ map.foldl(least_skipped(SearchSpace), SearchSpace ^ store, TopMostId,
Skipped),
(
- RootId = Skipped
+ TopMostId = Skipped
=>
- skipped(_) = get_status(SearchSpace, RootId)
+ skipped(_) = get_status(SearchSpace, TopMostId)
).
% least_skipped(SearchSpace, SuspectId1, Suspect1, SuspectId2,
@@ -1142,7 +1632,7 @@
).
pick_implicit_root(Store, SearchSpace, ImplicitRoot) :-
- root(SearchSpace, RootId),
+ SearchSpace ^ root = yes(RootId),
find_first_implicit_root(Store, SearchSpace, [RootId], ImplicitRoot).
% Look for an implicit root in the descendents of each suspect in
@@ -1201,5 +1691,3 @@
get_path(SearchSpace, ParentId, TopId, [BottomId | PathSoFar],
Path)
).
-
-
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.28
diff -u -r1.28 declarative_execution.m
--- browser/declarative_execution.m 19 Nov 2004 11:54:16 -0000 1.28
+++ browser/declarative_execution.m 24 Nov 2004 10:53:41 -0000
@@ -35,8 +35,9 @@
---> call(
call_preceding :: R,
% Preceding event.
- call_last_exit_redo :: R,
- % Last EXIT or REDO event.
+ call_last_interface :: R,
+ % Last EXIT, REDO, FAIL or
+ % EXCP event.
call_atom :: trace_atom,
% Atom that was called.
call_seq :: sequence_number,
@@ -401,6 +402,8 @@
:- import_module mdb__declarative_debugger.
:- import_module int, map, exception, store.
:- import_module require.
+:- import_module mdb.declarative_edt.
+:- import_module string.
%-----------------------------------------------------------------------------%
@@ -1026,7 +1029,7 @@
trace_node_first_disj(later_disj(_, _, FirstDisj), FirstDisj).
% Export a version of this function to be called by C code
- % in trace/declarative_debugger.c.
+ % in trace/mercury_trace_declarative.c.
%
:- func step_left_in_contour_store(trace_node_store, trace_node(trace_node_id))
= trace_node_id.
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.10
diff -u -r1.10 declarative_tree.m
--- browser/declarative_tree.m 24 Nov 2004 08:46:28 -0000 1.10
+++ browser/declarative_tree.m 24 Nov 2004 22:57:59 -0000
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2002-2004 The University of Melbourne.
+% Copyright (C) 2002-2003 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.
%-----------------------------------------------------------------------------%
@@ -55,9 +55,12 @@
pred(edt_get_e_bug/4) is trace_get_e_bug,
pred(edt_get_i_bug/4) is trace_get_i_bug,
pred(edt_children/3) is trace_children,
+ pred(edt_parent/3) is trace_last_parent,
pred(edt_dependency/6) is trace_dependency,
pred(edt_subterm_mode/5) is trace_subterm_mode,
- pred(edt_is_implicit_root/2) is trace_is_implicit_root
+ pred(edt_is_implicit_root/2) is trace_is_implicit_root,
+ pred(edt_same_nodes/3) is trace_same_event_numbers,
+ pred(edt_topmost_node/2) is trace_topmost_node
].
%-----------------------------------------------------------------------------%
@@ -188,7 +191,65 @@
get_edt_node_initial_atom(Store, BugRef, BugAtom),
get_edt_node_initial_atom(Store, InadmissibleRef, InadmissibleAtom),
get_edt_node_event_number(Store, BugRef, Event).
-
+
+ % Finding the parent of a node in the EDT from an EXIT event is
+ % in actual fact not deterministic in the presence of backtracking,
+ % since one EXIT event could belong to multiple children if it is in
+ % a call which is backtracked over and each of these children could
+ % have different parents. We return the last interface event of the
+ % parent CALL event as the parent. This is okay since trace_parent is
+ % only used when an explicit subtree is generated which is above the
+ % previous subtree, so it doesn't really matter which parent we pick.
+ %
+:- pred trace_last_parent(wrap(S)::in, edt_node(R)::in, edt_node(R)::out)
+ is semidet <= annotated_trace(S, R).
+
+trace_last_parent(wrap(Store), dynamic(Ref), dynamic(Parent)) :-
+ det_edt_return_node_from_id(Store, Ref, Node),
+ (
+ Node = fail(_, CallId, _, _)
+ ;
+ Node = exit(_, CallId, _, _, _, _)
+ ;
+ Node = excp(_, CallId, _, _, _)
+ ),
+ call_node_from_id(Store, CallId, Call),
+ CallPrecId = Call ^ call_preceding,
+ step_left_to_call(Store, CallPrecId, ParentCallNode),
+ Parent = ParentCallNode ^ call_last_interface.
+
+:- pred trace_same_event_numbers(wrap(S)::in, edt_node(R)::in,
+ edt_node(R)::in) is semidet <= annotated_trace(S, R).
+
+trace_same_event_numbers(wrap(Store), dynamic(Ref1), dynamic(Ref2)) :-
+ det_edt_return_node_from_id(Store, Ref1, Node1),
+ det_edt_return_node_from_id(Store, Ref2, Node2),
+ (
+ Node1 = exit(_, _, _, _, Event, _),
+ Node2 = exit(_, _, _, _, Event, _)
+ ;
+ Node1 = fail(_, _, _, Event),
+ Node2 = fail(_, _, _, Event)
+ ;
+ Node1 = excp(_, _, _, _, Event),
+ Node2 = excp(_, _, _, _, Event)
+ ).
+
+:- pred trace_topmost_node(wrap(S)::in, edt_node(R)::in) is semidet
+ <= annotated_trace(S, R).
+
+trace_topmost_node(wrap(Store), dynamic(Ref)) :-
+ det_edt_return_node_from_id(Store, Ref, Node),
+ (
+ Node = exit(_, CallId, _, _, _, _)
+ ;
+ Node = fail(_, CallId, _, _)
+ ;
+ Node = excp(_, CallId, _, _, _)
+ ),
+ % The node is topmost of the call sequence number is 1.
+ call_node_from_id(Store, CallId, call(_, _, _, 1, _, _, _, _, _)).
+
:- pred trace_children(wrap(S)::in, edt_node(R)::in, list(edt_node(R))::out)
is semidet <= annotated_trace(S, R).
@@ -772,10 +833,6 @@
PrevNodeId = NegPrec
;
Node = cond(CondPrec, _, _)
- ->
- PrevNodeId = CondPrec
- ;
- Node = cond(CondPrec, _, failed)
->
PrevNodeId = CondPrec
;
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.398
diff -u -r1.398 user_guide.texi
--- doc/user_guide.texi 19 Nov 2004 11:54:21 -0000 1.398
+++ doc/user_guide.texi 29 Nov 2004 09:30:27 -0000
@@ -3215,8 +3215,17 @@
@c makes an assertion, and if the assertion is incorrect, the resulting
@c behaviour would be hard for non-developers to understand. The option is
@c therefore deliberately not documented.
-Starts declarative debugging
-using the current event as the initial symptom.
+Starts declarative debugging using the current event as the initial symptom.
+ at sp 1
+The declarative debugger searches for bugs in a debug tree. Only a portion of
+the debug tree is materialized at any time to save memory. When a new portion
+of the tree needs to be materialized the program being debugged is re-executed.
+How much of the debug tree is materialized at any one time can be controlled
+with the @samp{-d at var{depth}} or @samp{--depth-step-size @var{depth}} option.
+ at var{depth} is the maximum depth of any newly materialized portion of the debug
+tree. A higher value of @var{depth} will mean more memory is used, but the
+program will have to be re-executed less often. Set a higher @var{depth} for
+long-running programs to improve the performance of the declarative debugger.
@sp 1
@item trust @var{module-name}|@var{proc-spec}
@kindex trust (mdb command)
@@ -3289,16 +3298,13 @@
@sp 1
@item save @var{filename}
@kindex save (mdb command)
-Saves current set of breakpoints, the current set of aliases and the
+Saves the current set of breakpoints, the current set of aliases and the
current set of objects trusted by the declarative debugger
in the named file as a set of @samp{break}, @samp{alias} and @samp{trust}
commands.
Sourcing the file will recreate the current breakpoints and aliases and will
trust the currently trusted objects.
- at sp 1
-Saves current set of breakpoints and the current set of aliases
-in the named file as a set of @samp{break} and @samp{alias} commands.
-Sourcing the file will recreate the current breakpoints and aliases.
+objects.
@sp 1
@item quit [-y]
@kindex quit (mdb command)
@@ -3900,6 +3906,15 @@
If, say, the date was only wrong in the year part, then we could also have
marked the year subterm in which case the next question would have been about
the call that constructed the year part of the date.
+
+This feature is also useful when using the procedural debugger. Suppose you
+come accross a CALL event and you'd like to know where a particular input
+to the call came from. To find out you could first go to the final event by
+issuing a @samp{finish} command. Then invoke the declarative debugger with
+a @samp{dd} command. Then mark the input term you're interested in. The
+next question should be about the call that bound the term at which point you
+could issue a @samp{pd} command to return to the procedural debugger at the
+final event of the call that bound the term.
@subsubsection Trusting predicates, functions and modules
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.67
diff -u -r1.67 Mmakefile
--- tests/debugger/declarative/Mmakefile 24 Nov 2004 08:46:29 -0000 1.67
+++ tests/debugger/declarative/Mmakefile 24 Nov 2004 22:59:24 -0000
@@ -321,7 +321,7 @@
|| { grep . $@ /dev/null; exit 1; }
mapinit.out: mapinit mapinit.inp
- $(MDB) ./mapinit < mapinit.inp > mapinit.out 2>&1 \
+ $(MDB_STD) ./mapinit < mapinit.inp > mapinit.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
mismatch_on_call.out: mismatch_on_call mismatch_on_call.$(DEBUG_INP)
Index: tests/debugger/declarative/app.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/app.exp,v
retrieving revision 1.16
diff -u -r1.16 app.exp
--- tests/debugger/declarative/app.exp 16 Nov 2004 00:16:42 -0000 1.16
+++ tests/debugger/declarative/app.exp 20 Nov 2004 04:32:54 -0000
@@ -17,7 +17,9 @@
mdb> dd
app([4, 5], [6, 7, 8], [4, ...])
Valid? yes
-No bug found.
+app([3, 4, 5], [6, 7, 8], [3, ...])
+Valid? abort
+Diagnosis aborted.
E6: C5 EXIT pred app.app/3-0 (det) app.m:26 (app.m:28)
mdb> continue
E7: C4 EXIT pred app.app/3-0 (det) app.m:26 (app.m:28)
Index: tests/debugger/declarative/app.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/app.inp,v
retrieving revision 1.6
diff -u -r1.6 app.inp
--- tests/debugger/declarative/app.inp 18 Aug 2000 10:59:35 -0000 1.6
+++ tests/debugger/declarative/app.inp 20 Nov 2004 03:00:14 -0000
@@ -8,6 +8,7 @@
finish -n
dd
yes
+abort
continue
continue
continue
Index: tests/debugger/declarative/catch.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/catch.exp,v
retrieving revision 1.3
diff -u -r1.3 catch.exp
--- tests/debugger/declarative/catch.exp 19 Nov 2004 11:54:26 -0000 1.3
+++ tests/debugger/declarative/catch.exp 20 Nov 2004 05:08:06 -0000
@@ -21,6 +21,9 @@
the following: code that catches exceptions.
The debugger is a work in progress, and this is not supported in the
current version.
+mdb: warning: reached unknown label
+This may result in some exception events
+being omitted from the trace.
E3: C2 EXIT pred catch.p/2-0 (cc_multi) catch.m:18 (catch.m:9)
mdb> continue
exception(univ_cons("q: bad input"))
Index: tests/debugger/declarative/explicit_subtree.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/explicit_subtree.exp,v
retrieving revision 1.1
diff -u -r1.1 explicit_subtree.exp
--- tests/debugger/declarative/explicit_subtree.exp 19 Nov 2004 11:54:30 -0000 1.1
+++ tests/debugger/declarative/explicit_subtree.exp 26 Nov 2004 05:26:19 -0000
@@ -1,37 +1,93 @@
- E1: C1 CALL pred explicit_subtree.main/2-0 (det) explicit_subtree.m:13
+ E1: C1 CALL pred explicit_subtree.main/2-0 (det) explicit_subtree.m:15
mdb> mdb> Contexts will not be printed.
mdb> echo on
Command echo enabled.
-mdb> step
- E2: C2 CALL pred explicit_subtree.p/2-0 (det)
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> break divide2
+ 0: + stop interface pred explicit_subtree.divide2/3-0 (det)
+mdb> continue
+ E2: C2 CALL pred explicit_subtree.divide2/3-0 (det)
mdb> finish
- E3: C2 EXIT pred explicit_subtree.p/2-0 (det)
-mdb> dd
-p(110, 230)
-Valid? b 2
+ E3: C2 EXCP pred explicit_subtree.divide2/3-0 (det) t;c3;
+mdb> dd -ad3
+Call divide2(10, 0, _)
+Throws "zero denominator"
+Expected? browse 2
+browser> mark
+a(0)
+Valid? n
+q(49, 0, 49)
+Valid? y
+q(51, 0, 51)
+Valid? b 3
browser> mark
-q(0, 230, 230)
+q(1, 50, 51)
Valid? n
+q(0, 51, 51)
+Valid? y
Found incorrect contour:
-q(0, 230, 230)
+q(1, 50, 51)
Is this a bug? n
-q(0, 230, 230)
+q(1, 50, 51)
Valid? [no] y
-q(100, 10, 110)
+q(50, 1, 51)
Valid? y
-q(200, 30, 230)
+Found incorrect contour:
+q(51, 0, 51)
+Is this a bug? n
+q(51, 0, 51)
Valid? y
Found incorrect contour:
-p(110, 230)
+a(0)
Is this a bug? n
-p(110, 230)
-Valid? b 1
+a(0)
+Valid? [no]
+q(49, 0, 49)
+Valid? [yes] b 3
browser> mark
-q(0, 110, 110)
+q(1, 48, 49)
+Valid? n
+q(0, 49, 49)
Valid? n
Found incorrect contour:
-q(0, 110, 110)
-Is this a bug? y
- E4: C3 EXIT pred explicit_subtree.q/3-0 (det)
-mdb> continue
-{110, 230}
+q(0, 49, 49)
+Is this a bug? n
+q(0, 49, 49)
+Valid? [no] y
+Found incorrect contour:
+q(1, 48, 49)
+Is this a bug? n
+q(1, 48, 49)
+Valid? [no] y
+q(48, 1, 49)
+Valid? y
+Found incorrect contour:
+q(49, 0, 49)
+Is this a bug? n
+q(49, 0, 49)
+Valid? y
+q(51, 0, 51)
+Valid? [yes]
+Found incorrect contour:
+a(0)
+Is this a bug? n
+a(0)
+Valid? [no] y
+Call calc(10, _)
+Throws "zero denominator"
+Expected? y
+Call p3(10, _)
+Throws "zero denominator"
+Expected? y
+Call p2(10, _)
+Throws "zero denominator"
+Expected? b 1
+browser> mark
+Call main(_, _)
+Throws "zero denominator"
+Expected? y
+No bug found.
+ E3: C2 EXCP pred explicit_subtree.divide2/3-0 (det) t;c3;
+mdb> quit -y
Index: tests/debugger/declarative/explicit_subtree.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/explicit_subtree.exp2,v
retrieving revision 1.1
diff -u -r1.1 explicit_subtree.exp2
--- tests/debugger/declarative/explicit_subtree.exp2 19 Nov 2004 11:54:30 -0000 1.1
+++ tests/debugger/declarative/explicit_subtree.exp2 29 Nov 2004 07:45:56 -0000
@@ -1,37 +1,126 @@
- E1: C1 CALL pred explicit_subtree.main/2-0 (det) explicit_subtree.m:13
-mdb> mdb> mdb> Contexts will not be printed.
+ E1: C1 CALL pred explicit_subtree.main/2-0 (det) explicit_subtree.m:15
+mdb> mdb> Contexts will not be printed.
mdb> echo on
Command echo enabled.
-mdb> step
- E2: C2 CALL pred explicit_subtree.p/2-0 (det)
+mdb> untrust 0
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> break divide2
+ 0: + stop interface pred explicit_subtree.divide2/3-0 (det)
+mdb> continue
+ E2: C2 CALL pred explicit_subtree.divide2/3-0 (det)
mdb> finish
- E3: C2 EXIT pred explicit_subtree.p/2-0 (det)
-mdb> dd
-p(110, 230)
-Valid? b 2
+ E3: C2 EXCP pred explicit_subtree.divide2/3-0 (det) t;c3;
+mdb> dd -ad3
+Call divide2(10, 0, _)
+Throws "zero denominator"
+Expected? browse 2
browser> mark
-+(229, 1) = 230
+-(100, 100) = 0
Valid? n
Found incorrect contour:
-+(229, 1) = 230
+-(100, 100) = 0
Is this a bug? n
-+(229, 1) = 230
+-(100, 100) = 0
Valid? [no] y
-q(100, 10, 110)
+Call calc(10, _)
+Throws "zero denominator"
+Expected? n
+>(10, 0)
+Valid? y
+a(0)
+Valid? n
+q(49, 0, 49)
+Valid? y
+q(51, 0, 51)
+Valid? b 3
+browser> mark
++(50, 1) = 51
+Valid? n
+Found incorrect contour:
++(50, 1) = 51
+Is this a bug? n
++(50, 1) = 51
+Valid? [no] y
+Call =<(51, 0)
+No solutions.
+Complete? y
+-(51, 1) = 50
+Valid? y
++(0, 1) = 1
+Valid? y
+q(50, 1, 51)
+Valid? y
+Found incorrect contour:
+q(51, 0, 51)
+Is this a bug? n
+q(51, 0, 51)
Valid? y
-q(200, 30, 230)
++(49, 51) = 100
Valid? y
Found incorrect contour:
-p(110, 230)
+a(0)
Is this a bug? n
-p(110, 230)
-Valid? b 1
+a(0)
+Valid? [no] n
+q(49, 0, 49)
+Valid? [yes] b 3
browser> mark
-+(109, 1) = 110
++(48, 1) = 49
Valid? n
Found incorrect contour:
-+(109, 1) = 110
-Is this a bug? y
- E4: C3 EXIT func int.+/2-0 (det)
-mdb> continue
-{110, 230}
++(48, 1) = 49
+Is this a bug? n
++(48, 1) = 49
+Valid? [no] y
+Call =<(49, 0)
+No solutions.
+Complete? y
+-(49, 1) = 48
+Valid? y
++(0, 1) = 1
+Valid? [yes] y
+q(48, 1, 49)
+Valid? y
+Found incorrect contour:
+q(49, 0, 49)
+Is this a bug? n
+q(49, 0, 49)
+Valid? y
+q(51, 0, 51)
+Valid? [yes] y
++(49, 51) = 100
+Valid? [yes] y
+-(100, 100) = 0
+Valid? [yes] y
+Found incorrect contour:
+a(0)
+Is this a bug? n
+a(0)
+Valid? [no] y
+Call divide2(10, 0, _)
+Throws "zero denominator"
+Expected? y
+Found unhandled exception:
+calc(10, _)
+"zero denominator"
+Is this a bug? n
+Call calc(10, _)
+Throws "zero denominator"
+Expected? [no] y
+Call p3(10, _)
+Throws "zero denominator"
+Expected? y
+Call p2(10, _)
+Throws "zero denominator"
+Expected? y
+Call p1(10, _)
+Throws "zero denominator"
+Expected? y
+Call main(_, _)
+Throws "zero denominator"
+Expected? y
+No bug found.
+ E3: C2 EXCP pred explicit_subtree.divide2/3-0 (det) t;c3;
+mdb> quit -y
Index: tests/debugger/declarative/explicit_subtree.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/explicit_subtree.inp,v
retrieving revision 1.1
diff -u -r1.1 explicit_subtree.inp
--- tests/debugger/declarative/explicit_subtree.inp 19 Nov 2004 11:54:30 -0000 1.1
+++ tests/debugger/declarative/explicit_subtree.inp 29 Nov 2004 08:16:15 -0000
@@ -1,19 +1,44 @@
register --quiet
context none
echo on
-step
+table_io allow
+table_io start
+break divide2
+continue
finish
-dd
-b 2
+dd -ad3
+browse 2
mark
n
+y
+b 3
+mark
n
y
+n
y
y
n
-b 1
+y
+n
+
+b 3
mark
n
+n
+n
y
-continue
+n
+y
+y
+n
+y
+
+n
+y
+y
+y
+b 1
+mark
+y
+quit -y
Index: tests/debugger/declarative/explicit_subtree.inp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/explicit_subtree.inp2,v
retrieving revision 1.1
diff -u -r1.1 explicit_subtree.inp2
--- tests/debugger/declarative/explicit_subtree.inp2 19 Nov 2004 11:54:31 -0000 1.1
+++ tests/debugger/declarative/explicit_subtree.inp2 29 Nov 2004 06:53:28 -0000
@@ -1,20 +1,57 @@
register --quiet
-untrust 0
context none
echo on
-step
+untrust 0
+table_io allow
+table_io start
+break divide2
+continue
finish
-dd
-b 2
+dd -ad3
+browse 2
mark
n
n
y
+n
y
+n
y
+b 3
+mark
+n
n
-b 1
+y
+y
+y
+y
+y
+n
+y
+y
+n
+n
+b 3
mark
n
+n
y
-continue
+y
+y
+y
+y
+n
+y
+y
+y
+y
+n
+y
+y
+n
+y
+y
+y
+y
+y
+quit -y
Index: tests/debugger/declarative/explicit_subtree.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/explicit_subtree.m,v
retrieving revision 1.1
diff -u -r1.1 explicit_subtree.m
--- tests/debugger/declarative/explicit_subtree.m 19 Nov 2004 11:54:31 -0000 1.1
+++ tests/debugger/declarative/explicit_subtree.m 22 Nov 2004 02:46:18 -0000
@@ -1,3 +1,5 @@
+% Test the tracking of a subterm through an explicit supertree.
+
:- module explicit_subtree.
:- interface.
@@ -8,16 +10,52 @@
:- implementation.
-:- import_module int, list.
+:- import_module int, exception.
main(!IO) :-
- p(X, Y),
- write({X, Y}, !IO),
+ p1(10, Q),
+ write_int(Q, !IO),
nl(!IO).
-:- pred p(int::out, int::out) is det.
+:- pred p1(int::in, int::out) is det.
+:- pred p2(int::in, int::out) is det.
+:- pred p3(int::in, int::out) is det.
+
+p1(X, Y) :- p2(X, Y).
+p2(X, Y) :- p3(X, Y).
+p3(X, Y) :- calc(X, Y).
+
+:- pred calc(int::in, int::out) is det.
+
+calc(X, Y) :-
+ (
+ X > 0
+ ->
+ a(Z)
+ ;
+ b(Z)
+ ),
+ divide2(X, Z, Y).
+
+:- pred divide2(int::in, int::in, int::out) is det.
+
+divide2(N, D, Q) :-
+ (
+ D = 0
+ ->
+ throw("zero denominator")
+ ;
+ Q = N // D
+ ).
+
+:- pred b(int::out) is det.
+
+b(-1).
+
+:- pred a(int::out) is det.
-p(X, Y) :- q(100, 10, X),q(200, 30, Y).
+a(X + Y - 100) :-
+ q(49, 0, X), q(51, 0, Y).
:- pred q(int::in, int::in, int::out) is det.
Index: tests/debugger/declarative/mapinit.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/mapinit.exp,v
retrieving revision 1.1
diff -u -r1.1 mapinit.exp
--- tests/debugger/declarative/mapinit.exp 13 Mar 2003 01:47:10 -0000 1.1
+++ tests/debugger/declarative/mapinit.exp 20 Nov 2004 04:47:19 -0000
@@ -1,14 +1,14 @@
- 1: 1 1 CALL pred mapinit.main/2-0 (det) mapinit.m:28
+ E1: C1 CALL pred mapinit.main/2-0 (det) mapinit.m:28
mdb> echo on
Command echo enabled.
mdb> step
- 2: 2 2 CALL pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+ E2: C2 CALL pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
mdb> finish
- 3: 2 2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+ E3: C2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
mdb> dd
xmap_init(empty)
-Valid? y
-No bug found.
- 3: 2 2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+Valid? a
+Diagnosis aborted.
+ E3: C2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
mdb> c
two(0, "zero", empty, empty)
Index: tests/debugger/declarative/mapinit.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/mapinit.inp,v
retrieving revision 1.1
diff -u -r1.1 mapinit.inp
--- tests/debugger/declarative/mapinit.inp 13 Mar 2003 01:47:10 -0000 1.1
+++ tests/debugger/declarative/mapinit.inp 20 Nov 2004 03:07:36 -0000
@@ -2,5 +2,5 @@
step
finish
dd
-y
+a
c
Index: tests/debugger/declarative/revise_2.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/revise_2.exp,v
retrieving revision 1.1
diff -u -r1.1 revise_2.exp
--- tests/debugger/declarative/revise_2.exp 3 Feb 2003 05:19:32 -0000 1.1
+++ tests/debugger/declarative/revise_2.exp 20 Nov 2004 04:38:57 -0000
@@ -20,8 +20,7 @@
p(41)
Is this a bug? no
p(41)
-Valid? [no] yes
-No bug found.
+Valid? [no] pd
3: 2 2 EXIT pred revise_2.p/1-0 (det) revise_2.m:14 (revise_2.m:8)
mdb> continue
41
Index: tests/debugger/declarative/revise_2.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/revise_2.inp,v
retrieving revision 1.1
diff -u -r1.1 revise_2.inp
--- tests/debugger/declarative/revise_2.inp 3 Feb 2003 05:19:32 -0000 1.1
+++ tests/debugger/declarative/revise_2.inp 20 Nov 2004 03:09:12 -0000
@@ -8,5 +8,5 @@
no
no
no
-yes
+pd
continue
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.74
diff -u -r1.74 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 19 Nov 2004 11:54:46 -0000 1.74
+++ trace/mercury_trace_declarative.c 29 Nov 2004 09:16:27 -0000
@@ -25,6 +25,18 @@
** - An alternative front end could graphically display the
** generated trees as part of a visualization tool rather
** than analyzing them for bugs.
+**
+** The backend decides which events should be included in the annotated trace.
+** Given a final event the backend can either build the
+** annotated trace for the subtree rooted at the final event down to a specified
+** depth limit, or can build the tree a specified number of ancestors above the
+** given event, with the given event as an implicit root of the existing trace.
+**
+** The backend can be called multiple times to materialize different portions
+** of the annotated trace. It is the responsibility of the frontend to
+** connect the various portions of the annotated trace together into a
+** complete tree. This is done in declarative_edt.m.
+**
*/
#include "mercury_imp.h"
@@ -101,28 +113,57 @@
static MR_Unsigned MR_edt_max_depth;
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;
-static MR_Unsigned MR_edt_initial_depth;
+static MR_Unsigned MR_edt_topmost_call_depth;
/*
-** The depth of the EDT is different from the call depth of the events,
-** since the call depth is not guaranteed to be the same for the children
-** of a call eventi - see comments in MR_trace_real in trace/mercury_trace.c.
-** We use the following variable to keep track of the EDT depth.
+** This tells MR_trace_decl_debug whether it is inside a portion of the
+** annotated trace that should be materialized (ignoring any depth limit). It
+** has opposite meanings depending on whether an explicit supertree or subtree
+** has been requested. When materializing a subtree it will be true for all
+** nodes in the subtree. When materializing a supertree it will be true for
+** all nodes outside the subtree above which a supertree was requested (we
+** don't want to include nodes in the subtree because that's already been
+** materialized).
*/
-static MR_Integer MR_edt_depth;
+static MR_bool MR_edt_inside;
/*
-** We only build the annotated trace for events down to a certain depth.
-** MR_edt_depth_step_size gives the default depth limit (relative to the
-** starting depth). In future it would be nice to adjust this factor based on
-** profiling information.
+** The initial event at which the `dd' command was given. This is used when
+** aborting diagnosis to return the user to the event where they initiated
+** the declarative debugging session.
*/
-
-static int MR_edt_depth_step_size = 3000;
+
+static MR_Unsigned MR_edt_initial_event;
+
+/*
+** This variable indicates whether we are building a supertree above a
+** given event or a subtree rooted at a given event.
+*/
+
+static MR_bool MR_edt_building_supertree;
+
+/*
+** The node returned to the frontend once a subtree or supertree has been
+** generated. If a supertree is generated then the implicit root in the
+** new supertree that represents the existing tree is returned, otherwise
+** the root of the new explicit subtree is returned.
+*/
+
+static MR_Trace_Node MR_edt_return_node;
+
+/*
+** The depth of the EDT is different from the call depth of the events, since
+** the call depth is not guaranteed to be the same for the children of a call
+** event - see comments in MR_trace_real in trace/mercury_trace.c. We use the
+** following variable to keep track of the EDT depth. We only keep track of
+** the depth of the portion of the EDT we are materializing. MR_edt_depth is 0
+** for the root of the tree we are materializing.
+*/
+
+static MR_Integer MR_edt_depth;
/*
** The declarative debugger ignores modules that were not compiled with
@@ -212,7 +253,8 @@
MR_Word *saved_regs);
static const char *MR_trace_start_collecting(MR_Unsigned event,
MR_Unsigned seqno, MR_Unsigned maxdepth,
- MR_Unsigned initial_depth,
+ MR_Unsigned topmost_call_depth,
+ MR_bool create_supertree,
MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info,
MR_Event_Details *event_details,
@@ -220,7 +262,9 @@
static MR_Code *MR_trace_restart_decl_debug(
MR_Trace_Node call_preceding,
MR_Unsigned event,
- MR_Unsigned seqno, MR_Trace_Cmd_Info *cmd,
+ MR_Unsigned seqno,
+ MR_bool create_supertree,
+ MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info,
MR_Event_Details *event_details);
static MR_Code *MR_decl_diagnosis(MR_Trace_Node root,
@@ -244,6 +288,13 @@
MR_bool MR_trace_decl_assume_all_io_is_tabled = MR_FALSE;
+MR_Integer MR_edt_depth_step_size = 3;
+
+/*
+** This function is called for every traced event when building the
+** annotated trace. It must decide which events are included in the
+** annotated trace.
+*/
MR_Code *
MR_trace_decl_debug(MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info)
{
@@ -257,7 +308,8 @@
entry = event_info->MR_event_sll->MR_sll_entry;
depth = event_info->MR_call_depth;
- if (event_info->MR_event_number > MR_edt_last_event) {
+ if (event_info->MR_event_number > MR_edt_last_event
+ && !MR_edt_building_supertree) {
/* This shouldn't ever be reached. */
fprintf(MR_mdb_err, "Warning: missed final event.\n");
fprintf(MR_mdb_err, "event %lu\nlast event %lu\n",
@@ -273,22 +325,102 @@
}
/*
- ** If this event is an interface event then increase or decrease
- ** the EDT depth appropriately.
+ ** Filter out events for compiler generated procedures.
+ ** XXX Compiler generated unify procedures should be included
+ ** in the annotated trace so that sub-term dependencies can be
+ ** tracked through them.
+ */
+ if (MR_PROC_LAYOUT_IS_UCI(entry)) {
+ /* && !MR_streq("__Unify__",
+ entry->MR_sle_proc_id.MR_proc_uci.MR_uci_pred_name)) {
+ */
+ return NULL;
+ }
+
+ /*
+ ** Decide if we are inside or outside the subtree or supertree that
+ ** needs to be materialized, ignoring for now any depth limit.
+ ** If we are materializing a supertree then MR_edt_inside will
+ ** be true whenever we are not in the subtree rooted at the call
+ ** corresponding to MR_edt_start_seqno. If we are materializing a
+ ** subtree then MR_edt_inside will be true whenever we are in the
+ ** subtree rooted at the call corresponding to MR_edt_start_segno.
+ */
+ if (MR_edt_building_supertree) {
+ if (!MR_edt_inside) {
+ if (event_info->MR_call_seqno == MR_edt_start_seqno &&
+ MR_port_is_final(event_info->MR_trace_port))
+ {
+ /*
+ ** We are exiting the subtree rooted at
+ ** MR_edt_start_seqno.
+ */
+ MR_edt_inside = MR_TRUE;
+ } else {
+ /*
+ ** We are in an existing explicit subtree.
+ */
+ MR_decl_checkpoint_filter(event_info);
+ return NULL;
+ }
+ } else {
+ if (event_info->MR_call_seqno == MR_edt_start_seqno) {
+ /*
+ ** The port must be either CALL or REDO;
+ ** we are leaving the supertree and entering
+ ** the existing explicit subtree.
+ ** We must still however add this node to the
+ ** genertaed EDT, so we don't return here.
+ */
+ MR_edt_inside = MR_FALSE;
+ }
+ }
+ } else {
+ if (MR_edt_inside) {
+ if (event_info->MR_call_seqno == MR_edt_start_seqno &&
+ MR_port_is_final(event_info->MR_trace_port))
+ {
+ /*
+ ** We are leaving the topmost call.
+ */
+ MR_edt_inside = MR_FALSE;
+ }
+ } else {
+ if (event_info->MR_call_seqno == MR_edt_start_seqno) {
+ /*
+ ** The port must be either CALL or REDO;
+ ** we are (re)entering the topmost call.
+ */
+ MR_edt_inside = MR_TRUE;
+ } else {
+ /*
+ ** Ignore this event---it is outside the
+ ** topmost call.
+ */
+ MR_decl_checkpoint_filter(event_info);
+ return NULL;
+ }
+ }
+ }
+
+ /*
+ ** If the current event is an interface event then increase or decrease
+ ** the EDT depth appropriately. Note that we must be inside the
+ ** portion of the trace being materialized (ignoring the depth limit)
+ ** when we reach this point.
*/
if (event_info->MR_trace_port == MR_PORT_CALL
|| event_info->MR_trace_port == MR_PORT_REDO) {
MR_edt_depth++;
+ depth_check_adjustment = 0;
}
- if (event_info->MR_trace_port == MR_PORT_EXIT
- || event_info->MR_trace_port == MR_PORT_FAIL
- || event_info->MR_trace_port == MR_PORT_EXCEPTION) {
+ if (MR_port_is_final(event_info->MR_trace_port)) {
/*
- ** The depth of the EXIT, FAIL or EXCP event is actually
- ** MR_edt_depth (not MR_edt_depth-1), however we need to
- ** adjust the depth here for future events. This
- ** inconsistency is neutralised by adjusting the depth
- ** limit check by setting depth_check_adjustment.
+ ** The depth of the EXIT, FAIL or EXCP event is
+ ** actually MR_edt_depth (not MR_edt_depth-1), however
+ ** we need to adjust the depth here for future events.
+ ** This inconsistency is neutralised by adjusting the
+ ** depth limit check by setting depth_check_adjustment.
*/
MR_edt_depth--;
depth_check_adjustment = 1;
@@ -317,39 +449,6 @@
return NULL;
}
- if (MR_edt_inside) {
- if (event_info->MR_call_seqno == MR_edt_start_seqno &&
- MR_port_is_final(event_info->MR_trace_port))
- {
- /*
- ** We are leaving the topmost call.
- */
- MR_edt_inside = MR_FALSE;
- }
- } else {
- if (event_info->MR_call_seqno == MR_edt_start_seqno) {
- /*
- ** The port must be either CALL or REDO;
- ** we are (re)entering the topmost call.
- */
- MR_edt_inside = MR_TRUE;
- } else {
- /*
- ** Ignore this event---it is outside the
- ** topmost call.
- */
- MR_decl_checkpoint_filter(event_info);
- return NULL;
- }
- }
-
- if (MR_PROC_LAYOUT_IS_UCI(entry)) {
- /*
- ** Filter out events for compiler generated procedures.
- */
- return NULL;
- }
-
trace_suppress = entry->MR_sle_module_layout->MR_ml_suppressed_events;
if (trace_suppress != 0) {
/*
@@ -427,11 +526,19 @@
MR_trace_call_depth = event_details.MR_call_depth;
MR_trace_event_number = event_details.MR_event_number;
- if (MR_trace_event_number == MR_edt_last_event) {
+ if (event_info->MR_call_seqno == MR_edt_start_seqno &&
+ MR_port_is_final(event_info->MR_trace_port))
+ {
+ MR_edt_return_node = MR_trace_current_node;
+ }
+
+ if ((!MR_edt_building_supertree &&
+ MR_trace_event_number == MR_edt_last_event)
+ || (MR_edt_building_supertree && MR_edt_depth == 0)) {
/*
** Call the front end.
*/
- return MR_decl_diagnosis(MR_trace_current_node, cmd,
+ return MR_decl_diagnosis(MR_edt_return_node, cmd,
event_info, &event_details);
}
@@ -1144,10 +1251,14 @@
MR_Retry_Result result;
const MR_Proc_Layout *entry;
FILE *out;
- MR_Unsigned depth_limit;
+ MR_Unsigned edt_depth_limit;
const char *message;
MR_Trace_Level trace_level;
+ MR_edt_return_node = (MR_Trace_Node) NULL;
+
+ MR_edt_initial_event = event_details->MR_event_number;
+
if (!MR_port_is_final(event_info->MR_trace_port)) {
fflush(MR_mdb_out);
fprintf(MR_mdb_err,
@@ -1211,16 +1322,16 @@
MR_trace_decl_mode = trace_mode;
MR_trace_decl_ensure_init();
- depth_limit = event_info->MR_call_depth + MR_edt_depth_step_size;
- MR_edt_initial_depth = event_info->MR_call_depth;
- MR_edt_depth = MR_edt_initial_depth;
+ edt_depth_limit = MR_edt_depth_step_size;
+ MR_edt_topmost_call_depth = event_info->MR_call_depth;
+ MR_edt_depth = 0;
MR_trace_current_node = (MR_Trace_Node) NULL;
message = MR_trace_start_collecting(event_info->MR_event_number,
- event_info->MR_call_seqno, depth_limit,
- MR_edt_initial_depth, cmd, event_info, event_details,
- jumpaddr);
+ event_info->MR_call_seqno, edt_depth_limit,
+ MR_edt_topmost_call_depth, MR_FALSE, cmd, event_info,
+ event_details, jumpaddr);
if (message == NULL) {
return MR_TRUE;
@@ -1237,26 +1348,39 @@
static MR_Code *
MR_trace_restart_decl_debug(
MR_Trace_Node call_preceding, MR_Unsigned event, MR_Unsigned seqno,
- MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info,
- MR_Event_Details *event_details)
+ MR_bool create_supertree, MR_Trace_Cmd_Info *cmd, MR_Event_Info
+ *event_info, MR_Event_Details *event_details)
{
- MR_Unsigned depth_limit;
+ MR_Unsigned edt_depth_limit;
const char *message;
MR_Code *jumpaddr;
- depth_limit = MR_edt_max_depth + MR_edt_depth_step_size;
+ MR_edt_return_node = (MR_Trace_Node) NULL;
/*
- ** Set this to the preceding node, so the new subtree's parent is
+ ** Set this to the preceding node, so the new explicit tree's parent is
** resolved correcly.
*/
MR_trace_current_node = call_preceding;
- MR_edt_depth = MR_edt_initial_depth;
+ /*
+ ** If we're going to build a supertree above the current root, then
+ ** adjust the depth of the topmost node.
+ */
+ if (create_supertree) {
+ if (MR_edt_depth_step_size < MR_edt_topmost_call_depth) {
+ MR_edt_topmost_call_depth -= MR_edt_depth_step_size;
+ } else {
+ MR_edt_topmost_call_depth = 1;
+ }
+ }
+ edt_depth_limit = MR_edt_depth_step_size + 1;
+
+ MR_edt_depth = 0;
- message = MR_trace_start_collecting(event, seqno, depth_limit,
- MR_edt_initial_depth, cmd, event_info, event_details,
- &jumpaddr);
+ message = MR_trace_start_collecting(event, seqno, edt_depth_limit,
+ MR_edt_topmost_call_depth, create_supertree, cmd,
+ event_info, event_details, &jumpaddr);
if (message != NULL) {
fflush(MR_mdb_out);
@@ -1272,21 +1396,22 @@
static const char *
MR_trace_start_collecting(MR_Unsigned event, MR_Unsigned seqno,
- MR_Unsigned maxdepth, MR_Unsigned initial_depth,
- MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info,
- MR_Event_Details *event_details, MR_Code **jumpaddr)
+ MR_Unsigned maxdepth, MR_Unsigned topmost_call_depth,
+ MR_bool create_supertree, MR_Trace_Cmd_Info *cmd, MR_Event_Info
+ *event_info, MR_Event_Details *event_details, MR_Code **jumpaddr)
{
const char *problem;
MR_Retry_Result retry_result;
+ MR_Unsigned retry_levels;
/*
** Go back to an event before the topmost call.
*/
retry_result = MR_trace_retry(event_info, event_details,
- event_info->MR_call_depth - initial_depth,
- MR_RETRY_IO_ONLY_IF_SAFE,
- MR_trace_decl_assume_all_io_is_tabled, &problem, NULL, NULL,
- jumpaddr);
+ event_info->MR_call_depth - topmost_call_depth,
+ MR_RETRY_IO_INTERACTIVE,
+ MR_trace_decl_assume_all_io_is_tabled, &problem,
+ MR_mdb_in, MR_mdb_out, jumpaddr);
if (retry_result != MR_RETRY_OK_DIRECT) {
if (retry_result == MR_RETRY_ERROR) {
return problem;
@@ -1305,11 +1430,17 @@
** desired depth bound.
*/
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;
+ if (create_supertree) {
+ MR_edt_inside = MR_TRUE;
+ } else {
+ MR_edt_inside = MR_FALSE;
+ }
+ MR_edt_building_supertree = create_supertree;
+
/*
** Restore globals from the saved copies.
*/
@@ -1344,6 +1475,7 @@
MR_bool symptom_found;
MR_bool no_bug_found;
MR_bool require_subtree;
+ MR_bool require_supertree;
MR_Unsigned bug_event;
MR_Unsigned symptom_event;
MR_Unsigned final_event;
@@ -1427,6 +1559,9 @@
(MR_Integer *) &final_event,
(MR_Integer *) &topmost_seqno,
(MR_Trace_Node *) &call_preceding);
+ require_supertree = MR_DD_diagnoser_require_supertree(response,
+ (MR_Integer *) &final_event,
+ (MR_Integer *) &topmost_seqno);
);
MR_trace_call_seqno = event_details->MR_call_seqno;
@@ -1446,22 +1581,29 @@
if (no_bug_found) {
/*
** No bug found. Return to the procedural debugger at the
- ** current event, which was the event it was left from.
+ ** event where the `dd' command was initially given.
*/
- MR_trace_decl_mode = MR_TRACE_INTERACTIVE;
- MR_debug_enabled = MR_TRUE;
- MR_update_trace_func_enabled();
- return MR_trace_event_internal(cmd, MR_TRUE, event_info);
+ return MR_decl_go_to_selected_event(MR_edt_initial_event, cmd,
+ event_info, event_details);
}
if (require_subtree) {
/*
- ** Front end requires a subtree to be made explicit.
- ** Restart the declarative debugger with deeper
- ** depth limit.
+ ** Front end requires a subtree to be made explicit. Restart
+ ** the declarative debugger with the appropriate depth limit.
*/
return MR_trace_restart_decl_debug(call_preceding,
- final_event, topmost_seqno,
+ final_event, topmost_seqno, MR_FALSE,
+ cmd, event_info, event_details);
+ }
+
+ if (require_supertree) {
+ /*
+ ** Front end requires a supertree to be made
+ ** explicit.
+ */
+ return MR_trace_restart_decl_debug((MR_Trace_Node)NULL,
+ final_event, topmost_seqno, MR_TRUE,
cmd, event_info, event_details);
}
@@ -1486,10 +1628,11 @@
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,
- MR_RETRY_IO_ONLY_IF_SAFE,
- MR_trace_decl_assume_all_io_is_tabled,
- &problem, NULL, NULL, &jumpaddr);
+ retry_result = MR_trace_retry(event_info, event_details,
+ event_info->MR_call_depth - MR_edt_topmost_call_depth,
+ MR_RETRY_IO_INTERACTIVE,
+ MR_trace_decl_assume_all_io_is_tabled, &problem,
+ MR_mdb_in, MR_mdb_out, &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_declarative.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.19
diff -u -r1.19 mercury_trace_declarative.h
--- trace/mercury_trace_declarative.h 16 Nov 2004 00:45:14 -0000 1.19
+++ trace/mercury_trace_declarative.h 19 Nov 2004 11:56:02 -0000
@@ -81,4 +81,13 @@
#define MR_TRACE_STATUS_FAILED (MR_Word) 1
#define MR_TRACE_STATUS_UNDECIDED (MR_Word) 2
+/*
+** We only build the annotated trace for events down to a certain depth.
+** MR_edt_depth_step_size gives the default depth limit (relative to the
+** starting depth). In future it would be nice to adjust this factor based on
+** profiling information.
+*/
+
+extern MR_Integer MR_edt_depth_step_size;
+
#endif /* MERCURY_TRACE_DECLARATIVE_H */
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.180
diff -u -r1.180 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 16 Nov 2004 00:45:14 -0000 1.180
+++ trace/mercury_trace_internal.c 19 Nov 2004 11:56:02 -0000
@@ -532,8 +532,8 @@
MR_bool *split, MR_bool *close_window, char ***words,
int *word_count, const char *cat, const char*item);
static MR_bool MR_trace_options_dd(MR_bool *assume_all_io_is_tabled,
- char ***words, int *word_count,
- const char *cat, const char *item);
+ MR_Integer *depth_step_size, char ***words,
+ int *word_count, const char *cat, const char *item);
static MR_bool MR_trace_options_type_ctor(MR_bool *print_rep,
MR_bool *print_functors, char ***words,
int *word_count, const char *cat, const char *item);
@@ -5335,8 +5335,9 @@
MR_Code **jumpaddr)
{
MR_trace_decl_assume_all_io_is_tabled = MR_FALSE;
+ MR_edt_depth_step_size = 3;
if (! MR_trace_options_dd(&MR_trace_decl_assume_all_io_is_tabled,
- &words, &word_count, "dd", "dd"))
+ &MR_edt_depth_step_size, &words, &word_count, "dd", "dd"))
{
; /* the usage message has already been printed */
} else if (word_count == 1) {
@@ -5369,8 +5370,9 @@
const char *filename;
MR_trace_decl_assume_all_io_is_tabled = MR_FALSE;
+ MR_edt_depth_step_size = 3;
if (! MR_trace_options_dd(&MR_trace_decl_assume_all_io_is_tabled,
- &words, &word_count, "dd", "dd_dd"))
+ &MR_edt_depth_step_size, &words, &word_count, "dd", "dd_dd"))
{
; /* the usage message has already been printed */
} else if (word_count <= 2) {
@@ -5380,7 +5382,7 @@
} else {
trace_mode = MR_TRACE_DECL_DEBUG_DEBUG;
filename = (const char *) NULL;
- }
+ }
if (MR_trace_start_decl_debug(trace_mode, filename,
cmd, event_info, event_details, jumpaddr))
@@ -6369,25 +6371,33 @@
static struct MR_option MR_trace_dd_opts[] =
{
{ "assume-all-io-is-tabled", MR_no_argument, NULL, 'a' },
+ { "depth-step-size", MR_required_argument, NULL, 'd' },
{ NULL, MR_no_argument, NULL, 0 }
};
static MR_bool
-MR_trace_options_dd(MR_bool *assume_all_io_is_tabled,
- char ***words, int *word_count, const char *cat, const char *item)
+MR_trace_options_dd(MR_bool *assume_all_io_is_tabled,
+ MR_Integer *depth_step_size, char ***words, int *word_count, const char
+ *cat, const char *item)
{
int c;
MR_optind = 0;
- while ((c = MR_getopt_long(*word_count, *words, "a", MR_trace_dd_opts,
- NULL)) != EOF)
+ while ((c = MR_getopt_long(*word_count, *words, "ad:",
+ MR_trace_dd_opts, NULL)) != EOF)
{
switch (c) {
case 'a':
*assume_all_io_is_tabled = MR_TRUE;
break;
-
+ case 'd':
+ if (!MR_trace_is_natural_number(MR_optarg,
+ depth_step_size)) {
+ MR_trace_usage(cat, item);
+ return MR_FALSE;
+ }
+ break;
default:
MR_trace_usage(cat, item);
return MR_FALSE;
--------------------------------------------------------------------------
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