mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 18:03:36 +00:00
ca9fb057a1
compiler/handle_options.m:
compiler/intermod_analysis.m:
compiler/lookup_switch.m:
compiler/ml_top_gen.m:
compiler/modecheck_goal.m:
compiler/options_file.m:
compiler/string_switch.m:
compiler/term_constr_build.m:
compiler/term_constr_data.m:
compiler/term_constr_initial.m:
compiler/term_constr_util.m:
grade_lib/grade_setup.m:
Replace the use of some predicates from the std_util module where more
direct alternatives now exist.
Update copyright notices.
486 lines
18 KiB
Mathematica
486 lines
18 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1997-2003, 2005-2012 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: term_constr_util.m.
|
|
% Main author: juliensf.
|
|
%
|
|
% This module defines some utility predicates used by the termination analyser.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.term_constr_util.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module libs.
|
|
:- import_module libs.lp_rational.
|
|
:- import_module libs.polyhedron.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_pragma.
|
|
:- import_module parse_tree.var_table.
|
|
:- import_module transform_hlds.term_constr_data.
|
|
:- import_module transform_hlds.term_constr_main_types.
|
|
|
|
:- import_module bool.
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module set.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Predicates for storing things in the HLDS.
|
|
%
|
|
|
|
% This predicate sets the argument size info (in terms of constraints
|
|
% on inter-argument size relationships) of a given list of procedures.
|
|
%
|
|
:- pred set_pred_proc_ids_constr_arg_size_info(list(pred_proc_id)::in,
|
|
constr_arg_size_info::in, module_info::in, module_info::out) is det.
|
|
|
|
:- func lookup_proc_constr_arg_size_info(module_info, pred_proc_id) =
|
|
maybe(constr_arg_size_info).
|
|
|
|
% Retrieve the abstraction representation from the module_info.
|
|
%
|
|
:- func get_abstract_scc(module_info, set(pred_proc_id)) = abstract_scc.
|
|
|
|
:- func get_abstract_proc(module_info, pred_proc_id) = abstract_proc.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Predicates for size_vars.
|
|
%
|
|
|
|
% Given a list of prog_vars, allocate one size_var per prog_var.
|
|
% Return the varset from which the size_vars were allocated and
|
|
% a map between prog_vars and size_vars.
|
|
%
|
|
:- pred make_size_var_map(list(prog_var)::in, size_varset::out,
|
|
size_var_map::out) is det.
|
|
|
|
% Given a list of prog_vars, allocate one size_var per prog_var.
|
|
% Allocate the size_vars from the provided size_varset.
|
|
% Return a map between prog_vars and size_vars.
|
|
%
|
|
:- pred make_size_var_map_alloc_from(list(prog_var)::in,
|
|
size_varset::in, size_varset::out, size_var_map::out) is det.
|
|
|
|
% Takes a list of prog_vars and outputs the corresponding
|
|
% list of size_vars, based on the given map.
|
|
%
|
|
:- func prog_vars_to_size_vars(size_var_map, list(prog_var)) = list(size_var).
|
|
:- func prog_var_to_size_var(size_var_map, prog_var) = size_var.
|
|
|
|
% Returns a set containing all the size_vars corresponding to prog_vars
|
|
% that have a type that is always of zero size. i.e. all those for which
|
|
% the functor norm returns zero for all values of the type.
|
|
%
|
|
:- func find_zero_size_vars(module_info, var_table, size_var_map) = zero_vars.
|
|
|
|
% create_nonneg_constraints(SizeVarMap, Zeros) = Constraints.
|
|
%
|
|
% Returns a list of constraints of the form "x >= 0" for every size_var
|
|
% x that is in `SizeVarMap' and is not in the set `Zeros'.
|
|
%
|
|
:- func create_nonneg_constraints(size_var_map, zero_vars) = constraints.
|
|
|
|
:- type var_substitution == map(size_var, size_var).
|
|
|
|
% create_var_substition(FromVars, ToVars) = Substitution.
|
|
% Create a mapping that maps elements of `FromVars' to their
|
|
% corresponding elements in `ToVars'. This mapping is many-one.
|
|
% An exception is thrown if `FromVars' contains any duplicate elements.
|
|
%
|
|
:- func create_var_substitution(list(size_var), list(size_var))
|
|
= var_substitution.
|
|
|
|
% Create a non-negativity constraint for each size_var in the list,
|
|
% *except* if it has zero size type.
|
|
%
|
|
:- func make_arg_constraints(list(size_var), zero_vars) = constraints.
|
|
|
|
% Check that a size_var is a member of the set of zero size_vars.
|
|
% XXX Ideally we would just use set.member directly but the arguments
|
|
% of that procedure are around the wrong way for use in most higher
|
|
% order procedures.
|
|
%
|
|
:- pred is_zero_size_var(zero_vars::in, size_var::in) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred add_context_to_constr_termination_info(
|
|
maybe(pragma_termination_info)::in, prog_context::in,
|
|
maybe(constr_termination_info)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% substitute_size_vars: Takes a list of constraints and a var_substitution.
|
|
% Returns the constraints with the specified substitutions made.
|
|
%
|
|
:- func substitute_size_vars(constraints, map(size_var, size_var))
|
|
= constraints.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred update_arg_size_info(pred_proc_id::in, polyhedron::in, module_info::in,
|
|
module_info::out) is det.
|
|
|
|
% change_procs_constr_termination_info(SCC, Override, Term2Info,
|
|
% !ProcTable).
|
|
%
|
|
% If Override is yes, then this predicate overrides any existing
|
|
% termination information. If Override is no, then it leaves the
|
|
% proc_info of a procedure unchanged unless the proc_info had no
|
|
% termination information (i.e. the maybe(termination_info)
|
|
% field was set to "no").
|
|
%
|
|
:- pred change_procs_constr_termination_info(list(proc_id)::in, bool::in,
|
|
constr_termination_info::in, proc_table::in, proc_table::out) is det.
|
|
|
|
% change_procs_constr_arg_size_info(SCC, Override, ArgSizeInfo,
|
|
% !ProcTable).
|
|
%
|
|
% This predicate sets the arg_size_info property of the given
|
|
% list of procedures. If Override is yes, then this predicate
|
|
% overrides any existing arg_size information. If Override is
|
|
% no, then it leaves the proc_info of a procedure unchanged
|
|
% unless the proc_info had no arg_size information (i.e. the
|
|
% maybe(arg_size_info) field was set to "no").
|
|
%
|
|
:- pred change_procs_constr_arg_size_info(list(proc_id)::in, bool::in,
|
|
constr_arg_size_info::in, proc_table::in, proc_table::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Predicates for printing out debugging traces. The first boolean argument
|
|
% of these predicates should be the value of the --debug-term option.
|
|
%
|
|
|
|
% Call the specified predicate.
|
|
%
|
|
% XXX This predicate is currently unused.
|
|
% If it is ever used again, give it a better name.
|
|
%
|
|
:- pred maybe_write_trace(io.text_output_stream::in, bool::in,
|
|
pred(io.text_output_stream, io, io)::in(pred(in, di, uo) is det),
|
|
io::di, io::uo) is det.
|
|
|
|
% As above but if the boolean argument is `yes', print a newline
|
|
% to stdout before flushing the output.
|
|
%
|
|
% XXX This predicate is currently unused.
|
|
% If it is ever used again, give it a better name.
|
|
%
|
|
:- pred maybe_write_trace_nl(io.text_output_stream::in, bool::in,
|
|
pred(io.text_output_stream, io, io)::in(pred(in, di, uo) is det),
|
|
bool::in, io::di, io::uo) is det.
|
|
|
|
:- pred maybe_write_scc_procs(io.text_output_stream::in, module_info::in,
|
|
list(pred_proc_id)::in, io::di, io::uo) is det.
|
|
|
|
:- pred maybe_write_proc_name(io.text_output_stream::in, module_info::in,
|
|
string::in, pred_proc_id::in, io::di, io::uo) is det.
|
|
|
|
:- pred write_size_vars(io.text_output_stream::in, size_varset::in,
|
|
list(size_var)::in, io::di, io::uo) is det.
|
|
|
|
:- pred dump_size_vars(io.text_output_stream::in, size_varset::in,
|
|
list(size_var)::in, io::di, io::uo) is det.
|
|
|
|
:- pred dump_size_varset(io.text_output_stream::in, size_varset::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.hlds_out.
|
|
:- import_module hlds.hlds_out.hlds_out_util.
|
|
:- import_module libs.rat.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module transform_hlds.term_constr_errors.
|
|
:- import_module transform_hlds.term_norm.
|
|
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
set_pred_proc_ids_constr_arg_size_info([], _ArgSize, !ModuleInfo).
|
|
set_pred_proc_ids_constr_arg_size_info([PPId | PPIds], ArgSize, !ModuleInfo) :-
|
|
PPId = proc(PredId, ProcId),
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
|
|
pred_info_proc_info(PredInfo0, ProcId, ProcInfo0),
|
|
proc_info_get_termination2_info(ProcInfo0, Term2Info0),
|
|
term2_info_set_success_constrs(yes(ArgSize), Term2Info0, Term2Info),
|
|
proc_info_set_termination2_info(Term2Info, ProcInfo0, ProcInfo),
|
|
pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo),
|
|
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
|
|
set_pred_proc_ids_constr_arg_size_info(PPIds, ArgSize, !ModuleInfo).
|
|
|
|
lookup_proc_constr_arg_size_info(ModuleInfo, PredProcId) = MaybeArgSizeInfo :-
|
|
PredProcId = proc(PredId, ProcId),
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
|
|
proc_info_get_termination2_info(ProcInfo, Term2Info),
|
|
MaybeArgSizeInfo = term2_info_get_success_constrs(Term2Info).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
get_abstract_scc(ModuleInfo, SCC) =
|
|
set.map(get_abstract_proc(ModuleInfo), SCC).
|
|
|
|
get_abstract_proc(ModuleInfo, PPId) = AbstractProc :-
|
|
module_info_pred_proc_info(ModuleInfo, PPId, _, ProcInfo),
|
|
proc_info_get_termination2_info(ProcInfo, Term2Info),
|
|
MaybeAbstractProc = term2_info_get_abstract_rep(Term2Info),
|
|
(
|
|
MaybeAbstractProc = yes(AbstractProc)
|
|
;
|
|
MaybeAbstractProc = no,
|
|
unexpected($pred, "no abstract rep. for proc")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
make_size_var_map(ProgVars, SizeVarSet, SizeVarMap) :-
|
|
make_size_var_map_alloc_from(ProgVars, varset.init, SizeVarSet,
|
|
SizeVarMap).
|
|
|
|
make_size_var_map_alloc_from(ProgVars, !SizeVarSet, SizeVarMap) :-
|
|
list.foldl2(make_size_var_for_var, ProgVars,
|
|
map.init, SizeVarMap, !SizeVarSet).
|
|
|
|
:- pred make_size_var_for_var(prog_var::in,
|
|
size_var_map::in, size_var_map::out,
|
|
size_varset::in, size_varset::out) is det.
|
|
|
|
make_size_var_for_var(ProgVar, !SizeVarMap, !SizeVarSet) :-
|
|
varset.new_var(SizeVar, !SizeVarSet),
|
|
map.set(ProgVar, SizeVar, !SizeVarMap).
|
|
|
|
prog_vars_to_size_vars(SizeVarMap, Vars)
|
|
= list.map(prog_var_to_size_var(SizeVarMap), Vars).
|
|
|
|
prog_var_to_size_var(SizeVarMap, Var) = SizeVar :-
|
|
( if map.search(SizeVarMap, Var, SizeVar0) then
|
|
SizeVar = SizeVar0
|
|
else
|
|
unexpected($pred, "prog_var not in size_var_map")
|
|
).
|
|
|
|
find_zero_size_vars(ModuleInfo, VarTable, SizeVarMap) = Zeros :-
|
|
ProgVars = map.keys(SizeVarMap),
|
|
ZeroProgVars = list.filter(is_zero_size_prog_var(ModuleInfo, VarTable),
|
|
ProgVars),
|
|
|
|
% Build zeros from corresponding size_vars.
|
|
ZerosList = prog_vars_to_size_vars(SizeVarMap, ZeroProgVars),
|
|
Zeros = set.list_to_set(ZerosList).
|
|
|
|
:- pred is_zero_size_prog_var(module_info::in, var_table::in,
|
|
prog_var::in) is semidet.
|
|
|
|
is_zero_size_prog_var(ModuleInfo, VarTable, Var) :-
|
|
lookup_var_type(VarTable, Var, Type),
|
|
(
|
|
term_norm.zero_size_type(ModuleInfo, Type)
|
|
;
|
|
% We don't include dummy types in the constraints - they won't tell us
|
|
% anything useful.
|
|
is_type_a_dummy(ModuleInfo, Type) = is_dummy_type
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Utility procedures used by various parts of the IR analysis.
|
|
%
|
|
|
|
create_nonneg_constraints(SizeVarMap, Zeros) = Constraints :-
|
|
create_nonneg_constraints_2(SizeVarMap, Zeros, Constraints).
|
|
|
|
:- pred create_nonneg_constraints_2(size_var_map::in, zero_vars::in,
|
|
constraints::out) is det.
|
|
|
|
create_nonneg_constraints_2(SizeVarMap, Zeros, NonNegs) :-
|
|
SizeVars = map.values(SizeVarMap),
|
|
list.negated_filter(is_zero_size_var(Zeros), SizeVars, NonZeroSizeVars),
|
|
NonNegs = list.map(make_nonneg_constr, NonZeroSizeVars).
|
|
|
|
create_var_substitution(Args, HeadVars) = SubstMap :-
|
|
create_var_substitution_2(Args, HeadVars, map.init, SubstMap).
|
|
|
|
:- pred create_var_substitution_2(list(size_var)::in, list(size_var)::in,
|
|
var_substitution::in, var_substitution::out) is det.
|
|
|
|
create_var_substitution_2([], [], !Subst).
|
|
create_var_substitution_2([_|_], [], _, _) :-
|
|
unexpected($pred, "unmatched lists").
|
|
create_var_substitution_2([], [_|_], _, _) :-
|
|
unexpected($pred, "unmatched lists").
|
|
create_var_substitution_2([Arg | Args], [HeadVar | HeadVars], !Subst) :-
|
|
map.det_insert(HeadVar, Arg, !Subst),
|
|
create_var_substitution_2(Args, HeadVars, !Subst).
|
|
|
|
make_arg_constraints([], _) = [].
|
|
make_arg_constraints([Var | Vars], Zeros) = Constraints :-
|
|
Constraints0 = make_arg_constraints(Vars, Zeros),
|
|
( if set.member(Var, Zeros) then
|
|
Constraints = Constraints0
|
|
else
|
|
NewConstraint = construct_constraint([Var - one], lp_gt_eq, zero),
|
|
Constraints = [NewConstraint | Constraints0]
|
|
).
|
|
|
|
is_zero_size_var(Zeros, SizeVar) :-
|
|
set.member(SizeVar, Zeros).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
add_context_to_constr_termination_info(no, _, no).
|
|
add_context_to_constr_termination_info(yes(cannot_loop(_)), _,
|
|
yes(cannot_loop(term_reason_import_supplied))).
|
|
add_context_to_constr_termination_info(yes(can_loop(_)), Context,
|
|
yes(can_loop([term2_error(Context, imported_pred)]))).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
substitute_size_vars(Constraints0, SubstMap) = Constraints :-
|
|
SubVarInCoeff =
|
|
( func(OldVar - Rat) = NewVar - Rat :-
|
|
map.lookup(SubstMap, OldVar, NewVar)
|
|
),
|
|
SubVarInEqn =
|
|
( func(Constr0) = Constr :-
|
|
deconstruct_constraint(Constr0, Coeffs0, Op, Rat),
|
|
Coeffs = list.map(SubVarInCoeff, Coeffs0),
|
|
Constr = construct_constraint(Coeffs, Op, Rat)
|
|
),
|
|
Constraints = list.map(SubVarInEqn, Constraints0).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
update_arg_size_info(PPID, Polyhedron, !ModuleInfo) :-
|
|
set_pred_proc_ids_constr_arg_size_info([PPID], Polyhedron, !ModuleInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
change_procs_constr_termination_info([], _, _, !ProcTable).
|
|
change_procs_constr_termination_info([ProcId | ProcIds], Override, Termination,
|
|
!ProcTable) :-
|
|
map.lookup(!.ProcTable, ProcId, ProcInfo0),
|
|
proc_info_get_termination2_info(ProcInfo0, Term2Info0),
|
|
( if
|
|
( Override = yes
|
|
; term2_info_get_term_status(Term2Info0) = no
|
|
)
|
|
then
|
|
term2_info_set_term_status(yes(Termination), Term2Info0, Term2Info),
|
|
proc_info_set_termination2_info(Term2Info, ProcInfo0, ProcInfo),
|
|
map.det_update(ProcId, ProcInfo, !ProcTable)
|
|
else
|
|
true
|
|
),
|
|
change_procs_constr_termination_info(ProcIds, Override, Termination,
|
|
!ProcTable).
|
|
|
|
change_procs_constr_arg_size_info([], _, _, !ProcTable).
|
|
change_procs_constr_arg_size_info([ProcId | ProcIds], Override, ArgSize,
|
|
!ProcTable) :-
|
|
map.lookup(!.ProcTable, ProcId, ProcInfo0),
|
|
proc_info_get_termination2_info(ProcInfo0, Term2Info0),
|
|
( if
|
|
( Override = yes
|
|
; term2_info_get_success_constrs(Term2Info0) = no
|
|
)
|
|
then
|
|
term2_info_set_success_constrs(yes(ArgSize), Term2Info0, Term2Info),
|
|
proc_info_set_termination2_info(Term2Info, ProcInfo0, ProcInfo),
|
|
map.det_update(ProcId, ProcInfo, !ProcTable)
|
|
else
|
|
true
|
|
),
|
|
change_procs_constr_arg_size_info(ProcIds, Override, ArgSize, !ProcTable).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Predicates for printing out debugging traces ...
|
|
%
|
|
|
|
maybe_write_trace(Stream, DebugTerm, TracePred, !IO) :-
|
|
maybe_write_trace_nl(Stream, DebugTerm, TracePred, no, !IO).
|
|
|
|
maybe_write_trace_nl(Stream, DebugTerm, TracePred, NewLine, !IO) :-
|
|
(
|
|
DebugTerm = yes,
|
|
TracePred(Stream, !IO),
|
|
(
|
|
NewLine = yes,
|
|
io.nl(Stream, !IO)
|
|
;
|
|
NewLine = no
|
|
),
|
|
io.flush_output(Stream, !IO)
|
|
;
|
|
DebugTerm = no
|
|
).
|
|
|
|
maybe_write_scc_procs(Stream, ModuleInfo, SCC, !IO) :-
|
|
write_scc_procs_loop(Stream, ModuleInfo, SCC, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
:- pred write_scc_procs_loop(io.text_output_stream::in, module_info::in,
|
|
list(pred_proc_id)::in, io::di, io::uo) is det.
|
|
|
|
write_scc_procs_loop(_, _, [], !IO).
|
|
write_scc_procs_loop(Stream, ModuleInfo, [PPId | PPIds], !IO) :-
|
|
PPIdStr = pred_proc_id_to_dev_string(ModuleInfo, PPId),
|
|
io.format(Stream, "\t%s\n", [s(PPIdStr)], !IO),
|
|
write_scc_procs_loop(Stream, ModuleInfo, PPIds, !IO).
|
|
|
|
maybe_write_proc_name(Stream, ModuleInfo, Prefix, PPId, !IO) :-
|
|
PPIdStr = pred_proc_id_to_dev_string(ModuleInfo, PPId),
|
|
io.format(Stream, "%s%s\n", [s(Prefix), s(PPIdStr)], !IO).
|
|
|
|
write_size_vars(Stream, VarSet, Vars, !IO) :-
|
|
list.map(varset.lookup_name(VarSet), Vars, VarNames),
|
|
io.format(Stream, "[%s]", [s(string.join_list(", ", VarNames))], !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
dump_size_vars(Stream, VarSet, Vars, !IO) :-
|
|
dump_size_varset_loop(Stream, VarSet, Vars, !IO).
|
|
|
|
dump_size_varset(Stream, VarSet, !IO) :-
|
|
Vars = varset.vars(VarSet),
|
|
dump_size_varset_loop(Stream, VarSet, Vars, !IO).
|
|
|
|
:- pred dump_size_varset_loop(io.text_output_stream::in, size_varset::in,
|
|
list(size_var)::in, io::di, io::uo) is det.
|
|
|
|
dump_size_varset_loop(_, _, [], !IO).
|
|
dump_size_varset_loop(Stream, VarSet, [Var | Vars], !IO) :-
|
|
Name = varset.lookup_name(VarSet, Var),
|
|
io.write(Stream, Var, !IO),
|
|
io.format(Stream, " = %s\n", [s(Name)], !IO),
|
|
dump_size_varset_loop(Stream, VarSet, Vars, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.term_constr_util.
|
|
%-----------------------------------------------------------------------------%
|