mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
454 lines
18 KiB
Mathematica
454 lines
18 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2007, 2009-2011 The University of Melbourne.
|
|
% Copyright (C) 2014-2015, 2018, 2022-2023, 2025 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: headvar_names.m.
|
|
% Main author: zs.
|
|
%
|
|
% This file contains code for improving the names of head variables,
|
|
% replacing HeadVar__n with user-given names whereever the clauses
|
|
% agree on the names.
|
|
|
|
:- module hlds.headvar_names.
|
|
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
|
|
:- import_module list.
|
|
|
|
:- type maybe_look_for_unneeded_statevars
|
|
---> do_not_look_for_unneeded_statevars
|
|
% No clause had any unused state variables.
|
|
; look_for_unneeded_statevars(list(string)).
|
|
% At least one clause had unused state variables.
|
|
% The argument gives, for each head variable,
|
|
% either its the consensus name (if it has one),
|
|
% or an empty string (if it does not).
|
|
% (pre_typecheck.m uses that info to decide whether an unneeded
|
|
% state variable in one clause is justified by consistency
|
|
% with another clause that *does* use that same state variable.)
|
|
|
|
% If all clauses give a given head variables the same name, use this name
|
|
% instead of the introduced `HeadVar__n' names for the head variables
|
|
% in the pred_info. This gives better error messages, more meaningful
|
|
% variable names in the debugger and slightly faster compilation.
|
|
%
|
|
:- pred maybe_improve_headvar_names(globals::in,
|
|
maybe_look_for_unneeded_statevars::out,
|
|
pred_info::in, pred_info::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_args.
|
|
:- import_module hlds.hlds_clauses.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module libs.op_mode.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_rename.
|
|
:- import_module parse_tree.set_of_var.
|
|
|
|
:- import_module bool.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module varset.
|
|
|
|
maybe_improve_headvar_names(Globals, MaybeLookForUnusedSVars, !PredInfo) :-
|
|
globals.get_op_mode(Globals, OpMode),
|
|
( if OpMode = opm_top_args(opma_augment(opmau_make_plain_opt), _) then
|
|
% Don't change headvar names when making a `.opt' file, because
|
|
% intermod.m needs to perform a similar transformation which THIS
|
|
% transformation would interfere with. (intermod.m places the
|
|
% original argument terms, not just the argument variables,
|
|
% in the clause head, and this pass would make it difficult to
|
|
% work out what were the original arguments).
|
|
MaybeLookForUnusedSVars = do_not_look_for_unneeded_statevars
|
|
else
|
|
pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
|
|
clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers),
|
|
clauses_info_get_arg_vector(ClausesInfo0, ArgVector0),
|
|
clauses_info_get_varset(ClausesInfo0, VarSet0),
|
|
get_clause_list_for_replacement(ClausesRep0, Clauses0),
|
|
(
|
|
Clauses0 = [],
|
|
MaybeLookForUnusedSVars = do_not_look_for_unneeded_statevars
|
|
;
|
|
Clauses0 = [SingleClause0],
|
|
Goal0 = SingleClause0 ^ clause_body,
|
|
|
|
Goal0 = hlds_goal(_, GoalInfo0),
|
|
goal_to_conj_list(Goal0, Conj0),
|
|
improve_single_clause_headvars(Conj0, ArgVector0, [],
|
|
VarSet0, VarSet, map.init, Subst, [], RevConj),
|
|
|
|
NonLocals0 = goal_info_get_nonlocals(GoalInfo0),
|
|
rename_vars_in_set_of_var(need_not_rename, Subst,
|
|
NonLocals0, NonLocals),
|
|
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
|
|
conj_list_to_goal(list.reverse(RevConj), GoalInfo, Goal),
|
|
|
|
apply_renaming_to_proc_arg_vector(Subst, ArgVector0, ArgVector),
|
|
clauses_info_set_arg_vector(ArgVector, ClausesInfo0, ClausesInfo1),
|
|
|
|
( if some_statevar_is_unused_in_clause(SingleClause0) then
|
|
HeadVars = proc_arg_vector_get_user_visible_args(ArgVector),
|
|
list.map(varset.lookup_name(VarSet), HeadVars, HeadVarNames),
|
|
MaybeLookForUnusedSVars =
|
|
look_for_unneeded_statevars(HeadVarNames)
|
|
else
|
|
MaybeLookForUnusedSVars = do_not_look_for_unneeded_statevars
|
|
),
|
|
|
|
SingleClause = SingleClause0 ^ clause_body := Goal,
|
|
set_clause_list([SingleClause], ClausesRep),
|
|
clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
|
|
ClausesInfo1, ClausesInfo2),
|
|
clauses_info_set_varset(VarSet, ClausesInfo2, ClausesInfo),
|
|
pred_info_set_clauses_info(ClausesInfo, !PredInfo)
|
|
;
|
|
Clauses0 = [_, _ | _],
|
|
% If a headvar is assigned to a variable with the same name
|
|
% (or no name) in every clause, rename it to have that name.
|
|
list.map2(find_headvar_names_in_clause(VarSet0, ArgVector0),
|
|
Clauses0, VarNameInfoMaps, VarsInMapSets),
|
|
ConsensusMap = find_consensus_headvar_names(VarsInMapSets,
|
|
VarNameInfoMaps),
|
|
|
|
( if
|
|
list.all_true(some_statevar_is_unused_in_clause, Clauses0)
|
|
then
|
|
HeadVars0 = proc_arg_vector_get_user_visible_args(ArgVector0),
|
|
list.map(find_consensus_name(ConsensusMap),
|
|
HeadVars0, HeadVarNames),
|
|
MaybeLookForUnusedSVars =
|
|
look_for_unneeded_statevars(HeadVarNames)
|
|
else
|
|
MaybeLookForUnusedSVars = do_not_look_for_unneeded_statevars
|
|
),
|
|
|
|
% We don't apply the renaming right now, because that could lead to
|
|
% error messages about unifications of the form X = X instead of
|
|
% HeadVar__n = X, which would be confusing.
|
|
%
|
|
% Instead, we record the renaming, and apply it only when we
|
|
% generate the data structures that record variable names for
|
|
% the debugger.
|
|
%
|
|
% We put the renaming into both all the proc_infos of the predicate
|
|
% (which is where stack_layout.m gets them from), and into the
|
|
% pred_info (so that any later procedures and/or predicates created
|
|
% from this one will get the rename map as well).
|
|
|
|
pred_info_set_var_name_remap(ConsensusMap, !PredInfo),
|
|
ProcIds = pred_info_all_procids(!.PredInfo),
|
|
pred_info_get_proc_table(!.PredInfo, ProcTable0),
|
|
list.foldl(set_var_name_remap_in_proc(ConsensusMap), ProcIds,
|
|
ProcTable0, ProcTable),
|
|
pred_info_set_proc_table(ProcTable, !PredInfo)
|
|
)
|
|
).
|
|
|
|
:- pred some_statevar_is_unused_in_clause(clause::in) is semidet.
|
|
|
|
some_statevar_is_unused_in_clause(Clause) :-
|
|
UnusedSVarArgMap = Clause ^ clause_unused_svar_arg_map,
|
|
not map.is_empty(UnusedSVarArgMap).
|
|
|
|
:- pred find_consensus_name(map(prog_var, string)::in, prog_var::in,
|
|
string::out) is det.
|
|
|
|
find_consensus_name(ConsensusMap, Var, ConsensusName) :-
|
|
( if map.search(ConsensusMap, Var, ConsensusNamePrime) then
|
|
ConsensusName = ConsensusNamePrime
|
|
else
|
|
ConsensusName = ""
|
|
).
|
|
|
|
:- pred set_var_name_remap_in_proc(map(prog_var, string)::in, proc_id::in,
|
|
proc_table::in, proc_table::out) is det.
|
|
|
|
set_var_name_remap_in_proc(ConsensusMap, ProcId, !ProcTable) :-
|
|
map.lookup(!.ProcTable, ProcId, ProcInfo0),
|
|
proc_info_set_var_name_remap(ConsensusMap, ProcInfo0, ProcInfo),
|
|
map.det_update(ProcId, ProcInfo, !ProcTable).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred improve_single_clause_headvars(list(hlds_goal)::in,
|
|
proc_arg_vector(prog_var)::in, list(prog_var)::in,
|
|
prog_varset::in, prog_varset::out,
|
|
map(prog_var, prog_var)::in, map(prog_var, prog_var)::out,
|
|
list(hlds_goal)::in, list(hlds_goal)::out) is det.
|
|
|
|
improve_single_clause_headvars([], _, _, !VarSet, !Subst, !RevConj).
|
|
improve_single_clause_headvars([Goal | Conj0], HeadVars, SeenVars0,
|
|
!VarSet, !Subst, !RevConj) :-
|
|
( if
|
|
goal_is_headvar_unification(HeadVars, Goal, HeadVar, yes(OtherVar))
|
|
then
|
|
% If the headvar doesn't appear elsewhere the unification
|
|
% can be removed.
|
|
( if
|
|
% The headvars must be distinct variables, so check that this
|
|
% variable doesn't already appear in the argument list.
|
|
not proc_arg_vector_member(HeadVars, OtherVar),
|
|
not list.member(OtherVar, SeenVars0),
|
|
|
|
not (
|
|
some [OtherGoal] (
|
|
( list.member(OtherGoal, Conj0)
|
|
; list.member(OtherGoal, !.RevConj)
|
|
),
|
|
OtherGoal = hlds_goal(_, OtherGoalInfo),
|
|
OtherNonLocals = goal_info_get_nonlocals(OtherGoalInfo),
|
|
set_of_var.member(OtherNonLocals, HeadVar)
|
|
)
|
|
)
|
|
then
|
|
SeenVars = [OtherVar | SeenVars0],
|
|
map.det_insert(HeadVar, OtherVar, !Subst),
|
|
|
|
% If the variable wasn't named, use the `HeadVar__n' name.
|
|
( if
|
|
not varset.search_name(!.VarSet, OtherVar, _),
|
|
varset.search_name(!.VarSet, HeadVar, HeadVarName)
|
|
then
|
|
varset.name_var(OtherVar, HeadVarName, !VarSet)
|
|
else
|
|
true
|
|
)
|
|
else
|
|
!:RevConj = [Goal | !.RevConj],
|
|
SeenVars = SeenVars0,
|
|
( if varset.search_name(!.VarSet, OtherVar, OtherVarName) then
|
|
% The unification can't be eliminated,
|
|
% so just rename the head variable.
|
|
varset.name_var(HeadVar, OtherVarName, !VarSet)
|
|
else if varset.search_name(!.VarSet, HeadVar, HeadVarName) then
|
|
% If the variable wasn't named, use the `HeadVar__n' name.
|
|
varset.name_var(OtherVar, HeadVarName, !VarSet)
|
|
else
|
|
true
|
|
)
|
|
)
|
|
else
|
|
!:RevConj = [Goal | !.RevConj],
|
|
SeenVars = SeenVars0
|
|
),
|
|
improve_single_clause_headvars(Conj0, HeadVars, SeenVars, !VarSet,
|
|
!Subst, !RevConj).
|
|
|
|
:- type var_name_info_map == map(prog_var, var_name_info).
|
|
:- type var_name_info
|
|
---> var_name_info(
|
|
% Is the head variable unified with a functor?
|
|
vni_unified_with_functor :: bool,
|
|
|
|
% What are the names of the named variables it is unified with?
|
|
vni_unified_with_vars :: set(string)
|
|
).
|
|
|
|
% Head variables that have the same name in each clause
|
|
% will have an entry of `yes(Name)' in the result map.
|
|
%
|
|
:- pred find_headvar_names_in_clause(prog_varset::in,
|
|
proc_arg_vector(prog_var)::in, clause::in,
|
|
var_name_info_map::out, set(prog_var)::out) is det.
|
|
|
|
find_headvar_names_in_clause(VarSet, HeadVars, Clause, VarNameInfoMap,
|
|
VarsInMap) :-
|
|
Goal = Clause ^ clause_body,
|
|
goal_to_conj_list(Goal, Conj),
|
|
list.foldl2(find_headvar_names_in_goal(VarSet, HeadVars), Conj,
|
|
map.init, VarNameInfoMap, set.init, VarsInMap).
|
|
|
|
:- pred find_headvar_names_in_goal(prog_varset::in,
|
|
proc_arg_vector(prog_var)::in, hlds_goal::in,
|
|
var_name_info_map::in, var_name_info_map::out,
|
|
set(prog_var)::in, set(prog_var)::out) is det.
|
|
|
|
find_headvar_names_in_goal(VarSet, HeadVars, Goal, !VarNameInfoMap,
|
|
!VarsInMap) :-
|
|
( if
|
|
goal_is_headvar_unification(HeadVars, Goal, HeadVar, MaybeOtherVar)
|
|
then
|
|
set.insert(HeadVar, !VarsInMap),
|
|
(
|
|
MaybeOtherVar = no,
|
|
( if map.search(!.VarNameInfoMap, HeadVar, VarNameInfo0) then
|
|
VarNameInfo0 = var_name_info(_UnifiedFunctor, VarNames),
|
|
VarNameInfo = var_name_info(yes, VarNames),
|
|
map.det_update(HeadVar, VarNameInfo, !VarNameInfoMap)
|
|
else
|
|
VarNameInfo = var_name_info(yes, set.init),
|
|
map.det_insert(HeadVar, VarNameInfo, !VarNameInfoMap)
|
|
)
|
|
;
|
|
MaybeOtherVar = yes(OtherVar),
|
|
( if varset.search_name(VarSet, OtherVar, OtherVarName) then
|
|
( if map.search(!.VarNameInfoMap, HeadVar, VarNameInfo0) then
|
|
VarNameInfo0 = var_name_info(UnifiedFunctor, VarNames0),
|
|
set.insert(OtherVarName, VarNames0, VarNames),
|
|
VarNameInfo = var_name_info(UnifiedFunctor, VarNames),
|
|
map.det_update(HeadVar, VarNameInfo, !VarNameInfoMap)
|
|
else
|
|
VarNames = set.make_singleton_set(OtherVarName),
|
|
VarNameInfo = var_name_info(no, VarNames),
|
|
map.det_insert(HeadVar, VarNameInfo, !VarNameInfoMap)
|
|
)
|
|
else
|
|
true
|
|
)
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred goal_is_headvar_unification(proc_arg_vector(prog_var)::in,
|
|
hlds_goal::in, prog_var::out, maybe(prog_var)::out) is semidet.
|
|
|
|
goal_is_headvar_unification(HeadVars, Goal, HeadVar, MaybeOtherVar) :-
|
|
Goal = hlds_goal(GoalExpr, _),
|
|
GoalExpr = unify(LVar, RHS, _, _, _),
|
|
(
|
|
RHS = rhs_var(RVar),
|
|
( if proc_arg_vector_member(HeadVars, LVar) then
|
|
HeadVar = LVar,
|
|
MaybeOtherVar = yes(RVar)
|
|
else if proc_arg_vector_member(HeadVars, RVar) then
|
|
HeadVar = RVar,
|
|
MaybeOtherVar = yes(LVar)
|
|
else
|
|
fail
|
|
)
|
|
;
|
|
RHS = rhs_functor(_, _, _),
|
|
( if proc_arg_vector_member(HeadVars, LVar) then
|
|
HeadVar = LVar,
|
|
MaybeOtherVar = no
|
|
else
|
|
fail
|
|
)
|
|
).
|
|
|
|
:- func find_consensus_headvar_names(list(set(prog_var)),
|
|
list(var_name_info_map)) = map(prog_var, string).
|
|
|
|
find_consensus_headvar_names(VarsInMapSets, VarNameInfoMaps) = ConsensusMap :-
|
|
VarsInMapSet = set.union_list(VarsInMapSets),
|
|
set.to_sorted_list(VarsInMapSet, VarsInMaps),
|
|
list.foldl(update_consensus_map_for_headvar(VarNameInfoMaps), VarsInMaps,
|
|
map.init, ConsensusMap).
|
|
|
|
:- pred update_consensus_map_for_headvar(list(var_name_info_map)::in,
|
|
prog_var::in,
|
|
map(prog_var, string)::in, map(prog_var, string)::out) is det.
|
|
|
|
update_consensus_map_for_headvar(VarNameInfos, HeadVar, !ConsensusMap) :-
|
|
MaybeName = find_consensus_name_for_headvar(VarNameInfos, HeadVar),
|
|
(
|
|
MaybeName = no
|
|
;
|
|
MaybeName = yes(Name),
|
|
map.det_insert(HeadVar, Name, !ConsensusMap)
|
|
).
|
|
|
|
:- func find_consensus_name_for_headvar(list(var_name_info_map), prog_var)
|
|
= maybe(string).
|
|
|
|
find_consensus_name_for_headvar(VarNameInfoMaps, HeadVar)
|
|
= MaybeConsensusName :-
|
|
group_var_infos(VarNameInfoMaps, HeadVar,
|
|
[], Inconsistents, [], Consistents, [], FunctorOnlys),
|
|
(
|
|
Inconsistents = [_ | _],
|
|
% Some clauses give two or more different names to HeadVar.
|
|
% If even a single clause cannot agree what HeadVar's name should be,
|
|
% the procedure as a whole cannot agree either.
|
|
MaybeConsensusName = no
|
|
;
|
|
Inconsistents = [],
|
|
(
|
|
Consistents = [],
|
|
% There is no name we *can* give.
|
|
MaybeConsensusName = no
|
|
;
|
|
Consistents = [_ | _],
|
|
(
|
|
FunctorOnlys = [],
|
|
list.sort_and_remove_dups(Consistents, SortedConsistents),
|
|
( if SortedConsistents = [ConsensusName] then
|
|
MaybeConsensusName = yes(ConsensusName)
|
|
else
|
|
MaybeConsensusName = no
|
|
)
|
|
;
|
|
FunctorOnlys = [_ | _],
|
|
% There is no consensus as to whether the variable *should*
|
|
% have a name. Given a predicate definition like this:
|
|
%
|
|
% p(A, _) :- ...
|
|
% p([_ | _], _) :- ...
|
|
%
|
|
% referring to the first head variable in the second clause
|
|
% by the name "A" would be confusing.
|
|
MaybeConsensusName = no
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred group_var_infos(list(var_name_info_map)::in, prog_var::in,
|
|
list(var_name_info)::in, list(var_name_info)::out,
|
|
list(string)::in, list(string)::out,
|
|
list(var_name_info)::in, list(var_name_info)::out) is det.
|
|
|
|
group_var_infos([], _, !Inconsistents, !Consistents, !FunctorOnlys).
|
|
group_var_infos([VarNameInfoMap | VarNameInfoMaps], HeadVar,
|
|
!Inconsistents, !Consistents, !FunctorOnlys) :-
|
|
( if map.search(VarNameInfoMap, HeadVar, VarInfo) then
|
|
VarInfo = var_name_info(UnifiedFunctor, VarNameSet),
|
|
set.count(VarNameSet, NameCount),
|
|
( if NameCount = 0 then
|
|
(
|
|
UnifiedFunctor = yes,
|
|
!:FunctorOnlys = [VarInfo | !.FunctorOnlys]
|
|
;
|
|
UnifiedFunctor = no
|
|
% The variable was unified only with anonymous variables.
|
|
)
|
|
else if NameCount = 1 then
|
|
% If the clause gave the variable a name, we don't care that
|
|
% it also unified the variable with a functor.
|
|
set.to_sorted_list(VarNameSet, VarNameList),
|
|
( if VarNameList = [VarName] then
|
|
!:Consistents = [VarName | !.Consistents]
|
|
else
|
|
unexpected($pred, "bad singleton set")
|
|
)
|
|
else
|
|
% NameCount > 1, so this *single clause* calls HeadVar
|
|
% by more than one name.
|
|
!:Inconsistents = [VarInfo | !.Inconsistents]
|
|
)
|
|
else
|
|
true
|
|
),
|
|
group_var_infos(VarNameInfoMaps, HeadVar,
|
|
!Inconsistents, !Consistents, !FunctorOnlys).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.headvar_names.
|
|
%-----------------------------------------------------------------------------%
|