mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-23 05:13:48 +00:00
625ec287f1
compiler/prog_type_construct.m:
New module for constructing types.
compiler/prog_type_repn.m:
New module for testing things related to type representation.
compiler/prog_type_scan.m:
New module for gather type vars in types.
compiler/prog_type_test.m:
New module containing simple tests on types.
compiler/prog_type_unify.m:
New module for testing whether two types unify, or whether
one type subsumes another.
compiler/prog_type.m:
Delete the code moved to the new modules.
compiler/parse_tree.m:
Include the new modules.
compiler/notes/compiler_design.html:
Document the new modules.
compiler/*.m:
Conform to the changes above, by adjusting imports as needed,
and by deleting any explicit module qualifications that
this diff makes obsolete.
336 lines
12 KiB
Mathematica
336 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, 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 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_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.
|
|
%---------------------------------------------------------------------------%
|