Files
mercury/compiler/ctgc.util.m
Zoltan Somogyi 22c831ffe7 Convert the ctgc modules to use var_tables.
compiler/ctgc.datastruct.m:
compiler/ctgc.livedata.m:
compiler/ctgc.util.m:
compiler/structure_reuse.analysis.m:
compiler/structure_reuse.direct.choose_reuse.m:
compiler/structure_reuse.direct.detect_garbage.m:
compiler/structure_reuse.domain.m:
compiler/structure_reuse.indirect.m:
compiler/structure_reuse.lbu.m:
compiler/structure_reuse.lfu.m:
compiler/structure_sharing.analysis.m:
compiler/structure_sharing.domain.m:
    Convert these modules to use var_tables.

    In cases where predicates took a proc_info argument that they used
    only to get access to type information, replace that argument
    with a var_table.

    In cases where predicates took a proc_info argument that they used
    both to get access to type information and for some other purpose,
    and their parent had the var_table already available, add the
    var_table as an additional argument.

compiler/type_util.m:
    Add var_table versions of some utility predicates for use
    by the modules above.

compiler/type_util.m:
2022-05-01 08:38:17 +10:00

213 lines
8.1 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_module.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.var_table.
:- import_module list.
:- import_module set.
%---------------------------------------------------------------------------%
% 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, prog_vars) =
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 check_hlds.
:- import_module check_hlds.type_util.
:- import_module hlds.status.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_subst.
:- import_module bool.
:- import_module map.
%---------------------------------------------------------------------------%
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_variable_renaming_to_type_list(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_variable_renaming_to_tvar(RevSubst, K0, K),
apply_variable_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.
%---------------------------------------------------------------------------%