[m-rev.] for review: change the way IO actions are handled in the declarative debugger
Ian MacLarty
maclarty at cs.mu.OZ.AU
Wed Jun 15 16:39:50 AEST 2005
For review by anyone.
Estimated hours taken: 4
Branches: main
Do not build an IO action map to pass around to predicates in the
declarative debugger that need access to IO actions.
Instead look these up directly in the IO state.
When using the declarative debugger to debug the Mercury compiler invoked
on typecheck.m, which generates about 2.3 million IO actions,
this change reduces the memory consumption by roughly half and reduces
the delay between the end of execution trace generation and the asking of the
first question from about 30 seconds to about 2 seconds.
Use the --force-disable-tracing option to turn off tracing in the browser
directory, even in .debug and .decldebug grades.
browser/MDB_FLAGS.in:
Turn off tracing for all code in the browser directory.
browser/declarative_analyser.m:
Remove the IO action map from the analyser state.
Reformat a comment.
browser/declarative_debugger.m:
Do not initialise the IO action map, since it no longer exists.
For final atoms, record a range of IO action numbers, instead
a list of IO actions. The actions themselves can be looked up from
the numbers when needed.
browser/declarative_edt.m:
Remove references to the IO action map.
browser/declarative_tree.m:
Remove references to the IO action map.
browser/declarative_user.m:
Look up tabled IO actions directly in the IO state when they need to be
displayed.
Implement a predicate, find_tabled_io_action, which finds a particular
tabled IO action given a range of IO action numbers and the sought
tabled IO action number.
Change several predicates to use the above instead of looking for
the IO actions in a list.
Implement a predicate, count_tabled_io_actions, which counts how many
tabled and untabled IO actions are in a range of IO action numbers.
Modify some predicates to use above.
browser/io_action.m:
Remove the io_action_map type and predicates used to construct values
of this type.
Add a new predicate, get_maybe_io_action, which looks up a possibly
untabled IO action number and returns the IO action if it was tabled.
The type returned by this predicate is maybe_tabled_io_action, which
has two functors: tabled/1 and untabled/1. The argument of the
untabled/1 functor is pointless, since it's just the IO action number,
which is required to look up the return value of get_maybe_io_action
in the first place. Remove the pointless argument.
Add a new type, io_action_range, for recording a range of IO actions.
Add an explicit `may_call_mercury' assertion to the pickup_io_action
foreign proc.
trace/mercury_trace_declarative.c:
Do not keep track of the start and finish IO action numbers for
the generated portions of the EDT and do not pass these to the
frontend. We still record the current IO action number at each
CALL and EXIT event.
Fix a bug in the progress indicator which is exposed when event
numbers become very big.
Index: browser/MDB_FLAGS.in
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/MDB_FLAGS.in,v
retrieving revision 1.1
diff -u -r1.1 MDB_FLAGS.in
--- browser/MDB_FLAGS.in 6 May 2005 08:42:06 -0000 1.1
+++ browser/MDB_FLAGS.in 15 Jun 2005 05:46:09 -0000
@@ -4,6 +4,7 @@
--no-warn-inferred-erroneous
--no-mercury-stdlib-dir
--no-shlib-linker-use-install-name
+--force-disable-tracing
-I../library
-I../mdbcomp
-I../browser
Index: browser/declarative_analyser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_analyser.m,v
retrieving revision 1.25
diff -u -r1.25 declarative_analyser.m
--- browser/declarative_analyser.m 10 May 2005 04:28:20 -0000 1.25
+++ browser/declarative_analyser.m 15 Jun 2005 05:46:09 -0000
@@ -21,7 +21,6 @@
:- import_module mdb.declarative_debugger.
:- import_module mdb.declarative_edt.
:- import_module mdb.declarative_oracle.
-:- import_module mdb.io_action.
:- import_module std_util, io.
@@ -60,9 +59,9 @@
:- func top_down_search_mode = search_mode.
-:- pred analyser_state_init(io_action_map::in, analyser_state(T)::out) is det.
+:- pred analyser_state_init(analyser_state(T)::out) is det.
- % Resets the state of the analyser except for the io_action_map.
+ % Resets the state of the analyser.
%
:- pred reset_analyser(analyser_state(T)::in, analyser_state(T)::out) is det.
@@ -72,9 +71,6 @@
:- pred set_fallback_search_mode(search_mode::in,
analyser_state(T)::in, analyser_state(T)::out) is det.
-:- pred analyser_state_replace_io_map(io_action_map::in,
- analyser_state(T)::in, analyser_state(T)::out) is det.
-
:- type analysis_type(T)
% Use the given tree to do analysis. The tree will be
% a new explicitly generated portion of the annotated
@@ -286,10 +282,6 @@
% it gets an answer.
last_search_question :: maybe(suspect_and_reason),
- % This field allows us to map I/O action
- % numbers to the actions themselves.
- io_action_map :: io_action_map,
-
% This field is present only to make it easier
% to debug the dependency tracking algorithm;
% if bound to yes, it records the result of
@@ -311,22 +303,19 @@
% explicit tree.
; explicit_supertree.
-analyser_state_init(IoActionMap, Analyser) :-
+analyser_state_init(Analyser) :-
Analyser = analyser(empty_search_space, no, top_down,
- top_down, no, IoActionMap, no).
+ top_down, no, no).
reset_analyser(!Analyser) :-
FallBack = !.Analyser ^ fallback_search_mode,
!:Analyser = analyser(empty_search_space, no, FallBack,
- FallBack, no, !.Analyser ^ io_action_map, no).
+ FallBack, no, no).
set_fallback_search_mode(FallBackSearchMode, !Analyser) :-
!:Analyser = !.Analyser ^ fallback_search_mode := FallBackSearchMode,
!:Analyser = !.Analyser ^ search_mode := FallBackSearchMode.
-analyser_state_replace_io_map(IoActionMap, !Analyser) :-
- !:Analyser = !.Analyser ^ io_action_map := IoActionMap.
-
debug_analyser_state(Analyser, Analyser ^ debug_origin).
start_or_resume_analysis(Store, Oracle, AnalysisType, Response, !Analyser) :-
@@ -338,8 +327,7 @@
SearchSpace0 = !.Analyser ^ search_space,
(
TreeType = explicit_supertree,
- incorporate_explicit_supertree(
- !.Analyser ^ io_action_map, Store,
+ incorporate_explicit_supertree(Store,
Oracle, Node, SearchSpace0,
SearchSpace)
;
@@ -363,8 +351,7 @@
topmost_det(SearchSpace, TopMostId),
!:Analyser = !.Analyser ^ last_search_question :=
yes(suspect_and_reason(TopMostId, start)),
- edt_question(!.Analyser ^ io_action_map, Store, Node,
- Question),
+ edt_question(Store, Node, Question),
Response = revise(Question)
)
;
@@ -450,8 +437,7 @@
root(SearchSpace, RootId)
->
Node = get_edt_node(!.Analyser ^ search_space, RootId),
- edt_question(!.Analyser ^ io_action_map, Store, Node,
- Question),
+ edt_question(Store, Node, Question),
Response = revise(Question),
revise_root(Store, SearchSpace, SearchSpace1),
!:Analyser = !.Analyser ^ search_space := SearchSpace1,
@@ -474,8 +460,7 @@
"Start of decide_analyser_response"),
some [!SearchSpace] (
!:SearchSpace = !.Analyser ^ search_space,
- search(!.Analyser ^ io_action_map, Store, Oracle, !SearchSpace,
- !.Analyser ^ search_mode,
+ search(Store, Oracle, !SearchSpace, !.Analyser ^ search_mode,
!.Analyser ^ fallback_search_mode, NewMode,
SearchResponse),
!:Analyser = !.Analyser ^ search_space := !.SearchSpace,
@@ -494,8 +479,7 @@
Response) :-
SearchSpace = !.Analyser ^ search_space,
Node = get_edt_node(SearchSpace, SuspectId),
- edt_question(!.Analyser ^ io_action_map, Store, Node,
- OracleQuestion),
+ edt_question(Store, Node, OracleQuestion),
(
(
suspect_unknown(SearchSpace, SuspectId)
@@ -539,22 +523,21 @@
handle_search_response(Store, found_bug(BugId, CorrectDescendents,
InadmissibleChildren), !Analyser, Response) :-
- bug_response(Store, !.Analyser ^ io_action_map,
- !.Analyser ^ search_space, BugId, [BugId | CorrectDescendents],
- InadmissibleChildren, Response).
+ bug_response(Store, !.Analyser ^ search_space, BugId,
+ [BugId | CorrectDescendents], InadmissibleChildren, Response).
- % bug_response(Store, IoActionMap, SearchSpace, BugId, Evidence,
+ % bug_response(Store, SearchSpace, BugId, Evidence,
% InadmissibleChildren, Response)
% Create a bug analyser-response using the given Evidence. If
% InadmissibleChildren isn't empty then an i_bug will be created,
% otherwise an e_bug will be created.
%
-:- pred bug_response(S::in, io_action_map::in, search_space(T)::in,
+:- pred bug_response(S::in, search_space(T)::in,
suspect_id::in, list(suspect_id)::in, list(suspect_id)::in,
analyser_response(T)::out) is det <= mercury_edt(S, T).
-bug_response(Store, IoActionMap, SearchSpace, BugId, Evidence,
- InadmissibleChildren, Response) :-
+bug_response(Store, SearchSpace, BugId, Evidence, InadmissibleChildren,
+ Response) :-
BugNode = get_edt_node(SearchSpace, BugId),
(
InadmissibleChildren = [InadmissibleChild | _],
@@ -563,11 +546,11 @@
Bug = i_bug(IBug)
;
InadmissibleChildren = [],
- edt_get_e_bug(IoActionMap, Store, BugNode, EBug),
+ edt_get_e_bug(Store, BugNode, EBug),
Bug = e_bug(EBug)
),
EDTNodes = list.map(get_edt_node(SearchSpace), Evidence),
- list.map(edt_question(IoActionMap, Store), EDTNodes,
+ list.map(edt_question(Store), EDTNodes,
EvidenceAsQuestions),
Response = bug_found(Bug, EvidenceAsQuestions).
@@ -579,44 +562,45 @@
% that the search algorithm being used can remember its current state
% next time round.
%
-:- pred search(io_action_map::in, S::in, oracle_state::in,
+:- pred search(S::in, oracle_state::in,
search_space(T)::in, search_space(T)::out,
search_mode::in, search_mode::in,
search_mode::out, search_response::out) is det <= mercury_edt(S, T).
-search(IoActionMap, Store, Oracle, !SearchSpace, top_down, FallBackSearchMode,
+search(Store, Oracle, !SearchSpace, top_down, FallBackSearchMode,
NewMode, Response) :-
- top_down_search(IoActionMap, Store, Oracle, !SearchSpace, Response),
+ top_down_search(Store, Oracle, !SearchSpace, Response),
% We always go back to the fallback search mode after a top-down
% search, because some fallback searches (such as divide and query)
% use top-down as a fail safe and we want the fallback search to
% resume after the top-down search.
NewMode = FallBackSearchMode.
-search(IoActionMap, Store, Oracle, !SearchSpace, SearchMode, FallBackSearchMode,
+search(Store, Oracle, !SearchSpace, SearchMode, FallBackSearchMode,
NewMode, Response) :-
- SearchMode = follow_subterm_end(SuspectId, ArgPos, TermPath, LastUnknown),
- follow_subterm_end_search(IoActionMap, Store, Oracle, !SearchSpace,
+ SearchMode = follow_subterm_end(SuspectId, ArgPos, TermPath,
+ LastUnknown),
+ follow_subterm_end_search(Store, Oracle, !SearchSpace,
LastUnknown, SuspectId, ArgPos, TermPath, FallBackSearchMode,
NewMode, Response).
-search(IoActionMap, Store, Oracle, !SearchSpace, SearchMode,
- FallBackSearchMode, NewMode, Response) :-
+search(Store, Oracle, !SearchSpace, SearchMode, FallBackSearchMode, NewMode,
+ Response) :-
SearchMode = binary(PathArray, Top - Bottom, LastTested),
- binary_search(IoActionMap, Store, Oracle, PathArray, Top, Bottom,
+ binary_search(Store, Oracle, PathArray, Top, Bottom,
LastTested, !SearchSpace, FallBackSearchMode, NewMode,
Response).
-search(IoActionMap, Store, Oracle, !SearchSpace, divide_and_query, _, NewMode,
+search(Store, Oracle, !SearchSpace, divide_and_query, _, NewMode,
Response) :-
- divide_and_query_search(IoActionMap, Store, Oracle, !SearchSpace,
+ divide_and_query_search(Store, Oracle, !SearchSpace,
Response, NewMode).
-:- pred top_down_search(io_action_map::in, S::in, oracle_state::in,
+:- pred top_down_search(S::in, oracle_state::in,
search_space(T)::in, search_space(T)::out,
search_response::out) is det <= mercury_edt(S, T).
-top_down_search(IoActionMap, Store, Oracle, !SearchSpace, Response) :-
+top_down_search(Store, Oracle, !SearchSpace, Response) :-
%
% 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.
@@ -628,7 +612,7 @@
;
topmost_det(!.SearchSpace, Start)
),
- first_unknown_descendent(IoActionMap, Store, Oracle, Start,
+ first_unknown_descendent(Store, Oracle, Start,
!SearchSpace, MaybeUnknownDescendent),
(
MaybeUnknownDescendent = found(Unknown),
@@ -644,17 +628,18 @@
% Since the are no skipped suspects and no unknown
% suspects in the search space, if there is a root
% (i.e. an erroneous suspect), then it must be a bug.
- % Note that only top down search actually checks if a bug was
- % found. This is okay, since all the other search algorithms
- % call top down search if they can't find an unknown suspect.
+ % Note that only top down search actually checks if a
+ % bug was found. This is okay, since all the other
+ % search algorithms call top down search if they can't
+ % find an unknown suspect.
root(!.SearchSpace, BugId)
->
(
- children(IoActionMap, Store, Oracle, BugId,
+ children(Store, Oracle, BugId,
!SearchSpace, BugChildren),
- non_ignored_descendents(IoActionMap,
- Store, Oracle, BugChildren,
- !SearchSpace, NonIgnoredDescendents),
+ non_ignored_descendents(Store, Oracle,
+ BugChildren, !SearchSpace,
+ NonIgnoredDescendents),
list.filter(suspect_correct_or_inadmissible(
!.SearchSpace), NonIgnoredDescendents,
CorrectDescendents, [])
@@ -677,12 +662,10 @@
% supertree be generated.
%
(
- extend_search_space_upwards(
- IoActionMap, Store, Oracle,
- !.SearchSpace,
- ExtendedSearchSpace)
+ extend_search_space_upwards(Store, Oracle,
+ !.SearchSpace, ExtendedSearchSpace)
->
- top_down_search(IoActionMap, Store,
+ top_down_search(Store,
Oracle, ExtendedSearchSpace,
!:SearchSpace, Response)
;
@@ -706,16 +689,16 @@
Response = require_explicit_subtree(RequireExplicitId)
).
-:- pred follow_subterm_end_search(io_action_map::in, S::in, oracle_state::in,
+:- pred follow_subterm_end_search(S::in, oracle_state::in,
search_space(T)::in, search_space(T)::out,
maybe(suspect_id)::in, suspect_id::in,
arg_pos::in, term_path::in, search_mode::in, search_mode::out,
search_response::out) is det <= mercury_edt(S, T).
-follow_subterm_end_search(IoActionMap, Store, Oracle, !SearchSpace,
+follow_subterm_end_search(Store, Oracle, !SearchSpace,
LastUnknown, SuspectId, ArgPos, TermPath, FallBackSearchMode,
NewMode, SearchResponse) :-
- find_subterm_origin(IoActionMap, Store, Oracle, SuspectId, ArgPos,
+ find_subterm_origin(Store, Oracle, SuspectId, ArgPos,
TermPath, !SearchSpace, FindOriginResponse),
(
FindOriginResponse = primitive_op(BindingSuspectId, FileName,
@@ -765,7 +748,7 @@
setup_binary_search(!.SearchSpace,
Unknown, NewMode)
;
- search(IoActionMap, Store, Oracle,
+ search(Store, Oracle,
!SearchSpace, FallBackSearchMode,
FallBackSearchMode, NewMode,
SearchResponse)
@@ -781,7 +764,7 @@
subterm_no_proc_rep),
setup_binary_search(!.SearchSpace, Unknown, NewMode)
;
- search(IoActionMap, Store, Oracle, !SearchSpace,
+ search(Store, Oracle, !SearchSpace,
FallBackSearchMode, FallBackSearchMode,
NewMode, SearchResponse)
)
@@ -830,7 +813,7 @@
setup_binary_search(!.SearchSpace,
Unknown, NewMode)
;
- search(IoActionMap, Store, Oracle,
+ search(Store, Oracle,
!SearchSpace, FallBackSearchMode,
FallBackSearchMode, NewMode,
SearchResponse)
@@ -844,7 +827,7 @@
% information to continue (and find_subterm_origin will
% respond with not_found).
%
- follow_subterm_end_search(IoActionMap, Store, Oracle,
+ follow_subterm_end_search(Store, Oracle,
!SearchSpace, NewLastUnknown, OriginId,
OriginArgPos, OriginTermPath,
FallBackSearchMode, NewMode, SearchResponse)
@@ -881,12 +864,12 @@
"TopId not an ancestor of BottomId"))
).
-:- pred binary_search(io_action_map::in, S::in, oracle_state::in,
+:- pred binary_search(S::in, oracle_state::in,
array(suspect_id)::in, int::in, int::in, int::in,
search_space(T)::in, search_space(T)::out, search_mode::in,
search_mode::out, search_response::out) is det <= mercury_edt(S, T).
-binary_search(IoActionMap, Store, Oracle, PathArray, Top, Bottom, LastTested,
+binary_search(Store, Oracle, PathArray, Top, Bottom, LastTested,
!SearchSpace, FallBackSearchMode, NewMode, Response) :-
SuspectId = PathArray ^ elem(LastTested),
%
@@ -915,7 +898,7 @@
->
% Revert to the fallback search mode when binary search is
% over.
- search(IoActionMap, Store, Oracle, !SearchSpace,
+ search(Store, Oracle, !SearchSpace,
FallBackSearchMode, FallBackSearchMode, NewMode,
Response)
;
@@ -932,7 +915,7 @@
;
% No unknown suspects on the path, so revert to
% the fallback search mode.
- search(IoActionMap, Store, Oracle, !SearchSpace,
+ search(Store, Oracle, !SearchSpace,
FallBackSearchMode, FallBackSearchMode,
NewMode, Response)
)
@@ -986,11 +969,11 @@
Unknown)
).
-:- pred divide_and_query_search(io_action_map::in, S::in, oracle_state::in,
+:- pred divide_and_query_search(S::in, oracle_state::in,
search_space(T)::in, search_space(T)::out, search_response::out,
search_mode::out) is det <= mercury_edt(S, T).
-divide_and_query_search(IoActionMap, Store, Oracle, !SearchSpace, Response,
+divide_and_query_search(Store, Oracle, !SearchSpace, Response,
NewMode) :-
%
% If there's no root yet (because the oracle hasn't asserted any nodes
@@ -1001,42 +984,41 @@
->
NewMode = divide_and_query,
(
- children(IoActionMap, Store, Oracle, RootId,
+ children(Store, Oracle, RootId,
!SearchSpace, Children)
->
- find_middle_weight(IoActionMap, Store, Oracle,
+ find_middle_weight(Store, Oracle,
Children, RootId, no, !SearchSpace, Response)
;
Response = require_explicit_subtree(RootId)
)
;
- top_down_search(IoActionMap, Store, Oracle, !SearchSpace,
- Response),
+ top_down_search(Store, Oracle, !SearchSpace, Response),
NewMode = divide_and_query
).
- % Call find_middle_weight/9 if we are able to find the children of the
+ % Call find_middle_weight/8 if we are able to find the children of the
% given suspect id, otherwise return a require_explicit_subtree
% search response in the last argument.
%
-:- pred find_middle_weight_if_children(io_action_map::in, S::in,
+:- pred find_middle_weight_if_children(S::in,
oracle_state::in, suspect_id::in, suspect_id::in,
maybe(suspect_id)::in, search_space(T)::in, search_space(T)::out,
search_response::out) is det <= mercury_edt(S, T).
-find_middle_weight_if_children(IoActionMap, Store, Oracle, SuspectId, TopId,
+find_middle_weight_if_children(Store, Oracle, SuspectId, TopId,
MaybeLastUnknown, !SearchSpace, Response) :-
(
- children(IoActionMap, Store, Oracle, SuspectId, !SearchSpace,
+ children(Store, Oracle, SuspectId, !SearchSpace,
Children)
->
- find_middle_weight(IoActionMap, Store, Oracle, Children, TopId,
+ find_middle_weight(Store, Oracle, Children, TopId,
MaybeLastUnknown, !SearchSpace, Response)
;
Response = require_explicit_subtree(SuspectId)
).
- % find_middle_weight(IoActionMap, Store, Oracle, SuspectIds, TopId,
+ % find_middle_weight(Store, Oracle, SuspectIds, TopId,
% MaybeLastUnknown, !SearchSpace, Response).
% Find the unknown suspect whose weight is closest to half the weight
% of TopId, considering only the heaviest suspect in SuspectIds, the
@@ -1044,13 +1026,13 @@
% MaybeLastUnknown is the last node that was unknown in the search (if
% any).
%
-:- pred find_middle_weight(io_action_map::in, S::in, oracle_state::in,
+:- pred find_middle_weight(S::in, oracle_state::in,
list(suspect_id)::in, suspect_id::in,
maybe(suspect_id)::in, search_space(T)::in,
search_space(T)::out, search_response::out)
is det <= mercury_edt(S, T).
-find_middle_weight(IoActionMap, Store, Oracle, [], TopId, MaybeLastUnknown,
+find_middle_weight(Store, Oracle, [], TopId, MaybeLastUnknown,
!SearchSpace, Response) :-
(
MaybeLastUnknown = yes(LastUnknown),
@@ -1063,10 +1045,10 @@
% This could happen when there were no unknown suspects
% encountered during the search, in which case we revert
% to top-down search.
- top_down_search(IoActionMap, Store, Oracle, !SearchSpace,
+ top_down_search(Store, Oracle, !SearchSpace,
Response)
).
-find_middle_weight(IoActionMap, Store, Oracle, [SuspectId | SuspectIds], TopId,
+find_middle_weight(Store, Oracle, [SuspectId | SuspectIds], TopId,
MaybeLastUnknown, !SearchSpace, Response) :-
TopWeight = get_weight(!.SearchSpace, TopId),
Target = TopWeight // 2,
@@ -1086,7 +1068,7 @@
;
NewMaybeLastUnknown = MaybeLastUnknown
),
- find_middle_weight_if_children(IoActionMap, Store, Oracle,
+ find_middle_weight_if_children(Store, Oracle,
Heaviest, TopId, NewMaybeLastUnknown, !SearchSpace,
Response)
;
@@ -1095,7 +1077,8 @@
->
(
MaybeLastUnknown = yes(LastUnknown),
- suspect_still_unknown(!.SearchSpace, LastUnknown)
+ suspect_still_unknown(!.SearchSpace,
+ LastUnknown)
->
LastUnknownWeight = get_weight(!.SearchSpace,
LastUnknown),
@@ -1122,7 +1105,8 @@
;
(
MaybeLastUnknown = yes(LastUnknown),
- suspect_still_unknown(!.SearchSpace, LastUnknown)
+ suspect_still_unknown(!.SearchSpace,
+ LastUnknown)
->
LastUnknownWeight = get_weight(!.SearchSpace,
LastUnknown),
@@ -1131,7 +1115,7 @@
LastUnknownWeight))
;
% Look deeper until we find an unknown:
- find_middle_weight_if_children(IoActionMap,
+ find_middle_weight_if_children(
Store, Oracle, Heaviest, TopId, no,
!SearchSpace, Response)
)
@@ -1325,8 +1309,7 @@
io.format(OutStream, "%s\n%s\n", [s(InfoMessage), s(WrappedReason)],
!IO),
Node = get_edt_node(SearchSpace, LastId),
- edt_question(Analyser ^ io_action_map, Store, Node,
- OracleQuestion),
+ edt_question(Store, Node, OracleQuestion),
Response = oracle_question(OracleQuestion).
:- func search_mode_to_string(search_mode) = string.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.58
diff -u -r1.58 declarative_debugger.m
--- browser/declarative_debugger.m 20 May 2005 05:40:17 -0000 1.58
+++ browser/declarative_debugger.m 15 Jun 2005 05:46:09 -0000
@@ -229,7 +229,7 @@
:- type final_decl_atom
---> final_decl_atom(
final_atom :: trace_atom,
- final_io_actions :: list(maybe_tabled_io_action)
+ final_io_actions :: maybe(io_action_range)
).
:- type decl_exception == term_rep.
@@ -291,19 +291,19 @@
:- type diagnoser_state(R).
-:- pred diagnoser_state_init(io_action_map::in, io.input_stream::in,
+:- pred diagnoser_state_init(io.input_stream::in,
io.output_stream::in, browser_info.browser_persistent_state::in,
help.system::in, diagnoser_state(R)::out) is det.
-:- pred diagnosis(S::in, analysis_type(edt_node(R))::in, int::in, int::in,
- int::in, diagnoser_response(R)::out,
+:- pred diagnosis(S::in, analysis_type(edt_node(R))::in,
+ diagnoser_response(R)::out,
diagnoser_state(R)::in, diagnoser_state(R)::out,
browser_info.browser_persistent_state::in,
browser_info.browser_persistent_state::out,
io::di, io::uo) is cc_multi <= annotated_trace(S, R).
:- pred unravel_decl_atom(some_decl_atom::in, trace_atom::out,
- list(maybe_tabled_io_action)::out) is det.
+ maybe(io_action_range)::out) is det.
%-----------------------------------------------------------------------------%
@@ -331,17 +331,18 @@
:- import_module mdb.util.
:- import_module mdbcomp.prim_data.
+:- import_module array.
:- import_module bool.
:- import_module exception.
:- import_module int.
:- import_module map.
-unravel_decl_atom(DeclAtom, TraceAtom, IoActions) :-
+unravel_decl_atom(DeclAtom, TraceAtom, MaybeIoActions) :-
(
DeclAtom = init(init_decl_atom(TraceAtom)),
- IoActions = []
+ MaybeIoActions = no
;
- DeclAtom = final(final_decl_atom(TraceAtom, IoActions))
+ DeclAtom = final(final_decl_atom(TraceAtom, MaybeIoActions))
).
get_decl_question_node(wrong_answer(Node, _, _)) = Node.
@@ -382,29 +383,15 @@
diagnoser_set_oracle(Oracle, diagnoser(Analyser, _),
diagnoser(Analyser, Oracle)).
-diagnoser_state_init(IoActionMap, InStr, OutStr, Browser, HelpSystem,
- Diagnoser) :-
- analyser_state_init(IoActionMap, Analyser),
+diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
+ analyser_state_init(Analyser),
oracle_state_init(InStr, OutStr, Browser, HelpSystem, Oracle),
Diagnoser = diagnoser(Analyser, Oracle).
-diagnosis(Store, AnalysisType, UseOldIoActionMap, IoActionStart, IoActionEnd,
- Response, !Diagnoser, !Browser, !IO) :-
+diagnosis(Store, AnalysisType, Response, !Diagnoser, !Browser, !IO) :-
mdb.declarative_oracle.set_browser_state(!.Browser, !.Diagnoser ^
oracle_state, Oracle),
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
- (
- UseOldIoActionMap > 0
- ->
- true
- ;
- make_io_action_map(IoActionStart, IoActionEnd, IoActionMap,
- !IO),
- Analyser0 = !.Diagnoser ^ analyser_state,
- analyser_state_replace_io_map(IoActionMap,
- Analyser0, Analyser1),
- !:Diagnoser = !.Diagnoser ^ analyser_state := Analyser1
- ),
try_io(diagnosis_2(Store, AnalysisType, !.Diagnoser), Result, !IO),
(
Result = succeeded({Response, !:Diagnoser})
@@ -571,8 +558,7 @@
"MR_DD_decl_diagnosis_state_init").
diagnoser_state_init_store(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
- diagnoser_state_init(map.init, InStr, OutStr, Browser, HelpSystem,
- Diagnoser).
+ diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser).
:- pred set_fallback_search_mode(
mdb.declarative_analyser.search_mode::in,
@@ -610,39 +596,36 @@
% materialized tree for use with the C backend code.
%
:- pred diagnosis_new_tree(trace_node_store::in, trace_node_id::in,
- int::in, int::in, int::in, diagnoser_response(trace_node_id)::out,
+ diagnoser_response(trace_node_id)::out,
diagnoser_state(trace_node_id)::in,
diagnoser_state(trace_node_id)::out,
browser_info.browser_persistent_state::in,
browser_info.browser_persistent_state::out, io::di, io::uo)
is cc_multi.
-:- pragma export(diagnosis_new_tree(in, in, in, in, in, out, in, out, in, out,
- di, uo), "MR_DD_decl_diagnosis_new_tree").
+:- pragma export(diagnosis_new_tree(in, in, out, in, out, in, out, di, uo),
+ "MR_DD_decl_diagnosis_new_tree").
-diagnosis_new_tree(Store, Node, UseOldIoActionMap, IoActionStart, IoActionEnd,
- Response, !State, !Browser, !IO) :-
- diagnosis(Store, new_tree(dynamic(Node)), UseOldIoActionMap,
- IoActionStart, IoActionEnd, Response, !State, !Browser, !IO).
+diagnosis_new_tree(Store, Node, Response, !State, !Browser, !IO) :-
+ diagnosis(Store, new_tree(dynamic(Node)), Response, !State, !Browser,
+ !IO).
% Export a monomorphic version of diagnosis/10 that requests the
% continuation of a previously suspended declarative debugging session.
%
-:- pred diagnosis_resume_previous(trace_node_store::in, int::in, int::in,
- int::in, diagnoser_response(trace_node_id)::out,
+:- pred diagnosis_resume_previous(trace_node_store::in,
+ diagnoser_response(trace_node_id)::out,
diagnoser_state(trace_node_id)::in,
diagnoser_state(trace_node_id)::out,
browser_info.browser_persistent_state::in,
browser_info.browser_persistent_state::out, io::di, io::uo)
is cc_multi.
-:- pragma export(diagnosis_resume_previous(in, in, in, in, out, in, out, in,
- out, di, uo), "MR_DD_decl_diagnosis_resume_previous").
+:- pragma export(diagnosis_resume_previous(in, out, in, out, in, out, di, uo),
+ "MR_DD_decl_diagnosis_resume_previous").
-diagnosis_resume_previous(Store, UseOldIoActionMap, IoActionStart, IoActionEnd,
- Response, !State, !Browser, !IO) :-
- diagnosis(Store, resume_previous, UseOldIoActionMap, IoActionStart,
- IoActionEnd, Response, !State, !Browser, !IO).
+diagnosis_resume_previous(Store, Response, !State, !Browser, !IO) :-
+ diagnosis(Store, resume_previous, Response, !State, !Browser, !IO).
% Export some predicates so that C code can interpret the
% diagnoser response.
Index: browser/declarative_edt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_edt.m,v
retrieving revision 1.10
diff -u -r1.10 declarative_edt.m
--- browser/declarative_edt.m 6 Jun 2005 00:15:24 -0000 1.10
+++ browser/declarative_edt.m 15 Jun 2005 05:46:09 -0000
@@ -60,7 +60,6 @@
:- import_module mdb.declarative_debugger.
:- import_module mdb.declarative_oracle.
-:- import_module mdb.io_action.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.program_representation.
@@ -89,14 +88,12 @@
% Returns the question corresponding to the given node.
%
- pred edt_question(io_action_map::in, S::in, T::in,
- decl_question(T)::out) is det,
+ pred edt_question(S::in, T::in, decl_question(T)::out) is det,
% If this node is an E-bug, then return the bug.
% An E-bug is an erroneous node whos children are all correct.
%
- pred edt_get_e_bug(io_action_map::in, S::in, T::in, decl_e_bug::out)
- is det,
+ pred edt_get_e_bug(S::in, T::in, decl_e_bug::out) is det,
% If this node is an I-bug then return the bug.
% An I-bug is an erroneous node whos children are all correct
@@ -265,7 +262,7 @@
%
:- pred topmost_det(search_space(T)::in, suspect_id::out) is det.
- % non_ignored_descendents(IoActionMap, Store, Oracle, SuspectIds,
+ % non_ignored_descendents(Store, Oracle, SuspectIds,
% !SearchSpace, Descendents).
% Descendents is the non-ignored children of the suspects in
% SuspectIds appended together. If a child is ignored then its
@@ -273,17 +270,17 @@
% recursively. Fails if an explicit subtree is required to find
% the children of an ignored suspect.
%
-:- pred non_ignored_descendents(io_action_map::in, S::in, oracle_state::in,
+:- pred non_ignored_descendents(S::in, oracle_state::in,
list(suspect_id)::in, search_space(T)::in, search_space(T)::out,
list(suspect_id)::out) is semidet <= mercury_edt(S, T).
- % children(IoActionMap, Store, Oracle, SuspectId, !SearchSpace,
+ % children(Store, Oracle, SuspectId, !SearchSpace,
% Children).
% Children is the list of children of SuspectId in the SearchSpace. If
% the children were not in the search space then they are added. Fails
% if SuspectId is the root of an implicit subtree.
%
-:- pred children(io_action_map::in, S::in, oracle_state::in, suspect_id::in,
+:- pred children(S::in, oracle_state::in, suspect_id::in,
search_space(T)::in, search_space(T)::out, list(suspect_id)::out)
is semidet <= mercury_edt(S, T).
@@ -320,7 +317,7 @@
:- pred skip_suspect(suspect_id::in, search_space(T)::in, search_space(T)::out)
is det.
- % find_subterm_origin(IoActionMap, Store, Oracle, SuspectId, ArgPos,
+ % find_subterm_origin(Store, Oracle, SuspectId, ArgPos,
% TermPath, !SearchSpace, Response).
% Finds the origin of the subterm given by SuspectId, ArgPos and
% TermPath in its immediate neighbours. If the children of a suspect
@@ -328,7 +325,7 @@
% explicit subtree is required in which case the appropriate response
% is returned (see definition of find_origin_response type below).
%
-:- pred find_subterm_origin(io_action_map::in, S::in, oracle_state::in,
+:- pred find_subterm_origin(S::in, oracle_state::in,
suspect_id::in, arg_pos::in, term_path::in, search_space(T)::in,
search_space(T)::out, find_origin_response::out)
is det <= mercury_edt(S, T).
@@ -384,23 +381,23 @@
:- pred incorporate_explicit_subtree(suspect_id::in, T::in,
search_space(T)::in, search_space(T)::out) is det.
- % incorporate_explicit_supertree(IoActionMap, Store, Oracle, Node,
+ % incorporate_explicit_supertree(Store, Oracle, 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(io_action_map::in, S::in,
+:- pred incorporate_explicit_supertree(S::in,
oracle_state::in, T::in, search_space(T)::in,
search_space(T)::out) is det <= mercury_edt(S, T).
- % extend_search_space_upwards(IoActionMap, Store, Oracle,
+ % extend_search_space_upwards(Store, Oracle,
% !SearchSpace).
% Attempts to add a parent of the current topmost node to the
% search space. Fails if this is not possible because an explicit
% supertree is required.
%
-:- pred extend_search_space_upwards(io_action_map::in, S::in, oracle_state::in,
+:- pred extend_search_space_upwards(S::in, oracle_state::in,
search_space(T)::in, search_space(T)::out)
is semidet <= mercury_edt(S, T).
@@ -441,7 +438,7 @@
%
:- pred suspect_ignored(search_space(T)::in, suspect_id::in) is semidet.
- % first_unknown_descendent(IoActionMap, Store, Oracle, SuspectId,
+ % first_unknown_descendent(Store, Oracle, SuspectId,
% !SearchSpace, MaybeDescendent).
% Search the search space for a suspect with status = unknown in a
% top down fashion, starting with SuspectId. If no unknown
@@ -450,7 +447,7 @@
% skipped, ignored or erroneous suspect is the root of an implicit
% subtree, then the call will fail.
%
-:- pred first_unknown_descendent(io_action_map::in, S::in, oracle_state::in,
+:- pred first_unknown_descendent(S::in, oracle_state::in,
suspect_id::in, search_space(T)::in, search_space(T)::out,
maybe_found_descendent::out) is det <= mercury_edt(S, T).
@@ -897,7 +894,7 @@
FinishId = StartId
).
-find_subterm_origin(IoActionMap, Store, Oracle, SuspectId, ArgPos, TermPath,
+find_subterm_origin(Store, Oracle, SuspectId, ArgPos, TermPath,
!SearchSpace, Response) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
ImplicitToExplicit = !.SearchSpace ^
@@ -924,17 +921,17 @@
Mode = subterm_in,
(
Suspect ^ parent = yes(ParentId),
- resolve_origin(IoActionMap, Store, Oracle, Node,
+ resolve_origin(Store, Oracle, Node,
ArgPos, TermPath, ParentId, no, !SearchSpace,
Response)
;
Suspect ^ parent = no,
(
- extend_search_space_upwards(IoActionMap, Store,
+ extend_search_space_upwards(Store,
Oracle, !SearchSpace)
->
topmost_det(!.SearchSpace, NewRootId),
- resolve_origin(IoActionMap, Store, Oracle,
+ resolve_origin(Store, Oracle,
Node, ArgPos, TermPath, NewRootId, no,
!SearchSpace, Response)
;
@@ -943,12 +940,12 @@
)
;
Mode = subterm_out,
- resolve_origin(IoActionMap, Store, Oracle, Node, ArgPos,
+ resolve_origin(Store, Oracle, Node, ArgPos,
TermPath, SuspectId, yes, !SearchSpace,
Response)
).
- % resolve_origin(IoActionMap, Store, Oracle, Node, ArgPos, TermPath,
+ % resolve_origin(Store, Oracle, Node, ArgPos, TermPath,
% SuspectId, Output, !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
@@ -958,12 +955,12 @@
% output. Output should be yes if the sub-term is an output of
% SuspectId and no if it isn't.
%
-:- pred resolve_origin(io_action_map::in, S::in, oracle_state::in, T::in,
+:- pred resolve_origin(S::in, oracle_state::in, T::in,
arg_pos::in, term_path::in, suspect_id::in, bool::in,
search_space(T)::in, search_space(T)::out, find_origin_response::out)
is det <= mercury_edt(S, T).
-resolve_origin(IoActionMap, Store, Oracle, Node, ArgPos, TermPath, SuspectId,
+resolve_origin(Store, Oracle, Node, ArgPos, TermPath, SuspectId,
Output, !SearchSpace, Response) :-
edt_dependency(Store, Node, ArgPos, TermPath, _, Origin),
(
@@ -989,7 +986,7 @@
ExplicitOrigin = OriginNode
),
(
- children(IoActionMap, Store, Oracle, SuspectId,
+ children(Store, Oracle, SuspectId,
!SearchSpace, Children)
->
(
@@ -1450,17 +1447,17 @@
% the given suspect. The suspect_ids for the new suspects will
% also be returned.
%
-:- pred add_children(io_action_map::in, S::in, oracle_state::in, list(T)::in,
+:- pred add_children(S::in, oracle_state::in, list(T)::in,
suspect_id::in, suspect_status::in, search_space(T)::in,
search_space(T)::out, list(suspect_id)::out)
is det <= mercury_edt(S, T).
-add_children(IoActionMap, Store, Oracle, EDTChildren, SuspectId, Status,
+add_children(Store, Oracle, EDTChildren, SuspectId, Status,
!SearchSpace, Children) :-
Counter0 = !.SearchSpace ^ suspect_id_counter,
lookup_suspect(!.SearchSpace, SuspectId, Suspect0),
Depth = Suspect0 ^ depth + 1,
- add_children_2(IoActionMap, Store, Oracle, EDTChildren, SuspectId,
+ add_children_2(Store, Oracle, EDTChildren, SuspectId,
Status, Depth, !SearchSpace, Counter0, Counter, Children),
% Lookup the suspect again, since its weight and/or status may have
% changed.
@@ -1470,8 +1467,8 @@
map.set(!.SearchSpace ^ store, SuspectId, SuspectWithChildren,
SuspectStoreWithChildren),
!:SearchSpace = !.SearchSpace ^ store := SuspectStoreWithChildren,
- list.foldl(adjust_suspect_status_from_oracle(IoActionMap, Store,
- Oracle), Children, !SearchSpace),
+ list.foldl(adjust_suspect_status_from_oracle(Store, Oracle), Children,
+ !SearchSpace),
%
% Recalc the weight if the suspect is ignored. This wouldn't have
% been done by ignore_suspect/4 since the children wouldn't have been
@@ -1493,13 +1490,13 @@
true
).
-:- pred add_children_2(io_action_map::in, S::in, oracle_state::in, list(T)::in,
+:- pred add_children_2(S::in, oracle_state::in, list(T)::in,
suspect_id::in, suspect_status::in, int::in,
search_space(T)::in, search_space(T)::out, counter::in, counter::out,
list(suspect_id)::out) is det <= mercury_edt(S, T).
-add_children_2(_, _, _, [], _, _, _, !SearchSpace, !Counter, []).
-add_children_2(IoActionMap, Store, Oracle, [EDTChild | EDTChildren],
+add_children_2(_, _, [], _, _, _, !SearchSpace, !Counter, []).
+add_children_2(Store, Oracle, [EDTChild | EDTChildren],
ParentId, Status, Depth, !SearchSpace, !Counter, Children)
:-
allocate(NextId, !Counter),
@@ -1510,7 +1507,7 @@
SuspectStore),
!:SearchSpace = !.SearchSpace ^ store := SuspectStore,
add_weight_to_ancestors(NextId, ExcessWeight, !SearchSpace),
- add_children_2(IoActionMap, Store, Oracle, EDTChildren, ParentId,
+ add_children_2(Store, Oracle, EDTChildren, ParentId,
Status, Depth, !SearchSpace, !Counter, OtherChildren),
Children = [NextId | OtherChildren].
@@ -1527,17 +1524,17 @@
),
!:Parent = !.Parent ^ children := yes(NewChildren).
-:- pred adjust_suspect_status_from_oracle(io_action_map::in, S::in,
+:- pred adjust_suspect_status_from_oracle(S::in,
oracle_state::in, suspect_id::in, search_space(T)::in,
search_space(T)::out) is det <= mercury_edt(S, T).
-adjust_suspect_status_from_oracle(IoActionMap, Store, Oracle, SuspectId,
+adjust_suspect_status_from_oracle(Store, Oracle, SuspectId,
!SearchSpace) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
(
Suspect ^ status = unknown
->
- edt_question(IoActionMap, Store, Suspect ^ edt_node, Question),
+ edt_question(Store, Suspect ^ edt_node, Question),
(
answer_known(Oracle, Question, Answer)
->
@@ -1585,13 +1582,13 @@
!.SearchSpace ^ implicit_roots_to_explicit_roots :=
ImplicitToExplicit.
-incorporate_explicit_supertree(IoActionMap, Store, Oracle, Node,
+incorporate_explicit_supertree(Store, Oracle, Node,
!SearchSpace) :-
topmost_det(!.SearchSpace, OldTopMostId),
(
edt_parent(Store, Node, Parent)
->
- insert_new_topmost_node(IoActionMap, Store, Oracle, Parent,
+ insert_new_topmost_node(Store, Oracle, Parent,
!SearchSpace),
%
% Node implicitly represents the root of the old search space,
@@ -1610,22 +1607,22 @@
"no parent"))
).
-extend_search_space_upwards(IoActionMap, Store, Oracle, !SearchSpace) :-
+extend_search_space_upwards(Store, Oracle, !SearchSpace) :-
topmost_det(!.SearchSpace, OldTopMostId),
edt_parent(Store, get_edt_node(!.SearchSpace, OldTopMostId),
NewTopMost),
- insert_new_topmost_node(IoActionMap, Store, Oracle, NewTopMost,
+ insert_new_topmost_node(Store, Oracle, NewTopMost,
!SearchSpace).
% Add the given EDT node to the top of the search space. The given
% node should be a parent of the current topmost node in the search
% space.
%
-:- pred insert_new_topmost_node(io_action_map::in, S::in, oracle_state::in,
+:- pred insert_new_topmost_node(S::in, oracle_state::in,
T::in, search_space(T)::in, search_space(T)::out)
is det <= mercury_edt(S, T).
-insert_new_topmost_node(IoActionMap, Store, Oracle, NewTopMostEDTNode,
+insert_new_topmost_node(Store, Oracle, NewTopMostEDTNode,
!SearchSpace) :-
(
edt_children(Store, NewTopMostEDTNode, EDTChildren)
@@ -1666,7 +1663,7 @@
!.SuspectStore
),
SiblingStatus = new_child_status(NewTopMostStatus),
- add_children(IoActionMap, Store, Oracle,
+ add_children(Store, Oracle,
append(LeftChildren, RightChildren),
NewTopMostId, SiblingStatus,
!SearchSpace, ChildrenIds),
@@ -1710,7 +1707,7 @@
),
!:SearchSpace = !.SearchSpace ^ topmost :=
yes(NewTopMostId),
- adjust_suspect_status_from_oracle(IoActionMap, Store,
+ adjust_suspect_status_from_oracle(Store,
Oracle, NewTopMostId, !SearchSpace)
;
throw(internal_error("insert_new_topmost_node",
@@ -1753,7 +1750,7 @@
lookup_suspect(SearchSpace, SuspectId, Parent),
Parent ^ parent = yes(ParentId).
-children(IoActionMap, Store, Oracle, SuspectId, !SearchSpace, Children) :-
+children(Store, Oracle, SuspectId, !SearchSpace, Children) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
(
Suspect ^ children = yes(Children)
@@ -1761,25 +1758,25 @@
Suspect ^ children = no,
edt_children(Store, Suspect ^ edt_node, EDTChildren),
NewStatus = new_child_status(Suspect ^ status),
- add_children(IoActionMap, Store, Oracle, EDTChildren,
+ add_children(Store, Oracle, EDTChildren,
SuspectId, NewStatus, !SearchSpace, Children)
).
-non_ignored_descendents(_, _, _, [], !SearchSpace, []).
-non_ignored_descendents(IoActionMap, Store, Oracle, [SuspectId | SuspectIds],
+non_ignored_descendents(_, _, [], !SearchSpace, []).
+non_ignored_descendents(Store, Oracle, [SuspectId | SuspectIds],
!SearchSpace, Descendents) :-
lookup_suspect(!.SearchSpace, SuspectId, Suspect),
(
Suspect ^ status = ignored
->
- children(IoActionMap, Store, Oracle, SuspectId, !SearchSpace,
+ children(Store, Oracle, SuspectId, !SearchSpace,
Children),
- non_ignored_descendents(IoActionMap, Store, Oracle, Children,
+ non_ignored_descendents(Store, Oracle, Children,
!SearchSpace, Descendents1)
;
Descendents1 = [SuspectId]
),
- non_ignored_descendents(IoActionMap, Store, Oracle, SuspectIds,
+ non_ignored_descendents(Store, Oracle, SuspectIds,
!SearchSpace, Descendents2),
append(Descendents1, Descendents2, Descendents).
@@ -1826,12 +1823,12 @@
LeastSkipped = SuspectId2
).
-first_unknown_descendent(IoActionMap, Store, Oracle, SuspectId, !SearchSpace,
+first_unknown_descendent(Store, Oracle, SuspectId, !SearchSpace,
MaybeFound) :-
- first_unknown_descendent_list(IoActionMap, Store, Oracle, [SuspectId],
+ first_unknown_descendent_list(Store, Oracle, [SuspectId],
!SearchSpace, MaybeFound).
- % first_unknown_descendent_list(IoActionMap, Store, Oracle, List,
+ % first_unknown_descendent_list(Store, Oracle, List,
% !SearchSpace, MaybeDescendent).
% Find the first unknown suspect in List. If one is found then
% it is returned through MaybeDescendent. Otherwise if there are
@@ -1842,12 +1839,12 @@
% unknown suspects. MaybeDescendent will be no if there are no
% unknown descendents and no explicit subtrees are required.
%
-:- pred first_unknown_descendent_list(io_action_map::in, S::in,
+:- pred first_unknown_descendent_list(S::in,
oracle_state::in, list(suspect_id)::in, search_space(T)::in,
search_space(T)::out, maybe_found_descendent::out)
is det <= mercury_edt(S, T).
-first_unknown_descendent_list(IoActionMap, Store, Oracle, SuspectList,
+first_unknown_descendent_list(Store, Oracle, SuspectList,
!SearchSpace, MaybeFound) :-
list.filter(suspect_unknown(!.SearchSpace), SuspectList, UnknownList,
Others),
@@ -1858,7 +1855,7 @@
UnknownList = [],
list.filter(suspect_in_buggy_subtree(
!.SearchSpace), Others, InBuggySubtree),
- get_children_list(IoActionMap, Store, Oracle, InBuggySubtree,
+ get_children_list(Store, Oracle, InBuggySubtree,
!SearchSpace, ExplicitRequired, Children),
(
Children = [],
@@ -1872,7 +1869,7 @@
)
;
Children = [_ | _],
- first_unknown_descendent_list(IoActionMap, Store,
+ first_unknown_descendent_list(Store,
Oracle, Children, !SearchSpace,
MaybeFound0),
(
@@ -1896,7 +1893,7 @@
)
).
- % get_children_list(IoActionMap, Store, Oracle, SuspectIds,
+ % get_children_list(Store, Oracle, SuspectIds,
% !SearchSpace, ExplicitRequired, Children).
% Children is the children of all the suspects in SuspectIds appended
% together. If an explicit subtree is required to find the children
@@ -1904,18 +1901,18 @@
% yes, otherwise it'll be no. If an explicit subtree is required for
% a suspect then its children are not included in Children.
%
-:- pred get_children_list(io_action_map::in, S::in, oracle_state::in,
+:- pred get_children_list(S::in, oracle_state::in,
list(suspect_id)::in, search_space(T)::in, search_space(T)::out,
maybe(suspect_id)::out, list(suspect_id)::out)
is det <= mercury_edt(S, T).
-get_children_list(_, _, _, [], SearchSpace, SearchSpace, no, []).
-get_children_list(IoActionMap, Store, Oracle, [SuspectId | SuspectIds],
+get_children_list(_, _, [], SearchSpace, SearchSpace, no, []).
+get_children_list(Store, Oracle, [SuspectId | SuspectIds],
!SearchSpace, ExplicitRequired, ChildrenList) :-
- get_children_list(IoActionMap, Store, Oracle, SuspectIds, !SearchSpace,
+ get_children_list(Store, Oracle, SuspectIds, !SearchSpace,
ExplicitRequired0, ChildrenList0),
(
- children(IoActionMap, Store, Oracle, SuspectId, !SearchSpace,
+ children(Store, Oracle, SuspectId, !SearchSpace,
Children)
->
append(Children, ChildrenList0, ChildrenList),
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.27
diff -u -r1.27 declarative_tree.m
--- browser/declarative_tree.m 20 May 2005 05:40:18 -0000 1.27
+++ browser/declarative_tree.m 15 Jun 2005 05:46:09 -0000
@@ -58,8 +58,8 @@
:- instance mercury_edt(wrap(S), edt_node(R)) <= annotated_trace(S, R)
where [
- pred(edt_question/4) is trace_question,
- pred(edt_get_e_bug/4) is trace_get_e_bug,
+ pred(edt_question/3) is trace_question,
+ pred(edt_get_e_bug/3) 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,
@@ -77,18 +77,24 @@
%-----------------------------------------------------------------------------%
-:- func exit_node_decl_atom(io_action_map::in, S::in,
+:- func exit_node_decl_atom(S::in,
trace_node(R)::in(trace_node_exit)) = (final_decl_atom::out) is det
<= annotated_trace(S, R).
-exit_node_decl_atom(IoActionMap, Store, ExitNode) = DeclAtom :-
+exit_node_decl_atom(Store, ExitNode) = DeclAtom :-
ExitAtom = get_trace_exit_atom(ExitNode),
CallId = ExitNode ^ exit_call,
call_node_from_id(Store, CallId, Call),
CallIoSeq = Call ^ call_io_seq_num,
ExitIoSeq = ExitNode ^ exit_io_seq_num,
- IoActions = make_io_actions(IoActionMap, CallIoSeq, ExitIoSeq),
- DeclAtom = final_decl_atom(ExitAtom, IoActions).
+ (
+ CallIoSeq = ExitIoSeq
+ ->
+ DeclAtom = final_decl_atom(ExitAtom, no)
+ ;
+ DeclAtom = final_decl_atom(ExitAtom,
+ yes(io_action_range(CallIoSeq, ExitIoSeq)))
+ ).
:- func call_node_decl_atom(S, R) = init_decl_atom <= annotated_trace(S, R).
@@ -97,21 +103,6 @@
CallAtom = get_trace_call_atom(CallNode),
DeclAtom = init_decl_atom(CallAtom).
-:- func make_io_actions(io_action_map, io_seq_num, io_seq_num)
- = list(maybe_tabled_io_action).
-
-make_io_actions(IoActionMap, InitIoSeq, ExitIoSeq) = IoActions :-
- ( InitIoSeq = ExitIoSeq ->
- IoActions = []
- ;
- Rest = make_io_actions(IoActionMap, InitIoSeq + 1, ExitIoSeq),
- ( map.search(IoActionMap, InitIoSeq, IoAction) ->
- IoActions = [tabled(IoAction) | Rest]
- ;
- IoActions = [untabled(InitIoSeq) | Rest]
- )
- ).
-
:- pred get_edt_node_initial_atom(S::in, R::in, init_decl_atom::out)
is det <= annotated_trace(S, R).
@@ -143,20 +134,20 @@
%-----------------------------------------------------------------------------%
-:- pred trace_question(io_action_map::in, wrap(S)::in, edt_node(R)::in,
+:- pred trace_question(wrap(S)::in, edt_node(R)::in,
decl_question(edt_node(R))::out) is det <= annotated_trace(S, R).
-trace_question(IoActionMap, wrap(Store), dynamic(Ref), Root) :-
+trace_question(wrap(Store), dynamic(Ref), Root) :-
det_edt_return_node_from_id(Store, Ref, Node),
(
Node = fail(_, CallId, RedoId, _, _),
DeclAtom = call_node_decl_atom(Store, CallId),
- get_answers(IoActionMap, Store, RedoId, [], Answers),
+ get_answers(Store, RedoId, [], Answers),
Root = missing_answer(dynamic(Ref), DeclAtom, Answers)
;
Node = exit(_, CallId, _, _, _, _, _),
InitDeclAtom = call_node_decl_atom(Store, CallId),
- FinalDeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
+ FinalDeclAtom = exit_node_decl_atom(Store, Node),
Root = wrong_answer(dynamic(Ref), InitDeclAtom, FinalDeclAtom)
;
Node = excp(_, CallId, _, Exception, _, _),
@@ -164,33 +155,32 @@
Root = unexpected_exception(dynamic(Ref), DeclAtom, Exception)
).
-:- pred get_answers(io_action_map::in, S::in, R::in,
+:- pred get_answers(S::in, R::in,
list(final_decl_atom)::in, list(final_decl_atom)::out) is det
<= annotated_trace(S, R).
-get_answers(IoActionMap, Store, RedoId, DeclAtoms0, DeclAtoms) :-
+get_answers(Store, RedoId, DeclAtoms0, DeclAtoms) :-
(
maybe_redo_node_from_id(Store, RedoId, redo(_, ExitId, _, _))
->
exit_node_from_id(Store, ExitId, ExitNode),
NextId = ExitNode ^ exit_prev_redo,
- DeclAtom = exit_node_decl_atom(IoActionMap, Store, ExitNode),
- get_answers(IoActionMap, Store, NextId,
- [DeclAtom | DeclAtoms0], DeclAtoms)
+ DeclAtom = exit_node_decl_atom(Store, ExitNode),
+ get_answers(Store, NextId, [DeclAtom | DeclAtoms0], DeclAtoms)
;
DeclAtoms = DeclAtoms0
).
-:- pred trace_get_e_bug(io_action_map::in, wrap(S)::in, edt_node(R)::in,
+:- pred trace_get_e_bug(wrap(S)::in, edt_node(R)::in,
decl_e_bug::out) is det <= annotated_trace(S, R).
-trace_get_e_bug(IoActionMap, wrap(Store), dynamic(Ref), Bug) :-
+trace_get_e_bug(wrap(Store), dynamic(Ref), Bug) :-
det_edt_return_node_from_id(Store, Ref, Node),
(
Node = exit(_, CallId, _, _, Event, _, _),
InitDeclAtom = call_node_decl_atom(Store, CallId),
- FinalDeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
- get_exit_atoms_in_contour(IoActionMap, Store, Node, Contour),
+ FinalDeclAtom = exit_node_decl_atom(Store, Node),
+ get_exit_atoms_in_contour(Store, Node, Contour),
Bug = incorrect_contour(InitDeclAtom, FinalDeclAtom, Contour,
Event)
;
@@ -1011,22 +1001,22 @@
Nodes1, Nodes)
).
-:- pred get_exit_atoms_in_contour(io_action_map::in, S::in,
+:- pred get_exit_atoms_in_contour(S::in,
trace_node(R)::in(trace_node_exit),
list(final_decl_atom)::out) is det <= annotated_trace(S, R).
-get_exit_atoms_in_contour(IoActionMap, Store, ExitNode, ExitAtoms) :-
+get_exit_atoms_in_contour(Store, ExitNode, ExitAtoms) :-
ExitPrecId = ExitNode ^ exit_preceding,
det_trace_node_from_id(Store, ExitPrecId, ExitPrec),
materialize_contour(Store, ExitPrecId, ExitPrec, [], Contour),
- list.filter_map(get_exit_atom(IoActionMap, Store), Contour, ExitAtoms).
+ list.filter_map(get_exit_atom(Store), Contour, ExitAtoms).
-:- pred get_exit_atom(io_action_map::in, S::in, pair(R, trace_node(R))::in,
+:- pred get_exit_atom(S::in, pair(R, trace_node(R))::in,
final_decl_atom::out) is semidet <= annotated_trace(S, R).
-get_exit_atom(IoActionMap, Store, _ - Exit, FinalAtom) :-
+get_exit_atom(Store, _ - Exit, FinalAtom) :-
Exit = exit(_, _, _, _, _, _, _),
- FinalAtom = exit_node_decl_atom(IoActionMap, Store, Exit).
+ FinalAtom = exit_node_decl_atom(Store, Exit).
:- type primitive_list_and_var(R)
---> primitive_list_and_var(
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.48
diff -u -r1.48 declarative_user.m
--- browser/declarative_user.m 2 May 2005 04:21:13 -0000 1.48
+++ browser/declarative_user.m 15 Jun 2005 05:46:09 -0000
@@ -246,18 +246,17 @@
handle_command(browse_io(ActionNum), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
- edt_node_io_actions(Question, MaybeTabledIoActions),
- filter_tabled_io_actions(MaybeTabledIoActions, IoActions, _),
+ edt_node_io_actions(Question, MaybeIoActions),
% We don't have code yet to trace a marked I/O action.
- browse_chosen_io_action(IoActions, ActionNum, _MaybeMark, !User, !IO),
+ browse_chosen_io_action(MaybeIoActions, ActionNum, _MaybeMark,
+ !User, !IO),
query_user(UserQuestion, Response, !User, !IO).
handle_command(print_io(From, To), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
- edt_node_io_actions(Question, MaybeTabledIoActions),
- filter_tabled_io_actions(MaybeTabledIoActions, IoActions, _),
- print_chosen_io_actions(IoActions, From, To, !.User, !IO),
+ edt_node_io_actions(Question, MaybeIoActions),
+ print_chosen_io_actions(MaybeIoActions, From, To, !.User, !IO),
query_user(UserQuestion, Response, !User, !IO).
handle_command(ask, UserQuestion, Response, !User, !IO) :-
@@ -368,13 +367,13 @@
edt_node_trace_atoms(unexpected_exception(_, InitDeclAtom, _),
InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
-:- pred edt_node_io_actions(decl_question(T)::in,
- list(maybe_tabled_io_action)::out) is det.
+:- pred edt_node_io_actions(decl_question(T)::in, maybe(io_action_range)::out)
+ is det.
edt_node_io_actions(wrong_answer(_, _, FinalDeclAtom),
FinalDeclAtom ^ final_io_actions).
-edt_node_io_actions(missing_answer(_, _, _), []).
-edt_node_io_actions(unexpected_exception(_, _, _), []).
+edt_node_io_actions(missing_answer(_, _, _), no).
+edt_node_io_actions(unexpected_exception(_, _, _), no).
:- pred decl_bug_trace_atom(decl_bug::in, trace_atom::out, trace_atom::out)
is det.
@@ -388,47 +387,96 @@
decl_bug_trace_atom(i_bug(inadmissible_call(_, _, InitDeclAtom, _)),
InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
-:- pred decl_bug_io_actions(decl_bug::in, list(maybe_tabled_io_action)::out)
- is det.
+:- pred decl_bug_io_actions(decl_bug::in, maybe(io_action_range)::out) is det.
decl_bug_io_actions(e_bug(incorrect_contour(_, FinalDeclAtom, _, _)),
FinalDeclAtom ^ final_io_actions).
-decl_bug_io_actions(e_bug(partially_uncovered_atom(_, _)), []).
-decl_bug_io_actions(e_bug(unhandled_exception(_, _, _)), []).
-decl_bug_io_actions(i_bug(inadmissible_call(_, _, _, _)), []).
+decl_bug_io_actions(e_bug(partially_uncovered_atom(_, _)), no).
+decl_bug_io_actions(e_bug(unhandled_exception(_, _, _)), no).
+decl_bug_io_actions(i_bug(inadmissible_call(_, _, _, _)), no).
-:- pred browse_chosen_io_action(list(io_action)::in, int::in,
+:- pred browse_chosen_io_action(maybe(io_action_range)::in, int::in,
maybe(term_path)::out, user_state::in, user_state::out,
io::di, io::uo) is cc_multi.
-browse_chosen_io_action(IoActions, ActionNum, MaybeMark, User0, User, !IO) :-
- ( list.index1(IoActions, ActionNum, IoAction) ->
- browse_io_action(IoAction, MaybeMark, User0, User, !IO)
+browse_chosen_io_action(MaybeIoActions, ActionNum, MaybeMark, !User, !IO) :-
+ (
+ MaybeIoActions = yes(IoActions),
+ find_tabled_io_action(IoActions, ActionNum, MaybeIoAction,
+ !IO),
+ (
+ MaybeIoAction = yes(IoAction),
+ browse_io_action(IoAction, MaybeMark, !User, !IO)
+ ;
+ MaybeIoAction = no,
+ MaybeMark = no
+ )
;
+ MaybeIoActions = no,
io.write_string("No such IO action.\n", !IO),
- MaybeMark = no,
- User = User0
+ MaybeMark = no
+ ).
+
+:- pred find_tabled_io_action(io_action_range::in, int::in,
+ maybe(io_action)::out, io::di, io::uo) is det.
+
+find_tabled_io_action(io_action_range(Cur, End), TabledActionNum,
+ MaybeIoAction, !IO) :-
+ (
+ Cur = End
+ ->
+ MaybeIoAction = no
+ ;
+ get_maybe_io_action(Cur, MaybeTabledIoAction, !IO),
+ (
+ MaybeTabledIoAction = tabled(IoAction),
+ (
+ TabledActionNum = 1
+ ->
+ MaybeIoAction = yes(IoAction)
+ ;
+ find_tabled_io_action(io_action_range(Cur + 1,
+ End), TabledActionNum - 1,
+ MaybeIoAction, !IO)
+ )
+ ;
+ MaybeTabledIoAction = untabled,
+ find_tabled_io_action(io_action_range(Cur + 1, End),
+ TabledActionNum, MaybeIoAction, !IO)
+ )
).
-:- pred print_chosen_io_actions(list(io_action)::in, int::in, int::in,
+:- pred print_chosen_io_actions(maybe(io_action_range)::in, int::in, int::in,
user_state::in, io::di, io::uo) is cc_multi.
-print_chosen_io_actions(Atom, From, To, User0, !IO) :-
- print_chosen_io_action(Atom, From, User0, OK, !IO),
+print_chosen_io_actions(MaybeIoActions, From, To, User0, !IO) :-
+ print_chosen_io_action(MaybeIoActions, From, User0, OK, !IO),
( OK = yes, From + 1 =< To ->
- print_chosen_io_actions(Atom, From + 1, To, User0, !IO)
+ print_chosen_io_actions(MaybeIoActions, From + 1, To, User0,
+ !IO)
;
true
).
-:- pred print_chosen_io_action(list(io_action)::in, int::in, user_state::in,
- bool::out, io::di, io::uo) is cc_multi.
+:- pred print_chosen_io_action(maybe(io_action_range)::in, int::in,
+ user_state::in, bool::out, io::di, io::uo) is cc_multi.
-print_chosen_io_action(IoActions, ActionNum, User0, OK, !IO) :-
- ( list.index1(IoActions, ActionNum, IoAction) ->
- print_io_action(User0, IoAction, !IO),
- OK = yes
+print_chosen_io_action(MaybeIoActions, ActionNum, User0, OK, !IO) :-
+ (
+ MaybeIoActions = yes(IoActions),
+ find_tabled_io_action(IoActions, ActionNum, MaybeIoAction,
+ !IO),
+ (
+ MaybeIoAction = yes(IoAction),
+ print_tabled_io_action(User0, tabled(IoAction), !IO),
+ OK = yes
+ ;
+ MaybeIoAction = no,
+ io.write_string("No such IO action.\n", !IO),
+ OK = no
+ )
;
+ MaybeIoActions = no,
io.write_string("No such IO action.\n", !IO),
OK = no
).
@@ -900,9 +948,8 @@
;
Command = browse_io(ActionNum)
->
- decl_bug_io_actions(Bug, MaybeTabledIoActions),
- filter_tabled_io_actions(MaybeTabledIoActions, IoActions, _),
- browse_chosen_io_action(IoActions, ActionNum, _MaybeMark,
+ decl_bug_io_actions(Bug, MaybeIoActions),
+ browse_chosen_io_action(MaybeIoActions, ActionNum, _MaybeMark,
!User, !IO),
user_confirm_bug(Bug, Response, !User, !IO)
;
@@ -998,7 +1045,7 @@
write_decl_atom(User, Indent, CallerType, DeclAtom, !IO) :-
io.write_string(User ^ outstr, Indent, !IO),
- unravel_decl_atom(DeclAtom, TraceAtom, MaybeTabledIoActions),
+ unravel_decl_atom(DeclAtom, TraceAtom, MaybeIoActions),
TraceAtom = atom(ProcLayout, Args0),
ProcLabel = get_proc_label_from_layout(ProcLayout),
get_pred_attributes(ProcLabel, _, Functor, _, PredOrFunc),
@@ -1013,47 +1060,63 @@
is_function(PredOrFunc)),
browse.print_browser_term(BrowserTerm, User ^ outstr, CallerType,
User ^ browser, !IO),
- write_maybe_tabled_io_actions(User, MaybeTabledIoActions, !IO).
+ write_maybe_tabled_io_actions(User, MaybeIoActions, !IO).
:- pred write_maybe_tabled_io_actions(user_state::in,
- list(maybe_tabled_io_action)::in, io::di, io::uo) is cc_multi.
+ maybe(io_action_range)::in, io::di, io::uo) is cc_multi.
-write_maybe_tabled_io_actions(User, MaybeTabledIoActions, !IO) :-
- filter_tabled_io_actions(MaybeTabledIoActions, IoActions, AreUntabled),
- write_io_actions(User, IoActions, !IO),
+write_maybe_tabled_io_actions(User, MaybeIoActions, !IO) :-
(
- AreUntabled = yes,
- io.write_string(User ^ outstr, "Warning: some IO actions " ++
- "for this atom are not tabled.\n", !IO)
+ MaybeIoActions = yes(IoActions),
+ count_tabled_io_actions(IoActions, NumTabled, NumUntabled,
+ !IO),
+ write_io_actions(User, NumTabled, IoActions, !IO),
+ (
+ NumUntabled > 0
+ ->
+ io.write_string(User ^ outstr, "Warning: some IO " ++
+ "actions for this atom are not tabled.\n", !IO)
+ ;
+ true
+ )
;
- AreUntabled = no
+ MaybeIoActions = no
).
-:- pred filter_tabled_io_actions(list(maybe_tabled_io_action)::in,
- list(io_action)::out, bool::out) is det.
+:- pred count_tabled_io_actions(io_action_range::in, int::out, int::out,
+ io::di, io::uo) is det.
+
+count_tabled_io_actions(io_action_range(Start, End), NumTabled,
+ NumUntabled, !IO) :-
+ count_tabled_io_actions_2(Start, End, 0, NumTabled, 0,
+ NumUntabled, !IO).
+
+:- pred count_tabled_io_actions_2(io_seq_num::in,
+ io_seq_num::in, int::in, int::out, int::in, int::out, io::di, io::uo)
+ is det.
-filter_tabled_io_actions(MaybeTabledIoActions, IoActions, AreUntabled) :-
- list.filter(io_action_is_tabled, MaybeTabledIoActions, TabledIoActions,
- UnTabledIoActions),
- IoActions = list.map(get_tabled_io_action, TabledIoActions),
+count_tabled_io_actions_2(Cur, End, PrevTabled, Tabled,
+ PrevUntabled, Untabled, !IO) :-
(
- UnTabledIoActions = [],
- AreUntabled = no
+ Cur = End
+ ->
+ Untabled = PrevUntabled,
+ Tabled = PrevTabled
;
- UnTabledIoActions = [_ | _],
- AreUntabled = yes
+ get_maybe_io_action(Cur, MaybeIoAction, !IO),
+ (
+ MaybeIoAction = tabled(_),
+ NewPrevUntabled = PrevUntabled,
+ NewPrevTabled = PrevTabled + 1
+ ;
+ MaybeIoAction = untabled,
+ NewPrevUntabled = PrevUntabled + 1,
+ NewPrevTabled = PrevTabled
+ ),
+ count_tabled_io_actions_2(Cur + 1, End,
+ NewPrevTabled, Tabled, NewPrevUntabled, Untabled, !IO)
).
-:- pred io_action_is_tabled(maybe_tabled_io_action::in) is semidet.
-
-io_action_is_tabled(tabled(_)).
-
-:- func get_tabled_io_action(maybe_tabled_io_action) = io_action.
-
-get_tabled_io_action(tabled(IoAction)) = IoAction.
-get_tabled_io_action(untabled(_)) = _ :-
- throw(internal_error("get_tabled_io_action", "io action not tabled")).
-
:- pred trace_atom_arg_to_univ(trace_atom_arg::in, univ::out) is det.
trace_atom_arg_to_univ(TraceAtomArg, Univ) :-
@@ -1066,26 +1129,25 @@
Univ = univ('_' `with_type` unbound)
).
-:- pred write_io_actions(user_state::in, list(io_action)::in,
+:- pred write_io_actions(user_state::in, int::in, io_action_range::in,
io::di, io::uo) is cc_multi.
-write_io_actions(User, IoActions, !IO) :-
- list.length(IoActions, NumIoActions),
- ( NumIoActions = 0 ->
+write_io_actions(User, NumTabled, IoActions, !IO) :-
+ ( NumTabled = 0 ->
true
;
- ( NumIoActions = 1 ->
+ ( NumTabled = 1 ->
io.write_string(User ^ outstr, "1 tabled IO action:",
!IO)
;
- io.write_int(User ^ outstr, NumIoActions, !IO),
+ io.write_int(User ^ outstr, NumTabled, !IO),
io.write_string(User ^ outstr, " tabled IO actions:",
!IO)
),
NumPrinted = get_num_printed_io_actions(User ^ browser),
- ( NumIoActions =< NumPrinted ->
+ ( NumTabled =< NumPrinted ->
io.nl(User ^ outstr, !IO),
- list.foldl(print_io_action(User), IoActions, !IO)
+ print_tabled_io_actions(User, IoActions, !IO)
;
io.write_string(User ^ outstr, " too many to show",
!IO),
@@ -1093,10 +1155,30 @@
)
).
-:- pred print_io_action(user_state::in, io_action::in, io::di, io::uo)
- is cc_multi.
+:- pred print_tabled_io_actions(user_state::in, io_action_range::in,
+ io::di, io::uo) is cc_multi.
+
+print_tabled_io_actions(User, IoActions, !IO) :-
+ IoActions = io_action_range(Start, End),
+ print_tabled_io_actions_2(User, Start, End, !IO).
+
+:- pred print_tabled_io_actions_2(user_state::in,
+ io_seq_num::in, io_seq_num::in, io::di, io::uo) is cc_multi.
+
+print_tabled_io_actions_2(User, Cur, End, !IO) :-
+ ( Cur = End ->
+ true
+ ;
+ get_maybe_io_action(Cur, MaybeIoAction, !IO),
+ print_tabled_io_action(User, MaybeIoAction, !IO),
+ print_tabled_io_actions_2(User, Cur + 1, End, !IO)
+ ).
+
+:- pred print_tabled_io_action(user_state::in, maybe_tabled_io_action::in,
+ io::di, io::uo) is cc_multi.
-print_io_action(User, IoAction, !IO) :-
+print_tabled_io_action(_, untabled, !IO).
+print_tabled_io_action(User, tabled(IoAction), !IO) :-
Term = io_action_to_browser_term(IoAction),
browse.print_browser_term(Term, User ^ outstr, print_all,
User ^ browser, !IO).
Index: browser/io_action.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/io_action.m,v
retrieving revision 1.8
diff -u -r1.8 io_action.m
--- browser/io_action.m 6 Apr 2005 01:11:30 -0000 1.8
+++ browser/io_action.m 15 Jun 2005 05:46:09 -0000
@@ -19,7 +19,9 @@
:- import_module mdb.browser_term.
:- import_module mdbcomp.prim_data.
-:- import_module list, map, std_util, io.
+:- import_module list.
+:- import_module io.
+:- import_module std_util.
:- type io_action
---> io_action(
@@ -30,23 +32,43 @@
:- type maybe_tabled_io_action
---> tabled(io_action)
- ; untabled(io_seq_num).
+ ; untabled.
:- type io_seq_num == int.
-:- type io_action_map == map(io_seq_num, io_action).
-:- pred make_io_action_map(int::in, int::in, io_action_map::out,
- io__state::di, io__state::uo) is det.
+:- type io_action_range
+ ---> io_action_range(
+ from_io_action :: io_seq_num,
+ to_io_action :: io_seq_num
+ ).
:- func io_action_to_browser_term(io_action) = browser_term.
+:- pred get_maybe_io_action(io_seq_num::in, maybe_tabled_io_action::out,
+ io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
:- implementation.
+:- import_module mdb.declarative_debugger.
+
:- import_module bool.
+:- import_module exception.
:- import_module int.
:- import_module require.
:- import_module svmap.
+get_maybe_io_action(IoActionNum, MaybeTabledIoAction, !IO) :-
+ pickup_io_action(IoActionNum, MaybeIoAction, !IO),
+ (
+ MaybeIoAction = yes(IoAction),
+ MaybeTabledIoAction = tabled(IoAction)
+ ;
+ MaybeIoAction = no,
+ MaybeTabledIoAction = untabled
+ ).
+
io_action_to_browser_term(IoAction) = Term :-
IoAction = io_action(ProcName, PredFunc, Args),
(
@@ -58,33 +80,12 @@
),
Term = synthetic_term_to_browser_term(ProcName, Args, IsFunc).
-make_io_action_map(Start, End, IoActionMap) -->
- make_io_action_map_2(Start, End, map__init, IoActionMap).
-
-:- pred make_io_action_map_2(int::in, int::in,
- io_action_map::in, io_action_map::out, io__state::di, io__state::uo)
- is det.
-
-make_io_action_map_2(Cur, End, !IoActionMap, !IO) :-
- ( Cur = End ->
- true
- ;
- pickup_io_action(Cur, MaybeIoAction, !IO),
- (
- MaybeIoAction = yes(IoAction),
- svmap.det_insert(Cur, IoAction, !IoActionMap)
- ;
- MaybeIoAction = no
- ),
- make_io_action_map_2(Cur + 1, End, !IoActionMap, !IO)
- ).
-
:- pred pickup_io_action(int::in, maybe(io_action)::out,
io__state::di, io__state::uo) is det.
:- pragma foreign_proc("C",
pickup_io_action(SeqNum::in, MaybeIOAction::out, S0::di, S::uo),
- [thread_safe, promise_pure, tabled_for_io],
+ [thread_safe, promise_pure, tabled_for_io, may_call_mercury],
"{
const char *problem;
const char *proc_name;
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.91
diff -u -r1.91 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 14 Jun 2005 09:40:25 -0000 1.91
+++ trace/mercury_trace_declarative.c 15 Jun 2005 05:46:38 -0000
@@ -218,8 +218,6 @@
static MR_Unsigned MR_edt_start_seqno;
-static MR_Unsigned MR_edt_start_io_counter;
-
/*
** 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
@@ -654,12 +652,6 @@
MR_edt_max_depth,
event_info, &event_details);
/*
- ** We will need all the io actions from
- ** the point after the retry above onwards.
- */
- MR_edt_start_io_counter =
- MR_io_tabling_counter;
- /*
** Reset the depth since we will now
** be at the top of the supertree to be
** materialized. We set it to -1 since
@@ -707,15 +699,6 @@
** we are (re)entering the topmost call.
*/
MR_edt_inside = MR_TRUE;
- /*
- ** If the port is a call and not a redo, then
- ** we need the io actions from here on.
- */
- if (event_info->MR_trace_port == MR_PORT_CALL)
- {
- MR_edt_start_io_counter =
- MR_io_tabling_counter;
- }
MR_edt_depth = -1;
return MR_TRUE;
} else {
@@ -1900,10 +1883,6 @@
return NULL;
}
-static MR_bool MR_io_action_map_cache_is_valid = MR_FALSE;
-static MR_Unsigned MR_io_action_map_cache_start;
-static MR_Unsigned MR_io_action_map_cache_end;
-
static MR_Code *
MR_decl_diagnosis(MR_Trace_Node root, MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info, MR_Event_Details *event_details,
@@ -1921,9 +1900,6 @@
MR_Unsigned topmost_seqno;
MR_Trace_Node call_preceding;
MercuryFile stream;
- MR_Integer use_old_io_map;
- MR_Unsigned io_start;
- MR_Unsigned io_end;
MR_Integer requested_subtree_depth;
if (MR_edt_compiler_flag_warning) {
@@ -1965,38 +1941,17 @@
MR_trace_decl_mode = MR_TRACE_DECL_DEBUG;
}
- io_start = MR_edt_start_io_counter;
- io_end = MR_io_tabling_counter;
-
- if (MR_io_action_map_cache_is_valid
- && MR_io_action_map_cache_start <= io_start
- && io_end <= MR_io_action_map_cache_end)
- {
- use_old_io_map = MR_TRUE;
- } else {
- use_old_io_map = MR_FALSE;
-
- MR_io_action_map_cache_is_valid = MR_TRUE;
- MR_io_action_map_cache_start = io_start;
- MR_io_action_map_cache_end = io_end;
- }
-
MR_TRACE_CALL_MERCURY(
if (new_tree == MR_TRUE) {
MR_DD_decl_diagnosis_new_tree(MR_trace_node_store,
- root, use_old_io_map,
- MR_io_action_map_cache_start,
- MR_io_action_map_cache_end,
- &response, MR_trace_front_end_state,
+ root, &response, MR_trace_front_end_state,
&MR_trace_front_end_state,
MR_trace_browser_persistent_state,
&MR_trace_browser_persistent_state
);
} else {
MR_DD_decl_diagnosis_resume_previous(
- MR_trace_node_store, MR_FALSE,
- MR_io_action_map_cache_start,
- MR_io_action_map_cache_end,
+ MR_trace_node_store,
&response, MR_trace_front_end_state,
&MR_trace_front_end_state,
MR_trace_browser_persistent_state,
@@ -2363,8 +2318,10 @@
{
MR_Unsigned current_tick;
- if (event_number % MR_DECL_PROGRESS_CHECK_INTERVAL == 0) {
- if (! MR_edt_building_supertree) {
+ if (! MR_edt_building_supertree) {
+ if (event_number % MR_DECL_PROGRESS_CHECK_INTERVAL == 0
+ || event_number == MR_edt_last_event)
+ {
if (MR_edt_progress_last_tick == 0 &&
(MR_edt_start_time + MR_DECL_DISPLAY_PROGRESS_DELAY
< MR_get_user_cpu_miliseconds()))
@@ -2377,9 +2334,10 @@
*/
MR_edt_progress_last_tick = 1;
} else if (MR_edt_progress_last_tick > 0) {
- current_tick = ((event_number - MR_edt_first_event)
- * MR_DECL_PROGRESS_TOTAL)
- / (MR_edt_last_event - MR_edt_first_event);
+ current_tick = (MR_Unsigned)((
+ (float)(event_number - MR_edt_first_event)
+ * (float)MR_DECL_PROGRESS_TOTAL)
+ / (float)(MR_edt_last_event - MR_edt_first_event));
if (current_tick != MR_edt_progress_last_tick) {
for (; MR_edt_progress_last_tick < current_tick;
MR_edt_progress_last_tick++)
@@ -2390,7 +2348,9 @@
}
}
}
- } else {
+ }
+ } else {
+ if (event_number % MR_DECL_PROGRESS_CHECK_INTERVAL == 0) {
/*
** If we are building a supertree we don't know what the
** final event will be, so we just show a tick every
--------------------------------------------------------------------------
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