mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-18 15:26:31 +00:00
f9fe8dcf61
Estimated hours taken: 8
Branches: main
Improve the error messages generated for determinism errors involving committed
choice contexts. Previously, we printed a message to the effect that e.g.
a cc pred is called in context that requires all solutions, but we didn't say
*why* the context requires all solutions. We now keep track of all the goals
to the right that could fail, since it is these goals that may reject the first
solution of a committed choice goal.
The motivation for this diff was the fact that I found that locating the
failing goal can be very difficult if the conjunction to the right is
a couple of hundred lines long. This would have been a nontrivial problem,
since (a) unifications involving values of user-defined types are committed
choice goals, and (b) we can expect uses of user-defined types to increase.
compiler/det_analysis.m:
Keep track of goals to the right of the current goal that could fail,
and include them in the error representation if required.
compiler/det_report.m:
Include the list of failing goals to the right in the representations
of determinism errors involving committed committed choice goals.
Convert the last part of this module that wasn't using error_util
to use error_util. Make most parts of this module just construct
error message specifications; print those specifications (using
error_util) in only a few places.
compiler/hlds_out.m:
Add a function for use by the new code in det_report.m.
compiler/error_util.m:
Add a function for use by the new code in det_report.m.
compiler/error_util.m:
compiler/compiler_util.m:
Error_util is still changing reasonably often, and yet it is
included in lots of modules, most of which need only a few simple
non-parse-tree-related predicates from it (e.g. unexpected).
Move those predicates to a new module, compiler_util.m. This also
eliminates some undesirable dependencies from libs to parse_tree.
compiler/libs.m:
Include compiler_util.m.
compiler/notes/compiler_design.html:
Document compiler_util.m, and fix the documentation of some other
modules.
compiler/*.m:
Import compiler_util instead of or in addition to error_util.
To make this easier, consistently use . instead of __ for module
qualifying module names.
tests/invalid/det_errors_cc.{m,err_exp}:
Add this new test case to test the error messages for cc contexts.
tests/invalid/det_errors_deet.{m,err_exp}:
Add this new test case to test the error messages for unifications
inside function symbols.
tests/invalid/Mmakefile:
Add the new test cases.
tests/invalid/det_errors.err_exp:
tests/invalid/magicbox.err_exp:
Change the expected output to conform to the change in det_report.m,
which is now more consistent.
509 lines
20 KiB
Mathematica
509 lines
20 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% file: closure_analysis.m
|
|
% main author: juliensf
|
|
|
|
% Perform local closure analysis on procedures. This involves tracking
|
|
% the possible values that a higher-order variable can take within a
|
|
% procedure. We attach this information to places where knowing the
|
|
% possible values of a higher-order call may be useful.
|
|
|
|
% This is similar to the analysis done by higher-order specialization, except
|
|
% that here, we do care if a higher-order variable can take multiple values.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.closure_analysis.
|
|
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module io.
|
|
|
|
:- pred process_module(module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module transform_hlds.dependency_graph.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module counter.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module set.
|
|
:- import_module std_util.
|
|
:- import_module string.
|
|
:- import_module svmap.
|
|
:- import_module svset.
|
|
:- import_module varset.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
process_module(!ModuleInfo, !IO) :-
|
|
%
|
|
% XXX At the moment it is not necessary to do this on a per-SCC basis,
|
|
% since the analysis is only procedure-local, but we would eventually
|
|
% like to extend it.
|
|
%
|
|
globals.io_lookup_bool_option(debug_closure, Debug, !IO),
|
|
module_info_ensure_dependency_info(!ModuleInfo),
|
|
module_info_dependency_info(!.ModuleInfo, DepInfo),
|
|
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
|
|
list.foldl2(process_scc(Debug), SCCs, !ModuleInfo, !IO).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Perform closure analysis on a SCC
|
|
%
|
|
|
|
:- pred process_scc(bool::in, list(pred_proc_id)::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
process_scc(Debug, SCC, !ModuleInfo, !IO) :-
|
|
list.foldl2(process_proc(Debug), SCC, !ModuleInfo, !IO).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
% This type represents the possible values of a higher-order valued
|
|
% variable.
|
|
%
|
|
:- type closure_values
|
|
---> unknown
|
|
% The higher-order variable may be bound to something
|
|
% but we don't know what it is.
|
|
|
|
; partial(set(pred_proc_id))
|
|
% The higher-order variable may be bound to these
|
|
% values, or it may be bound to something else we don't
|
|
% know about. (This is intended to be useful in producing
|
|
% error messages for the termination analysis; if one
|
|
% of the higher-order values is definitely non-terminating
|
|
% we can certainly let the user know about it.)
|
|
|
|
; exclusive(set(pred_proc_id)).
|
|
% The higher-order variable will be exclusively bound
|
|
% to this set of values.
|
|
|
|
% We attach a closure_info to each goal where it may be of interest;
|
|
% at the moment calls and generic_calls.
|
|
%
|
|
:- type closure_info == map(prog_var, closure_values).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- func closure_info_init(module_info, vartypes, prog_vars, list(mer_mode))
|
|
= closure_info.
|
|
|
|
closure_info_init(ModuleInfo, VarTypes, HeadVars, ArgModes) = ClosureInfo :-
|
|
partition_arguments(ModuleInfo, VarTypes, HeadVars, ArgModes,
|
|
set.init, Inputs0, set.init, _Outputs),
|
|
Inputs = set.filter(var_has_ho_type(VarTypes), Inputs0),
|
|
set.fold(insert_unknown, Inputs, map.init, ClosureInfo).
|
|
|
|
% Succeeds iff the given variable has a higher-order type.
|
|
%
|
|
:- pred var_has_ho_type(vartypes::in, prog_var::in) is semidet.
|
|
|
|
var_has_ho_type(VarTypes, Var) :-
|
|
Type = map.lookup(VarTypes, Var),
|
|
type_is_higher_order(Type).
|
|
|
|
% Insert the given prog_var into the closure_info and set the
|
|
% possible values to unknown.
|
|
%
|
|
:- pred insert_unknown(prog_var::in, closure_info::in, closure_info::out)
|
|
is det.
|
|
|
|
insert_unknown(Var, !ClosureInfo) :-
|
|
svmap.det_insert(Var, unknown, !ClosureInfo).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Perform local closure analysis on a procedure
|
|
%
|
|
|
|
:- pred process_proc(bool::in, pred_proc_id::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
process_proc(Debug, PPId, !ModuleInfo, !IO) :-
|
|
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
|
|
proc_info_headvars(ProcInfo0, HeadVars),
|
|
proc_info_vartypes(ProcInfo0, VarTypes),
|
|
proc_info_argmodes(ProcInfo0, ArgModes),
|
|
ClosureInfo0 = closure_info_init(!.ModuleInfo, VarTypes, HeadVars,
|
|
ArgModes),
|
|
write_proc_progress_message("% Analysing closures in ", PPId, !.ModuleInfo,
|
|
!IO),
|
|
proc_info_goal(ProcInfo0, Body0),
|
|
process_goal(VarTypes, !.ModuleInfo, Body0, Body,
|
|
ClosureInfo0, _ClosureInfo),
|
|
(
|
|
Debug = yes,
|
|
proc_info_varset(ProcInfo, Varset),
|
|
dump_closure_info(Varset, Body, !IO),
|
|
io.flush_output(!IO)
|
|
;
|
|
Debug = no
|
|
),
|
|
proc_info_set_goal(Body, ProcInfo0, ProcInfo),
|
|
module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Track higher-order values through goals
|
|
%
|
|
|
|
:- pred process_goal(vartypes::in, module_info::in,
|
|
hlds_goal::in, hlds_goal::out, closure_info::in, closure_info::out) is det.
|
|
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = conj(Goals0) - GoalInfo,
|
|
list.map_foldl(process_goal(VarTypes, ModuleInfo), Goals0, Goals,
|
|
!ClosureInfo),
|
|
Goal = conj(Goals) - GoalInfo.
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = GoalExpr - GoalInfo0,
|
|
GoalExpr = call(CallPredId, CallProcId, CallArgs, _, _, _),
|
|
%
|
|
% Look for any higher-order arguments and divide them
|
|
% into sets of input and output arguments.
|
|
%
|
|
module_info_pred_proc_info(ModuleInfo, CallPredId, CallProcId,
|
|
_CallPredInfo, CallProcInfo),
|
|
proc_info_argmodes(CallProcInfo, CallArgModes),
|
|
%
|
|
% NOTE: we construct sets of arguments, rather than lists,
|
|
% in case there are duplicate arguments.
|
|
%
|
|
partition_arguments(ModuleInfo, VarTypes, CallArgs, CallArgModes,
|
|
set.init, InputArgs, set.init, OutputArgs),
|
|
%
|
|
% Update the goal_info to include any information about the
|
|
% values of higher-order valued variables.
|
|
%
|
|
AddValues = (pred(Var::in, !.ValueMap::in, !:ValueMap::out) is det :-
|
|
%
|
|
% The closure_info won't yet contain any information about
|
|
% higher-order outputs from this call.
|
|
%
|
|
( map.search(!.ClosureInfo, Var, PossibleValues) ->
|
|
(
|
|
PossibleValues = unknown
|
|
;
|
|
PossibleValues = partial(_)
|
|
;
|
|
PossibleValues = exclusive(KnownValues),
|
|
svmap.det_insert(Var, KnownValues, !ValueMap)
|
|
)
|
|
;
|
|
true
|
|
)
|
|
),
|
|
set.fold(AddValues, InputArgs, map.init, Values),
|
|
goal_info_set_ho_values(Values, GoalInfo0, GoalInfo),
|
|
%
|
|
% Insert any information about higher-order
|
|
% outputs from this call into the closure_info.
|
|
%
|
|
set.fold(insert_unknown, OutputArgs, !ClosureInfo),
|
|
Goal = GoalExpr - GoalInfo.
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = GoalExpr - GoalInfo0,
|
|
%
|
|
% XXX We should probably just ignore Aditi stuff and unsafe_casts
|
|
% but annotating them with closure_infos won't hurt.
|
|
%
|
|
GoalExpr = generic_call(Details, GCallArgs, GCallModes, _),
|
|
partition_arguments(ModuleInfo, VarTypes, GCallArgs, GCallModes,
|
|
set.init, InputArgs0, set.init, OutputArgs),
|
|
%
|
|
% For higher-order calls we need to make sure that the actual higher-order
|
|
% variable being called is also considered (it will typically be the
|
|
% variable of interest). This variable is not included in 'GCallArgs' so
|
|
% we need to include in the set of input argument separately.
|
|
%
|
|
( Details = higher_order(CalledClosure0, _, _, _) ->
|
|
svset.insert(CalledClosure0, InputArgs0, InputArgs)
|
|
;
|
|
InputArgs = InputArgs0
|
|
),
|
|
AddValues = (pred(Var::in, !.ValueMap::in, !:ValueMap::out) is det :-
|
|
%
|
|
% The closure_info won't yet contain any information about
|
|
% higher-order outputs from this call.
|
|
%
|
|
( map.search(!.ClosureInfo, Var, PossibleValues) ->
|
|
(
|
|
PossibleValues = unknown
|
|
;
|
|
PossibleValues = partial(_)
|
|
;
|
|
PossibleValues = exclusive(KnownValues),
|
|
svmap.det_insert(Var, KnownValues, !ValueMap)
|
|
)
|
|
;
|
|
true
|
|
)
|
|
),
|
|
set.fold(AddValues, InputArgs, map.init, Values),
|
|
goal_info_set_ho_values(Values, GoalInfo0, GoalInfo),
|
|
%
|
|
% Insert any information about higher-order
|
|
% outputs from this call into the closure_info.
|
|
%
|
|
set.fold(insert_unknown, OutputArgs, !ClosureInfo),
|
|
Goal = GoalExpr - GoalInfo.
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = switch(SwitchVar, SwitchCanFail, Cases0) - GoalInfo,
|
|
ProcessCase = (func(Case0) = Case - CaseInfo :-
|
|
Case0 = case(ConsId, CaseGoal0),
|
|
process_goal(VarTypes, ModuleInfo, CaseGoal0, CaseGoal,
|
|
!.ClosureInfo, CaseInfo),
|
|
Case = case(ConsId, CaseGoal)
|
|
),
|
|
CasesAndInfos = list.map(ProcessCase, Cases0),
|
|
assoc_list.keys_and_values(CasesAndInfos, Cases, CasesInfo),
|
|
list.foldl(merge_closure_infos, CasesInfo, map.init, !:ClosureInfo),
|
|
Goal = switch(SwitchVar, SwitchCanFail, Cases) - GoalInfo.
|
|
process_goal(VarTypes, _, Goal, Goal, !ClosureInfo) :-
|
|
Goal = unify(_, _, _, Unification, _) - _,
|
|
(
|
|
Unification = construct(LHS, RHS, _, _, _, _, _),
|
|
(
|
|
% NOTE: we don't bother worrying about features
|
|
% that relate to Aditi, i.e. when EvalMethod = (aditi_bottom_up)
|
|
RHS = pred_const(ShroudedPPId, EvalMethod),
|
|
EvalMethod = lambda_normal
|
|
->
|
|
PPId = unshroud_pred_proc_id(ShroudedPPId),
|
|
HO_Value = set.make_singleton_set(PPId),
|
|
svmap.det_insert(LHS, exclusive(HO_Value), !ClosureInfo)
|
|
;
|
|
true
|
|
)
|
|
;
|
|
Unification = deconstruct(_, _, Args, _, _, _),
|
|
%
|
|
% XXX We don't currently support tracking the values of
|
|
% closures that are stored in data structures.
|
|
%
|
|
HO_Args = list.filter(var_has_ho_type(VarTypes), Args),
|
|
list.foldl(insert_unknown, HO_Args, !ClosureInfo)
|
|
;
|
|
Unification = assign(LHS, RHS),
|
|
( var_has_ho_type(VarTypes, LHS) ->
|
|
%
|
|
% Sanity check: make sure the rhs is also a higher-order variable.
|
|
%
|
|
( not var_has_ho_type(VarTypes, RHS) ->
|
|
unexpected(this_file,
|
|
"not a higher-order var in process_goal_2")
|
|
;
|
|
true
|
|
),
|
|
Values = map.lookup(!.ClosureInfo, RHS),
|
|
svmap.det_insert(LHS, Values, !ClosureInfo)
|
|
;
|
|
true
|
|
)
|
|
;
|
|
Unification = simple_test(_, _)
|
|
;
|
|
Unification = complicated_unify(_, _, _)
|
|
).
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = disj(Goals0) - GoalInfo,
|
|
ProcessDisjunct = (func(Disjunct0) = DisjunctResult :-
|
|
process_goal(VarTypes, ModuleInfo, Disjunct0, Disjunct,
|
|
!.ClosureInfo, ClosureInfoForDisjunct),
|
|
DisjunctResult = Disjunct - ClosureInfoForDisjunct
|
|
),
|
|
DisjunctsAndInfos = list.map(ProcessDisjunct, Goals0),
|
|
assoc_list.keys_and_values(DisjunctsAndInfos, Goals, DisjunctsInfo),
|
|
list.foldl(merge_closure_infos, DisjunctsInfo, map.init, !:ClosureInfo),
|
|
Goal = disj(Goals) - GoalInfo.
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = not(NegatedGoal0) - GoalInfo,
|
|
process_goal(VarTypes, ModuleInfo, NegatedGoal0, NegatedGoal,
|
|
!.ClosureInfo, _),
|
|
Goal = not(NegatedGoal) - GoalInfo.
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = scope(Reason, ScopedGoal0) - GoalInfo,
|
|
process_goal(VarTypes, ModuleInfo, ScopedGoal0, ScopedGoal, !ClosureInfo),
|
|
Goal = scope(Reason, ScopedGoal) - GoalInfo.
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = if_then_else(ExistQVars, If0, Then0, Else0) - GoalInfo,
|
|
process_goal(VarTypes, ModuleInfo, If0, If, !.ClosureInfo, IfInfo),
|
|
process_goal(VarTypes, ModuleInfo, Then0, Then, IfInfo, IfThenInfo),
|
|
process_goal(VarTypes, ModuleInfo, Else0, Else, !.ClosureInfo, ElseInfo),
|
|
map.union(merge_closure_values, IfThenInfo, ElseInfo, !:ClosureInfo),
|
|
Goal = if_then_else(ExistQVars, If, Then, Else) - GoalInfo.
|
|
process_goal(_, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
%
|
|
% XXX 'ExtraArgs' should probably be ignored here since it is only
|
|
% used by the tabling transformation.
|
|
%
|
|
% XXX We may eventually want to annotate foreign_procs with
|
|
% clousure_infos as well. It isn't useful at the moment however.
|
|
%
|
|
Goal0 = GoalExpr - GoalInfo,
|
|
GoalExpr = foreign_proc(_, _, _, Args, _ExtraArgs, _),
|
|
ForeignHOArgs = (pred(Arg::in, Out::out) is semidet :-
|
|
Arg = foreign_arg(Var, NameMode, Type),
|
|
%
|
|
% A 'no' here means that the foreign argument is unused.
|
|
%
|
|
NameMode = yes(_ - Mode),
|
|
mode_util.mode_is_output(ModuleInfo, Mode),
|
|
type_is_higher_order(Type),
|
|
Out = Var - unknown
|
|
),
|
|
list.filter_map(ForeignHOArgs, Args, OutputForeignHOArgs),
|
|
svmap.det_insert_from_assoc_list(OutputForeignHOArgs, !ClosureInfo),
|
|
Goal = GoalExpr - GoalInfo.
|
|
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
|
|
Goal0 = par_conj(Goals0) - GoalInfo,
|
|
list.map_foldl(process_goal(VarTypes, ModuleInfo), Goals0, Goals,
|
|
!ClosureInfo),
|
|
Goal = par_conj(Goals) - GoalInfo.
|
|
process_goal(_, _, shorthand(_) - _, _, _, _) :-
|
|
unexpected(this_file, "shorthand/1 goal during closure analysis.").
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- pred partition_arguments(module_info::in, vartypes::in,
|
|
prog_vars::in, list(mer_mode)::in,
|
|
set(prog_var)::in, set(prog_var)::out,
|
|
set(prog_var)::in, set(prog_var)::out) is det.
|
|
|
|
partition_arguments(_, _, [], [], !Inputs, !Outputs).
|
|
partition_arguments(_, _, [_|_], [], _, _, _, _) :-
|
|
unexpected(this_file, "partition_arguments/7 unequal length lists.").
|
|
partition_arguments(_, _, [], [_|_], _, _, _, _) :-
|
|
unexpected(this_file, "partition_arguments/7 unequal length lists.").
|
|
partition_arguments(ModuleInfo, VarTypes, [ Var | Vars ], [ Mode | Modes ],
|
|
!Inputs, !Outputs) :-
|
|
( var_has_ho_type(VarTypes, Var) ->
|
|
( mode_is_input(ModuleInfo, Mode) ->
|
|
svset.insert(Var, !Inputs)
|
|
; mode_is_output(ModuleInfo, Mode) ->
|
|
svset.insert(Var, !Outputs)
|
|
;
|
|
true
|
|
)
|
|
;
|
|
true
|
|
),
|
|
partition_arguments(ModuleInfo, VarTypes, Vars, Modes, !Inputs, !Outputs).
|
|
|
|
:- pred merge_closure_infos(closure_info::in, closure_info::in,
|
|
closure_info::out) is det.
|
|
|
|
merge_closure_infos(A, B, C) :-
|
|
map.union(merge_closure_values, A, B, C).
|
|
|
|
:- pred merge_closure_values(closure_values::in, closure_values::in,
|
|
closure_values::out) is det.
|
|
|
|
merge_closure_values(unknown, unknown, unknown).
|
|
merge_closure_values(unknown, partial(A), partial(A)).
|
|
merge_closure_values(unknown, exclusive(A), partial(A)).
|
|
merge_closure_values(partial(A), unknown, partial(A)).
|
|
merge_closure_values(partial(A), partial(B), partial(A `set.union` B)).
|
|
merge_closure_values(partial(A), exclusive(B), partial(A `set.union` B)).
|
|
merge_closure_values(exclusive(A), unknown, partial(A)).
|
|
merge_closure_values(exclusive(A), partial(B), partial(A `set.union` B)).
|
|
merge_closure_values(exclusive(A), exclusive(B), exclusive(A `set.union` B)).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Debugging code (used by '--debug-closure' option)
|
|
%
|
|
|
|
:- pred dump_closure_info(prog_varset::in, hlds_goal::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_closure_info(Varset, conj(Goals) - _, !IO) :-
|
|
list.foldl(dump_closure_info(Varset), Goals, !IO).
|
|
dump_closure_info(Varset, par_conj(Goals) - _, !IO) :-
|
|
list.foldl(dump_closure_info(Varset), Goals, !IO).
|
|
dump_closure_info(Varset, call(_,_,_,_,_,_) - GoalInfo, !IO) :-
|
|
dump_ho_values(GoalInfo, Varset, !IO).
|
|
dump_closure_info(Varset, generic_call(_,_,_,_) - GoalInfo, !IO) :-
|
|
dump_ho_values(GoalInfo, Varset, !IO).
|
|
dump_closure_info(Varset, scope(_, Goal) - _, !IO) :-
|
|
dump_closure_info(Varset, Goal, !IO).
|
|
dump_closure_info(Varset, switch(_, _, Cases) - _, !IO) :-
|
|
CaseToGoal = (func(case(_, Goal)) = Goal),
|
|
Goals = list.map(CaseToGoal, Cases),
|
|
list.foldl(dump_closure_info(Varset), Goals, !IO).
|
|
dump_closure_info(Varset, if_then_else(_, If, Then, Else) - _, !IO) :-
|
|
list.foldl(dump_closure_info(Varset), [If, Then, Else], !IO).
|
|
dump_closure_info(_, unify(_,_,_,_,_) - _, !IO).
|
|
dump_closure_info(Varset, not(Goal) - _, !IO) :-
|
|
dump_closure_info(Varset, Goal, !IO).
|
|
dump_closure_info(_, foreign_proc(_,_,_,_,_,_) - _, !IO).
|
|
dump_closure_info(Varset, disj(Goals) - _, !IO) :-
|
|
list.foldl(dump_closure_info(Varset), Goals, !IO).
|
|
dump_closure_info(_, shorthand(_) - _, _, _) :-
|
|
unexpected(this_file, "shorthand goal encountered.\n").
|
|
|
|
:- pred dump_ho_values(hlds_goal_info::in, prog_varset::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_ho_values(GoalInfo, Varset, !IO) :-
|
|
HO_Values = goal_info_get_ho_values(GoalInfo),
|
|
( not map.is_empty(HO_Values) ->
|
|
goal_info_get_context(GoalInfo, Context),
|
|
prog_out.write_context(Context, !IO),
|
|
io.nl(!IO),
|
|
map.foldl(dump_ho_value(Varset), HO_Values, !IO)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred dump_ho_value(prog_varset::in, prog_var::in, set(pred_proc_id)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_ho_value(Varset, ProgVar, Values, !IO) :-
|
|
VarName = varset.lookup_name(Varset, ProgVar),
|
|
io.format("%s =\n", [s(VarName)], !IO),
|
|
WritePPIds = (pred(PPId::in, !.IO::di, !:IO::uo) is det :-
|
|
io.write_string("\t", !IO),
|
|
io.write(PPId, !IO),
|
|
io.nl(!IO)
|
|
),
|
|
set.fold(WritePPIds, Values, !IO).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "closure_analysis.m".
|
|
|
|
%----------------------------------------------------------------------------%
|
|
:- end_module closure_analysis.
|
|
%----------------------------------------------------------------------------%
|