mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 13:23:53 +00:00
672f77c4ec
Estimated hours taken: 20 Branches: main Add a new compiler option. --inform-ite-instead-of-switch. If this is enabled, the compiler will generate informational messages about if-then-elses that it thinks should be converted to switches for the sake of program reliability. Act on the output generated by this option. compiler/simplify.m: Implement the new option. Fix an old bug that could cause us to generate warnings about code that was OK in one duplicated copy but not in another (where a switch arm's code is duplicated due to the case being selected for more than one cons_id). compiler/options.m: Add the new option. Add a way to test for the bug fix in simplify. doc/user_guide.texi: Document the new option. NEWS: Mention the new option. library/*.m: mdbcomp/*.m: browser/*.m: compiler/*.m: deep_profiler/*.m: Convert if-then-elses to switches at most of the sites suggested by the new option. At the remaining sites, switching to switches would have nontrivial downsides. This typically happens with the switched-on type has many functors, and we treat one or two specially (e.g. cons/2 in the cons_id type). Perform misc cleanups in the vicinity of the if-then-else to switch conversions. In a few cases, improve the error messages generated. compiler/accumulator.m: compiler/hlds_goal.m: (Rename and) move insts for particular kinds of goal from accumulator.m to hlds_goal.m, to allow them to be used in other modules. Using these insts allowed us to eliminate some if-then-elses entirely. compiler/exprn_aux.m: Instead of fixing some if-then-elses, delete the predicates containing them, since they aren't used, and (as pointed out by the new option) would need considerable other fixing if they were ever needed again. compiler/lp_rational.m: Add prefixes to the names of the function symbols on some types, since without those prefixes, it was hard to figure out what type the switch corresponding to an old if-then-else was switching on. tests/invalid/reserve_tag.err_exp: Expect a new, improved error message.
1538 lines
62 KiB
Mathematica
1538 lines
62 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-2007 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: mode_util.m.
|
|
% Main author: fjh.
|
|
%
|
|
% This module contains utility predicates for dealing with modes and insts.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.mode_util.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- 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 bool.
|
|
:- import_module list.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% mode_get_insts returns the initial instantiatedness and the final
|
|
% instantiatedness for a 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.
|
|
|
|
% A version of mode_get_insts that fails if the mode is undefined.
|
|
%
|
|
:- pred mode_get_insts_semidet(module_info::in, mer_mode::in,
|
|
mer_inst::out, mer_inst::out) is semidet.
|
|
|
|
% A mode is considered input if the initial inst is bound.
|
|
% Throws an exception if the mode is undefined.
|
|
%
|
|
:- pred mode_is_input(module_info::in, mer_mode::in) is semidet.
|
|
|
|
% A mode is considered fully input if the initial inst is ground.
|
|
% Throws an exception if the mode is undefined.
|
|
%
|
|
:- pred mode_is_fully_input(module_info::in, mer_mode::in) is semidet.
|
|
|
|
% A mode is considered output if the initial inst is free and the
|
|
% final inst is bound.
|
|
% Throws an exception if the mode is undefined.
|
|
%
|
|
:- pred mode_is_output(module_info::in, mer_mode::in) is semidet.
|
|
|
|
% A mode is considered fully output if the initial inst is free and
|
|
% the final inst is ground.
|
|
% Throws an exception if the mode is undefined.
|
|
%
|
|
:- pred mode_is_fully_output(module_info::in, mer_mode::in) is semidet.
|
|
|
|
% A mode is considered unused if both initial and final insts are free.
|
|
% Throws an exception if the mode is undefined.
|
|
%
|
|
:- pred mode_is_unused(module_info::in, mer_mode::in) is semidet.
|
|
|
|
% Succeeds iff the given mode is undefined.
|
|
%
|
|
:- pred mode_is_undefined(module_info::in, mer_mode::in) is semidet.
|
|
|
|
% mode_to_arg_mode converts a mode (and corresponding type) to
|
|
% an arg_mode. A mode is a high-level notion, the normal
|
|
% Mercury language mode. An `arg_mode' is a low-level notion
|
|
% used for code generation, which indicates the argument
|
|
% passing convention (top_in, top_out, or top_unused) that
|
|
% corresponds to that mode. We need to know the type, not just
|
|
% the mode, because the argument passing convention can depend
|
|
% on the type's representation.
|
|
%
|
|
:- pred mode_to_arg_mode(module_info::in, mer_mode::in, mer_type::in,
|
|
arg_mode::out) is det.
|
|
|
|
:- pred modes_to_arg_modes(module_info::in, list(mer_mode)::in,
|
|
list(mer_type)::in, list(arg_mode)::out) is det.
|
|
|
|
:- func mode_get_initial_inst(module_info, mer_mode) = mer_inst.
|
|
|
|
:- func mode_get_final_inst(module_info, mer_mode) = mer_inst.
|
|
|
|
:- 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.
|
|
|
|
:- pred modes_to_uni_modes(module_info::in, list(mer_mode)::in,
|
|
list(mer_mode)::in, list(uni_mode)::out) is det.
|
|
|
|
% Given a user-defined or compiler-defined inst name, lookup the
|
|
% corresponding inst in the inst table.
|
|
%
|
|
:- pred inst_lookup(module_info::in, inst_name::in, mer_inst::out) is det.
|
|
|
|
% Use the instmap deltas for all the atomic sub-goals to recompute
|
|
% the instmap deltas for all the non-atomic sub-goals of a goal.
|
|
% Used to ensure that the instmap deltas remain valid after code has
|
|
% been re-arranged, e.g. by followcode. This also takes the
|
|
% module_info as input and output since it may need to insert new
|
|
% merge_insts into the merge_inst table. If the first argument is
|
|
% yes, the instmap_deltas for calls and deconstruction unifications
|
|
% are also recomputed.
|
|
%
|
|
:- pred recompute_instmap_delta_proc(bool::in, proc_info::in, proc_info::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
:- pred recompute_instmap_delta(bool::in, hlds_goal::in, hlds_goal::out,
|
|
vartypes::in, inst_varset::in, instmap::in, module_info::in,
|
|
module_info::out) is det.
|
|
|
|
% Given corresponding lists of types and modes, produce a new list
|
|
% of modes which includes the information provided by the
|
|
% corresponding types.
|
|
%
|
|
:- pred propagate_types_into_mode_list(module_info::in, list(mer_type)::in,
|
|
list(mer_mode)::in, list(mer_mode)::out) is det.
|
|
|
|
% Given corresponding lists of types and insts and a substitution
|
|
% for the type variables in the type, produce a new list of insts
|
|
% which includes the information provided by the corresponding types.
|
|
%
|
|
:- pred propagate_types_into_inst_list(module_info::in, tsubst::in,
|
|
list(mer_type)::in, list(mer_inst)::in, list(mer_inst)::out) is det.
|
|
|
|
% 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,
|
|
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,
|
|
list(constructor)::in, list(bound_inst)::out) is det.
|
|
|
|
% 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.
|
|
|
|
% Given the switched on variable and the instmaps before the switch
|
|
% and after a branch make sure that any information added by the
|
|
% functor test gets added to the instmap for the case.
|
|
%
|
|
:- pred fixup_switch_var(prog_var::in, instmap::in, instmap::in,
|
|
hlds_goal::in, hlds_goal::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred normalise_insts(module_info::in, list(mer_type)::in,
|
|
list(mer_inst)::in, list(mer_inst)::out) is det.
|
|
|
|
:- pred normalise_inst(module_info::in, mer_type::in,
|
|
mer_inst::in, mer_inst::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Partition a list of arguments into inputs and others.
|
|
% Throws an exception if one of the modes is undefined.
|
|
%
|
|
:- pred partition_args(module_info::in, list(mer_mode)::in, list(T)::in,
|
|
list(T)::out, list(T)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.inst_match.
|
|
:- import_module check_hlds.inst_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module libs.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_type_subst.
|
|
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
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).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% A mode is considered an input mode if the top-level node is input.
|
|
%
|
|
mode_is_input(ModuleInfo, Mode) :-
|
|
mode_get_insts(ModuleInfo, Mode, InitialInst, _FinalInst),
|
|
inst_is_bound(ModuleInfo, InitialInst).
|
|
|
|
% A mode is considered fully input if its initial inst is ground.
|
|
%
|
|
mode_is_fully_input(ModuleInfo, Mode) :-
|
|
mode_get_insts(ModuleInfo, Mode, InitialInst, _FinalInst),
|
|
inst_is_ground(ModuleInfo, InitialInst).
|
|
|
|
% A mode is considered an output mode if the top-level node is output.
|
|
%
|
|
mode_is_output(ModuleInfo, Mode) :-
|
|
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
|
|
inst_is_free(ModuleInfo, InitialInst),
|
|
inst_is_bound(ModuleInfo, FinalInst).
|
|
|
|
% A mode is considered fully output if its initial inst is free
|
|
% and its final insts is ground.
|
|
%
|
|
mode_is_fully_output(ModuleInfo, Mode) :-
|
|
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
|
|
inst_is_free(ModuleInfo, InitialInst),
|
|
inst_is_ground(ModuleInfo, FinalInst).
|
|
|
|
% A mode is considered a unused mode if it is equivalent to free >> free.
|
|
%
|
|
mode_is_unused(ModuleInfo, Mode) :-
|
|
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
|
|
inst_is_free(ModuleInfo, InitialInst),
|
|
inst_is_free(ModuleInfo, FinalInst).
|
|
|
|
mode_is_undefined(ModuleInfo, Mode) :-
|
|
not mode_get_insts_semidet(ModuleInfo, Mode, _, _).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
modes_to_arg_modes(_ModuleInfo, [], [], []).
|
|
modes_to_arg_modes(_ModuleInfo, [], [_ | _], _) :-
|
|
unexpected(this_file, "modes_to_arg_modes: length mismatch").
|
|
modes_to_arg_modes(_ModuleInfo, [_ | _], [], _) :-
|
|
unexpected(this_file, "modes_to_arg_modes: length mismatch").
|
|
modes_to_arg_modes(ModuleInfo, [Mode | Modes], [Type | Types],
|
|
[ArgMode | ArgModes]) :-
|
|
mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
|
|
modes_to_arg_modes(ModuleInfo, Modes, Types, ArgModes).
|
|
|
|
mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode) :-
|
|
mode_to_arg_mode_2(ModuleInfo, Mode, Type, [], ArgMode).
|
|
|
|
:- pred mode_to_arg_mode_2(module_info::in, mer_mode::in, mer_type::in,
|
|
list(type_ctor)::in, arg_mode::out) is det.
|
|
|
|
mode_to_arg_mode_2(ModuleInfo, Mode, Type, ContainingTypes, ArgMode) :-
|
|
%
|
|
% We need to handle no_tag types (types which have exactly one constructor,
|
|
% and whose one constructor has exactly one argument) specially here,
|
|
% since for them an inst of bound(f(free)) is not really bound as far as
|
|
% code generation is concerned, since the f/1 will get optimized away.
|
|
%
|
|
(
|
|
% Is this a no_tag type?
|
|
type_is_no_tag_type(ModuleInfo, Type, FunctorName, ArgType),
|
|
% Avoid infinite recursion.
|
|
type_to_ctor_and_args(Type, TypeCtor, _TypeArgs),
|
|
\+ list.member(TypeCtor, ContainingTypes)
|
|
->
|
|
% The arg_mode will be determined by the mode and type of the
|
|
% functor's argument, so we figure out the mode and type of the
|
|
% argument, and then recurse.
|
|
%
|
|
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
|
|
ConsId = cons(FunctorName, 1),
|
|
get_single_arg_inst(InitialInst, ModuleInfo, ConsId, InitialArgInst),
|
|
get_single_arg_inst(FinalInst, ModuleInfo, ConsId, FinalArgInst),
|
|
ModeOfArg = (InitialArgInst -> FinalArgInst),
|
|
mode_to_arg_mode_2(ModuleInfo, ModeOfArg, ArgType,
|
|
[TypeCtor | ContainingTypes], ArgMode)
|
|
;
|
|
base_mode_to_arg_mode(ModuleInfo, Mode, ArgMode)
|
|
).
|
|
|
|
:- pred base_mode_to_arg_mode(module_info::in, mer_mode::in, arg_mode::out)
|
|
is det.
|
|
|
|
base_mode_to_arg_mode(ModuleInfo, Mode, ArgMode) :-
|
|
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
|
|
( inst_is_bound(ModuleInfo, InitialInst) ->
|
|
ArgMode = top_in
|
|
; inst_is_bound(ModuleInfo, FinalInst) ->
|
|
ArgMode = top_out
|
|
;
|
|
ArgMode = top_unused
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% get_single_arg_inst(Inst, ConsId, Arity, ArgInsts):
|
|
% Given an inst `Inst', figure out what the inst of the argument would be,
|
|
% assuming that the functor is the one given by the specified ConsId,
|
|
% whose arity is 1.
|
|
%
|
|
:- pred get_single_arg_inst(mer_inst::in, module_info::in, cons_id::in,
|
|
mer_inst::out) is det.
|
|
|
|
get_single_arg_inst(defined_inst(InstName), ModuleInfo, ConsId, ArgInst) :-
|
|
inst_lookup(ModuleInfo, InstName, Inst),
|
|
get_single_arg_inst(Inst, ModuleInfo, ConsId, ArgInst).
|
|
get_single_arg_inst(not_reached, _, _, not_reached).
|
|
get_single_arg_inst(ground(Uniq, _PredInst), _, _, ground(Uniq, none)).
|
|
get_single_arg_inst(bound(_Uniq, List), _, ConsId, ArgInst) :-
|
|
( get_single_arg_inst_2(List, ConsId, ArgInst0) ->
|
|
ArgInst = ArgInst0
|
|
;
|
|
% The code is unreachable.
|
|
ArgInst = not_reached
|
|
).
|
|
get_single_arg_inst(free, _, _, free).
|
|
get_single_arg_inst(free(_Type), _, _, free). % XXX loses type info
|
|
get_single_arg_inst(any(Uniq), _, _, any(Uniq)).
|
|
get_single_arg_inst(abstract_inst(_, _), _, _, _) :-
|
|
unexpected(this_file,
|
|
"get_single_arg_inst: abstract insts not supported").
|
|
get_single_arg_inst(inst_var(_), _, _, _) :-
|
|
unexpected(this_file, "get_single_arg_inst: inst_var").
|
|
get_single_arg_inst(constrained_inst_vars(_, Inst), ModuleInfo, ConsId,
|
|
ArgInst) :-
|
|
get_single_arg_inst(Inst, ModuleInfo, ConsId, ArgInst).
|
|
|
|
:- pred get_single_arg_inst_2(list(bound_inst)::in, cons_id::in, mer_inst::out)
|
|
is semidet.
|
|
|
|
get_single_arg_inst_2([BoundInst | BoundInsts], ConsId, ArgInst) :-
|
|
( BoundInst = bound_functor(ConsId, [ArgInst0]) ->
|
|
ArgInst = ArgInst0
|
|
;
|
|
get_single_arg_inst_2(BoundInsts, ConsId, ArgInst)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given two lists of modes (inst mappings) of equal length, convert
|
|
% them into a single list of inst pair mappings.
|
|
%
|
|
modes_to_uni_modes(_ModuleInfo, [], [], []).
|
|
modes_to_uni_modes(_ModuleInfo, [], [_ | _], _) :-
|
|
unexpected(this_file, "modes_to_uni_modes: length mismatch").
|
|
modes_to_uni_modes(_ModuleInfo, [_ | _], [], _) :-
|
|
unexpected(this_file, "modes_to_uni_modes: length mismatch").
|
|
modes_to_uni_modes(ModuleInfo, [X | Xs], [Y | Ys], [A | As]) :-
|
|
mode_get_insts(ModuleInfo, X, InitialX, FinalX),
|
|
mode_get_insts(ModuleInfo, Y, InitialY, FinalY),
|
|
A = ((InitialX - InitialY) -> (FinalX - FinalY)),
|
|
modes_to_uni_modes(ModuleInfo, Xs, Ys, As).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
inst_lookup(ModuleInfo, InstName, Inst) :-
|
|
(
|
|
InstName = unify_inst(_, _, _, _),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_unify_insts(InstTable, UnifyInstTable),
|
|
map.lookup(UnifyInstTable, InstName, MaybeInst),
|
|
( MaybeInst = inst_det_known(Inst0, _) ->
|
|
Inst = Inst0
|
|
;
|
|
Inst = defined_inst(InstName)
|
|
)
|
|
;
|
|
InstName = merge_inst(A, B),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_merge_insts(InstTable, MergeInstTable),
|
|
map.lookup(MergeInstTable, A - B, MaybeInst),
|
|
( MaybeInst = inst_known(Inst0) ->
|
|
Inst = Inst0
|
|
;
|
|
Inst = defined_inst(InstName)
|
|
)
|
|
;
|
|
InstName = ground_inst(_, _, _, _),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_ground_insts(InstTable, GroundInstTable),
|
|
map.lookup(GroundInstTable, InstName, MaybeInst),
|
|
( MaybeInst = inst_det_known(Inst0, _) ->
|
|
Inst = Inst0
|
|
;
|
|
Inst = defined_inst(InstName)
|
|
)
|
|
;
|
|
InstName = any_inst(_, _, _, _),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_any_insts(InstTable, AnyInstTable),
|
|
map.lookup(AnyInstTable, InstName, MaybeInst),
|
|
( MaybeInst = inst_det_known(Inst0, _) ->
|
|
Inst = Inst0
|
|
;
|
|
Inst = defined_inst(InstName)
|
|
)
|
|
;
|
|
InstName = shared_inst(SharedInstName),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_shared_insts(InstTable, SharedInstTable),
|
|
map.lookup(SharedInstTable, SharedInstName, MaybeInst),
|
|
( MaybeInst = inst_known(Inst0) ->
|
|
Inst = Inst0
|
|
;
|
|
Inst = defined_inst(InstName)
|
|
)
|
|
;
|
|
InstName = mostly_uniq_inst(NondetLiveInstName),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_mostly_uniq_insts(InstTable,
|
|
NondetLiveInstTable),
|
|
map.lookup(NondetLiveInstTable, NondetLiveInstName, MaybeInst),
|
|
( MaybeInst = inst_known(Inst0) ->
|
|
Inst = Inst0
|
|
;
|
|
Inst = defined_inst(InstName)
|
|
)
|
|
;
|
|
InstName = user_inst(Name, Args),
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_user_insts(InstTable, UserInstTable),
|
|
user_inst_table_get_inst_defns(UserInstTable, InstDefns),
|
|
list.length(Args, Arity),
|
|
( map.search(InstDefns, inst_id(Name, Arity), InstDefn) ->
|
|
InstDefn = hlds_inst_defn(_VarSet, Params, InstBody, _C, _),
|
|
inst_lookup_subst_args(InstBody, Params, Name, Args, Inst)
|
|
;
|
|
Inst = abstract_inst(Name, Args)
|
|
)
|
|
;
|
|
InstName = typed_ground(Uniq, Type),
|
|
map.init(Subst),
|
|
propagate_type_into_inst(ModuleInfo, Subst, Type,
|
|
ground(Uniq, none), Inst)
|
|
;
|
|
InstName = typed_inst(Type, TypedInstName),
|
|
inst_lookup(ModuleInfo, TypedInstName, Inst0),
|
|
map.init(Subst),
|
|
propagate_type_into_inst(ModuleInfo, Subst, Type, Inst0, Inst)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given corresponding lists of types and modes, produce a new
|
|
% list of modes which includes the information provided by the
|
|
% corresponding types.
|
|
%
|
|
propagate_types_into_mode_list(_, [], [], []).
|
|
propagate_types_into_mode_list(ModuleInfo, [Type | Types],
|
|
[Mode0 | Modes0], [Mode | Modes]) :-
|
|
propagate_type_into_mode(ModuleInfo, Type, Mode0, Mode),
|
|
propagate_types_into_mode_list(ModuleInfo, Types, Modes0, Modes).
|
|
propagate_types_into_mode_list(_, [], [_ | _], []) :-
|
|
unexpected(this_file, "propagate_types_into_mode_list: length mismatch").
|
|
propagate_types_into_mode_list(_, [_ | _], [], []) :-
|
|
unexpected(this_file, "propagate_types_into_mode_list: length mismatch").
|
|
|
|
propagate_types_into_inst_list(_, _, [], [], []).
|
|
propagate_types_into_inst_list(ModuleInfo, Subst, [Type | Types],
|
|
[Inst0 | Insts0], [Inst | Insts]) :-
|
|
propagate_type_into_inst(ModuleInfo, Subst, Type, Inst0, Inst),
|
|
propagate_types_into_inst_list(ModuleInfo, Subst, Types, Insts0, Insts).
|
|
propagate_types_into_inst_list(_, _, [], [_ | _], []) :-
|
|
unexpected(this_file, "propagate_types_into_inst_list: length mismatch").
|
|
propagate_types_into_inst_list(_, _, [_ | _], [], []) :-
|
|
unexpected(this_file, "propagate_types_into_inst_list: length mismatch").
|
|
|
|
% Given a type and a mode, produce a new mode that includes the
|
|
% information provided by the type.
|
|
%
|
|
:- pred propagate_type_into_mode(module_info::in, mer_type::in,
|
|
mer_mode::in, mer_mode::out) is det.
|
|
|
|
propagate_type_into_mode(ModuleInfo, Type, Mode0, Mode) :-
|
|
mode_get_insts(ModuleInfo, Mode0, InitialInst0, FinalInst0),
|
|
map.init(Subst),
|
|
propagate_type_into_inst_lazily(ModuleInfo, Subst, Type,
|
|
InitialInst0, InitialInst),
|
|
propagate_type_into_inst_lazily(ModuleInfo, Subst, Type,
|
|
FinalInst0, FinalInst),
|
|
Mode = (InitialInst -> FinalInst).
|
|
|
|
% Given a type, an inst and a substitution for the type variables in
|
|
% the type, produce a new inst that includes the information
|
|
% provided by the type.
|
|
%
|
|
% There are three sorts of information added:
|
|
% 1. Module qualifiers.
|
|
% 2. The set of constructors in the type.
|
|
% 3. For higher-order function types
|
|
% (but not higher-order predicate types),
|
|
% the higher-order inst, i.e. the argument modes
|
|
% and the determinism.
|
|
%
|
|
% Currently #2 is not yet implemented, due to unsolved
|
|
% efficiency problems. (See the XXX's below.)
|
|
%
|
|
% There are two versions, an "eager" one and a "lazy" one. In
|
|
% general eager expansion is to be preferred, because the expansion
|
|
% is done just once, whereas with lazy expansion the work will be
|
|
% done N times.
|
|
% However, for recursive insts we must use lazy expansion (otherwise
|
|
% we would get infinite regress). Also, usually many of the
|
|
% imported procedures will not be called, so for the insts in
|
|
% imported mode declarations N is often zero.
|
|
%
|
|
:- pred propagate_type_into_inst(module_info::in, tsubst::in, mer_type::in,
|
|
mer_inst::in, mer_inst::out) is det.
|
|
|
|
:- pred propagate_type_into_inst_lazily(module_info::in, tsubst::in,
|
|
mer_type::in, mer_inst::in, mer_inst::out) is det.
|
|
|
|
% % XXX We ought to expand things eagerly here, using the commented
|
|
% % out code below. However, that causes efficiency problems,
|
|
% % so for the moment it is disabled.
|
|
% propagate_type_into_inst(Type, Subst, ModuleInfo, Inst0, Inst) :-
|
|
% apply_type_subst(Type0, Subst, Type),
|
|
% (
|
|
% type_constructors(Type, ModuleInfo, Constructors)
|
|
% ->
|
|
% propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo, Inst)
|
|
% ;
|
|
% Inst = Inst0
|
|
% ).
|
|
|
|
propagate_type_into_inst(ModuleInfo, Subst, Type, Inst0, Inst) :-
|
|
propagate_ctor_info_lazily(ModuleInfo, Subst, Type, Inst0, Inst).
|
|
|
|
propagate_type_into_inst_lazily(ModuleInfo, Subst, Type, Inst0, Inst) :-
|
|
propagate_ctor_info_lazily(ModuleInfo, Subst, Type, Inst0, Inst).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred propagate_ctor_info(module_info::in, mer_type::in,
|
|
list(constructor)::in, mer_inst::in, mer_inst::out) is det.
|
|
|
|
propagate_ctor_info(ModuleInfo, Type, Constructors, Inst0, Inst) :-
|
|
(
|
|
Inst0 = any(_Uniq),
|
|
Inst = Inst0 % XXX loses type info!
|
|
;
|
|
Inst0 = free,
|
|
% Inst = free(Type)
|
|
Inst = free % XXX temporary hack
|
|
;
|
|
Inst0 = free(_),
|
|
unexpected(this_file, "propagate_ctor_info: type info already present")
|
|
;
|
|
Inst0 = bound(Uniq, BoundInsts0),
|
|
propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
|
|
(
|
|
BoundInsts = [],
|
|
Inst = not_reached
|
|
;
|
|
BoundInsts = [_ | _],
|
|
% XXX do we need to sort the BoundInsts?
|
|
Inst = bound(Uniq, BoundInsts)
|
|
)
|
|
;
|
|
Inst0 = ground(Uniq, none),
|
|
( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
|
|
default_higher_order_func_inst(ModuleInfo, ArgTypes,
|
|
HigherOrderInstInfo),
|
|
Inst = ground(Uniq, higher_order(HigherOrderInstInfo))
|
|
;
|
|
constructors_to_bound_insts(ModuleInfo, Uniq,
|
|
Constructors, BoundInsts0),
|
|
list.sort_and_remove_dups(BoundInsts0, BoundInsts),
|
|
Inst = bound(Uniq, BoundInsts)
|
|
)
|
|
;
|
|
Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
|
|
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, Det),
|
|
(
|
|
type_is_higher_order_details(Type, _, PredOrFunc, _, ArgTypes),
|
|
list.same_length(ArgTypes, Modes0)
|
|
->
|
|
propagate_types_into_mode_list(ModuleInfo, ArgTypes, Modes0, Modes)
|
|
;
|
|
% The inst is not a valid inst for the type, so leave it alone.
|
|
% This can only happen if the user has made a mistake. A mode
|
|
% error should hopefully be reported if anything tries to match
|
|
% with the inst.
|
|
Modes = Modes0
|
|
),
|
|
PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
|
|
Inst = ground(Uniq, higher_order(PredInstInfo))
|
|
;
|
|
Inst0 = not_reached,
|
|
Inst = Inst0
|
|
;
|
|
Inst0 = inst_var(_),
|
|
Inst = Inst0
|
|
;
|
|
Inst0 = constrained_inst_vars(V, SubInst0),
|
|
propagate_ctor_info(ModuleInfo, Type, Constructors, SubInst0, SubInst),
|
|
Inst = constrained_inst_vars(V, SubInst)
|
|
;
|
|
Inst0 = abstract_inst(_Name, _Args),
|
|
Inst = Inst0 % XXX loses info
|
|
;
|
|
Inst0 = defined_inst(InstName),
|
|
inst_lookup(ModuleInfo, InstName, NamedInst),
|
|
propagate_ctor_info(ModuleInfo, Type, Constructors, NamedInst, Inst)
|
|
).
|
|
|
|
:- pred propagate_ctor_info_lazily(module_info::in, tsubst::in, mer_type::in,
|
|
mer_inst::in, mer_inst::out) is det.
|
|
|
|
propagate_ctor_info_lazily(ModuleInfo, Subst, Type0, Inst0, Inst) :-
|
|
(
|
|
Inst0 = any(_Uniq),
|
|
Inst = Inst0 % XXX loses type info!
|
|
;
|
|
Inst0 = free,
|
|
% Inst = free(Type0)
|
|
Inst = free % XXX temporary hack
|
|
;
|
|
Inst0 = free(_),
|
|
unexpected(this_file,
|
|
"propagate_ctor_info_lazily: typeinfo already present")
|
|
;
|
|
Inst0 = bound(Uniq, BoundInsts0),
|
|
apply_type_subst(Type0, Subst, Type),
|
|
propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts),
|
|
(
|
|
BoundInsts = [],
|
|
Inst = not_reached
|
|
;
|
|
BoundInsts = [_ | _],
|
|
% XXX Do we need to sort the BoundInsts?
|
|
Inst = bound(Uniq, BoundInsts)
|
|
)
|
|
;
|
|
Inst0 = ground(Uniq, none),
|
|
apply_type_subst(Type0, Subst, Type),
|
|
( type_is_higher_order_details(Type, _, pf_function, _, ArgTypes) ->
|
|
default_higher_order_func_inst(ModuleInfo, ArgTypes,
|
|
HigherOrderInstInfo),
|
|
Inst = ground(Uniq, higher_order(HigherOrderInstInfo))
|
|
;
|
|
% XXX The information added by this is not yet used, so it's
|
|
% disabled since it unnecessarily complicates the insts.
|
|
%
|
|
% Inst = defined_inst(typed_ground(Uniq, Type))
|
|
Inst = ground(Uniq, none)
|
|
)
|
|
;
|
|
Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
|
|
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, Det),
|
|
apply_type_subst(Type0, Subst, Type),
|
|
(
|
|
type_is_higher_order_details(Type, _, PredOrFunc, _, ArgTypes),
|
|
list.same_length(ArgTypes, Modes0)
|
|
->
|
|
propagate_types_into_mode_list(ModuleInfo, ArgTypes, Modes0, Modes)
|
|
;
|
|
% The inst is not a valid inst for the type, so leave it alone.
|
|
% This can only happen if the user has made a mistake. A mode error
|
|
% should hopefully be reported if anything tries to match with the
|
|
% inst.
|
|
Modes = Modes0
|
|
),
|
|
PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
|
|
Inst = ground(Uniq, higher_order(PredInstInfo))
|
|
;
|
|
Inst0 = not_reached,
|
|
Inst = Inst0
|
|
;
|
|
Inst0 = inst_var(_),
|
|
Inst = Inst0
|
|
;
|
|
Inst0 = constrained_inst_vars(V, SubInst0),
|
|
propagate_ctor_info_lazily(ModuleInfo, Subst, Type0,
|
|
SubInst0, SubInst),
|
|
Inst = constrained_inst_vars(V, SubInst)
|
|
;
|
|
Inst0 = abstract_inst(_Name, _Args),
|
|
Inst = Inst0 % XXX loses info
|
|
;
|
|
Inst0 = defined_inst(InstName0),
|
|
apply_type_subst(Type0, Subst, Type),
|
|
( InstName0 = typed_inst(_, _) ->
|
|
% If this happens, it means that we have already lazily propagated
|
|
% type info into this inst. We want to avoid creating insts of
|
|
% the form typed_inst(_, typed_inst(...)), because that would be
|
|
% unnecessary, and could cause efficiency problems or perhaps
|
|
% even infinite loops.
|
|
InstName = InstName0
|
|
;
|
|
InstName = typed_inst(Type, InstName0)
|
|
),
|
|
Inst = defined_inst(InstName)
|
|
).
|
|
|
|
%
|
|
% If the user does not explicitly specify a higher-order inst
|
|
% for a higher-order function type, it defaults to
|
|
% `func(in, in, ..., in) = out is det',
|
|
% i.e. all args input, return value output, and det.
|
|
% This applies recursively to the arguments and return
|
|
% value too.
|
|
%
|
|
:- pred default_higher_order_func_inst(module_info::in, list(mer_type)::in,
|
|
pred_inst_info::out) is det.
|
|
|
|
default_higher_order_func_inst(ModuleInfo, PredArgTypes, PredInstInfo) :-
|
|
In = (ground(shared, none) -> ground(shared, none)),
|
|
Out = (free -> ground(shared, none)),
|
|
list.length(PredArgTypes, NumPredArgs),
|
|
NumFuncArgs = NumPredArgs - 1,
|
|
list.duplicate(NumFuncArgs, In, FuncArgModes),
|
|
FuncRetMode = Out,
|
|
list.append(FuncArgModes, [FuncRetMode], PredArgModes0),
|
|
propagate_types_into_mode_list(ModuleInfo, PredArgTypes,
|
|
PredArgModes0, PredArgModes),
|
|
PredInstInfo = pred_inst_info(pf_function, PredArgModes, detism_det).
|
|
|
|
constructors_to_bound_insts(ModuleInfo, Uniq, Constructors, BoundInsts) :-
|
|
constructors_to_bound_insts_2(ModuleInfo, Uniq,
|
|
Constructors, ground(Uniq, none), BoundInsts).
|
|
|
|
constructors_to_bound_any_insts(ModuleInfo, Uniq, Constructors, BoundInsts) :-
|
|
constructors_to_bound_insts_2(ModuleInfo, Uniq,
|
|
Constructors, any(Uniq), BoundInsts).
|
|
|
|
:- pred constructors_to_bound_insts_2(module_info::in, uniqueness::in,
|
|
list(constructor)::in, mer_inst::in, list(bound_inst)::out) is det.
|
|
|
|
constructors_to_bound_insts_2(_, _, [], _, []).
|
|
constructors_to_bound_insts_2(ModuleInfo, Uniq, [Ctor | Ctors], ArgInst,
|
|
[BoundInst | BoundInsts]) :-
|
|
Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
|
|
ctor_arg_list_to_inst_list(Args, ArgInst, Insts),
|
|
list.length(Insts, Arity),
|
|
BoundInst = bound_functor(cons(Name, Arity), Insts),
|
|
constructors_to_bound_insts_2(ModuleInfo, Uniq, 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).
|
|
|
|
:- pred propagate_ctor_info_2(module_info::in, mer_type::in,
|
|
list(bound_inst)::in, list(bound_inst)::out) is det.
|
|
|
|
propagate_ctor_info_2(ModuleInfo, Type, BoundInsts0, BoundInsts) :-
|
|
(
|
|
type_is_tuple(Type, TupleArgTypes)
|
|
->
|
|
list.map(propagate_ctor_info_tuple(ModuleInfo, TupleArgTypes),
|
|
BoundInsts0, BoundInsts)
|
|
;
|
|
type_to_ctor_and_args(Type, TypeCtor, TypeArgs),
|
|
TypeCtor = type_ctor(qualified(TypeModule, _), _),
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
map.search(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_tparams(TypeDefn, TypeParams),
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
Constructors = TypeBody ^ du_type_ctors
|
|
->
|
|
map.from_corresponding_lists(TypeParams, TypeArgs, ArgSubst),
|
|
propagate_ctor_info_3(ModuleInfo, ArgSubst, TypeModule, Constructors,
|
|
BoundInsts0, BoundInsts1),
|
|
list.sort(BoundInsts1, BoundInsts)
|
|
;
|
|
% Builtin types don't need processing.
|
|
BoundInsts = BoundInsts0
|
|
).
|
|
|
|
:- pred propagate_ctor_info_tuple(module_info::in, list(mer_type)::in,
|
|
bound_inst::in, bound_inst::out) is det.
|
|
|
|
propagate_ctor_info_tuple(ModuleInfo, TupleArgTypes, BoundInst0, BoundInst) :-
|
|
BoundInst0 = bound_functor(Functor, ArgInsts0),
|
|
(
|
|
Functor = cons(unqualified("{}"), _),
|
|
list.length(ArgInsts0, ArgInstsLen),
|
|
list.length(TupleArgTypes, TupleArgTypesLen),
|
|
ArgInstsLen = TupleArgTypesLen
|
|
->
|
|
map.init(Subst),
|
|
propagate_types_into_inst_list(ModuleInfo, Subst, TupleArgTypes,
|
|
ArgInsts0, ArgInsts)
|
|
;
|
|
% The bound_inst's arity does not match the
|
|
% tuple's arity, so leave it alone. This can
|
|
% only happen in a user defined bound_inst.
|
|
% A mode error should be reported if anything
|
|
% tries to match with the inst.
|
|
ArgInsts = ArgInsts0
|
|
),
|
|
BoundInst = bound_functor(Functor, ArgInsts).
|
|
|
|
:- pred propagate_ctor_info_3(module_info::in, tsubst::in,
|
|
module_name::in, list(constructor)::in,
|
|
list(bound_inst)::in, list(bound_inst)::out) is det.
|
|
|
|
propagate_ctor_info_3(_, _, _, _, [], []).
|
|
propagate_ctor_info_3(ModuleInfo, Subst, TypeModule, Constructors,
|
|
[BoundInst0 | BoundInsts0], [BoundInst | BoundInsts]) :-
|
|
BoundInst0 = bound_functor(ConsId0, ArgInsts0),
|
|
( ConsId0 = cons(unqualified(Name), Ar) ->
|
|
ConsId = cons(qualified(TypeModule, Name), Ar)
|
|
;
|
|
ConsId = ConsId0
|
|
),
|
|
(
|
|
ConsId = cons(ConsName, Arity),
|
|
GetCons = (pred(Ctor::in) is semidet :-
|
|
Ctor = ctor(_, _, ConsName, CtorArgs, _),
|
|
list.length(CtorArgs, Arity)
|
|
),
|
|
list.filter(GetCons, Constructors, [Constructor])
|
|
->
|
|
Constructor = ctor(_ExistQVars, _Constraints, _Name, Args, _Ctxt),
|
|
GetArgTypes = (pred(CtorArg::in, ArgType::out) is det :-
|
|
ArgType = CtorArg ^ arg_type
|
|
),
|
|
list.map(GetArgTypes, Args, ArgTypes),
|
|
propagate_types_into_inst_list(ModuleInfo, Subst, ArgTypes,
|
|
ArgInsts0, ArgInsts),
|
|
BoundInst = bound_functor(ConsId, ArgInsts)
|
|
;
|
|
% The cons_id is not a valid constructor for the type,
|
|
% so leave it alone. This can only happen in a user defined
|
|
% bound_inst. A mode error should be reported if anything
|
|
% tries to match with the inst.
|
|
BoundInst = bound_functor(ConsId, ArgInsts0)
|
|
),
|
|
propagate_ctor_info_3(ModuleInfo, Subst, TypeModule,
|
|
Constructors, BoundInsts0, BoundInsts).
|
|
|
|
:- pred apply_type_subst(mer_type::in, tsubst::in, mer_type::out) is det.
|
|
|
|
apply_type_subst(Type0, Subst, Type) :-
|
|
% optimize common case
|
|
( map.is_empty(Subst) ->
|
|
Type = Type0
|
|
;
|
|
apply_subst_to_type(Subst, Type0, Type)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred inst_lookup_subst_args(hlds_inst_body::in, list(inst_var)::in,
|
|
sym_name::in, list(mer_inst)::in, mer_inst::out) is det.
|
|
|
|
inst_lookup_subst_args(eqv_inst(Inst0), Params, _Name, Args, Inst) :-
|
|
inst_substitute_arg_list(Params, Args, Inst0, Inst).
|
|
inst_lookup_subst_args(abstract_inst, _Params, Name, Args,
|
|
abstract_inst(Name, Args)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% mode_get_insts returns the initial instantiatedness and
|
|
% the final instantiatedness for a given mode.
|
|
%
|
|
mode_get_insts_semidet(_ModuleInfo, (InitialInst -> FinalInst),
|
|
InitialInst, FinalInst).
|
|
mode_get_insts_semidet(ModuleInfo, user_defined_mode(Name, Args),
|
|
Initial, Final) :-
|
|
list.length(Args, Arity),
|
|
module_info_get_mode_table(ModuleInfo, Modes),
|
|
mode_table_get_mode_defns(Modes, ModeDefns),
|
|
map.search(ModeDefns, mode_id(Name, Arity), HLDS_Mode),
|
|
HLDS_Mode = hlds_mode_defn(_VarSet, Params, ModeDefn, _Context, _Status),
|
|
ModeDefn = eqv_mode(Mode0),
|
|
mode_substitute_arg_list(Mode0, Params, Args, Mode),
|
|
mode_get_insts_semidet(ModuleInfo, Mode, Initial, Final).
|
|
|
|
mode_get_insts(ModuleInfo, Mode, InstA, InstB) :-
|
|
( mode_get_insts_semidet(ModuleInfo, Mode, InstA0, InstB0) ->
|
|
InstA = InstA0,
|
|
InstB = InstB0
|
|
;
|
|
unexpected(this_file, "mode_get_insts_semidet failed")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Use the instmap deltas for all the atomic sub-goals to recompute
|
|
% the instmap deltas for all the non-atomic sub-goals of a goal.
|
|
% Used to ensure that the instmap deltas remain valid after
|
|
% code has been re-arranged, e.g. by followcode.
|
|
% After common.m has been run, it may be necessary to recompute
|
|
% instmap deltas for atomic goals, since more outputs of calls
|
|
% and deconstructions may become non-local (XXX does this require
|
|
% rerunning mode analysis rather than just recompute_instmap_delta?).
|
|
%
|
|
recompute_instmap_delta_proc(RecomputeAtomic, !ProcInfo, !ModuleInfo) :-
|
|
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
|
|
proc_info_get_vartypes(!.ProcInfo, VarTypes),
|
|
proc_info_get_goal(!.ProcInfo, Goal0),
|
|
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
|
|
recompute_instmap_delta(RecomputeAtomic, Goal0, Goal,
|
|
VarTypes, InstVarSet, InstMap0, !ModuleInfo),
|
|
proc_info_set_goal(Goal, !ProcInfo).
|
|
|
|
recompute_instmap_delta(RecomputeAtomic, Goal0, Goal, VarTypes, InstVarSet,
|
|
InstMap0, ModuleInfo0, ModuleInfo) :-
|
|
RI0 = recompute_info(ModuleInfo0, InstVarSet),
|
|
recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal, VarTypes,
|
|
InstMap0, _, RI0, RI),
|
|
ModuleInfo = RI ^ module_info.
|
|
|
|
:- pred recompute_instmap_delta_1(bool::in, hlds_goal::in, hlds_goal::out,
|
|
vartypes::in, instmap::in, instmap_delta::out,
|
|
recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal,
|
|
VarTypes, InstMap0, InstMapDelta, !RI) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
(
|
|
RecomputeAtomic = no,
|
|
goal_is_atomic(GoalExpr0),
|
|
GoalExpr0 \= unify(_, rhs_lambda_goal(_, _, _, _, _, _, _, _), _, _, _)
|
|
% Lambda expressions always need to be processed.
|
|
->
|
|
GoalExpr = GoalExpr0,
|
|
GoalInfo1 = GoalInfo0
|
|
;
|
|
recompute_instmap_delta_2(RecomputeAtomic, GoalExpr0, GoalInfo0,
|
|
GoalExpr, VarTypes, InstMap0, InstMapDelta0, !RI),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo0),
|
|
instmap_delta_restrict(NonLocals, InstMapDelta0, InstMapDelta1),
|
|
goal_info_set_instmap_delta(InstMapDelta1, GoalInfo0, GoalInfo1)
|
|
),
|
|
|
|
% If the initial instmap is unreachable so is the final instmap.
|
|
( instmap.is_unreachable(InstMap0) ->
|
|
instmap_delta_init_unreachable(UnreachableInstMapDelta),
|
|
goal_info_set_instmap_delta(UnreachableInstMapDelta,
|
|
GoalInfo1, GoalInfo)
|
|
;
|
|
GoalInfo = GoalInfo1
|
|
),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo),
|
|
InstMapDelta = goal_info_get_instmap_delta(GoalInfo).
|
|
|
|
:- type recompute_info
|
|
---> recompute_info(
|
|
module_info :: module_info,
|
|
inst_varset :: inst_varset
|
|
).
|
|
|
|
% update_module_info(P, R, RI0, RI) will call predicate P, passing it
|
|
% the module_info from RI0 and placing the output module_info in RI.
|
|
% The output of P's first argument is returned in R.
|
|
%
|
|
:- pred update_module_info(
|
|
pred(T, module_info, module_info)::in(pred(out, in, out) is det),
|
|
T::out, recompute_info::in, recompute_info::out) is det.
|
|
|
|
update_module_info(P, R, !RI) :-
|
|
ModuleInfo0 = !.RI ^ module_info,
|
|
P(R, ModuleInfo0, ModuleInfo),
|
|
!:RI = !.RI ^ module_info := ModuleInfo.
|
|
|
|
:- pred recompute_instmap_delta_2(bool::in, hlds_goal_expr::in,
|
|
hlds_goal_info::in, hlds_goal_expr::out, vartypes::in, instmap::in,
|
|
instmap_delta::out, recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_2(Atomic, switch(Var, Det, Cases0), GoalInfo,
|
|
switch(Var, Det, Cases), VarTypes, InstMap, InstMapDelta, !RI) :-
|
|
( goal_info_has_feature(GoalInfo, feature_mode_check_clauses_goal) ->
|
|
Cases = Cases0,
|
|
InstMapDelta = goal_info_get_instmap_delta(GoalInfo)
|
|
;
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
recompute_instmap_delta_cases(Atomic, Var, Cases0, Cases,
|
|
VarTypes, InstMap, NonLocals, InstMapDelta, !RI)
|
|
).
|
|
|
|
recompute_instmap_delta_2(Atomic, conj(ConjType, Goals0), _GoalInfo,
|
|
conj(ConjType, Goals), VarTypes, InstMap, InstMapDelta, !RI) :-
|
|
recompute_instmap_delta_conj(Atomic, Goals0, Goals,
|
|
VarTypes, InstMap, InstMapDelta, !RI).
|
|
|
|
recompute_instmap_delta_2(Atomic, disj(Goals0), GoalInfo, disj(Goals),
|
|
VarTypes, InstMap, InstMapDelta, !RI) :-
|
|
( goal_info_has_feature(GoalInfo, feature_mode_check_clauses_goal) ->
|
|
Goals = Goals0,
|
|
InstMapDelta = goal_info_get_instmap_delta(GoalInfo)
|
|
;
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
recompute_instmap_delta_disj(Atomic, Goals0, Goals,
|
|
VarTypes, InstMap, NonLocals, InstMapDelta, !RI)
|
|
).
|
|
|
|
recompute_instmap_delta_2(Atomic, negation(Goal0), _, negation(Goal),
|
|
VarTypes, InstMap, InstMapDelta, !RI) :-
|
|
instmap_delta_init_reachable(InstMapDelta),
|
|
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, _,
|
|
!RI).
|
|
|
|
recompute_instmap_delta_2(Atomic, if_then_else(Vars, Cond0, Then0, Else0),
|
|
GoalInfo, if_then_else(Vars, Cond, Then, Else), VarTypes,
|
|
InstMap0, InstMapDelta, !RI) :-
|
|
recompute_instmap_delta_1(Atomic, Cond0, Cond, VarTypes, InstMap0,
|
|
InstMapDeltaCond, !RI),
|
|
instmap.apply_instmap_delta(InstMap0, InstMapDeltaCond, InstMapCond),
|
|
recompute_instmap_delta_1(Atomic, Then0, Then, VarTypes, InstMapCond,
|
|
InstMapDeltaThen, !RI),
|
|
recompute_instmap_delta_1(Atomic, Else0, Else, VarTypes, InstMap0,
|
|
InstMapDeltaElse, !RI),
|
|
instmap_delta_apply_instmap_delta(InstMapDeltaCond, InstMapDeltaThen,
|
|
test_size, InstMapDeltaCondThen),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
update_module_info(
|
|
merge_instmap_delta(InstMap0, NonLocals,
|
|
VarTypes, InstMapDeltaElse, InstMapDeltaCondThen),
|
|
InstMapDelta, !RI).
|
|
|
|
recompute_instmap_delta_2(Atomic, scope(Reason, Goal0), _,
|
|
scope(Reason, Goal), VarTypes, InstMap, InstMapDelta, !RI) :-
|
|
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap,
|
|
InstMapDelta, !RI).
|
|
|
|
recompute_instmap_delta_2(_, generic_call(Details, Vars, Modes, Detism), _,
|
|
generic_call(Details, Vars, Modes, Detism),
|
|
_VarTypes, _InstMap, InstMapDelta, !RI) :-
|
|
ModuleInfo = !.RI ^ module_info,
|
|
instmap_delta_from_mode_list(Vars, Modes, ModuleInfo, InstMapDelta).
|
|
|
|
recompute_instmap_delta_2(_, plain_call(PredId, ProcId, Args, BI, UC, Name), _,
|
|
plain_call(PredId, ProcId, Args, BI, UC, Name), VarTypes,
|
|
InstMap, InstMapDelta, !RI) :-
|
|
recompute_instmap_delta_call(PredId, ProcId,
|
|
Args, VarTypes, InstMap, InstMapDelta, !RI).
|
|
|
|
recompute_instmap_delta_2(Atomic, unify(LHS, RHS0, UniMode0, Uni, Context),
|
|
GoalInfo, unify(LHS, RHS, UniMode, Uni, Context), VarTypes,
|
|
InstMap0, InstMapDelta, !RI) :-
|
|
(
|
|
RHS0 = rhs_lambda_goal(Purity, PorF, EvalMethod, NonLocals,
|
|
LambdaVars, Modes, Det, Goal0)
|
|
->
|
|
ModuleInfo0 = !.RI ^ module_info,
|
|
instmap.pre_lambda_update(ModuleInfo0, LambdaVars, Modes,
|
|
InstMap0, InstMap),
|
|
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes,
|
|
InstMap, _, !RI),
|
|
RHS = rhs_lambda_goal(Purity, PorF, EvalMethod, NonLocals,
|
|
LambdaVars, Modes, Det, Goal)
|
|
;
|
|
RHS = RHS0
|
|
),
|
|
(
|
|
Atomic = yes,
|
|
recompute_instmap_delta_unify(Uni, UniMode0, UniMode,
|
|
GoalInfo, InstMap0, InstMapDelta, !.RI)
|
|
;
|
|
Atomic = no,
|
|
UniMode = UniMode0,
|
|
InstMapDelta = goal_info_get_instmap_delta(GoalInfo)
|
|
).
|
|
|
|
recompute_instmap_delta_2(_,
|
|
call_foreign_proc(Attr, PredId, ProcId, Args, ExtraArgs, MTRC, Impl),
|
|
GoalInfo,
|
|
call_foreign_proc(Attr, PredId, ProcId, Args, ExtraArgs, MTRC, Impl),
|
|
VarTypes, InstMap, InstMapDelta, !RI) :-
|
|
ArgVars = list.map(foreign_arg_var, Args),
|
|
recompute_instmap_delta_call(PredId, ProcId,
|
|
ArgVars, VarTypes, InstMap, InstMapDelta0, !RI),
|
|
(
|
|
ExtraArgs = [],
|
|
InstMapDelta = InstMapDelta0
|
|
;
|
|
ExtraArgs = [_ | _],
|
|
OldInstMapDelta = goal_info_get_instmap_delta(GoalInfo),
|
|
ExtraArgVars = list.map(foreign_arg_var, ExtraArgs),
|
|
instmap_delta_restrict(set.list_to_set(ExtraArgVars),
|
|
OldInstMapDelta, ExtraArgsInstMapDelta),
|
|
instmap_delta_apply_instmap_delta(InstMapDelta0,
|
|
ExtraArgsInstMapDelta, large_base, InstMapDelta)
|
|
).
|
|
|
|
recompute_instmap_delta_2(_, shorthand(_), _, _, _, _, _, !RI) :-
|
|
% these should have been expanded out by now
|
|
unexpected(this_file,
|
|
"recompute_instmap_delta_2: unexpected shorthand").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred recompute_instmap_delta_conj(bool::in, list(hlds_goal)::in,
|
|
list(hlds_goal)::out, vartypes::in, instmap::in, instmap_delta::out,
|
|
recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_conj(_, [], [], _, _, InstMapDelta, !RI) :-
|
|
instmap_delta_init_reachable(InstMapDelta).
|
|
recompute_instmap_delta_conj(Atomic, [Goal0 | Goals0], [Goal | Goals],
|
|
VarTypes, InstMap0, InstMapDelta, !RI) :-
|
|
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap0,
|
|
InstMapDelta0, !RI),
|
|
instmap.apply_instmap_delta(InstMap0, InstMapDelta0, InstMap1),
|
|
recompute_instmap_delta_conj(Atomic, Goals0, Goals, VarTypes, InstMap1,
|
|
InstMapDelta1, !RI),
|
|
instmap_delta_apply_instmap_delta(InstMapDelta0, InstMapDelta1,
|
|
large_overlay, InstMapDelta).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred recompute_instmap_delta_disj(bool::in, list(hlds_goal)::in,
|
|
list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in,
|
|
instmap_delta::out, recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_disj(Atomic, Goals0, Goals, VarTypes, InstMap,
|
|
NonLocals, InstMapDelta, !RI) :-
|
|
recompute_instmap_delta_disj_2(Atomic, Goals0, Goals, VarTypes, InstMap,
|
|
NonLocals, InstMapDeltas, !RI),
|
|
(
|
|
InstMapDeltas = [],
|
|
instmap_delta_init_unreachable(InstMapDelta)
|
|
;
|
|
InstMapDeltas = [_ | _],
|
|
update_module_info(
|
|
merge_instmap_deltas(InstMap, NonLocals, VarTypes, InstMapDeltas),
|
|
InstMapDelta, !RI)
|
|
).
|
|
|
|
:- pred recompute_instmap_delta_disj_2(bool::in, list(hlds_goal)::in,
|
|
list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in,
|
|
list(instmap_delta)::out, recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_disj_2(_Atomic, [], [],
|
|
_VarTypes, _InstMap, _NonLocals, [], !RI).
|
|
recompute_instmap_delta_disj_2(Atomic, [Goal0 | Goals0], [Goal | Goals],
|
|
VarTypes, InstMap, NonLocals, [InstMapDelta | InstMapDeltas], !RI) :-
|
|
recompute_instmap_delta_1(Atomic, Goal0, Goal,
|
|
VarTypes, InstMap, InstMapDelta, !RI),
|
|
recompute_instmap_delta_disj_2(Atomic, Goals0, Goals,
|
|
VarTypes, InstMap, NonLocals, InstMapDeltas, !RI).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred recompute_instmap_delta_cases(bool::in, prog_var::in, list(case)::in,
|
|
list(case)::out, vartypes::in, instmap::in, set(prog_var)::in,
|
|
instmap_delta::out, recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_cases(Atomic, Var, Cases0, Cases, VarTypes,
|
|
InstMap0, NonLocals, InstMapDelta, !RI) :-
|
|
recompute_instmap_delta_cases_2(Atomic, Var, Cases0, Cases, VarTypes,
|
|
InstMap0, NonLocals, InstMapDeltas, !RI),
|
|
(
|
|
InstMapDeltas = [],
|
|
instmap_delta_init_unreachable(InstMapDelta)
|
|
;
|
|
InstMapDeltas = [_ | _],
|
|
update_module_info(
|
|
merge_instmap_deltas(InstMap0, NonLocals, VarTypes, InstMapDeltas),
|
|
InstMapDelta, !RI)
|
|
).
|
|
|
|
:- pred recompute_instmap_delta_cases_2(bool::in, prog_var::in, list(case)::in,
|
|
list(case)::out, vartypes::in, instmap::in, set(prog_var)::in,
|
|
list(instmap_delta)::out, recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_cases_2(_Atomic, _Var, [], [],
|
|
_VarTypes, _InstMap, _NonLocals, [], !RI).
|
|
recompute_instmap_delta_cases_2(Atomic, Var, [Case0 | Cases0], [Case | Cases],
|
|
VarTypes, InstMap0, NonLocals, [InstMapDelta | InstMapDeltas], !RI) :-
|
|
Case0 = case(Functor, Goal0),
|
|
map.lookup(VarTypes, Var, Type),
|
|
update_module_info(instmap.bind_var_to_functor(Var, Type, Functor,
|
|
InstMap0), InstMap1, !RI),
|
|
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap1,
|
|
InstMapDelta0, !RI),
|
|
update_module_info(instmap_delta_bind_var_to_functor(Var, Type,
|
|
Functor, InstMap0, InstMapDelta0), InstMapDelta, !RI),
|
|
Case = case(Functor, Goal),
|
|
recompute_instmap_delta_cases_2(Atomic, Var, Cases0, Cases,
|
|
VarTypes, InstMap0, NonLocals, InstMapDeltas, !RI).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred recompute_instmap_delta_call(pred_id::in, proc_id::in,
|
|
list(prog_var)::in, vartypes::in, instmap::in, instmap_delta::out,
|
|
recompute_info::in, recompute_info::out) is det.
|
|
|
|
recompute_instmap_delta_call(PredId, ProcId, Args, VarTypes, InstMap,
|
|
InstMapDelta, !RI) :-
|
|
ModuleInfo = !.RI ^ module_info,
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
|
|
proc_info_interface_determinism(ProcInfo, Detism),
|
|
( determinism_components(Detism, _, at_most_zero) ->
|
|
instmap_delta_init_unreachable(InstMapDelta)
|
|
;
|
|
proc_info_get_argmodes(ProcInfo, ArgModes0),
|
|
proc_info_get_inst_varset(ProcInfo, ProcInstVarSet),
|
|
InstVarSet = !.RI ^ inst_varset,
|
|
rename_apart_inst_vars(InstVarSet, ProcInstVarSet,
|
|
ArgModes0, ArgModes1),
|
|
mode_list_get_initial_insts(ModuleInfo, ArgModes1, InitialInsts),
|
|
|
|
% Compute the inst_var substitution from the initial insts
|
|
% of the called procedure and the insts of the argument variables.
|
|
map.init(InstVarSub0),
|
|
update_module_info(compute_inst_var_sub(Args, VarTypes, InstMap,
|
|
InitialInsts, InstVarSub0), InstVarSub, !RI),
|
|
|
|
% Apply the inst_var substitution to the argument modes.
|
|
mode_list_apply_substitution(InstVarSub, ArgModes1, ArgModes2),
|
|
|
|
% Calculate the final insts of the argument variables from their
|
|
% initial insts and the final insts of the called procedure
|
|
% (with inst_var substitutions applied).
|
|
update_module_info(
|
|
recompute_instmap_delta_call_2(Args, InstMap, ArgModes2),
|
|
ArgModes, !RI),
|
|
instmap_delta_from_mode_list(Args, ArgModes, ModuleInfo, InstMapDelta)
|
|
).
|
|
|
|
:- pred compute_inst_var_sub(list(prog_var)::in, vartypes::in, instmap::in,
|
|
list(mer_inst)::in, inst_var_sub::in, inst_var_sub::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
compute_inst_var_sub([], _, _, [], !Sub, !ModuleInfo).
|
|
compute_inst_var_sub([_ | _], _, _, [], !Sub, !ModuleInfo) :-
|
|
unexpected(this_file, "compute_inst_var_sub").
|
|
compute_inst_var_sub([], _, _, [_ | _], !Sub, !ModuleInfo) :-
|
|
unexpected(this_file, "compute_inst_var_sub").
|
|
compute_inst_var_sub([Arg | Args], VarTypes, InstMap, [Inst | Insts],
|
|
!Sub, !ModuleInfo) :-
|
|
% This is similar to modecheck_var_has_inst.
|
|
SaveModuleInfo = !.ModuleInfo,
|
|
SaveSub = !.Sub,
|
|
( instmap.is_reachable(InstMap) ->
|
|
instmap.lookup_var(InstMap, Arg, ArgInst),
|
|
map.lookup(VarTypes, Arg, Type),
|
|
( inst_matches_initial(ArgInst, Inst, Type, !ModuleInfo, !Sub) ->
|
|
true
|
|
;
|
|
% error("compute_inst_var_sub: " ++
|
|
% ++ "inst_matches_initial failed")
|
|
% XXX We shouldn't ever get here, but unfortunately
|
|
% the mode system currently has several problems (most
|
|
% noticeably lack of alias tracking for unique modes)
|
|
% which mean inst_matches_initial can sometimes fail
|
|
% here.
|
|
!:ModuleInfo = SaveModuleInfo,
|
|
!:Sub = SaveSub
|
|
)
|
|
;
|
|
true
|
|
),
|
|
compute_inst_var_sub(Args, VarTypes, InstMap, Insts, !Sub, !ModuleInfo).
|
|
|
|
:- pred recompute_instmap_delta_call_2(list(prog_var)::in, instmap::in,
|
|
list(mer_mode)::in, list(mer_mode)::out, module_info::in, module_info::out)
|
|
is det.
|
|
|
|
recompute_instmap_delta_call_2([], _, [], [], !ModuleInfo).
|
|
recompute_instmap_delta_call_2([_ | _], _, [], _, !ModuleInfo) :-
|
|
unexpected(this_file, "recompute_instmap_delta_call_2").
|
|
recompute_instmap_delta_call_2([], _, [_ | _], _, !ModuleInfo) :-
|
|
unexpected(this_file, "recompute_instmap_delta_call_2").
|
|
recompute_instmap_delta_call_2([Arg | Args], InstMap, [Mode0 | Modes0],
|
|
[Mode | Modes], !ModuleInfo) :-
|
|
% This is similar to modecheck_set_var_inst.
|
|
( instmap.is_reachable(InstMap) ->
|
|
instmap.lookup_var(InstMap, Arg, ArgInst0),
|
|
mode_get_insts(!.ModuleInfo, Mode0, _, FinalInst),
|
|
(
|
|
abstractly_unify_inst(is_dead, ArgInst0, FinalInst,
|
|
fake_unify, UnifyInst, _, !ModuleInfo)
|
|
->
|
|
Mode = (ArgInst0 -> UnifyInst)
|
|
;
|
|
unexpected(this_file,
|
|
"recompute_instmap_delta_call_2: unify_inst failed")
|
|
)
|
|
;
|
|
Mode = (not_reached -> not_reached)
|
|
),
|
|
recompute_instmap_delta_call_2(Args, InstMap, Modes0, Modes,
|
|
!ModuleInfo).
|
|
|
|
:- pred recompute_instmap_delta_unify(unification::in, unify_mode::in,
|
|
unify_mode::out, hlds_goal_info::in, instmap::in, instmap_delta::out,
|
|
recompute_info::in) is det.
|
|
|
|
recompute_instmap_delta_unify(Uni, UniMode0, UniMode, GoalInfo,
|
|
InstMap, InstMapDelta, RI) :-
|
|
% Deconstructions are the only types of unifications that can require
|
|
% updating of the instmap_delta after simplify.m has been run.
|
|
% Type specialization may require constructions of type-infos,
|
|
% typeclass-infos or predicate constants to be added to the
|
|
% instmap_delta.
|
|
ModuleInfo = RI ^ module_info,
|
|
(
|
|
Uni = deconstruct(Var, _ConsId, Vars, UniModes, _, _CanCGC),
|
|
|
|
% Get the final inst of the deconstructed var, which will be the same
|
|
% as in the old instmap.
|
|
|
|
OldInstMapDelta = goal_info_get_instmap_delta(GoalInfo),
|
|
instmap.lookup_var(InstMap, Var, InitialInst),
|
|
( instmap_delta_search_var(OldInstMapDelta, Var, FinalInst1) ->
|
|
% XXX we need to merge the information in InitialInst
|
|
% and FinalInst1. In puzzle_detism_bug, InitialInst
|
|
% has a var bound to one function symbol (james), while
|
|
% FinalInst1 has it bound to another (katherine).
|
|
% The correct final inst is thus `unreachable', but
|
|
% we don't return that.
|
|
FinalInst = FinalInst1
|
|
;
|
|
% It wasn't in the instmap_delta, so the inst didn't
|
|
% change.
|
|
FinalInst = InitialInst
|
|
),
|
|
UniModeToRhsMode =
|
|
(pred(UMode::in, Mode::out) is det :-
|
|
UMode = ((_ - Inst0) -> (_ - Inst)),
|
|
Mode = (Inst0 -> Inst)
|
|
),
|
|
list.map(UniModeToRhsMode, UniModes, Modes),
|
|
instmap_delta_from_mode_list([Var | Vars],
|
|
[(InitialInst -> FinalInst) | Modes],
|
|
ModuleInfo, InstMapDelta),
|
|
UniMode = UniMode0
|
|
;
|
|
Uni = construct(Var, ConsId, Args, _, _, _, _),
|
|
(
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
set.member(Var, NonLocals),
|
|
OldInstMapDelta = goal_info_get_instmap_delta(GoalInfo),
|
|
\+ instmap_delta_search_var(OldInstMapDelta, Var, _),
|
|
MaybeInst = cons_id_to_shared_inst(ModuleInfo, ConsId,
|
|
length(Args)),
|
|
MaybeInst = yes(Inst)
|
|
->
|
|
UniMode = UniMode0,
|
|
instmap_delta_init_reachable(InstMapDelta0),
|
|
instmap_delta_set(Var, Inst, InstMapDelta0, InstMapDelta)
|
|
;
|
|
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
|
|
UniMode = UniMode0
|
|
)
|
|
;
|
|
( Uni = assign(_, _)
|
|
; Uni = simple_test(_, _)
|
|
; Uni = complicated_unify(_, _, _)
|
|
),
|
|
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
|
|
UniMode = UniMode0
|
|
).
|
|
|
|
% For a builtin constructor, return the inst of the constructed term.
|
|
% Handling user-defined constructors properly would require running
|
|
% mode analysis again.
|
|
%
|
|
:- func cons_id_to_shared_inst(module_info, cons_id, int) = maybe(mer_inst).
|
|
|
|
cons_id_to_shared_inst(_, cons(_, _), _) = no.
|
|
cons_id_to_shared_inst(_, ConsId @ int_const(_), _) =
|
|
yes(bound(shared, [bound_functor(ConsId, [])])).
|
|
cons_id_to_shared_inst(_, ConsId @ float_const(_), _) =
|
|
yes(bound(shared, [bound_functor(ConsId, [])])).
|
|
cons_id_to_shared_inst(_, ConsId @ string_const(_), _) =
|
|
yes(bound(shared, [bound_functor(ConsId, [])])).
|
|
cons_id_to_shared_inst(ModuleInfo, pred_const(PredProcId, _), NumArgs) =
|
|
yes(ground(shared, higher_order(pred_inst_info(PorF, Modes, Det)))) :-
|
|
module_info_pred_proc_info(ModuleInfo, unshroud_pred_proc_id(PredProcId),
|
|
PredInfo, ProcInfo),
|
|
PorF = pred_info_is_pred_or_func(PredInfo),
|
|
proc_info_interface_determinism(ProcInfo, Det),
|
|
proc_info_get_argmodes(ProcInfo, ProcArgModes),
|
|
( list.drop(NumArgs, ProcArgModes, Modes0) ->
|
|
Modes = Modes0
|
|
;
|
|
unexpected(this_file, "list.drop failed in cons_id_to_shared_inst")
|
|
).
|
|
cons_id_to_shared_inst(_, type_ctor_info_const(_, _, _), _) =
|
|
yes(ground(shared, none)).
|
|
cons_id_to_shared_inst(_, base_typeclass_info_const(_, _, _, _), _) =
|
|
yes(ground(shared, none)).
|
|
cons_id_to_shared_inst(_, type_info_cell_constructor(_), _) =
|
|
yes(ground(shared, none)).
|
|
cons_id_to_shared_inst(_, typeclass_info_cell_constructor, _) =
|
|
yes(ground(shared, none)).
|
|
cons_id_to_shared_inst(_, tabling_info_const(_), _) =
|
|
yes(ground(shared, none)).
|
|
cons_id_to_shared_inst(_, deep_profiling_proc_layout(_), _) =
|
|
yes(ground(shared, none)).
|
|
cons_id_to_shared_inst(_, table_io_decl(_), _) =
|
|
yes(ground(shared, none)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Arguments with final inst `clobbered' are dead, any
|
|
% others are assumed to be live.
|
|
%
|
|
get_arg_lives(_, [], []).
|
|
get_arg_lives(ModuleInfo, [Mode | Modes], [IsLive | IsLives]) :-
|
|
mode_get_insts(ModuleInfo, Mode, _InitialInst, FinalInst),
|
|
( inst_is_clobbered(ModuleInfo, FinalInst) ->
|
|
IsLive = is_dead
|
|
;
|
|
IsLive = is_live
|
|
),
|
|
get_arg_lives(ModuleInfo, Modes, IsLives).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
normalise_insts(_, [], [], []).
|
|
normalise_insts(_, [], [_ | _], _) :-
|
|
unexpected(this_file, "normalise_insts: length mismatch").
|
|
normalise_insts(_, [_ | _], [], _) :-
|
|
unexpected(this_file, "normalise_insts: length mismatch").
|
|
normalise_insts(ModuleInfo, [Type | Types],
|
|
[Inst0 | Insts0], [Inst | Insts]) :-
|
|
normalise_inst(ModuleInfo, Type, Inst0, Inst),
|
|
normalise_insts(ModuleInfo, Types, Insts0, Insts).
|
|
|
|
% This is a bit of a hack.
|
|
% The aim is to avoid non-termination due to the creation
|
|
% of ever-expanding insts.
|
|
% XXX should also normalise partially instantiated insts.
|
|
%
|
|
normalise_inst(ModuleInfo, Type, Inst0, NormalisedInst) :-
|
|
inst_expand(ModuleInfo, Inst0, Inst),
|
|
( Inst = bound(_, _) ->
|
|
(
|
|
inst_is_ground(ModuleInfo, Inst),
|
|
inst_is_unique(ModuleInfo, Inst),
|
|
% don't infer unique modes for introduced type_infos
|
|
% arguments, because that leads to an increase
|
|
% in the number of inferred modes without any benefit
|
|
\+ is_introduced_type_info_type(Type),
|
|
\+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
|
|
->
|
|
NormalisedInst = ground(unique, none)
|
|
;
|
|
inst_is_ground(ModuleInfo, Inst),
|
|
inst_is_mostly_unique(ModuleInfo, Inst),
|
|
% don't infer unique modes for introduced type_infos
|
|
% arguments, because that leads to an increase
|
|
% in the number of inferred modes without any benefit
|
|
\+ is_introduced_type_info_type(Type),
|
|
\+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
|
|
->
|
|
NormalisedInst = ground(mostly_unique, none)
|
|
;
|
|
inst_is_ground(ModuleInfo, Inst),
|
|
\+ inst_is_clobbered(ModuleInfo, Inst),
|
|
\+ inst_contains_nonstandard_func_mode(ModuleInfo, Inst)
|
|
->
|
|
NormalisedInst = ground(shared, none)
|
|
;
|
|
% XXX need to limit the potential size of insts
|
|
% here in order to avoid infinite loops in
|
|
% mode inference
|
|
NormalisedInst = Inst
|
|
)
|
|
;
|
|
NormalisedInst = Inst
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
fixup_switch_var(Var, InstMap0, InstMap, Goal0, Goal) :-
|
|
Goal0 = hlds_goal(GoalExpr, GoalInfo0),
|
|
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
|
|
instmap.lookup_var(InstMap0, Var, Inst0),
|
|
instmap.lookup_var(InstMap, Var, Inst),
|
|
( Inst = Inst0 ->
|
|
GoalInfo = GoalInfo0
|
|
;
|
|
instmap_delta_set(Var, Inst, InstMapDelta0, InstMapDelta),
|
|
goal_info_set_instmap_delta(InstMapDelta, GoalInfo0, GoalInfo)
|
|
),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
partition_args(_, [], [_ | _], _, _) :-
|
|
unexpected(this_file, "partition_args").
|
|
partition_args(_, [_ | _], [], _, _) :-
|
|
unexpected(this_file, "partition_args").
|
|
partition_args(_, [], [], [], []).
|
|
partition_args(ModuleInfo, [ArgMode | ArgModes], [Arg | Args],
|
|
!:InputArgs, !:OutputArgs) :-
|
|
partition_args(ModuleInfo, ArgModes, Args, !:InputArgs, !:OutputArgs),
|
|
( mode_is_input(ModuleInfo, ArgMode) ->
|
|
!:InputArgs = [Arg | !.InputArgs]
|
|
;
|
|
!:OutputArgs = [Arg | !.OutputArgs]
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "mode_util.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|