mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
d76c7bf617
This step significantly improves module cohesion.
compiler/inst_abstract_unify.m:
New module carved out of inst_util.m, which does abstract unifications
on insts.
compiler/inst_merge.m:
New module carved out of inst_util.m, which merges insts.
compiler/inst_lookup.m:
New module carved partly out of inst_util.m and partly out of mode_util.m,
which looks up insts in the module_info, and then possibly expands out
the result.
compiler/mode_test.m:
New module carved out of mode_util.m, whose predicates
perform tests on modes.
compiler/mode_top_functor.m:
New module carved out of mode_util.m, which computes top_functor_modes
from modes.
compiler/inst_mode_type_prop.m:
New module carved out of mode_util.m, which propagates type information
into both insts and modes.
compiler/recompute_instmap_deltas.m:
New module carved out of mode_util.m, which recomputes goals'
instmap_deltas.
compiler/inst_test.m:
Move here the predicates in inst_util.m that perform tests on insts.
compiler/inst_util.m:
compiler/mode_util.m:
Delete the code that this diff moves to other modules.
compiler/check_hlds.m:
Add the new modules to the check_hlds package, the package that also
contains inst_util.m and mode_util.m. (Some of these modules could
be argued to fit better in the hlds package, but moving them there
would not be desirable while they depend on code that is still in the
check_hlds package.)
compiler/notes/compiler_design.html:
Document the new modules.
compiler/add_pragma_tabling.m:
compiler/arg_info.m:
compiler/bytecode_gen.m:
compiler/closure_analysis.m:
compiler/complexity.m:
compiler/deep_profiling.m:
compiler/deforest.m:
compiler/dep_par_conj.m:
compiler/det_report.m:
compiler/direct_arg_in_out.m:
compiler/distance_granularity.m:
compiler/equiv_type_hlds.m:
compiler/error_msg_inst.m:
compiler/fact_table.m:
compiler/float_regs.m:
compiler/follow_code.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_pred.m:
compiler/hlds_rtti.m:
compiler/inlining.m:
compiler/inst_match.m:
compiler/inst_user.m:
compiler/instmap.m:
compiler/intermod.m:
compiler/interval.m:
compiler/introduce_exists_casts.m:
compiler/lambda.m:
compiler/lco.m:
compiler/liveness.m:
compiler/lookup_util.m:
compiler/loop_inv.m:
compiler/mark_tail_calls.m:
compiler/ml_args_util.m:
compiler/ml_code_util.m:
compiler/ml_foreign_proc_gen.m:
compiler/ml_unify_gen_construct.m:
compiler/ml_unify_gen_util.m:
compiler/mode_constraints.m:
compiler/mode_errors.m:
compiler/modecheck_call.m:
compiler/modecheck_coerce.m:
compiler/modecheck_goal.m:
compiler/modecheck_unify.m:
compiler/modecheck_util.m:
compiler/modes.m:
compiler/oisu_check.m:
compiler/par_conj_gen.m:
compiler/pd_util.m:
compiler/post_typecheck.m:
compiler/pragma_c_gen.m:
compiler/proc_requests.m:
compiler/prog_rep.m:
compiler/push_goals_together.m:
compiler/rbmm.region_transformation.m:
compiler/saved_vars.m:
compiler/simplify_goal_switch.m:
compiler/simplify_proc.m:
compiler/size_prof.m:
compiler/ssdebug.m:
compiler/stack_opt.m:
compiler/stm_expand.m:
compiler/stratify.m:
compiler/structure_reuse.versions.m:
compiler/structure_sharing.domain.m:
compiler/superhomogeneous.m:
compiler/table_gen.m:
compiler/term_constr_build.m:
compiler/term_pass2.m:
compiler/term_util.m:
compiler/tupling.m:
compiler/unify_gen_construct.m:
compiler/unify_gen_util.m:
compiler/unique_modes.m:
compiler/unneeded_code.m:
compiler/untupling.m:
compiler/unused_args.m:
Conform to the changes above by importing the required new modules,
sometimes in addition to inst_util.m or mode_util.m, but more usually
instead of them.
346 lines
13 KiB
Mathematica
346 lines
13 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-2012 The University of Melbourne.
|
|
% Copyright (C) 2015 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: mode_util.m.
|
|
% Main author: fjh.
|
|
%
|
|
% This module contains utility predicates for dealing with modes.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.mode_util.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Breaking down modes into their initial and final insts.
|
|
%
|
|
|
|
:- func from_to_insts_to_init_inst(from_to_insts) = mer_inst.
|
|
:- func from_to_insts_to_final_inst(from_to_insts) = mer_inst.
|
|
|
|
%---------------------%
|
|
|
|
% Return the initial and final instantiatedness for the given mode.
|
|
% Fail if the mode is undefined.
|
|
%
|
|
:- pred mode_get_insts_semidet(module_info::in, mer_mode::in,
|
|
mer_inst::out, mer_inst::out) is semidet.
|
|
|
|
% Return the initial and final instantiatedness for the given mode.
|
|
% Throw an exception if the mode is undefined.
|
|
%
|
|
:- pred mode_get_insts(module_info::in, mer_mode::in,
|
|
mer_inst::out, mer_inst::out) is det.
|
|
:- pred mode_get_from_to_insts(module_info::in, mer_mode::in,
|
|
from_to_insts::out) is det.
|
|
|
|
%---------------------%
|
|
|
|
% Return the initial or final instantiatedness for the given mode.
|
|
% Throw an exception if the mode is undefined.
|
|
%
|
|
:- func mode_get_initial_inst(module_info, mer_mode) = mer_inst.
|
|
:- func mode_get_final_inst(module_info, mer_mode) = mer_inst.
|
|
|
|
% Return the initial or final instantiatedness for each of
|
|
% the given modes.
|
|
% Throw an exception if any mode is undefined.
|
|
%
|
|
:- pred mode_list_get_initial_insts(module_info::in,
|
|
list(mer_mode)::in, list(mer_inst)::out) is det.
|
|
:- pred mode_list_get_final_insts(module_info::in,
|
|
list(mer_mode)::in, list(mer_inst)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Converting between from_to_insts and modes.
|
|
%
|
|
|
|
:- func from_to_insts_to_mode(from_to_insts) = mer_mode.
|
|
:- func mode_to_from_to_insts(module_info, mer_mode) = from_to_insts.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Converting between unify_modes and from_to_insts/modes.
|
|
%
|
|
|
|
:- pred unify_mode_to_lhs_rhs_from_to_insts(unify_mode::in,
|
|
from_to_insts::out, from_to_insts::out) is det.
|
|
|
|
% Return the modes of the operands on the given side of the unifications.
|
|
%
|
|
:- func unify_mode_to_lhs_mode(unify_mode) = mer_mode.
|
|
:- func unify_mode_to_rhs_mode(unify_mode) = mer_mode.
|
|
:- func unify_mode_to_lhs_from_to_insts(unify_mode) = from_to_insts.
|
|
:- func unify_mode_to_rhs_from_to_insts(unify_mode) = from_to_insts.
|
|
|
|
% Given the modes of the two sides of a unification, return the unify_mode.
|
|
%
|
|
:- pred modes_to_unify_mode(module_info::in,
|
|
mer_mode::in, mer_mode::in, unify_mode::out) is det.
|
|
:- pred from_to_insts_to_unify_mode(from_to_insts::in, from_to_insts::in,
|
|
unify_mode::out) is det.
|
|
|
|
% Given two lists of modes (of equal length), with each pair
|
|
% giving the modes of the two sides of a unification,
|
|
% return a unify_mode for each corresponding pair of modes.
|
|
%
|
|
:- pred modes_to_unify_modes(module_info::in,
|
|
list(mer_mode)::in, list(mer_mode)::in, list(unify_mode)::out) is det.
|
|
:- pred from_to_insts_to_unify_modes(
|
|
list(from_to_insts)::in, list(from_to_insts)::in, list(unify_mode)::out)
|
|
is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Figure out which arguments are live in callers.
|
|
%
|
|
|
|
% Given the mode of a predicate, work out which arguments are live
|
|
% (might be used again by the caller of that predicate) and which are dead.
|
|
%
|
|
:- pred get_arg_lives(module_info::in, list(mer_mode)::in, list(is_live)::out)
|
|
is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Constructing bound_insts.
|
|
%
|
|
|
|
% Convert a list of constructors to a list of bound_insts where the
|
|
% arguments are `ground'.
|
|
%
|
|
% NOTE: the list(bound_inst) is not sorted and may contain duplicates.
|
|
%
|
|
:- pred constructors_to_bound_insts(module_info::in, uniqueness::in,
|
|
type_ctor::in, list(constructor)::in, list(bound_inst)::out) is det.
|
|
|
|
% Convert a list of constructors to a list of bound_insts where the
|
|
% arguments are `any'.
|
|
%
|
|
% NOTE: the list(bound_inst) is not sorted and may contain duplicates.
|
|
%
|
|
:- pred constructors_to_bound_any_insts(module_info::in, uniqueness::in,
|
|
type_ctor::in, list(constructor)::in, list(bound_inst)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.inst_test.
|
|
:- import_module hlds.hlds_inst_mode.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.builtin_modules.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.prog_mode.
|
|
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
from_to_insts_to_init_inst(FromToInsts) = Init :-
|
|
FromToInsts = from_to_insts(Init, _Final).
|
|
|
|
from_to_insts_to_final_inst(FromToInsts) = Final :-
|
|
FromToInsts = from_to_insts(_Init, Final).
|
|
|
|
%---------------------%
|
|
|
|
mode_get_insts_semidet(ModuleInfo, Mode0, InitialInst, FinalInst) :-
|
|
(
|
|
Mode0 = from_to_mode(InitialInst, FinalInst)
|
|
;
|
|
Mode0 = user_defined_mode(Name, Args),
|
|
list.length(Args, Arity),
|
|
module_info_get_mode_table(ModuleInfo, Modes),
|
|
mode_table_get_mode_defns(Modes, ModeDefns),
|
|
% Try looking up Name as-is. If that fails and Name is unqualified,
|
|
% try looking it up with the builtin qualifier.
|
|
% XXX This is a makeshift fix for a problem that requires more
|
|
% investigation (without this fix the compiler occasionally
|
|
% throws an exception in mode_get_insts/4).
|
|
( if map.search(ModeDefns, mode_ctor(Name, Arity), HLDS_Mode0) then
|
|
HLDS_Mode = HLDS_Mode0
|
|
else
|
|
Name = unqualified(String),
|
|
BuiltinName = qualified(mercury_public_builtin_module, String),
|
|
map.search(ModeDefns, mode_ctor(BuiltinName, Arity), HLDS_Mode)
|
|
),
|
|
HLDS_Mode = hlds_mode_defn(_VarSet, Params, ModeDefn,
|
|
_Context, _Status),
|
|
ModeDefn = hlds_mode_body(Mode1),
|
|
mode_substitute_arg_list(Mode1, Params, Args, Mode),
|
|
mode_get_insts_semidet(ModuleInfo, Mode, InitialInst, FinalInst)
|
|
).
|
|
|
|
mode_get_insts(ModuleInfo, Mode, InitInst, FinalInst) :-
|
|
( if
|
|
mode_get_insts_semidet(ModuleInfo, Mode, InitInstPrime, FinalInstPrime)
|
|
then
|
|
InitInst = InitInstPrime,
|
|
FinalInst = FinalInstPrime
|
|
else
|
|
unexpected($pred, "mode_get_insts_semidet failed")
|
|
).
|
|
|
|
mode_get_from_to_insts(ModuleInfo, Mode, FromToInsts) :-
|
|
mode_get_insts(ModuleInfo, Mode, InitInst, FinalInst),
|
|
FromToInsts = from_to_insts(InitInst, FinalInst).
|
|
|
|
%---------------------%
|
|
|
|
mode_get_initial_inst(ModuleInfo, Mode) = Inst :-
|
|
mode_get_insts(ModuleInfo, Mode, Inst, _).
|
|
|
|
mode_get_final_inst(ModuleInfo, Mode) = Inst :-
|
|
mode_get_insts(ModuleInfo, Mode, _, Inst).
|
|
|
|
mode_list_get_initial_insts(_ModuleInfo, [], []).
|
|
mode_list_get_initial_insts(ModuleInfo, [Mode | Modes], [Inst | Insts]) :-
|
|
mode_get_insts(ModuleInfo, Mode, Inst, _),
|
|
mode_list_get_initial_insts(ModuleInfo, Modes, Insts).
|
|
|
|
mode_list_get_final_insts(_ModuleInfo, [], []).
|
|
mode_list_get_final_insts(ModuleInfo, [Mode | Modes], [Inst | Insts]) :-
|
|
mode_get_insts(ModuleInfo, Mode, _, Inst),
|
|
mode_list_get_final_insts(ModuleInfo, Modes, Insts).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
from_to_insts_to_mode(FromToInsts) = Mode :-
|
|
FromToInsts = from_to_insts(Init, Final),
|
|
Mode = from_to_mode(Init, Final).
|
|
|
|
mode_to_from_to_insts(ModuleInfo, Mode) = FromToInsts :-
|
|
mode_get_insts(ModuleInfo, Mode, Init, Final),
|
|
FromToInsts = from_to_insts(Init, Final).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
unify_mode_to_lhs_rhs_from_to_insts(UnifyMode, LHSInsts, RHSInsts) :-
|
|
LHSInsts = from_to_insts(LHSInitInst, LHSFinalInst),
|
|
RHSInsts = from_to_insts(RHSInitInst, RHSFinalInst),
|
|
UnifyMode = unify_modes_li_lf_ri_rf(LHSInitInst, LHSFinalInst,
|
|
RHSInitInst, RHSFinalInst).
|
|
|
|
unify_mode_to_lhs_mode(UnifyMode) = LHSMode :-
|
|
UnifyMode = unify_modes_li_lf_ri_rf(LHSInitInst, LHSFinalInst, _, _),
|
|
LHSMode = from_to_mode(LHSInitInst, LHSFinalInst).
|
|
|
|
unify_mode_to_rhs_mode(UnifyMode) = RHSMode :-
|
|
UnifyMode = unify_modes_li_lf_ri_rf(_, _, RHSInitInst, RHSFinalInst),
|
|
RHSMode = from_to_mode(RHSInitInst, RHSFinalInst).
|
|
|
|
unify_mode_to_lhs_from_to_insts(UnifyMode) = LHSFromToInsts :-
|
|
UnifyMode = unify_modes_li_lf_ri_rf(LHSInitInst, LHSFinalInst, _, _),
|
|
LHSFromToInsts = from_to_insts(LHSInitInst, LHSFinalInst).
|
|
|
|
unify_mode_to_rhs_from_to_insts(UnifyMode) = RHSFromToInsts :-
|
|
UnifyMode = unify_modes_li_lf_ri_rf(_, _, RHSInitInst, RHSFinalInst),
|
|
RHSFromToInsts = from_to_insts(RHSInitInst, RHSFinalInst).
|
|
|
|
%---------------------%
|
|
|
|
modes_to_unify_mode(ModuleInfo, ModeX, ModeY, UnifyMode) :-
|
|
mode_get_insts(ModuleInfo, ModeX, InitialX, FinalX),
|
|
mode_get_insts(ModuleInfo, ModeY, InitialY, FinalY),
|
|
UnifyMode = unify_modes_li_lf_ri_rf(InitialX, FinalX, InitialY, FinalY).
|
|
|
|
from_to_insts_to_unify_mode(FromToInstsX, FromToInstsY, UnifyMode) :-
|
|
FromToInstsX = from_to_insts(InitInstX, FinalInstX),
|
|
FromToInstsY = from_to_insts(InitInstY, FinalInstY),
|
|
UnifyMode = unify_modes_li_lf_ri_rf(InitInstX, FinalInstX,
|
|
InitInstY, FinalInstY).
|
|
|
|
modes_to_unify_modes(_ModuleInfo, [], [], []).
|
|
modes_to_unify_modes(_ModuleInfo, [], [_ | _], _) :-
|
|
unexpected($pred, "length mismatch").
|
|
modes_to_unify_modes(_ModuleInfo, [_ | _], [], _) :-
|
|
unexpected($pred, "length mismatch").
|
|
modes_to_unify_modes(ModuleInfo,
|
|
[ModeX | ModeXs], [ModeY | ModeYs],
|
|
[UnifyMode | UnifyModes]) :-
|
|
modes_to_unify_mode(ModuleInfo, ModeX, ModeY, UnifyMode),
|
|
modes_to_unify_modes(ModuleInfo, ModeXs, ModeYs, UnifyModes).
|
|
|
|
from_to_insts_to_unify_modes([], [], []).
|
|
from_to_insts_to_unify_modes([], [_ | _], _) :-
|
|
unexpected($pred, "length mismatch").
|
|
from_to_insts_to_unify_modes([_ | _], [], _) :-
|
|
unexpected($pred, "length mismatch").
|
|
from_to_insts_to_unify_modes(
|
|
[FromToInstsX | FromToInstsXs], [FromToInstsY | FromToInstsYs],
|
|
[UnifyMode | UnifyModes]) :-
|
|
from_to_insts_to_unify_mode(FromToInstsX, FromToInstsY, UnifyMode),
|
|
from_to_insts_to_unify_modes(FromToInstsXs, FromToInstsYs, UnifyModes).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
get_arg_lives(_, [], []).
|
|
get_arg_lives(ModuleInfo, [Mode | Modes], [IsLive | IsLives]) :-
|
|
% Arguments with final inst `clobbered' are dead, any others
|
|
% are assumed to be live.
|
|
mode_get_insts(ModuleInfo, Mode, _InitialInst, FinalInst),
|
|
( if inst_is_clobbered(ModuleInfo, FinalInst) then
|
|
IsLive = is_dead
|
|
else
|
|
IsLive = is_live
|
|
),
|
|
get_arg_lives(ModuleInfo, Modes, IsLives).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
constructors_to_bound_insts(ModuleInfo, Uniq, TypeCtor, Constructors,
|
|
BoundInsts) :-
|
|
constructors_to_bound_insts_loop_over_ctors(ModuleInfo, Uniq, TypeCtor,
|
|
Constructors, ground(Uniq, none_or_default_func), BoundInsts).
|
|
|
|
constructors_to_bound_any_insts(ModuleInfo, Uniq, TypeCtor, Constructors,
|
|
BoundInsts) :-
|
|
constructors_to_bound_insts_loop_over_ctors(ModuleInfo, Uniq, TypeCtor,
|
|
Constructors, any(Uniq, none_or_default_func), BoundInsts).
|
|
|
|
:- pred constructors_to_bound_insts_loop_over_ctors(module_info::in,
|
|
uniqueness::in, type_ctor::in, list(constructor)::in, mer_inst::in,
|
|
list(bound_inst)::out) is det.
|
|
|
|
constructors_to_bound_insts_loop_over_ctors(_, _, _, [], _, []).
|
|
constructors_to_bound_insts_loop_over_ctors(ModuleInfo, Uniq, TypeCtor,
|
|
[Ctor | Ctors], ArgInst, [BoundInst | BoundInsts]) :-
|
|
Ctor = ctor(_Ordinal, _MaybeExistConstraints, Name, Args, _Arity, _Ctxt),
|
|
ctor_arg_list_to_inst_list(Args, ArgInst, Insts),
|
|
list.length(Insts, Arity),
|
|
BoundInst = bound_functor(cons(Name, Arity, TypeCtor), Insts),
|
|
constructors_to_bound_insts_loop_over_ctors(ModuleInfo, Uniq, TypeCtor,
|
|
Ctors, ArgInst, BoundInsts).
|
|
|
|
:- pred ctor_arg_list_to_inst_list(list(constructor_arg)::in, mer_inst::in,
|
|
list(mer_inst)::out) is det.
|
|
|
|
ctor_arg_list_to_inst_list([], _, []).
|
|
ctor_arg_list_to_inst_list([_ | Args], Inst, [Inst | Insts]) :-
|
|
ctor_arg_list_to_inst_list(Args, Inst, Insts).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module check_hlds.mode_util.
|
|
%---------------------------------------------------------------------------%
|