mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-26 06:44:24 +00:00
d8a31e574e
compiler/inst_lookup.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_util.m:
compiler/mode_util.m:
compiler/type_util.m:
Move these modules from the check_hlds package to the hlds package.
The reason is that all the content of five of these modules, and
most of the content of one module (inst_util.m) is not used
exclusively during semantic checking passes. (A later diff
should deal with the exception.) Some are used by the pass that
builds the initial HLDS, and all are used by middle-end and backend
passes. The move therefore reduces the number of inappropriate imports
of the check_hlds package.
compiler/check_hlds.m:
compiler/hlds.m:
Effect the transfer.
compiler/*.m:
Conform to the changes above.
387 lines
14 KiB
Mathematica
387 lines
14 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 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: hlds_proc_util.m.
|
|
%
|
|
% This module defines some utility operations on procedures.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module hlds.hlds_proc_util.
|
|
:- interface.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_constraint_robdd.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.instmap.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.var_table.
|
|
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Nontrivial access predicates on proc_infos.
|
|
%
|
|
|
|
:- pred proc_info_head_modes_constraint(proc_info::in,
|
|
mode_constraint::out) is det.
|
|
|
|
:- pred proc_info_declared_argmodes(proc_info::in, list(mer_mode)::out) is det.
|
|
|
|
% See also proc_info_interface_code_model in code_model.m.
|
|
%
|
|
:- pred proc_info_interface_determinism(proc_info::in, determinism::out)
|
|
is det.
|
|
|
|
:- type can_proc_succeed
|
|
---> proc_can_maybe_succeed
|
|
; proc_cannot_succeed.
|
|
|
|
% Return whether the procedure can ever succeed according to
|
|
% its declared determinism. If it has no declared determinism,
|
|
% return proc_can_maybe_succeed.
|
|
%
|
|
:- pred can_proc_info_ever_succeed(proc_info::in, can_proc_succeed::out)
|
|
is det.
|
|
|
|
:- pred proc_info_arglives(module_info::in, proc_info::in,
|
|
list(is_live)::out) is det.
|
|
:- pred proc_info_arg_info(proc_info::in, list(arg_info)::out) is det.
|
|
:- pred proc_info_get_initial_instmap(module_info::in, proc_info::in,
|
|
instmap::out) is det.
|
|
|
|
% Given a procedure, return a list of all its headvars which are
|
|
% (further) instantiated by the procedure.
|
|
%
|
|
:- pred proc_info_instantiated_head_vars(module_info::in, proc_info::in,
|
|
list(prog_var)::out) is det.
|
|
|
|
% Given a procedure, return a list of all its headvars which are
|
|
% not (further) instantiated by the procedure.
|
|
%
|
|
:- pred proc_info_uninstantiated_head_vars(module_info::in, proc_info::in,
|
|
list(prog_var)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Updating proc_infos.
|
|
%
|
|
|
|
% Create a new variable of the given type to the procedure.
|
|
%
|
|
:- pred proc_info_create_var_from_type(string::in, mer_type::in,
|
|
is_dummy_type::in, prog_var::out, proc_info::in, proc_info::out) is det.
|
|
|
|
% Create a new variable for each element of the list of types.
|
|
%
|
|
:- pred proc_info_create_vars_from_types(module_info::in, list(mer_type)::in,
|
|
list(prog_var)::out, proc_info::in, proc_info::out) is det.
|
|
|
|
% Make sure that all headvars are named. This can be useful e.g.
|
|
% because the debugger ignores unnamed variables.
|
|
%
|
|
:- pred ensure_all_headvars_are_named(proc_info::in, proc_info::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Tests on proc_infos.
|
|
%
|
|
|
|
% If the procedure has a input/output pair of io.state arguments,
|
|
% return the positions of those arguments in the argument list.
|
|
% The positions are given as argument numbers, with the first argument
|
|
% in proc_info_get_headvars being position 1, and so on. The first output
|
|
% argument gives the position of the input state, the second the
|
|
% position of the output state.
|
|
%
|
|
% Note that the automatically constructed unify, index and compare
|
|
% procedures for the io:state type are not counted as having io:state
|
|
% args, since they do not fall into the scheme of one input and one
|
|
% output arg. Since they should never be called, this should not matter.
|
|
%
|
|
:- pred proc_info_has_io_state_pair(module_info::in, proc_info::in,
|
|
int::out, int::out) is semidet.
|
|
|
|
:- pred proc_info_has_io_state_pair_from_details(module_info::in,
|
|
var_table::in, list(prog_var)::in, list(mer_mode)::in,
|
|
int::out, int::out) is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Operations on proc_ids.
|
|
%
|
|
|
|
% Given a procedure table and the id of a procedure in that table,
|
|
% return a procedure id to be attached to a clone of that procedure.
|
|
% (The task of creating the clone proc_info and inserting into the
|
|
% procedure table is the task of the caller.)
|
|
%
|
|
:- pred clone_proc_id(proc_table::in, proc_id::in, proc_id::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.inst_match.
|
|
:- import_module check_hlds.mode_test.
|
|
:- import_module hlds.mode_util.
|
|
:- import_module hlds.var_table_hlds.
|
|
:- import_module parse_tree.prog_type_test.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
proc_info_head_modes_constraint(ProcInfo, HeadModesConstraint) :-
|
|
proc_info_get_maybe_head_modes_constr(ProcInfo, MaybeHeadModesConstraint),
|
|
(
|
|
MaybeHeadModesConstraint = yes(HeadModesConstraint)
|
|
;
|
|
MaybeHeadModesConstraint = no,
|
|
unexpected($pred, "no constraint")
|
|
).
|
|
|
|
proc_info_declared_argmodes(ProcInfo, ArgModes) :-
|
|
proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeArgModes),
|
|
(
|
|
MaybeArgModes = yes(ArgModes1),
|
|
ArgModes = ArgModes1
|
|
;
|
|
MaybeArgModes = no,
|
|
proc_info_get_argmodes(ProcInfo, ArgModes)
|
|
).
|
|
|
|
proc_info_interface_determinism(ProcInfo, Determinism) :-
|
|
proc_info_get_declared_determinism(ProcInfo, MaybeDeterminism),
|
|
(
|
|
MaybeDeterminism = no,
|
|
proc_info_get_inferred_determinism(ProcInfo, Determinism)
|
|
;
|
|
MaybeDeterminism = yes(Determinism)
|
|
).
|
|
|
|
can_proc_info_ever_succeed(ProcInfo, CanSucceed) :-
|
|
proc_info_get_declared_determinism(ProcInfo, DeclaredDeterminism),
|
|
(
|
|
DeclaredDeterminism = no,
|
|
CanSucceed = proc_can_maybe_succeed
|
|
;
|
|
DeclaredDeterminism = yes(Determinism),
|
|
determinism_components(Determinism, _, MaxSoln),
|
|
(
|
|
MaxSoln = at_most_zero,
|
|
CanSucceed = proc_cannot_succeed
|
|
;
|
|
( MaxSoln = at_most_one
|
|
; MaxSoln = at_most_many
|
|
; MaxSoln = at_most_many_cc
|
|
),
|
|
CanSucceed = proc_can_maybe_succeed
|
|
)
|
|
).
|
|
|
|
proc_info_arglives(ModuleInfo, ProcInfo, ArgLives) :-
|
|
proc_info_get_maybe_arglives(ProcInfo, MaybeArgLives),
|
|
(
|
|
MaybeArgLives = yes(ArgLives0),
|
|
ArgLives = ArgLives0
|
|
;
|
|
MaybeArgLives = no,
|
|
proc_info_get_argmodes(ProcInfo, Modes),
|
|
get_arg_lives(ModuleInfo, Modes, ArgLives)
|
|
).
|
|
|
|
proc_info_arg_info(ProcInfo, ArgInfo) :-
|
|
proc_info_get_maybe_arg_info(ProcInfo, MaybeArgInfo0),
|
|
(
|
|
MaybeArgInfo0 = yes(ArgInfo)
|
|
;
|
|
MaybeArgInfo0 = no,
|
|
unexpected($pred, "arg_info not set")
|
|
).
|
|
|
|
proc_info_get_initial_instmap(ModuleInfo, ProcInfo, InstMap) :-
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
mode_list_get_initial_insts(ModuleInfo, ArgModes, InitialInsts),
|
|
assoc_list.from_corresponding_lists(HeadVars, InitialInsts, InstAL),
|
|
InstMap = instmap_from_assoc_list(InstAL).
|
|
|
|
%---------------------%
|
|
|
|
proc_info_instantiated_head_vars(ModuleInfo, ProcInfo, ChangedInstHeadVars) :-
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
assoc_list.from_corresponding_lists(HeadVars, ArgModes, HeadVarModes),
|
|
IsInstChanged =
|
|
( pred(VarMode::in, Var::out) is semidet :-
|
|
VarMode = Var - Mode,
|
|
lookup_var_type(VarTable, Var, Type),
|
|
mode_get_insts(ModuleInfo, Mode, Inst1, Inst2),
|
|
not inst_matches_binding(ModuleInfo, Type, Inst1, Inst2)
|
|
),
|
|
list.filter_map(IsInstChanged, HeadVarModes, ChangedInstHeadVars).
|
|
|
|
proc_info_uninstantiated_head_vars(ModuleInfo, ProcInfo,
|
|
UnchangedInstHeadVars) :-
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
assoc_list.from_corresponding_lists(HeadVars, ArgModes, HeadVarModes),
|
|
IsInstUnchanged =
|
|
( pred(VarMode::in, Var::out) is semidet :-
|
|
VarMode = Var - Mode,
|
|
lookup_var_type(VarTable, Var, Type),
|
|
mode_get_insts(ModuleInfo, Mode, Inst1, Inst2),
|
|
inst_matches_binding(ModuleInfo, Type, Inst1, Inst2)
|
|
),
|
|
list.filter_map(IsInstUnchanged, HeadVarModes, UnchangedInstHeadVars).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
proc_info_create_var_from_type(Name, Type, IsDummy, Var, !ProcInfo) :-
|
|
proc_info_get_var_table(!.ProcInfo, VarTable0),
|
|
Entry = vte(Name, Type, IsDummy),
|
|
add_var_entry(Entry, Var, VarTable0, VarTable),
|
|
proc_info_set_var_table(VarTable, !ProcInfo).
|
|
|
|
proc_info_create_vars_from_types(ModuleInfo, Types, Vars, !ProcInfo) :-
|
|
proc_info_get_var_table(!.ProcInfo, VarTable0),
|
|
create_fresh_vars(ModuleInfo, Types, Vars, VarTable0, VarTable),
|
|
proc_info_set_var_table(VarTable, !ProcInfo).
|
|
|
|
%---------------------%
|
|
|
|
ensure_all_headvars_are_named(!ProcInfo) :-
|
|
proc_info_get_headvars(!.ProcInfo, HeadVars),
|
|
proc_info_get_var_table(!.ProcInfo, VarTable0),
|
|
ensure_all_headvars_are_named_loop(HeadVars, 1, VarTable0, VarTable),
|
|
proc_info_set_var_table(VarTable, !ProcInfo).
|
|
|
|
:- pred ensure_all_headvars_are_named_loop(list(prog_var)::in, int::in,
|
|
var_table::in, var_table::out) is det.
|
|
|
|
ensure_all_headvars_are_named_loop([], _, !VarTable).
|
|
ensure_all_headvars_are_named_loop([Var | Vars], SeqNum, !VarTable) :-
|
|
lookup_var_entry(!.VarTable, Var, Entry0),
|
|
Entry0 = vte(Name0, Type, IsDummy),
|
|
( if Name0 = "" then
|
|
Name = "HeadVar__" ++ int_to_string(SeqNum),
|
|
Entry = vte(Name, Type, IsDummy),
|
|
update_var_entry(Var, Entry, !VarTable)
|
|
else
|
|
true
|
|
),
|
|
ensure_all_headvars_are_named_loop(Vars, SeqNum + 1, !VarTable).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
proc_info_has_io_state_pair(ModuleInfo, ProcInfo, InArgNum, OutArgNum) :-
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
proc_info_has_io_state_pair_from_details(ModuleInfo, VarTable,
|
|
HeadVars, ArgModes, InArgNum, OutArgNum).
|
|
|
|
proc_info_has_io_state_pair_from_details(ModuleInfo, VarTable,
|
|
HeadVars, ArgModes, InArgNum, OutArgNum) :-
|
|
assoc_list.from_corresponding_lists(HeadVars, ArgModes, HeadVarsModes),
|
|
proc_info_has_io_state_pair_2(ModuleInfo, VarTable, 1, HeadVarsModes,
|
|
no, MaybeIn, no, MaybeOut),
|
|
( if
|
|
MaybeIn = yes(In),
|
|
MaybeOut = yes(Out)
|
|
then
|
|
InArgNum = In,
|
|
OutArgNum = Out
|
|
else
|
|
fail
|
|
).
|
|
|
|
:- pred proc_info_has_io_state_pair_2(module_info::in, var_table::in,
|
|
int::in, assoc_list(prog_var, mer_mode)::in,
|
|
maybe(int)::in, maybe(int)::out, maybe(int)::in, maybe(int)::out)
|
|
is semidet.
|
|
|
|
proc_info_has_io_state_pair_2(_, _, _, [], !MaybeIn, !MaybeOut).
|
|
proc_info_has_io_state_pair_2(ModuleInfo, VarTable, ArgNum,
|
|
[Var - Mode | VarModes], !MaybeIn, !MaybeOut) :-
|
|
( if
|
|
lookup_var_type(VarTable, Var, VarType),
|
|
type_is_io_state(VarType)
|
|
then
|
|
( if mode_is_fully_input(ModuleInfo, VarType, Mode) then
|
|
(
|
|
!.MaybeIn = no,
|
|
!:MaybeIn = yes(ArgNum)
|
|
;
|
|
!.MaybeIn = yes(_),
|
|
% Procedures with two input arguments of type io.state
|
|
% (e.g. the automatically generated unification or comparison
|
|
% procedure for the io.state type) do not fall into the
|
|
% one input/one output pattern we are looking for.
|
|
fail
|
|
)
|
|
else if mode_is_fully_output(ModuleInfo, VarType, Mode) then
|
|
(
|
|
!.MaybeOut = no,
|
|
!:MaybeOut = yes(ArgNum)
|
|
;
|
|
!.MaybeOut = yes(_),
|
|
% Procedures with two output arguments of type io.state
|
|
% do not fall into the one input/one output pattern we are
|
|
% looking for.
|
|
fail
|
|
)
|
|
else
|
|
fail
|
|
)
|
|
else
|
|
true
|
|
),
|
|
proc_info_has_io_state_pair_2(ModuleInfo, VarTable, ArgNum + 1,
|
|
VarModes, !MaybeIn, !MaybeOut).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
clone_proc_id(ProcTable, _ProcId, CloneProcId) :-
|
|
find_lowest_unused_proc_id(ProcTable, CloneProcId).
|
|
|
|
:- pred find_lowest_unused_proc_id(proc_table::in, proc_id::out) is det.
|
|
|
|
find_lowest_unused_proc_id(ProcTable, CloneProcId) :-
|
|
find_lowest_unused_proc_id_loop(ProcTable, 0, CloneProcId).
|
|
|
|
:- pred find_lowest_unused_proc_id_loop(proc_table::in, int::in,
|
|
proc_id::out) is det.
|
|
|
|
find_lowest_unused_proc_id_loop(ProcTable, TrialProcIdInt, CloneProcId) :-
|
|
proc_id_to_int(TrialProcId, TrialProcIdInt),
|
|
( if map.search(ProcTable, TrialProcId, _) then
|
|
find_lowest_unused_proc_id_loop(ProcTable, TrialProcIdInt + 1,
|
|
CloneProcId)
|
|
else
|
|
CloneProcId = TrialProcId
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module hlds.hlds_proc_util.
|
|
%---------------------------------------------------------------------------%
|