mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
compiler/prog_type_subst.m:
compiler/type_util.m:
Apply s/apply_variable_renaming_to_/apply_renaming_to_/ and
s/_to_x_list/_to_xs/ to the names of predicate.
Conform to the change in hlds_class.m below.
compiler/hlds_class.m:
This module used to define types named (a) hlds_constraint, and
(b) hlds_constraints, and the latter was NOT a list of items
of type hlds_constraint. Rename the latter to hlds_constraint_db
to free up the name apply_renaming_to_constraints to apply
to list(hlds_constraint). However, the rename also makes code
operating on hlds_constraint_dbs easier to understand. Before
this diff, several modules used variables named Constraints
to refer to a list(hlds_constraint) in some places and to
what is now a hlds_constraint_db in other places, which is confusing;
the latter are now named ConstraintDb.
compiler/type_assign.m:
Conform to the changes above.
Add an XXX about some existing variable names that *look* right
but turn out to be subtly misleading.
compiler/add_pragma_type_spec.m:
compiler/add_type.m:
compiler/check_typeclass.m:
compiler/comp_unit_interface.m:
compiler/cse_detection.m:
compiler/ctgc.util.m:
compiler/decide_type_repn.m:
compiler/deforest.m:
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/higher_order.higher_order_global_info.m:
compiler/higher_order.make_specialized_preds.m:
compiler/higher_order.specialize_calls.m:
compiler/hlds_rtti.m:
compiler/inlining.m:
compiler/modecheck_coerce.m:
compiler/old_type_constraints.m:
compiler/polymorphism_clause.m:
compiler/polymorphism_goal.m:
compiler/polymorphism_type_class_info.m:
compiler/prog_type_unify.m:
compiler/qual_info.m:
compiler/recompilation.version.m:
compiler/resolve_unify_functor.m:
compiler/typecheck.m:
compiler/typecheck_clauses.m:
compiler/typecheck_cons_infos.m:
compiler/typecheck_debug.m:
compiler/typecheck_error_type_assign.m:
compiler/typecheck_errors.m:
compiler/typecheck_unify_var_functor.m:
compiler/typecheck_util.m:
compiler/typeclasses.m:
compiler/unify_proc.m:
compiler/var_table.m:
compiler/vartypes.m:
Conform to the changes above.
335 lines
12 KiB
Mathematica
335 lines
12 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2006-2008, 2010-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: ctgc.util.m.
|
|
% Main author: nancy.
|
|
%
|
|
% Utility operations for the CTGC-system.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.ctgc.util.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_table.
|
|
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module set.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func goal_info_get_maybe_lfu(hlds_goal_info) = maybe(set_of_progvar).
|
|
:- func goal_info_get_maybe_lbu(hlds_goal_info) = maybe(set_of_progvar).
|
|
:- func goal_info_get_maybe_reuse(hlds_goal_info) = maybe(reuse_description).
|
|
|
|
% The following functions produce an 'unexpected' error when the
|
|
% requested values have not been set.
|
|
%
|
|
:- func goal_info_get_lfu(hlds_goal_info) = set_of_progvar.
|
|
:- func goal_info_get_lbu(hlds_goal_info) = set_of_progvar.
|
|
:- func goal_info_get_reuse(hlds_goal_info) = reuse_description.
|
|
|
|
:- pred goal_info_set_lfu(set_of_progvar::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
:- pred goal_info_set_lbu(set_of_progvar::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
:- pred goal_info_set_reuse(reuse_description::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Check if some of the predicates are "special" predicates (as in
|
|
% "special_pred_map" known from module_info) or not defined in the
|
|
% current module, as these predicates are not analysed by the CTGC system.
|
|
%
|
|
:- pred some_preds_require_no_analysis(module_info::in,
|
|
set(pred_proc_id)::in) is semidet.
|
|
|
|
:- pred pred_requires_no_analysis(module_info::in, pred_id::in) is semidet.
|
|
:- pred pred_requires_analysis(module_info::in, pred_id::in) is semidet.
|
|
|
|
% Given the pred_proc_id of a procedure call and its actual arguments,
|
|
% determine the variable renaming to rename anything which is defined
|
|
% in terms of the formal arguments of the called procedure to the context
|
|
% of the actual arguments.
|
|
%
|
|
:- func get_variable_renaming(module_info, pred_proc_id, list(prog_var)) =
|
|
prog_var_renaming.
|
|
|
|
% get_type_substitution(ModuleInfo, PPId, ActualTypes,
|
|
% CallerTypeVarSet, CallerExternalTypeParams) = TypeSubst
|
|
%
|
|
% Work out a type substitution to map the callee's argument types into the
|
|
% caller's.
|
|
%
|
|
:- func get_type_substitution(module_info, pred_proc_id, list(mer_type),
|
|
tvarset, external_type_params) = tsubst.
|
|
|
|
% var_needs_sharing_analysis(ModuleInfo, VarTable, Var).
|
|
%
|
|
% Succeed iff Var is of a type for which we need to consider structure
|
|
% sharing.
|
|
%
|
|
:- pred var_needs_sharing_analysis(module_info::in, var_table::in,
|
|
prog_var::in) is semidet.
|
|
|
|
% Succeed iff the type is one for which we need to consider structure
|
|
% sharing.
|
|
%
|
|
:- pred type_needs_sharing_analysis(module_info::in, mer_type::in) is semidet.
|
|
|
|
% Succeed iff values of the given type may have a top-level cell
|
|
% that could be reused.
|
|
%
|
|
:- pred top_cell_may_be_reusable(module_info::in, mer_type::in) is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.status.
|
|
:- import_module hlds.type_util.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_type_subst.
|
|
:- import_module parse_tree.prog_type_unify.
|
|
|
|
:- import_module bool.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
goal_info_get_maybe_lfu(GoalInfo) = MaybeLFU :-
|
|
MaybeCTGC = goal_info_get_maybe_ctgc(GoalInfo),
|
|
(
|
|
MaybeCTGC = yes(CTGC),
|
|
MaybeLFU = yes(CTGC ^ ctgc_lfu)
|
|
;
|
|
MaybeCTGC = no,
|
|
MaybeLFU = no
|
|
).
|
|
|
|
goal_info_get_maybe_lbu(GoalInfo) = MaybeLBU :-
|
|
MaybeCTGC = goal_info_get_maybe_ctgc(GoalInfo),
|
|
(
|
|
MaybeCTGC = yes(CTGC),
|
|
MaybeLBU = yes(CTGC ^ ctgc_lbu)
|
|
;
|
|
MaybeCTGC = no,
|
|
MaybeLBU = no
|
|
).
|
|
|
|
goal_info_get_maybe_reuse(GoalInfo) = MaybeReuse :-
|
|
MaybeCTGC = goal_info_get_maybe_ctgc(GoalInfo),
|
|
(
|
|
MaybeCTGC = yes(CTGC),
|
|
MaybeReuse = yes(CTGC ^ ctgc_reuse)
|
|
;
|
|
MaybeCTGC = no,
|
|
MaybeReuse = no
|
|
).
|
|
|
|
goal_info_get_lfu(GoalInfo) = LFU :-
|
|
MaybeLFU = goal_info_get_maybe_lfu(GoalInfo),
|
|
(
|
|
MaybeLFU = yes(LFU)
|
|
;
|
|
MaybeLFU = no,
|
|
unexpected($pred,
|
|
"Requesting LFU information while CTGC field not set.")
|
|
).
|
|
|
|
goal_info_get_lbu(GoalInfo) = LBU :-
|
|
MaybeLBU = goal_info_get_maybe_lbu(GoalInfo),
|
|
(
|
|
MaybeLBU = yes(LBU)
|
|
;
|
|
MaybeLBU = no,
|
|
unexpected($pred,
|
|
"Requesting LBU information while CTGC field not set.")
|
|
).
|
|
|
|
goal_info_get_reuse(GoalInfo) = Reuse :-
|
|
MaybeReuse = goal_info_get_maybe_reuse(GoalInfo),
|
|
(
|
|
MaybeReuse = yes(Reuse)
|
|
;
|
|
MaybeReuse = no,
|
|
unexpected($pred,
|
|
"Requesting reuse information while CTGC field not set.")
|
|
).
|
|
|
|
goal_info_set_lfu(LFU, !GoalInfo) :-
|
|
MaybeCTGC0 = goal_info_get_maybe_ctgc(!.GoalInfo),
|
|
(
|
|
MaybeCTGC0 = yes(CTGC0)
|
|
;
|
|
MaybeCTGC0 = no,
|
|
CTGC0 = ctgc_goal_info_init
|
|
),
|
|
CTGC = CTGC0 ^ ctgc_lfu := LFU,
|
|
MaybeCTGC = yes(CTGC),
|
|
goal_info_set_maybe_ctgc(MaybeCTGC, !GoalInfo).
|
|
|
|
goal_info_set_lbu(LBU, !GoalInfo) :-
|
|
MaybeCTGC0 = goal_info_get_maybe_ctgc(!.GoalInfo),
|
|
(
|
|
MaybeCTGC0 = yes(CTGC0)
|
|
;
|
|
MaybeCTGC0 = no,
|
|
CTGC0 = ctgc_goal_info_init
|
|
),
|
|
CTGC = CTGC0 ^ ctgc_lbu := LBU,
|
|
MaybeCTGC = yes(CTGC),
|
|
goal_info_set_maybe_ctgc(MaybeCTGC, !GoalInfo).
|
|
|
|
goal_info_set_reuse(Reuse, !GoalInfo) :-
|
|
MaybeCTGC0 = goal_info_get_maybe_ctgc(!.GoalInfo),
|
|
(
|
|
MaybeCTGC0 = yes(CTGC0)
|
|
;
|
|
MaybeCTGC0 = no,
|
|
CTGC0 = ctgc_goal_info_init
|
|
),
|
|
CTGC = CTGC0 ^ ctgc_reuse := Reuse,
|
|
MaybeCTGC = yes(CTGC),
|
|
goal_info_set_maybe_ctgc(MaybeCTGC, !GoalInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
some_preds_require_no_analysis(ModuleInfo, PPIds) :-
|
|
set.member(proc(PredId, _), PPIds),
|
|
pred_requires_no_analysis(ModuleInfo, PredId).
|
|
|
|
pred_requires_no_analysis(ModuleInfo, PredId) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_status(PredInfo, PredStatus),
|
|
% We handle `:- pragma external_{pred/func}' predicates and functions
|
|
% later. In that sense, they do *not* require that we don't analyse them.
|
|
PredStatus = pred_status(status_imported(_)).
|
|
|
|
pred_requires_analysis(ModuleInfo, PredId) :-
|
|
not pred_requires_no_analysis(ModuleInfo, PredId).
|
|
|
|
get_variable_renaming(ModuleInfo, PPId, ActualArgs) = VariableRenaming :-
|
|
module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo, ProcInfo),
|
|
proc_info_get_headvars(ProcInfo, FormalVars),
|
|
map.from_corresponding_lists(FormalVars, ActualArgs, VariableRenaming).
|
|
|
|
get_type_substitution(ModuleInfo, PPId, CallerArgTypes, CallerTypeVarSet,
|
|
CallerExternalTypeParams) = TypeSubn :-
|
|
PPId = proc(PredId, _),
|
|
module_info_pred_info(ModuleInfo, PredId, CalleePredInfo),
|
|
pred_info_get_typevarset(CalleePredInfo, CalleeTypeVarSet),
|
|
pred_info_get_arg_types(CalleePredInfo, CalleeArgTypes0),
|
|
pred_info_get_exist_quant_tvars(CalleePredInfo, CalleeExistQVars),
|
|
|
|
% Rename apart the type variables. We don't care about the merged
|
|
% typevarset.
|
|
tvarset_merge_renaming(CallerTypeVarSet, CalleeTypeVarSet, _TypeVarSet,
|
|
CalleeTypeVarRenaming),
|
|
apply_renaming_to_types(CalleeTypeVarRenaming,
|
|
CalleeArgTypes0, CalleeArgTypes),
|
|
|
|
compute_caller_callee_type_substitution(CalleeArgTypes, CallerArgTypes,
|
|
CallerExternalTypeParams, CalleeExistQVars, TypeSubn1),
|
|
|
|
% TypeSubn1 is a substitition for the merged typevarset. We apply the
|
|
% reverse of CalleeTypeVarRenaming to get TypeSubn, a substitition for
|
|
% the callee typevarset.
|
|
% XXX preferably, we wouldn't need to do this reverse renaming
|
|
map.keys(CalleeTypeVarRenaming, CalleeTypeVarRenamingKeys),
|
|
map.values(CalleeTypeVarRenaming, CalleeTypeVarRenamingValues),
|
|
map.from_corresponding_lists(CalleeTypeVarRenamingValues,
|
|
CalleeTypeVarRenamingKeys, RevCalleeTypeVarRenaming),
|
|
map.foldl(reverse_renaming(RevCalleeTypeVarRenaming), TypeSubn1,
|
|
map.init, TypeSubn).
|
|
|
|
:- pred reverse_renaming(tvar_renaming::in, tvar::in, mer_type::in,
|
|
tsubst::in, tsubst::out) is det.
|
|
|
|
reverse_renaming(RevSubst, K0, V0, !Acc) :-
|
|
apply_renaming_to_tvar(RevSubst, K0, K),
|
|
apply_renaming_to_type(RevSubst, V0, V),
|
|
map.det_insert(K, V, !Acc).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
var_needs_sharing_analysis(ModuleInfo, VarTable, Var) :-
|
|
lookup_var_type(VarTable, Var, Type),
|
|
type_needs_sharing_analysis(ModuleInfo, Type).
|
|
|
|
type_needs_sharing_analysis(ModuleInfo, Type) :-
|
|
TypeCat = classify_type(ModuleInfo, Type),
|
|
type_category_needs_sharing_analysis(TypeCat) = yes.
|
|
|
|
:- func type_category_needs_sharing_analysis(type_ctor_category) = bool.
|
|
|
|
type_category_needs_sharing_analysis(CtorCat) = NeedsSharingAnalysis :-
|
|
(
|
|
( CtorCat = ctor_cat_builtin(_)
|
|
; CtorCat = ctor_cat_higher_order
|
|
; CtorCat = ctor_cat_enum(_)
|
|
; CtorCat = ctor_cat_builtin_dummy
|
|
; CtorCat = ctor_cat_void
|
|
; CtorCat = ctor_cat_system(_)
|
|
; CtorCat = ctor_cat_user(cat_user_direct_dummy)
|
|
; CtorCat = ctor_cat_user(cat_user_abstract_dummy)
|
|
),
|
|
NeedsSharingAnalysis = no
|
|
;
|
|
( CtorCat = ctor_cat_variable
|
|
; CtorCat = ctor_cat_tuple
|
|
; CtorCat = ctor_cat_user(cat_user_notag)
|
|
; CtorCat = ctor_cat_user(cat_user_abstract_notag)
|
|
; CtorCat = ctor_cat_user(cat_user_general)
|
|
),
|
|
NeedsSharingAnalysis = yes
|
|
).
|
|
|
|
top_cell_may_be_reusable(ModuleInfo, Type) :-
|
|
TypeCat = classify_type(ModuleInfo, Type),
|
|
type_category_top_cell_may_be_reusable(TypeCat) = yes.
|
|
|
|
:- func type_category_top_cell_may_be_reusable(type_ctor_category) = bool.
|
|
|
|
type_category_top_cell_may_be_reusable(CtorCat) = Reusable :-
|
|
(
|
|
( CtorCat = ctor_cat_builtin(_)
|
|
; CtorCat = ctor_cat_higher_order
|
|
; CtorCat = ctor_cat_enum(_)
|
|
; CtorCat = ctor_cat_builtin_dummy
|
|
; CtorCat = ctor_cat_variable
|
|
; CtorCat = ctor_cat_void
|
|
; CtorCat = ctor_cat_system(_)
|
|
; CtorCat = ctor_cat_user(cat_user_direct_dummy)
|
|
; CtorCat = ctor_cat_user(cat_user_abstract_dummy)
|
|
; CtorCat = ctor_cat_user(cat_user_notag)
|
|
; CtorCat = ctor_cat_user(cat_user_abstract_notag)
|
|
),
|
|
Reusable = no
|
|
;
|
|
( CtorCat = ctor_cat_tuple
|
|
; CtorCat = ctor_cat_user(cat_user_general)
|
|
),
|
|
Reusable = yes
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.ctgc.util.
|
|
%---------------------------------------------------------------------------%
|