mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 21:35:49 +00:00
672f77c4ec
Estimated hours taken: 20 Branches: main Add a new compiler option. --inform-ite-instead-of-switch. If this is enabled, the compiler will generate informational messages about if-then-elses that it thinks should be converted to switches for the sake of program reliability. Act on the output generated by this option. compiler/simplify.m: Implement the new option. Fix an old bug that could cause us to generate warnings about code that was OK in one duplicated copy but not in another (where a switch arm's code is duplicated due to the case being selected for more than one cons_id). compiler/options.m: Add the new option. Add a way to test for the bug fix in simplify. doc/user_guide.texi: Document the new option. NEWS: Mention the new option. library/*.m: mdbcomp/*.m: browser/*.m: compiler/*.m: deep_profiler/*.m: Convert if-then-elses to switches at most of the sites suggested by the new option. At the remaining sites, switching to switches would have nontrivial downsides. This typically happens with the switched-on type has many functors, and we treat one or two specially (e.g. cons/2 in the cons_id type). Perform misc cleanups in the vicinity of the if-then-else to switch conversions. In a few cases, improve the error messages generated. compiler/accumulator.m: compiler/hlds_goal.m: (Rename and) move insts for particular kinds of goal from accumulator.m to hlds_goal.m, to allow them to be used in other modules. Using these insts allowed us to eliminate some if-then-elses entirely. compiler/exprn_aux.m: Instead of fixing some if-then-elses, delete the predicates containing them, since they aren't used, and (as pointed out by the new option) would need considerable other fixing if they were ever needed again. compiler/lp_rational.m: Add prefixes to the names of the function symbols on some types, since without those prefixes, it was hard to figure out what type the switch corresponding to an old if-then-else was switching on. tests/invalid/reserve_tag.err_exp: Expect a new, improved error message.
1929 lines
74 KiB
Mathematica
1929 lines
74 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-2007 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU Library General
|
|
% Public License - see the file COPYING.LIB in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: declarative_tree.m
|
|
% Author: Mark Brown
|
|
%
|
|
% This module defines an instance of mercury_edt/2, the debugging tree.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module mdb.declarative_tree.
|
|
:- interface.
|
|
|
|
:- import_module mdb.declarative_edt.
|
|
:- import_module mdb.declarative_execution.
|
|
:- import_module mdbcomp.program_representation.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The type of nodes in our implementation of EDTs. The parameter
|
|
% is meant to be the type of references to trace nodes. In
|
|
% particular, the references should be to trace nodes that could
|
|
% be considered nodes in the EDT, namely those for exit, fail
|
|
% and exception events.
|
|
%
|
|
:- type edt_node(R)
|
|
---> dynamic(R).
|
|
|
|
:- instance mercury_edt(wrap(S), edt_node(R)) <= annotated_trace(S, R).
|
|
|
|
% The wrap/1 around the first argument of the instance is
|
|
% required by the language.
|
|
%
|
|
:- type wrap(S)
|
|
---> wrap(S).
|
|
|
|
:- pred edt_subtree_details(S::in, edt_node(R)::in, event_number::out,
|
|
sequence_number::out, R::out) is det <= annotated_trace(S, R).
|
|
|
|
:- pred trace_atom_subterm_is_ground(trace_atom::in, arg_pos::in,
|
|
term_path::in) is semidet.
|
|
|
|
:- pred trace_implicit_tree_info(wrap(S)::in, edt_node(R)::in,
|
|
implicit_tree_info::out) is semidet <= annotated_trace(S, R).
|
|
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdb.declarative_debugger.
|
|
:- import_module mdb.io_action.
|
|
:- import_module mdb.term_rep.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.program_representation.
|
|
:- import_module mdbcomp.rtti_access.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module deconstruct.
|
|
:- import_module exception.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module string.
|
|
:- import_module unit.
|
|
:- import_module univ.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- instance mercury_edt(wrap(S), edt_node(R)) <= annotated_trace(S, R)
|
|
where [
|
|
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,
|
|
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_same_nodes/3) is trace_same_event_numbers,
|
|
pred(edt_topmost_node/2) is trace_topmost_node,
|
|
pred(edt_number_of_events/4) is trace_number_of_events,
|
|
pred(edt_subtree_suspicion/4) is trace_subtree_suspicion,
|
|
pred(edt_context/4) is trace_context,
|
|
func(edt_proc_label/2) is trace_node_proc_label,
|
|
func(edt_arg_pos_to_user_arg_num/3) is trace_arg_pos_to_user_arg_num
|
|
].
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- 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(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,
|
|
( 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).
|
|
|
|
call_node_decl_atom(Store, CallId) = DeclAtom :-
|
|
call_node_from_id(Store, CallId, CallNode),
|
|
CallAtom = get_trace_call_atom(CallNode),
|
|
DeclAtom = init_decl_atom(CallAtom).
|
|
|
|
:- pred get_edt_node_initial_atom(S::in, R::in, init_decl_atom::out)
|
|
is det <= annotated_trace(S, R).
|
|
|
|
get_edt_node_initial_atom(Store, Ref, Atom) :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_exit(_, CallId, _, _, _, _, _, _),
|
|
Atom = call_node_decl_atom(Store, CallId)
|
|
;
|
|
Node = node_fail(_, CallId, _, _, _, _),
|
|
Atom = call_node_decl_atom(Store, CallId)
|
|
;
|
|
Node = node_excp(_, CallId, _, _, _, _, _),
|
|
Atom = call_node_decl_atom(Store, CallId)
|
|
).
|
|
|
|
:- pred get_edt_node_event_number(S::in, R::in, event_number::out)
|
|
is det <= annotated_trace(S, R).
|
|
|
|
get_edt_node_event_number(Store, Ref, Event) :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_exit(_, _, _, _, Event, _, _, _)
|
|
;
|
|
Node = node_fail(_, _, _, Event, _, _)
|
|
;
|
|
Node = node_excp(_, _, _, _, Event, _, _)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred trace_question(wrap(S)::in, edt_node(R)::in,
|
|
decl_question(edt_node(R))::out) is det <= annotated_trace(S, R).
|
|
|
|
trace_question(wrap(Store), dynamic(Ref), Root) :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_fail(_, CallId, RedoId, _, _, _),
|
|
DeclAtom = call_node_decl_atom(Store, CallId),
|
|
get_answers(Store, RedoId, [], Answers),
|
|
Root = missing_answer(dynamic(Ref), DeclAtom, Answers)
|
|
;
|
|
Node = node_exit(_, CallId, _, _, _, _, _, _),
|
|
InitDeclAtom = call_node_decl_atom(Store, CallId),
|
|
FinalDeclAtom = exit_node_decl_atom(Store, Node),
|
|
Root = wrong_answer(dynamic(Ref), InitDeclAtom, FinalDeclAtom)
|
|
;
|
|
Node = node_excp(_, CallId, _, Exception, _, _, _),
|
|
DeclAtom = call_node_decl_atom(Store, CallId),
|
|
Root = unexpected_exception(dynamic(Ref), DeclAtom, Exception)
|
|
).
|
|
|
|
:- 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(Store, RedoId, DeclAtoms0, DeclAtoms) :-
|
|
( maybe_redo_node_from_id(Store, RedoId, node_redo(_, ExitId, _, _, _)) ->
|
|
exit_node_from_id(Store, ExitId, ExitNode),
|
|
NextId = ExitNode ^ exit_prev_redo,
|
|
DeclAtom = exit_node_decl_atom(Store, ExitNode),
|
|
get_answers(Store, NextId, [DeclAtom | DeclAtoms0], DeclAtoms)
|
|
;
|
|
DeclAtoms = DeclAtoms0
|
|
).
|
|
|
|
:- 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(wrap(Store), dynamic(Ref), Bug) :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_exit(_, CallId, _, _, Event, _, _, _),
|
|
InitDeclAtom = call_node_decl_atom(Store, CallId),
|
|
FinalDeclAtom = exit_node_decl_atom(Store, Node),
|
|
get_exit_atoms_in_contour(Store, Node, Contour),
|
|
Bug = incorrect_contour(InitDeclAtom, FinalDeclAtom, Contour, Event)
|
|
;
|
|
Node = node_fail(_, CallId, _, Event, _, _),
|
|
DeclAtom = call_node_decl_atom(Store, CallId),
|
|
Bug = partially_uncovered_atom(DeclAtom, Event)
|
|
;
|
|
Node = node_excp(_, CallId, _, Exception, Event, _, _),
|
|
DeclAtom = call_node_decl_atom(Store, CallId),
|
|
Bug = unhandled_exception(DeclAtom, Exception, Event)
|
|
).
|
|
|
|
:- pred trace_get_i_bug(wrap(S)::in, edt_node(R)::in,
|
|
edt_node(R)::in, decl_i_bug::out) is det <= annotated_trace(S, R).
|
|
|
|
trace_get_i_bug(wrap(Store), dynamic(BugRef), dynamic(InadmissibleRef),
|
|
inadmissible_call(BugAtom, unit, InadmissibleAtom, Event)) :-
|
|
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_last_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 = node_fail(_, CallId, _, _, _, _)
|
|
;
|
|
Node = node_exit(_, CallId, _, _, _, _, _, _)
|
|
;
|
|
Node = 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 = node_exit(_, _, _, _, Event, _, _, _),
|
|
Node2 = node_exit(_, _, _, _, Event, _, _, _)
|
|
;
|
|
Node1 = node_fail(_, _, _, Event, _, _),
|
|
Node2 = node_fail(_, _, _, Event, _, _)
|
|
;
|
|
Node1 = node_excp(_, _, _, _, Event, _, _),
|
|
Node2 = node_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 = node_exit(_, CallId, _, _, _, _, _, _)
|
|
;
|
|
Node = node_fail(_, CallId, _, _, _, _)
|
|
;
|
|
Node = node_excp(_, CallId, _, _, _, _, _)
|
|
),
|
|
% XXX This is buggy: see the io_read_bug test case.
|
|
% The node is topmost if the call sequence number is 1.
|
|
call_node_from_id(Store, CallId, node_call(_, _, _, 1, _, _, _, _, _, _)).
|
|
|
|
:- pred trace_children(wrap(S)::in, edt_node(R)::in, list(edt_node(R))::out)
|
|
is semidet <= annotated_trace(S, R).
|
|
|
|
trace_children(wrap(Store), dynamic(Ref), Children) :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_fail(PrecId, CallId, _, _, _, _),
|
|
not_at_depth_limit(Store, CallId),
|
|
stratum_children(Store, PrecId, CallId, [], Children)
|
|
;
|
|
Node = node_exit(PrecId, CallId, _, _, _, _, _, _),
|
|
Atom = get_trace_exit_atom(Node),
|
|
not_at_depth_limit(Store, CallId),
|
|
( missing_answer_special_case(Atom) ->
|
|
stratum_children(Store, PrecId, CallId, [], Children)
|
|
;
|
|
contour_children(normal, Store, PrecId, CallId, [], Children)
|
|
)
|
|
;
|
|
Node = node_excp(PrecId, CallId, _, _, _, _, _),
|
|
not_at_depth_limit(Store, CallId),
|
|
contour_children(exception, Store, PrecId, CallId, [], Children)
|
|
).
|
|
|
|
:- pred trace_is_implicit_root(wrap(S)::in, edt_node(R)::in) is semidet
|
|
<= annotated_trace(S, R).
|
|
|
|
trace_is_implicit_root(wrap(Store), dynamic(Ref)) :-
|
|
get_edt_call_node(Store, Ref, CallId),
|
|
\+ not_at_depth_limit(Store, CallId).
|
|
|
|
trace_implicit_tree_info(wrap(Store), dynamic(Ref), ImplicitTreeInfo) :-
|
|
get_edt_call_node(Store, Ref, CallId),
|
|
call_node_from_id(Store, CallId, CallNode),
|
|
CallNode ^ call_at_max_depth = yes(ImplicitTreeInfo).
|
|
|
|
:- pred trace_number_of_events(wrap(S)::in, edt_node(R)::in, int::out,
|
|
int::out) is det <= annotated_trace(S, R).
|
|
|
|
trace_number_of_events(Store, NodeId, Events, DuplicatedEvents) :-
|
|
trace_weight(number_of_events, Store, NodeId, 0, Events, no, 0, 0,
|
|
DuplicatedEvents).
|
|
|
|
:- pred trace_subtree_suspicion(wrap(S)::in, edt_node(R)::in, int::out,
|
|
int::out) is det <= annotated_trace(S, R).
|
|
|
|
trace_subtree_suspicion(Store, NodeId, Suspicion, Excess) :-
|
|
trace_weight(suspicion, Store, NodeId, 0, Suspicion, no, 0, 0, Excess).
|
|
|
|
% trace_weight(Weighting, Store, Node, PrevWeight, Weight, RecordDups,
|
|
% DupFactor, PrevDupWeight, Excess)
|
|
% Calculate the difference between the value of a field in an EXIT,
|
|
% FAIL or EXCP node and the same field in the corresponding CALL node
|
|
% (the field that is used depends on the value of Weighting). If Node
|
|
% is a FAIL or EXCP, then sum the differences between the first
|
|
% CALL and the first EXIT, subsequent REDOs and EXITs and the final
|
|
% REDO and FAIL/EXCP. If Node is a FAIL or EXCP then all the previous
|
|
% EXITS will be included in the EDT and the subtrees rooted at these
|
|
% EXITS will have common annotated trace nodes. Excess is the total
|
|
% weight of all duplicated nodes. PrevWeight and PrevDupWeight are
|
|
% accumulators which should initially be zero. RecordDups keeps track
|
|
% of whether the final node was a FAIL or EXCP. This should be `no'
|
|
% initially. DupFactor keeps track of how many times the nodes before
|
|
% the last REDO could have been duplicated and should initially be zero.
|
|
%
|
|
:- pred trace_weight(weighting_heuristic::in, wrap(S)::in, edt_node(R)::in,
|
|
int::in, int::out, bool::in, int::in, int::in, int::out)
|
|
is det <= annotated_trace(S, R).
|
|
|
|
trace_weight(Weighting, wrap(Store), dynamic(Ref), PrevWeight, Weight,
|
|
RecordDups, DupFactor, PrevDupWeight, Excess) :-
|
|
det_trace_node_from_id(Store, Ref, Final),
|
|
(
|
|
(
|
|
Final = node_exit(_, CallId, RedoId, _, FinalEvent, _, _,
|
|
FinalSuspicion),
|
|
NewRecordDups = RecordDups
|
|
;
|
|
Final = node_fail(_, CallId, RedoId, FinalEvent, _,
|
|
FinalSuspicion),
|
|
NewRecordDups = yes
|
|
;
|
|
Final = node_excp(_, CallId, RedoId, _, FinalEvent, _,
|
|
FinalSuspicion),
|
|
NewRecordDups = yes
|
|
)
|
|
->
|
|
(
|
|
maybe_redo_node_from_id(Store, RedoId, Redo),
|
|
Redo = node_redo(_, ExitId, RedoEvent, _, RedoSuspicion)
|
|
->
|
|
(
|
|
NewRecordDups = yes,
|
|
(
|
|
Weighting = number_of_events,
|
|
NewPrevDupWeight = PrevDupWeight +
|
|
DupFactor * (FinalEvent - RedoEvent + 1)
|
|
;
|
|
Weighting = suspicion,
|
|
NewPrevDupWeight = PrevDupWeight +
|
|
DupFactor * (FinalSuspicion - RedoSuspicion)
|
|
)
|
|
;
|
|
NewRecordDups = no,
|
|
NewPrevDupWeight = 0
|
|
),
|
|
(
|
|
Weighting = number_of_events,
|
|
NewPrevWeight = PrevWeight + FinalEvent - RedoEvent + 1
|
|
;
|
|
Weighting = suspicion,
|
|
NewPrevWeight = PrevWeight + FinalSuspicion - RedoSuspicion
|
|
),
|
|
trace_weight(Weighting, wrap(Store), dynamic(ExitId),
|
|
NewPrevWeight, Weight, NewRecordDups,
|
|
DupFactor + 1, NewPrevDupWeight, Excess)
|
|
;
|
|
call_node_from_id(Store, CallId, Call),
|
|
CallEvent = Call ^ call_event,
|
|
CallSuspicion = Call ^ call_suspicion,
|
|
(
|
|
Weighting = number_of_events,
|
|
Weight = PrevWeight + FinalEvent - CallEvent + 1
|
|
;
|
|
Weighting = suspicion,
|
|
Weight = PrevWeight + FinalSuspicion - CallSuspicion
|
|
),
|
|
(
|
|
NewRecordDups = yes,
|
|
(
|
|
Weighting = number_of_events,
|
|
Excess = PrevDupWeight + DupFactor *
|
|
(FinalEvent - CallEvent + 1)
|
|
;
|
|
Weighting = suspicion,
|
|
Excess = PrevDupWeight + DupFactor *
|
|
(FinalSuspicion - CallSuspicion)
|
|
)
|
|
;
|
|
NewRecordDups = no,
|
|
Excess = 0
|
|
)
|
|
)
|
|
;
|
|
throw(internal_error("trace_weight", "not a final event"))
|
|
).
|
|
|
|
:- pred trace_context(wrap(S)::in, edt_node(R)::in, pair(string, int)::out,
|
|
maybe(pair(string, int))::out) is semidet <= annotated_trace(S, R).
|
|
|
|
trace_context(wrap(Store), dynamic(Ref), FileName - LineNo,
|
|
MaybeReturnContext) :-
|
|
det_trace_node_from_id(Store, Ref, Final),
|
|
(
|
|
Final = node_exit(_, CallId, _, _, _, Label, _, _)
|
|
;
|
|
Final = node_fail(_, CallId, _, _, Label, _)
|
|
;
|
|
Final = node_excp(_, CallId, _, _, _, Label, _)
|
|
),
|
|
get_context_from_label_layout(Label, FileName, LineNo),
|
|
call_node_from_id(Store, CallId, Call),
|
|
(
|
|
Call ^ call_return_label = yes(ReturnLabel),
|
|
get_context_from_label_layout(ReturnLabel, ReturnFileName,
|
|
ReturnLineNo),
|
|
MaybeReturnContext = yes(ReturnFileName - ReturnLineNo)
|
|
;
|
|
Call ^ call_return_label = no,
|
|
MaybeReturnContext = no
|
|
).
|
|
|
|
:- pred missing_answer_special_case(trace_atom::in) is semidet.
|
|
|
|
missing_answer_special_case(Atom) :-
|
|
ProcLabel = get_proc_label_from_layout(Atom ^ proc_layout),
|
|
ProcLabel = ordinary_proc_label(StdUtilModule1, pf_predicate,
|
|
StdUtilModule2, "builtin_aggregate", 4, _),
|
|
possible_sym_library_module_name("solutions", StdUtilModule1),
|
|
possible_sym_library_module_name("solutions", StdUtilModule2).
|
|
|
|
:- pred possible_sym_library_module_name(string::in, module_name::out)
|
|
is multi.
|
|
|
|
possible_sym_library_module_name(ModuleStr, unqualified(ModuleStr)).
|
|
possible_sym_library_module_name(ModuleStr, qualified(unqualified("library"),
|
|
ModuleStr)).
|
|
|
|
:- pred not_at_depth_limit(S::in, R::in) is semidet <= annotated_trace(S, R).
|
|
|
|
not_at_depth_limit(Store, Ref) :-
|
|
call_node_from_id(Store, Ref, CallNode),
|
|
CallNode ^ call_at_max_depth = no.
|
|
|
|
:- func trace_node_proc_label(wrap(S), edt_node(R)) = proc_label
|
|
<= annotated_trace(S, R).
|
|
|
|
trace_node_proc_label(wrap(Store), dynamic(Ref)) = ProcLabel :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_fail(_, _, _, _, Label, _)
|
|
;
|
|
Node = node_exit(_, _, _, _, _, Label, _, _)
|
|
;
|
|
Node = node_excp(_, _, _, _, _, Label, _)
|
|
),
|
|
ProcLayout = get_proc_layout_from_label_layout(Label),
|
|
ProcLabel = get_proc_label_from_layout(ProcLayout).
|
|
|
|
:- type contour_type
|
|
---> normal
|
|
% The contour ends with an EXIT event.
|
|
|
|
; exception.
|
|
% The contour ends with an EXCP event.
|
|
|
|
:- pred contour_children(contour_type::in, S::in, R::in, R::in,
|
|
list(edt_node(R))::in, list(edt_node(R))::out) is det
|
|
<= annotated_trace(S, R).
|
|
|
|
contour_children(ContourType, Store, NodeId, StartId, Ns0, Ns) :-
|
|
( NodeId = StartId ->
|
|
Ns = Ns0
|
|
;
|
|
contour_children_2(ContourType, Store, NodeId, StartId, Ns0, Ns)
|
|
).
|
|
|
|
:- pred contour_children_2(contour_type::in, S::in, R::in, R::in,
|
|
list(edt_node(R))::in, list(edt_node(R))::out) is det
|
|
<= annotated_trace(S, R).
|
|
|
|
contour_children_2(ContourType, Store, NodeId, StartId, Ns0, Ns) :-
|
|
det_trace_node_from_id(Store, NodeId, Node),
|
|
(
|
|
Node = node_call(_, _, _, _, _, _, _, _, _, _),
|
|
throw(internal_error("contour_children_2",
|
|
"unexpected start of contour"))
|
|
;
|
|
Node = node_exit(_, _, _, _, _, _, _, _),
|
|
% Add a child for this node.
|
|
Ns1 = [dynamic(NodeId) | Ns0]
|
|
;
|
|
Node = node_fail(_, CallId, _, _, _, _),
|
|
|
|
% Fail events can be reached here if there were events missing
|
|
% due to a parent being shallow traced. In this case, we can't tell
|
|
% whether the call was in a negated context or backtracked over,
|
|
% so we have to assume the former.
|
|
%
|
|
% Fail events can also be reached here if the parent was a variant
|
|
% of solutions/2.
|
|
%
|
|
% If this really is in a negated context, the start of the context
|
|
% would be just before the entry to this failed call, modulo
|
|
% any det/semidet code which succeeded.
|
|
|
|
call_node_from_id(Store, CallId, Call),
|
|
NestedStartId = Call ^ call_preceding,
|
|
stratum_children(Store, NodeId, NestedStartId, Ns0, Ns1)
|
|
;
|
|
Node = node_neg_fail(Prec, NestedStartId, _),
|
|
|
|
% There is a nested context. Neg_fail events can be reached here
|
|
% if there were events missing due to a parent being shallow traced.
|
|
% In this case, we can't tell whether the call was in a negated context
|
|
% or backtracked over, so we have to assume the former.
|
|
|
|
contour_children(ContourType, Store, Prec, NestedStartId, Ns0, Ns1)
|
|
;
|
|
( Node = node_else(Prec, NestedStartId, _)
|
|
; Node = node_neg_succ(Prec, NestedStartId, _)
|
|
),
|
|
% There is a nested context.
|
|
stratum_children(Store, Prec, NestedStartId, Ns0, Ns1)
|
|
;
|
|
Node = node_excp(_, CallId, _, _, _, _, _),
|
|
|
|
% If the contour ends in an exception, then add this exception
|
|
% to the list of contour children and continue along the contour,
|
|
% since in this case we are only interested in nodes that caused
|
|
% the exception to be thrown.
|
|
%
|
|
% If the contour ends with an exit then the exception must have been
|
|
% caught by a try/2 or try_all/3 or similar. In this case we want to
|
|
% add all the exits of the call that threw the exception to the list
|
|
% of children since one of the generated solutions may be incorrect.
|
|
|
|
(
|
|
ContourType = exception,
|
|
Ns1 = [dynamic(NodeId) | Ns0]
|
|
;
|
|
ContourType = normal,
|
|
call_node_from_id(Store, CallId, Call),
|
|
NestedStartId = Call ^ call_preceding,
|
|
stratum_children(Store, NodeId, NestedStartId, Ns0, Ns1)
|
|
)
|
|
;
|
|
( Node = node_redo(_, _, _, _, _)
|
|
; Node = node_switch(_, _)
|
|
; Node = node_first_disj(_, _)
|
|
; Node = node_later_disj(_, _, _)
|
|
; Node = node_then(_, _, _)
|
|
),
|
|
|
|
% We skip neg_succ nodes for the same reason that we skip exit nodes
|
|
% This handles the following cases: redo, switch, first_disj,
|
|
% later_disj, and then. Also handles cond when the status is anything
|
|
% other than failed.
|
|
%
|
|
% Redo events can be reached here if there were missing events
|
|
% due to a shallow tracing. In this case, we have to scan over
|
|
% the entire previous contour, since there is no way to tell
|
|
% how much of it was backtracked over.
|
|
|
|
Ns1 = Ns0
|
|
;
|
|
Node = node_cond(_, _, CondStatus),
|
|
(
|
|
CondStatus = failed,
|
|
throw(internal_error("contour_children_2",
|
|
"unexpected start of contour"))
|
|
;
|
|
( CondStatus = succeeded
|
|
; CondStatus = undecided
|
|
),
|
|
Ns1 = Ns0
|
|
)
|
|
;
|
|
Node = node_neg(_, _, NegStatus),
|
|
(
|
|
ContourType = normal,
|
|
throw(internal_error("contour_children_2",
|
|
"unexpected start of contour"))
|
|
;
|
|
ContourType = exception,
|
|
(
|
|
NegStatus = failed,
|
|
throw(internal_error("contour_children_2",
|
|
"unexpected start of contour"))
|
|
;
|
|
( NegStatus = succeeded
|
|
; NegStatus = undecided
|
|
),
|
|
% A non-failed NEGE could be encountered when gathering
|
|
% the children of an exception node, since the exception
|
|
% may have been thrown inside the negation.
|
|
Ns1 = Ns0
|
|
)
|
|
)
|
|
),
|
|
Next = step_left_in_contour(Store, Node),
|
|
contour_children(ContourType, Store, Next, StartId, Ns1, Ns).
|
|
|
|
:- pred stratum_children(S::in, R::in, R::in, list(edt_node(R))::in,
|
|
list(edt_node(R))::out) is det <= annotated_trace(S, R).
|
|
|
|
stratum_children(Store, NodeId, StartId, Ns0, Ns) :-
|
|
( NodeId = StartId ->
|
|
Ns = Ns0
|
|
;
|
|
stratum_children_2(Store, NodeId, StartId, Ns0, Ns)
|
|
).
|
|
|
|
:- pred stratum_children_2(S::in, R::in, R::in, list(edt_node(R))::in,
|
|
list(edt_node(R))::out) is det <= annotated_trace(S, R).
|
|
|
|
stratum_children_2(Store, NodeId, StartId, Ns0, Ns) :-
|
|
det_trace_node_from_id(Store, NodeId, Node),
|
|
(
|
|
( Node = node_call(_, _, _, _, _, _, _, _, _, _)
|
|
; Node = node_neg(_, _, _)
|
|
),
|
|
throw(internal_error("stratum_children_2",
|
|
"unexpected start of contour"))
|
|
;
|
|
( Node = node_fail(_, _, _, _, _, _)
|
|
; Node = node_excp(_, _, _, _, _, _, _)
|
|
),
|
|
% Add a child for this node.
|
|
Ns1 = [dynamic(NodeId) | Ns0]
|
|
;
|
|
Node = node_neg_fail(Prec, NestedStartId, _),
|
|
% There is a nested successful context.
|
|
contour_children(normal, Store, Prec, NestedStartId, Ns0, Ns1)
|
|
;
|
|
Node = node_else(Prec, NestedStartId, _),
|
|
% There is a nested failed context.
|
|
stratum_children(Store, Prec, NestedStartId, Ns0, Ns1)
|
|
;
|
|
Node = node_exit(_, CallId, _, _, _, _, _, _),
|
|
% Only include an exit node as a missing answer child if it
|
|
% produces output. If the exit event doesn't produce output
|
|
% then the only way the call could have behaved differently
|
|
% is by failing, which won't change the fail, negs or else event
|
|
% anchoring the end of the current stratum, since the rest of the goal
|
|
% failed anyway.
|
|
|
|
( calls_arguments_are_all_ground(Store, CallId) ->
|
|
Ns1 = Ns0
|
|
;
|
|
Ns1 = [dynamic(NodeId) | Ns0]
|
|
)
|
|
;
|
|
( Node = node_redo(_, _, _, _, _)
|
|
; Node = node_switch(_, _)
|
|
; Node = node_first_disj(_, _)
|
|
; Node = node_later_disj(_, _, _)
|
|
; Node = node_then(_, _, _)
|
|
; Node = node_neg_succ(_, _, _)
|
|
),
|
|
% We skip neg_succ nodes for the same reason that we skip exit nodes
|
|
% where there are no outputs (see above).
|
|
Ns1 = Ns0
|
|
;
|
|
Node = node_cond(_, _, CondStatus),
|
|
(
|
|
( CondStatus = succeeded
|
|
; CondStatus = undecided
|
|
),
|
|
Ns1 = Ns0
|
|
;
|
|
CondStatus = failed,
|
|
throw(internal_error("stratum_children_2",
|
|
"unexpected start of contour"))
|
|
)
|
|
),
|
|
Next = step_in_stratum(Store, Node),
|
|
stratum_children(Store, Next, StartId, Ns1, Ns).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Tracking a subterm dependency.
|
|
%
|
|
% We are given an EDT node, an argument position, and a path to the selected
|
|
% subterm. We wish to find the origin of that subterm within the body of the
|
|
% given node, or within the body of its parent. We can figure out the mode of
|
|
% the top of the selected subterm.
|
|
%
|
|
% If the mode is `in', the origin could be:
|
|
% - a primitive (unification or foreign_proc) within the body of the
|
|
% parent,
|
|
% - an output subterm in a sibling node, or
|
|
% - an input subterm of the parent node.
|
|
% In this case we look at the contour leading up to the call event associated
|
|
% with the given node. This contour will be wholly within the parent call.
|
|
%
|
|
% If the mode is `out', the origin could be:
|
|
% - a primitive (unification or foreign_proc) within the body of the
|
|
% call,
|
|
% - an output subterm of a child of the node, or
|
|
% - an input subterm of the node itself.
|
|
% In this case we look at the contour leading up to the exit or exception event
|
|
% associated with the given node. This contour will be wholly within the
|
|
% current call.
|
|
%
|
|
% Our algorithm for finding the origin has three phases.
|
|
%
|
|
% In the first phase, we materialize a list of the nodes in the contour.
|
|
%
|
|
% In the second phase, we use this list of nodes to construct a list of the
|
|
% primitive goals along that contour in the body of the relevant procedure,
|
|
% leading up to either the call event (if subterm_mode is `in') or the exit
|
|
% event (if subterm_mode is `out').
|
|
%
|
|
% In the third phase, we traverse the list of primitive goals backwards, from
|
|
% the most recently executed primitive to the earliest one, keeping track of
|
|
% the variable which contains the selected subterm, and the location within
|
|
% this variable.
|
|
|
|
:- type dependency_chain_start(R)
|
|
---> chain_start(
|
|
% The argument number of the selected position in the full list
|
|
% of arguments, including the compiler-generated ones.
|
|
start_loc(R),
|
|
|
|
% The total number of arguments including the compiler
|
|
% generated ones.
|
|
int,
|
|
|
|
int,
|
|
|
|
% The id of the node preceding the exit node if start_loc
|
|
% is cur_goal, and the id of the node preceding the call node
|
|
% if start_loc is parent_goal.
|
|
R,
|
|
|
|
% No if start_loc is cur_goal; and yes wrapped around the
|
|
% goal path of the call in the parent procedure if start_loc
|
|
% is parent_goal.
|
|
maybe(goal_path),
|
|
|
|
% The body of the procedure indicated by start_loc.
|
|
maybe(proc_defn_rep)
|
|
)
|
|
|
|
; require_explicit_subtree.
|
|
% An explicit subtree is required before the
|
|
% chain start can be calculated.
|
|
|
|
:- type start_loc(R)
|
|
---> cur_goal
|
|
; parent_goal(R, trace_node(R)).
|
|
|
|
:- type goal_and_path
|
|
---> goal_and_path(goal_rep, goal_path).
|
|
|
|
:- type goal_and_path_list == list(goal_and_path).
|
|
|
|
:- type annotated_primitive(R)
|
|
---> primitive(
|
|
string, % filename
|
|
int, % line number
|
|
list(var_rep), % vars bound by the atomic goal
|
|
atomic_goal_rep, % the atomic goal itself
|
|
goal_path, % its goal path
|
|
maybe(R) % if the atomic goal is a call,
|
|
% the id of the call's exit event
|
|
).
|
|
|
|
:- pred trace_subterm_mode(wrap(S)::in, edt_node(R)::in, arg_pos::in,
|
|
term_path::in, subterm_mode::out) is det <= annotated_trace(S, R).
|
|
|
|
trace_subterm_mode(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode) :-
|
|
find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart),
|
|
(
|
|
ChainStart = chain_start(StartLoc, _, _, _, _, _),
|
|
Mode = start_loc_to_subterm_mode(StartLoc)
|
|
;
|
|
ChainStart = require_explicit_subtree,
|
|
% The only time a subtree will be required is if the
|
|
% mode of the subterm is output.
|
|
Mode = subterm_out
|
|
).
|
|
|
|
:- pred trace_dependency(wrap(S)::in, edt_node(R)::in, arg_pos::in,
|
|
term_path::in, subterm_mode::out, subterm_origin(edt_node(R))::out)
|
|
is det <= annotated_trace(S, R).
|
|
|
|
trace_dependency(wrap(Store), dynamic(Ref), ArgPos, TermPath, Mode, Origin) :-
|
|
find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart),
|
|
(
|
|
ChainStart = chain_start(StartLoc, ArgNum, TotalArgs, NodeId,
|
|
StartPath, MaybeProcDefnRep),
|
|
Mode = start_loc_to_subterm_mode(StartLoc),
|
|
(
|
|
MaybeProcDefnRep = no,
|
|
Origin = origin_not_found
|
|
;
|
|
MaybeProcDefnRep = yes(ProcDefnRep),
|
|
(
|
|
trace_dependency_special_case(Store, ProcDefnRep, Ref,
|
|
StartLoc, ArgNum, TermPath, NodeId, Origin0)
|
|
->
|
|
Origin = Origin0
|
|
;
|
|
trace_dependency_in_proc_defn_rep(Store, TermPath, StartLoc,
|
|
ArgNum, TotalArgs, NodeId, StartPath, ProcDefnRep, Origin)
|
|
)
|
|
)
|
|
;
|
|
ChainStart = require_explicit_subtree,
|
|
Origin = origin_require_explicit_subtree,
|
|
% The only time a subtree will be required is if the subterm is output.
|
|
Mode = subterm_out
|
|
).
|
|
|
|
% trace_dependency_special_case handles special cases not handled
|
|
% by the usual subterm dependency tracking algorithm. At the moment
|
|
% it handles tracking of subterms through catch_impl.
|
|
%
|
|
:- pred trace_dependency_special_case(S::in, proc_defn_rep::in, R::in,
|
|
start_loc(R)::in, int::in, term_path::in, R::in,
|
|
subterm_origin(edt_node(R))::out) is semidet <= annotated_trace(S, R).
|
|
|
|
trace_dependency_special_case(Store, ProcDefnRep, Ref, StartLoc,
|
|
ArgNum, TermPath, NodeId, Origin) :-
|
|
% Catch_impl's body is a single call to builtin_catch. Builtin_catch
|
|
% doesn't generate any events, so we need to handle catch_impl specially.
|
|
|
|
proc_defn_rep_is_catch_impl(ProcDefnRep),
|
|
(
|
|
StartLoc = parent_goal(_, _),
|
|
% The subterm being tracked is an input to builtin_catch so we know
|
|
% the origin will be in the first argument of catch_impl, because
|
|
% builtin_catch is only called from catch_impl.
|
|
|
|
Origin = origin_input(user_head_var(1), [ArgNum | TermPath])
|
|
;
|
|
StartLoc = cur_goal,
|
|
% The subterm being tracked is an output of catch_impl so we know
|
|
% its origin will be the output of the closure passed to try.
|
|
% If the closure succeeded, then we continue to track the subterm
|
|
% in the child call to exception.wrap_success_or_failure, otherwise
|
|
% we stop tracking at the catch_impl.
|
|
% XXX In future we should track exception values to the throw
|
|
% that created them.
|
|
|
|
exit_node_from_id(Store, Ref, ExitNode),
|
|
ExitAtom = get_trace_exit_atom(ExitNode),
|
|
ExitAtom = atom(_, Args),
|
|
list.index1_det(Args, ArgNum, TryResultArgInfo),
|
|
TryResultArgInfo = arg_info(_, _, yes(TryResultRep)),
|
|
rep_to_univ(TryResultRep, TryResultUniv),
|
|
univ_value(TryResultUniv) = TryResult,
|
|
deconstruct(TryResult, canonicalize, Functor, _, _),
|
|
( Functor = "succeeded" ->
|
|
Origin = origin_output(dynamic(NodeId), any_head_var_from_back(1),
|
|
TermPath)
|
|
;
|
|
Origin = origin_primitive_op("exception.m", 0, primop_builtin_call)
|
|
)
|
|
).
|
|
|
|
:- pred trace_dependency_in_proc_defn_rep(S::in, term_path::in,
|
|
start_loc(R)::in, int::in, int::in, R::in, maybe(goal_path)::in,
|
|
proc_defn_rep::in, subterm_origin(edt_node(R))::out) is det
|
|
<= annotated_trace(S, R).
|
|
|
|
trace_dependency_in_proc_defn_rep(Store, TermPath, StartLoc, ArgNum,
|
|
TotalArgs, NodeId, StartPath, ProcDefnRep, Origin) :-
|
|
det_trace_node_from_id(Store, NodeId, Node),
|
|
materialize_contour(Store, NodeId, Node, [], Contour0),
|
|
(
|
|
StartLoc = parent_goal(CallId, CallNode),
|
|
Contour = list.append(Contour0, [CallId - CallNode])
|
|
;
|
|
StartLoc = cur_goal,
|
|
Contour = Contour0
|
|
),
|
|
ProcDefnRep = proc_defn_rep(HeadVars, GoalRep),
|
|
is_traced_grade(AllTraced),
|
|
MaybePrims = make_primitive_list(Store, [goal_and_path(GoalRep, empty)],
|
|
Contour, StartPath, ArgNum, TotalArgs, HeadVars, AllTraced, []),
|
|
(
|
|
MaybePrims = yes(primitive_list_and_var(Primitives, Var,
|
|
MaybeClosure)),
|
|
|
|
% If the subterm is in a closure argument then the argument number
|
|
% of the closure argument is prefixed to the term path, since the
|
|
% closure is itself a term. This is done here because at the time
|
|
% of the closure call it is not easy to decide if the call is higher
|
|
% order or not, without repeating all the work done in
|
|
% make_primitive_list.
|
|
|
|
(
|
|
MaybeClosure = yes,
|
|
AdjustedTermPath = [ArgNum | TermPath]
|
|
;
|
|
MaybeClosure = no,
|
|
AdjustedTermPath = TermPath
|
|
),
|
|
traverse_primitives(Primitives, Var, AdjustedTermPath, Store,
|
|
ProcDefnRep, Origin)
|
|
;
|
|
MaybePrims = no,
|
|
Origin = origin_not_found
|
|
).
|
|
|
|
% proc_defn_rep_is_catch_impl(ProcDefnRep) is true if ProcDefnRep
|
|
% is a representation of exception.catch_impl (the converse is true
|
|
% assuming exception.builtin_catch is only called from
|
|
% exception.catch_impl).
|
|
%
|
|
:- pred proc_defn_rep_is_catch_impl(proc_defn_rep::in) is semidet.
|
|
|
|
proc_defn_rep_is_catch_impl(ProcDefnRep) :-
|
|
ProcDefnRep = proc_defn_rep([A, B, C, D],
|
|
atomic_goal_rep(_, "exception.m", _, [D],
|
|
plain_call_rep("exception", "builtin_catch", [A, B, C, D]))).
|
|
|
|
:- pred find_chain_start(S::in, R::in, arg_pos::in, term_path::in,
|
|
dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
|
|
|
|
find_chain_start(Store, Ref, ArgPos, TermPath, ChainStart) :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_exit(_, CallId, _, _, _, _, _, _),
|
|
ExitAtom = get_trace_exit_atom(Node),
|
|
call_node_from_id(Store, CallId, CallNode),
|
|
CallAtom = get_trace_call_atom(CallNode),
|
|
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
|
|
find_chain_start_inside(Store, CallId, CallNode,
|
|
ArgPos, ChainStart)
|
|
; trace_atom_subterm_is_ground(ExitAtom, ArgPos, TermPath) ->
|
|
( not_at_depth_limit(Store, CallId) ->
|
|
find_chain_start_outside(CallNode, Node, ArgPos, ChainStart)
|
|
;
|
|
ChainStart = require_explicit_subtree
|
|
)
|
|
;
|
|
throw(internal_error("find_chain_start",
|
|
"unbound wrong answer term"))
|
|
)
|
|
;
|
|
Node = node_fail(_, CallId, _, _, _, _),
|
|
call_node_from_id(Store, CallId, CallNode),
|
|
CallAtom = get_trace_call_atom(CallNode),
|
|
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
|
|
find_chain_start_inside(Store, CallId, CallNode,
|
|
ArgPos, ChainStart)
|
|
;
|
|
throw(internal_error("find_chain_start",
|
|
"unbound missing answer term"))
|
|
)
|
|
;
|
|
Node = node_excp(_, CallId, _, _, _, _, _),
|
|
call_node_from_id(Store, CallId, CallNode),
|
|
CallAtom = get_trace_call_atom(CallNode),
|
|
|
|
% XXX We don't yet handle tracking of the exception value.
|
|
|
|
( trace_atom_subterm_is_ground(CallAtom, ArgPos, TermPath) ->
|
|
find_chain_start_inside(Store, CallId, CallNode,
|
|
ArgPos, ChainStart)
|
|
;
|
|
throw(internal_error("find_chain_start",
|
|
"unbound exception term"))
|
|
)
|
|
).
|
|
|
|
:- pred find_chain_start_inside(S::in, R::in,
|
|
trace_node(R)::in(trace_node_call), arg_pos::in,
|
|
dependency_chain_start(R)::out) is det <= annotated_trace(S, R).
|
|
|
|
find_chain_start_inside(Store, CallId, CallNode, ArgPos, ChainStart) :-
|
|
CallPrecId = CallNode ^ call_preceding,
|
|
CallAtom = get_trace_call_atom(CallNode),
|
|
CallPathStr = get_goal_path_from_maybe_label(CallNode ^ call_return_label),
|
|
goal_path_from_string_det(CallPathStr, CallPath),
|
|
StartLoc = parent_goal(CallId, CallNode),
|
|
absolute_arg_num(ArgPos, CallAtom, ArgNum),
|
|
TotalArgs = length(CallAtom ^ atom_args),
|
|
StartId = CallPrecId,
|
|
StartPath = yes(CallPath),
|
|
parent_proc_defn_rep(Store, CallId, StartRep),
|
|
ChainStart = chain_start(StartLoc, ArgNum, TotalArgs, StartId,
|
|
StartPath, StartRep).
|
|
|
|
:- pred find_chain_start_outside(trace_node(R)::in(trace_node_call),
|
|
trace_node(R)::in(trace_node_exit), arg_pos::in,
|
|
dependency_chain_start(R)::out) is det.
|
|
|
|
find_chain_start_outside(CallNode, ExitNode, ArgPos, ChainStart) :-
|
|
StartLoc = cur_goal,
|
|
ExitAtom = get_trace_exit_atom(ExitNode),
|
|
absolute_arg_num(ArgPos, ExitAtom, ArgNum),
|
|
TotalArgs = length(ExitAtom ^ atom_args),
|
|
StartId = ExitNode ^ exit_preceding,
|
|
StartPath = no,
|
|
call_node_maybe_proc_defn_rep(CallNode, StartRep),
|
|
ChainStart = chain_start(StartLoc, ArgNum, TotalArgs, StartId,
|
|
StartPath, StartRep).
|
|
|
|
:- pred parent_proc_defn_rep(S::in, R::in, maybe(proc_defn_rep)::out)
|
|
is det <= annotated_trace(S, R).
|
|
|
|
parent_proc_defn_rep(Store, CallId, ProcDefnRep) :-
|
|
call_node_from_id(Store, CallId, Call),
|
|
CallPrecId = Call ^ call_preceding,
|
|
( step_left_to_call(Store, CallPrecId, ParentCallNode) ->
|
|
call_node_maybe_proc_defn_rep(ParentCallNode, ProcDefnRep)
|
|
;
|
|
ProcDefnRep = no
|
|
).
|
|
|
|
% Finds the call node of the parent of the given node. Fails if
|
|
% the call node cannot be found because it was not included in the
|
|
% annotated trace.
|
|
%
|
|
:- pred step_left_to_call(S::in, R::in, trace_node(R)::out(trace_node_call))
|
|
is semidet <= annotated_trace(S, R).
|
|
|
|
step_left_to_call(Store, NodeId, ParentCallNode) :-
|
|
trace_node_from_id(Store, NodeId, Node),
|
|
( Node = node_call(_, _, _, _, _, _, _, _, _, _) ->
|
|
ParentCallNode = Node
|
|
;
|
|
% We wish to step through negated contexts, so we handle NEGE
|
|
% and COND events separately, since step_left_in_contour/2
|
|
% will throw an exception if it reaches the boundary of a
|
|
% negated context.
|
|
|
|
( Node = node_neg(NegPrec, _, _) ->
|
|
PrevNodeId = NegPrec
|
|
; Node = node_cond(CondPrec, _, _) ->
|
|
PrevNodeId = CondPrec
|
|
;
|
|
PrevNodeId = step_left_in_contour(Store, Node)
|
|
),
|
|
step_left_to_call(Store, PrevNodeId, ParentCallNode)
|
|
).
|
|
|
|
:- pred materialize_contour(S::in, R::in, trace_node(R)::in,
|
|
assoc_list(R, trace_node(R))::in, assoc_list(R, trace_node(R))::out)
|
|
is det <= annotated_trace(S, R).
|
|
|
|
materialize_contour(Store, NodeId, Node, Nodes0, Nodes) :-
|
|
( Node = node_call(_, _, _, _, _, _, _, _, _, _) ->
|
|
Nodes = Nodes0
|
|
;
|
|
% We include NEGE and (possibly failed) COND events in the contour
|
|
% so we can track input sub-terms through negated contexts.
|
|
|
|
( Node = node_neg(NegPrec, _, _) ->
|
|
PrevNodeId = NegPrec
|
|
; Node = node_cond(CondPrec, _, _) ->
|
|
PrevNodeId = CondPrec
|
|
;
|
|
PrevNodeId = step_left_in_contour(Store, Node)
|
|
),
|
|
det_trace_node_from_id(Store, PrevNodeId, PrevNode),
|
|
( Node = node_then(_, _, _) ->
|
|
% The cond node is enough to tell us which way the if-then-else
|
|
% went; the then node would just complicate the job of
|
|
% make_primitive_list.
|
|
Nodes1 = Nodes0
|
|
;
|
|
Nodes1 = [NodeId - Node | Nodes0]
|
|
),
|
|
materialize_contour(Store, PrevNodeId, PrevNode, Nodes1, Nodes)
|
|
).
|
|
|
|
:- 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(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(Store), Contour, ExitAtoms).
|
|
|
|
:- 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(Store, _ - Exit, FinalAtom) :-
|
|
Exit = node_exit(_, _, _, _, _, _, _, _),
|
|
FinalAtom = exit_node_decl_atom(Store, Exit).
|
|
|
|
:- type primitive_list_and_var(R)
|
|
---> primitive_list_and_var(
|
|
primitives :: list(annotated_primitive(R)),
|
|
|
|
var :: var_rep,
|
|
% The var_rep for the argument which holds the
|
|
% subterm we are trying to find the origin of.
|
|
% If the subterm is in one of the arguments
|
|
% that were passed to a closure when the
|
|
% closure was created, then this will be the
|
|
% var_rep for the variable containing the closure.
|
|
|
|
closure :: bool
|
|
% Was the subterm inside a closure argument
|
|
% that was passed in when the closure was
|
|
% created?
|
|
).
|
|
|
|
% Constructs a list of the primitive goals along the given contour if
|
|
% it can. It might not be able to construct the list in the case where
|
|
% there are higher order calls and we're not sure if everything is
|
|
% traced, then there might be extra/missing events on the contour and
|
|
% we need to make sure the primitive atomic goals match up with the
|
|
% contour events, but in the case of higher order calls this is not
|
|
% easily done as the name/module of the higher order call is not
|
|
% available in the goal_rep. If it cannot construct the primitive list
|
|
% reliably then `no' is returned. MaybeEnd is the goal path of the
|
|
% call event that should be at the end of the contour for input
|
|
% subterms.
|
|
%
|
|
:- func make_primitive_list(S, goal_and_path_list,
|
|
assoc_list(R, trace_node(R)), maybe(goal_path), int, int,
|
|
list(var_rep), bool, list(annotated_primitive(R)))
|
|
= maybe(primitive_list_and_var(R)) <= annotated_trace(S, R).
|
|
|
|
make_primitive_list(Store, GoalPaths, Contour, MaybeEnd, ArgNum, TotalArgs,
|
|
HeadVars, AllTraced, Primitives0) = MaybePrims :-
|
|
(
|
|
AllTraced = no,
|
|
(
|
|
next_goal_generates_internal_event(GoalPaths)
|
|
;
|
|
GoalPaths = []
|
|
)
|
|
->
|
|
% There may be extra exit and fail events in the
|
|
% contour if a call to an untraced module was made, but
|
|
% then something in the untraced module called
|
|
% something in a traced module.
|
|
remove_leading_exit_fail_events(Contour, AdjustedContour)
|
|
;
|
|
AdjustedContour = Contour
|
|
),
|
|
(
|
|
AllTraced = no,
|
|
contour_at_end_path(AdjustedContour, MaybeEnd),
|
|
(
|
|
next_goal_generates_internal_event(GoalPaths)
|
|
;
|
|
GoalPaths = []
|
|
)
|
|
->
|
|
% We were unable to identify the goal corresponding to this
|
|
% call (it might have been a higher order call) so we return no
|
|
% to indicate this. This is the safest thing to do when we're
|
|
% not sure what has/hasn't been traced.
|
|
MaybePrims = no
|
|
;
|
|
(
|
|
GoalPaths = [goal_and_path(Goal, Path) | Tail],
|
|
MaybePrims = match_goal_to_contour_event(Store, Goal, Path, Tail,
|
|
AdjustedContour, MaybeEnd, ArgNum, TotalArgs, HeadVars,
|
|
AllTraced, Primitives0)
|
|
;
|
|
GoalPaths = [],
|
|
decl_require(unify(AdjustedContour, []),
|
|
"make_primitive_list", "nonempty contour at end"),
|
|
decl_require(unify(MaybeEnd, no),
|
|
"make_primitive_list", "found end when looking for call"),
|
|
find_variable_in_args(HeadVars, ArgNum, TotalArgs, Var),
|
|
MaybePrims = yes(primitive_list_and_var(Primitives0, Var, no))
|
|
)
|
|
).
|
|
|
|
:- pred contour_at_end_path(assoc_list(R, trace_node(R))::in,
|
|
maybe(goal_path)::in) is semidet.
|
|
|
|
contour_at_end_path([_ - Node], yes(EndPath)) :-
|
|
Node = node_call(_, _, _, _, _, _, MaybeReturnLabel, _, _, _),
|
|
CallPathStr = get_goal_path_from_maybe_label(MaybeReturnLabel),
|
|
goal_path_from_string_det(CallPathStr, CallPath),
|
|
CallPath = EndPath.
|
|
|
|
:- pred next_goal_generates_internal_event(list(goal_and_path)::in) is semidet.
|
|
|
|
next_goal_generates_internal_event([goal_and_path(NextGoal, _) | _]) :-
|
|
goal_generates_internal_event(NextGoal) = yes.
|
|
|
|
% match_goal_to_contour_event(Store, Goal, Path, GoalPaths, Contour,
|
|
% MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced, Primitives0)
|
|
% = MaybePrims:
|
|
%
|
|
% Matches the given goal_rep to the first event in the contour for
|
|
% all goal_reps except atomic goal reps which need to be handled
|
|
% differently depending on whether everything is traced (AllTraced).
|
|
% Returns Primitives0 appended to the end of the list of primitive goals
|
|
% along the remaining contour. If it cannot match a higher order call
|
|
% to a contour event and AllTraced is no, then it returns "no".
|
|
%
|
|
:- func match_goal_to_contour_event(S, goal_rep, goal_path, goal_and_path_list,
|
|
assoc_list(R, trace_node(R)), maybe(goal_path), int, int,
|
|
list(var_rep), bool, list(annotated_primitive(R)))
|
|
= maybe(primitive_list_and_var(R)) <= annotated_trace(S, R).
|
|
|
|
match_goal_to_contour_event(Store, Goal, Path, GoalPaths, Contour, MaybeEnd,
|
|
ArgNum, TotalArgs, HeadVars, AllTraced, Primitives0) = MaybePrims :-
|
|
(
|
|
Goal = conj_rep(Conjs),
|
|
add_paths_to_conjuncts(Conjs, Path, 1, ConjPaths),
|
|
MaybePrims = make_primitive_list(Store, ConjPaths ++ GoalPaths,
|
|
Contour, MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives0)
|
|
;
|
|
Goal = scope_rep(InnerGoal, MaybeCut),
|
|
InnerPath = cord.snoc(Path, step_scope(MaybeCut)),
|
|
InnerAndPath = goal_and_path(InnerGoal, InnerPath),
|
|
MaybePrims = make_primitive_list(Store, [InnerAndPath | GoalPaths],
|
|
Contour, MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives0)
|
|
;
|
|
Goal = atomic_goal_rep(_, File, Line, BoundVars, AtomicGoal),
|
|
GeneratesEvent = atomic_goal_generates_event_like_call(AtomicGoal),
|
|
(
|
|
GeneratesEvent = yes(AtomicGoalArgs),
|
|
MaybePrims = match_atomic_goal_to_contour_event(Store, File, Line,
|
|
BoundVars, AtomicGoal, AtomicGoalArgs, Path, GoalPaths,
|
|
Contour, MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives0)
|
|
;
|
|
GeneratesEvent = no,
|
|
Primitive = primitive(File, Line, BoundVars, AtomicGoal, Path, no),
|
|
Primitives1 = [Primitive | Primitives0],
|
|
MaybePrims = make_primitive_list(Store, GoalPaths, Contour,
|
|
MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced, Primitives1)
|
|
)
|
|
;
|
|
Goal = disj_rep(Disjs),
|
|
(
|
|
Contour = [_ - ContourHeadNode | ContourTail],
|
|
(
|
|
ContourHeadNode = node_first_disj(_, Label)
|
|
;
|
|
ContourHeadNode = node_later_disj(_, Label, _)
|
|
),
|
|
DisjPathStr = get_goal_path_from_label_layout(Label),
|
|
goal_path_from_string_det(DisjPathStr, DisjPath),
|
|
cord.split_last(DisjPath, DisjInitialPath, DisjLastStep),
|
|
cord.equal(DisjInitialPath, Path),
|
|
DisjLastStep = step_disj(N)
|
|
->
|
|
list.index1_det(Disjs, N, Disj),
|
|
DisjAndPath = goal_and_path(Disj, DisjPath),
|
|
MaybePrims = make_primitive_list(Store, [DisjAndPath | GoalPaths],
|
|
ContourTail, MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives0)
|
|
;
|
|
throw(internal_error("match_goal_to_contour_event",
|
|
"mismatch on disj"))
|
|
)
|
|
;
|
|
Goal = switch_rep(_SwitchVar, Cases),
|
|
(
|
|
Contour = [_ - ContourHeadNode | ContourTail],
|
|
ContourHeadNode = node_switch(_, Label),
|
|
ArmPathStr = get_goal_path_from_label_layout(Label),
|
|
goal_path_from_string_det(ArmPathStr, ArmPath),
|
|
cord.split_last(ArmPath, ArmInitialPath, ArmLastStep),
|
|
cord.equal(ArmInitialPath, Path),
|
|
ArmLastStep = step_switch(N, _)
|
|
->
|
|
list.index1_det(Cases, N, Case),
|
|
Case = case_rep(_ConsId, _ConsIdArity, Arm),
|
|
ArmAndPath = goal_and_path(Arm, ArmPath),
|
|
MaybePrims = make_primitive_list(Store, [ArmAndPath | GoalPaths],
|
|
ContourTail, MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives0)
|
|
;
|
|
throw(internal_error("match_goal_to_contour_event",
|
|
"mismatch on switch"))
|
|
)
|
|
;
|
|
Goal = ite_rep(Cond, Then, Else),
|
|
(
|
|
Contour = [_ - ContourHeadNode | ContourTail],
|
|
ContourHeadNode = node_cond(_, Label, _),
|
|
CondPathStr = get_goal_path_from_label_layout(Label),
|
|
goal_path_from_string_det(CondPathStr, CondPath),
|
|
cord.split_last(CondPath, CondInitialPath, CondLastStep),
|
|
cord.equal(CondInitialPath, Path),
|
|
CondLastStep = step_ite_cond
|
|
->
|
|
ThenPath = cord.snoc(Path, step_ite_then),
|
|
CondAndPath = goal_and_path(Cond, CondPath),
|
|
ThenAndPath = goal_and_path(Then, ThenPath),
|
|
MaybePrims = make_primitive_list(Store,
|
|
[CondAndPath, ThenAndPath | GoalPaths], ContourTail,
|
|
MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced, Primitives0)
|
|
;
|
|
Contour = [_ - ContourHeadNode | ContourTail],
|
|
ContourHeadNode = node_else(_, ElseCondId, _),
|
|
cond_node_from_id(Store, ElseCondId, CondNode),
|
|
CondNode = node_cond(_, Label, _),
|
|
CondPathStr = get_goal_path_from_label_layout(Label),
|
|
goal_path_from_string_det(CondPathStr, CondPath),
|
|
cord.split_last(CondPath, CondInitialPath, CondLastStep),
|
|
cord.equal(CondInitialPath, Path),
|
|
CondLastStep = step_ite_cond
|
|
->
|
|
ElsePath = cord.snoc(Path, step_ite_else),
|
|
ElseAndPath = goal_and_path(Else, ElsePath),
|
|
MaybePrims = make_primitive_list(Store, [ElseAndPath | GoalPaths],
|
|
ContourTail, MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives0)
|
|
;
|
|
throw(internal_error("match_goal_to_contour_event",
|
|
"mismatch on if-then-else"))
|
|
)
|
|
;
|
|
Goal = negation_rep(NegGoal),
|
|
(
|
|
Contour = [_ - ContourHeadNode | ContourTail],
|
|
ContourHeadNode = node_neg_succ(_, _, _)
|
|
->
|
|
% The negated goal cannot contribute any bindings.
|
|
MaybePrims = make_primitive_list(Store, GoalPaths, ContourTail,
|
|
MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced, Primitives0)
|
|
;
|
|
Contour = [_ - ContourHeadNode | ContourTail],
|
|
ContourHeadNode = node_neg(_, _, _)
|
|
->
|
|
% The end of the primitive list is somewhere inside
|
|
% NegGoal.
|
|
NegPath = cord.snoc(Path, step_neg),
|
|
NegAndPath = goal_and_path(NegGoal, NegPath),
|
|
MaybePrims = make_primitive_list(Store, [NegAndPath], ContourTail,
|
|
MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced, Primitives0)
|
|
;
|
|
throw(internal_error("match_goal_to_contour_event",
|
|
"mismatch on negation"))
|
|
)
|
|
).
|
|
|
|
:- pred remove_leading_exit_fail_events(
|
|
assoc_list(R, trace_node(R))::in,
|
|
assoc_list(R, trace_node(R))::out) is det.
|
|
|
|
remove_leading_exit_fail_events([], []).
|
|
remove_leading_exit_fail_events(Contour0, Contour) :-
|
|
Contour0 = [_ - ContourHeadNode | ContourTail],
|
|
(
|
|
(
|
|
ContourHeadNode = node_exit(_, _, _, _, _, _, _, _)
|
|
;
|
|
ContourHeadNode = node_fail(_, _, _, _, _, _)
|
|
)
|
|
->
|
|
remove_leading_exit_fail_events(ContourTail, Contour)
|
|
;
|
|
Contour = Contour0
|
|
).
|
|
|
|
% Trys to match an atomic goal to the first event on the contour.
|
|
% These should match if AllTraced = yes. If AllTraced = no, then
|
|
% if the goal doesn't match the contour event (i.e. they are for
|
|
% different predicates), then the goal will be treated as a primitive
|
|
% operation with no children. The next atomic goal will then be tried
|
|
% as a match for the first event on the contour. This will
|
|
% continue until a non-atomic goal is reached, at which point all
|
|
% events that could match atomic goals (exit and fail events) are
|
|
% removed from the top of the contour. This strategy will work
|
|
% best when untraced calls do not call traced modules (which seems
|
|
% more likely for the majority of untraced calls).
|
|
%
|
|
:- func match_atomic_goal_to_contour_event(S, string, int,
|
|
list(var_rep), atomic_goal_rep, list(var_rep), goal_path,
|
|
list(goal_and_path), assoc_list(R, trace_node(R)), maybe(goal_path),
|
|
int, int, list(var_rep), bool, list(annotated_primitive(R))) =
|
|
maybe(primitive_list_and_var(R)) <= annotated_trace(S, R).
|
|
|
|
match_atomic_goal_to_contour_event(Store, File, Line, BoundVars, AtomicGoal,
|
|
AtomicGoalArgs, Path, GoalPaths, Contour, MaybeEnd, ArgNum,
|
|
TotalArgs, HeadVars, AllTraced, Primitives0) = MaybePrims :-
|
|
(
|
|
Contour = [_ - ContourHeadNode],
|
|
MaybeEnd = yes(EndPath)
|
|
->
|
|
(
|
|
ContourHeadNode = node_call(_, _, _, _, _, _,
|
|
MaybeReturnLabel, _, _, _),
|
|
Atom = get_trace_call_atom(ContourHeadNode),
|
|
CallPathStr = get_goal_path_from_maybe_label( MaybeReturnLabel),
|
|
goal_path_from_string_det(CallPathStr, CallPath),
|
|
CallPath = EndPath
|
|
->
|
|
(
|
|
( atomic_goal_identifiable(AtomicGoal) = yes(AtomicGoalId) ->
|
|
atomic_goal_matches_atom(AtomicGoalId, Atom)
|
|
;
|
|
AllTraced = yes
|
|
)
|
|
->
|
|
(
|
|
% Test to see that the argument is not a closure argument
|
|
% (passed in when the closure was created).
|
|
ArgNum > TotalArgs - length(AtomicGoalArgs)
|
|
->
|
|
find_variable_in_args(AtomicGoalArgs, ArgNum, TotalArgs,
|
|
Var),
|
|
MaybePrims = yes(
|
|
primitive_list_and_var(Primitives0, Var, no))
|
|
;
|
|
% Perhaps this is a closure and the argument was passed in
|
|
% when the closure was created.
|
|
( AtomicGoal = higher_order_call_rep(Closure, _) ->
|
|
Var = Closure,
|
|
MaybePrims = yes(
|
|
primitive_list_and_var(Primitives0, Var, yes))
|
|
;
|
|
throw(internal_error("make_primitive_list",
|
|
"argument number mismatch"))
|
|
)
|
|
)
|
|
;
|
|
(
|
|
AllTraced = yes,
|
|
throw(internal_error("match_atomic_goal_to_contour_event",
|
|
"name mismatch on call"))
|
|
;
|
|
AllTraced = no,
|
|
Primitive = primitive(File, Line, BoundVars, AtomicGoal,
|
|
Path, no),
|
|
Primitives1 = [Primitive|Primitives0],
|
|
MaybePrims = make_primitive_list(Store, GoalPaths, Contour,
|
|
MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives1)
|
|
)
|
|
)
|
|
;
|
|
throw(internal_error("match_atomic_goal_to_contour_event",
|
|
"goalpath mismatch on call"))
|
|
)
|
|
;
|
|
(
|
|
Contour = [ContourHeadId - ContourHeadNode | ContourTail],
|
|
( Atom = get_trace_exit_atom(ContourHeadNode) ->
|
|
(
|
|
(
|
|
atomic_goal_identifiable(AtomicGoal) =
|
|
yes(AtomicGoalId)
|
|
->
|
|
atomic_goal_matches_atom(AtomicGoalId, Atom)
|
|
;
|
|
AllTraced = yes
|
|
)
|
|
->
|
|
CallInfo = yes(ContourHeadId),
|
|
NewContour = ContourTail
|
|
;
|
|
(
|
|
AllTraced = yes,
|
|
throw(internal_error(
|
|
"match_atomic_goal_to_contour_event",
|
|
"atomic goal doesn't match exit event\n"))
|
|
;
|
|
AllTraced = no,
|
|
CallInfo = no,
|
|
NewContour = Contour
|
|
)
|
|
)
|
|
;
|
|
(
|
|
AllTraced = yes,
|
|
throw(internal_error("match_atomic_goal_to_contour_event",
|
|
"atomic goal with no exit event "
|
|
++ "when assuming all traced"))
|
|
;
|
|
AllTraced = no,
|
|
CallInfo = no,
|
|
NewContour = Contour
|
|
)
|
|
),
|
|
Primitive = primitive(File, Line, BoundVars, AtomicGoal, Path,
|
|
CallInfo),
|
|
Primitives1 = [Primitive | Primitives0],
|
|
MaybePrims = make_primitive_list(Store, GoalPaths, NewContour,
|
|
MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced, Primitives1)
|
|
;
|
|
Contour = [],
|
|
(
|
|
MaybeEnd = no,
|
|
AllTraced = no
|
|
->
|
|
Primitive = primitive(File, Line, BoundVars, AtomicGoal, Path,
|
|
no),
|
|
Primitives1 = [Primitive | Primitives0],
|
|
MaybePrims = make_primitive_list(Store, GoalPaths, [],
|
|
MaybeEnd, ArgNum, TotalArgs, HeadVars, AllTraced,
|
|
Primitives1)
|
|
;
|
|
throw(internal_error("match_atomic_goal_to_contour_event",
|
|
"premature contour end"))
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred atomic_goal_matches_atom(atomic_goal_id::in, trace_atom::in)
|
|
is semidet.
|
|
|
|
atomic_goal_matches_atom(AtomicGoalId, Atom) :-
|
|
AtomicGoalId = atomic_goal_id(GoalModule, GoalName, GoalArity),
|
|
ProcLabel = get_proc_label_from_layout(Atom ^ proc_layout),
|
|
get_pred_attributes(ProcLabel, EventModule, EventName, _, _),
|
|
EventArity = length(Atom ^ atom_args),
|
|
GoalModule = sym_name_to_string(EventModule),
|
|
EventName = GoalName,
|
|
EventArity = GoalArity.
|
|
|
|
:- pred find_variable_in_args(list(var_rep)::in, int::in, int::in,
|
|
var_rep::out) is det.
|
|
|
|
find_variable_in_args(Args, ArgNum, TotalArgs, Var) :-
|
|
% We reverse the arg list in case this is an argument of a closure call
|
|
% that is passed in at the time of the call.
|
|
( index1(reverse(Args), TotalArgs - ArgNum + 1, FoundVar) ->
|
|
Var = FoundVar
|
|
;
|
|
throw(internal_error("find_variable_in_args", "arg not found"))
|
|
).
|
|
|
|
:- pred traverse_primitives(list(annotated_primitive(R))::in,
|
|
var_rep::in, term_path::in, S::in, proc_defn_rep::in,
|
|
subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
|
|
|
|
traverse_primitives([], Var0, TermPath0, _, ProcDefnRep, Origin) :-
|
|
ProcDefnRep = proc_defn_rep(HeadVars, _),
|
|
ArgPos = find_arg_pos(HeadVars, Var0),
|
|
Origin = origin_input(ArgPos, TermPath0).
|
|
traverse_primitives([Prim | Prims], Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin) :-
|
|
Prim = primitive(File, Line, BoundVars, AtomicGoal, _GoalPath,
|
|
MaybeNodeId),
|
|
(
|
|
AtomicGoal = unify_construct_rep(_CellVar, _Cons, FieldVars),
|
|
( list.member(Var0, BoundVars) ->
|
|
(
|
|
TermPath0 = [],
|
|
Origin = origin_primitive_op(File, Line, primop_unification)
|
|
;
|
|
TermPath0 = [TermPathStep0 | TermPath],
|
|
list.index1_det(FieldVars, TermPathStep0, Var),
|
|
traverse_primitives(Prims, Var, TermPath, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = unify_deconstruct_rep(CellVar, _Cons, FieldVars),
|
|
( list.member(Var0, BoundVars) ->
|
|
( list.nth_member_search(FieldVars, Var0, Pos) ->
|
|
traverse_primitives(Prims, CellVar, [Pos | TermPath0],
|
|
Store, ProcDefnRep, Origin)
|
|
;
|
|
throw(internal_error("traverse_primitives", "bad deconstruct"))
|
|
)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = partial_deconstruct_rep(_, _, MaybeFieldVars),
|
|
(
|
|
list.member(Var0, BoundVars),
|
|
TermPath0 = [TermPathStep0 | TermPath]
|
|
->
|
|
list.index1_det(MaybeFieldVars, TermPathStep0, MaybeVar),
|
|
(
|
|
MaybeVar = yes(Var),
|
|
% This partial deconstruction bound the TermPathStep0'th
|
|
% argument of Var0.
|
|
traverse_primitives(Prims, Var, TermPath, Store, ProcDefnRep,
|
|
Origin)
|
|
;
|
|
MaybeVar = no,
|
|
% This partial deconstruction did not bind the TermPathStep0'th
|
|
% argument, so continue looking for the unification which did.
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = partial_construct_rep(_, _, MaybeFieldVars),
|
|
(
|
|
list.member(Var0, BoundVars)
|
|
->
|
|
(
|
|
TermPath0 = [],
|
|
Origin = origin_primitive_op(File, Line, primop_unification)
|
|
;
|
|
TermPath0 = [TermPathStep0 | TermPath],
|
|
list.index1_det(MaybeFieldVars, TermPathStep0, MaybeVar),
|
|
(
|
|
MaybeVar = yes(Var),
|
|
% The partial construction bound the TermPathStep0'th
|
|
% argument of Var0.
|
|
traverse_primitives(Prims, Var, TermPath, Store,
|
|
ProcDefnRep, Origin)
|
|
;
|
|
MaybeVar = no,
|
|
% We got to the construction which bound the outermost
|
|
% functor of Var0 without finding the unification which
|
|
% bound the TermPathStep0'th argument of that functor.
|
|
% So something has gone wrong.
|
|
throw(internal_error("traverse_primitives",
|
|
"input argument not found"))
|
|
)
|
|
)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = unify_assign_rep(ToVar, FromVar),
|
|
% We handle assigns the same as we handle unsafe casts.
|
|
( list.member(Var0, BoundVars) ->
|
|
decl_require(unify(Var0, ToVar), "traverse_primitives",
|
|
"bad assign"),
|
|
traverse_primitives(Prims, FromVar, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = cast_rep(ToVar, FromVar),
|
|
% We handle casts the same as we handle assigns.
|
|
( list.member(Var0, BoundVars) ->
|
|
decl_require(unify(Var0, ToVar), "traverse_primitives",
|
|
"bad unsafe_cast"),
|
|
traverse_primitives(Prims, FromVar, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = pragma_foreign_code_rep(_Args),
|
|
( list.member(Var0, BoundVars) ->
|
|
Origin = origin_primitive_op(File, Line, primop_foreign_proc)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = unify_simple_test_rep(_LVar, _RVar),
|
|
( list.member(Var0, BoundVars) ->
|
|
throw(internal_error("traverse_primitives", "bad test"))
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = higher_order_call_rep(_, Args),
|
|
traverse_call(BoundVars, File, Line, Args, MaybeNodeId, Prims,
|
|
Var0, TermPath0, Store, ProcDefnRep, Origin)
|
|
;
|
|
AtomicGoal = method_call_rep(_, _, Args),
|
|
traverse_call(BoundVars, File, Line, Args, MaybeNodeId, Prims,
|
|
Var0, TermPath0, Store, ProcDefnRep, Origin)
|
|
;
|
|
AtomicGoal = plain_call_rep(Module, Name, Args),
|
|
(
|
|
list.member(Var0, BoundVars),
|
|
plain_call_is_special_case(Module, Name, Args, NewVar)
|
|
->
|
|
traverse_primitives(Prims, NewVar, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
;
|
|
traverse_call(BoundVars, File, Line, Args, MaybeNodeId,
|
|
Prims, Var0, TermPath0, Store, ProcDefnRep, Origin)
|
|
)
|
|
;
|
|
AtomicGoal = builtin_call_rep(_, _, _),
|
|
( list.member(Var0, BoundVars) ->
|
|
Origin = origin_primitive_op(File, Line, primop_builtin_call)
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
;
|
|
AtomicGoal = event_call_rep(_, _),
|
|
( list.member(Var0, BoundVars) ->
|
|
throw(internal_error("traverse_primitives", "bad event"))
|
|
;
|
|
traverse_primitives(Prims, Var0, TermPath0, Store, ProcDefnRep,
|
|
Origin)
|
|
)
|
|
).
|
|
|
|
% Some foreign calls, such as casts, are handled specially
|
|
% to improve the accuracy of the subterm dependency tracking algorithm.
|
|
%
|
|
:- pred plain_call_is_special_case(string::in, string::in, list(var_rep)::in,
|
|
var_rep::out) is semidet.
|
|
|
|
plain_call_is_special_case(Module, Name, Args, NewVar) :-
|
|
% builtin.cc_multi_equal is the same as a unification for the
|
|
% purposes of subterm dependency tracking.
|
|
|
|
Module = "builtin",
|
|
Name = "cc_multi_equal",
|
|
list.length(Args, 3),
|
|
index1_det(Args, 2) = NewVar.
|
|
|
|
:- type plain_call_info
|
|
---> plain_call_info(
|
|
file_name :: string,
|
|
line_number :: int,
|
|
flat_module_name :: string,
|
|
pred_name :: string
|
|
).
|
|
|
|
:- pred traverse_call(list(var_rep)::in, string::in, int::in,
|
|
list(var_rep)::in, maybe(R)::in, list(annotated_primitive(R))::in,
|
|
var_rep::in, term_path::in, S::in, proc_defn_rep::in,
|
|
subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
|
|
|
|
traverse_call(BoundVars, File, Line, Args, MaybeNodeId,
|
|
Prims, Var, TermPath, Store, ProcDefnRep, Origin) :-
|
|
( list.member(Var, BoundVars) ->
|
|
Pos = find_arg_pos(Args, Var),
|
|
(
|
|
MaybeNodeId = yes(NodeId),
|
|
Origin = origin_output(dynamic(NodeId), Pos, TermPath)
|
|
;
|
|
MaybeNodeId = no,
|
|
Origin = origin_primitive_op(File, Line, primop_untraced_call)
|
|
)
|
|
;
|
|
traverse_primitives(Prims, Var, TermPath, Store, ProcDefnRep, Origin)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred add_paths_to_conjuncts(list(goal_rep)::in, goal_path::in, int::in,
|
|
goal_and_path_list::out) is det.
|
|
|
|
add_paths_to_conjuncts([], _, _, []).
|
|
add_paths_to_conjuncts([Goal | Goals], ParentPath, N,
|
|
[goal_and_path(Goal, Path) | GoalAndPaths]) :-
|
|
Path = cord.snoc(ParentPath, step_conj(N)),
|
|
add_paths_to_conjuncts(Goals, ParentPath, N + 1, GoalAndPaths).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred is_traced_grade(bool::out) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
is_traced_grade(TracingOn::out),
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
#ifdef MR_EXEC_TRACE
|
|
TracingOn = MR_YES;
|
|
#else
|
|
TracingOn = MR_NO;
|
|
#endif
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func start_loc_to_subterm_mode(start_loc(R)) = subterm_mode.
|
|
|
|
start_loc_to_subterm_mode(cur_goal) = subterm_out.
|
|
start_loc_to_subterm_mode(parent_goal(_, _)) = subterm_in.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func find_arg_pos(list(var_rep), var_rep) = arg_pos.
|
|
|
|
find_arg_pos(HeadVars, Var) = ArgPos :-
|
|
find_arg_pos_from_back(HeadVars, Var, length(HeadVars), ArgPos).
|
|
|
|
:- pred find_arg_pos_from_back(list(var_rep)::in, var_rep::in, int::in,
|
|
arg_pos::out) is det.
|
|
|
|
find_arg_pos_from_back([], _, _, _) :-
|
|
throw(internal_error("find_arg_pos_2", "empty list")).
|
|
find_arg_pos_from_back([HeadVar | HeadVars], Var, Pos, ArgPos) :-
|
|
( HeadVar = Var ->
|
|
ArgPos = any_head_var_from_back(Pos)
|
|
;
|
|
find_arg_pos_from_back(HeadVars, Var, Pos - 1, ArgPos)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
edt_subtree_details(Store, dynamic(Ref), Event, SeqNo, CallPreceding) :-
|
|
det_edt_return_node_from_id(Store, Ref, Node),
|
|
(
|
|
Node = node_exit(_, Call, _, _, Event, _, _, _)
|
|
;
|
|
Node = node_fail(_, Call, _, Event, _, _)
|
|
;
|
|
Node = node_excp(_, Call, _, _, Event, _, _)
|
|
),
|
|
call_node_from_id(Store, Call, CallNode),
|
|
SeqNo = CallNode ^ call_seq,
|
|
CallPreceding = CallNode ^ call_preceding.
|
|
|
|
:- inst edt_return_node
|
|
---> node_exit(ground, ground, ground, ground, ground, ground, ground,
|
|
ground)
|
|
; node_fail(ground, ground, ground, ground, ground, ground)
|
|
; node_excp(ground, ground, ground, ground, ground, ground, ground).
|
|
|
|
:- pred det_edt_return_node_from_id(S::in, R::in,
|
|
trace_node(R)::out(edt_return_node)) is det <= annotated_trace(S, R).
|
|
|
|
det_edt_return_node_from_id(Store, Ref, Node) :-
|
|
(
|
|
trace_node_from_id(Store, Ref, Node0),
|
|
(
|
|
Node0 = node_exit(_, _, _, _, _, _, _, _)
|
|
;
|
|
Node0 = node_fail(_, _, _, _, _, _)
|
|
;
|
|
Node0 = node_excp(_, _, _, _, _, _, _)
|
|
)
|
|
->
|
|
Node = Node0
|
|
;
|
|
throw(internal_error("det_edt_return_node_from_id",
|
|
"not a return node"))
|
|
).
|
|
|
|
:- pred get_edt_call_node(S::in, R::in, R::out) is det
|
|
<= annotated_trace(S, R).
|
|
|
|
get_edt_call_node(Store, Ref, CallId) :-
|
|
(
|
|
trace_node_from_id(Store, Ref, Node0),
|
|
(
|
|
Node0 = node_exit(_, CallId0, _, _, _, _, _, _)
|
|
;
|
|
Node0 = node_fail(_, CallId0, _, _, _, _)
|
|
;
|
|
Node0 = node_excp(_, CallId0, _, _, _, _, _)
|
|
)
|
|
->
|
|
CallId = CallId0
|
|
;
|
|
throw(internal_error("get_edt_call_node", "not a return node"))
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
trace_atom_subterm_is_ground(atom(_, Args), ArgPos, _) :-
|
|
select_arg_at_pos(ArgPos, Args, ArgInfo),
|
|
ArgInfo = arg_info(_, _, MaybeArg),
|
|
MaybeArg = yes(_).
|
|
|
|
:- func trace_arg_pos_to_user_arg_num(wrap(S), edt_node(R), arg_pos) = int
|
|
<= annotated_trace(S, R).
|
|
|
|
trace_arg_pos_to_user_arg_num(wrap(Store), dynamic(Ref), ArgPos) = ArgNum :-
|
|
get_edt_call_node(Store, Ref, CallId),
|
|
call_node_from_id(Store, CallId, Call),
|
|
Atom = get_trace_call_atom(Call),
|
|
user_arg_num(ArgPos, Atom, ArgNum).
|
|
|
|
:- pred calls_arguments_are_all_ground(S::in, R::in) is semidet
|
|
<= annotated_trace(S, R).
|
|
|
|
calls_arguments_are_all_ground(Store, CallId) :-
|
|
call_node_from_id(Store, CallId, Call),
|
|
Args = Call ^ call_atom_args,
|
|
|
|
% XXX The following won't work for partially instantiated arguments.
|
|
all [Arg] (
|
|
list.member(Arg, Args)
|
|
=>
|
|
Arg = arg_info(_, _, yes(_))
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred decl_require((pred)::in((pred) is semidet), string::in, string::in)
|
|
is det.
|
|
|
|
decl_require(Goal, Loc, Msg) :-
|
|
( call(Goal) ->
|
|
true
|
|
;
|
|
throw(internal_error(Loc, Msg))
|
|
).
|