mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
ee9c7d3a84
The code that checks whether a bound inst wrapped around
a list of bound_functors matched the ground inst did several things
in a suboptimal fashion.
- It looked up the definition of the type constructor of the relevant type
(the type of the variable the inst is for) more than once. (This was
not easily visible because the lookups were in different predicates.)
This diff factors these out, not for the immesurably small speedup,
but to make possible the fixes for the next two issues.
- To simplify the "is there a bound_functor for each constructor in the type"
check, it sorted the constructors of the type by name and arity. (Lists of
bound_functors are always sorted by name and arity.) Given that most
modules contain more than one bound inst for any given type constructor,
any sorting after the first was unnecessarily repeated work. This diff
therefore extends the representation of du types, which until now has
include only a list of the data constructors in the type definition
in definition order, with a list of those exact same data constructors
in name/arity order.
- Even if a list of bound_functors lists all the constructors of a type,
the bound inst containing them is not equivalent to ground if the inst
of some argument of some bound_inst is not equivalent to ground.
This means that we need to know the actual argument of each constructor.
The du type definition lists argument types that refer to the type
constructor's type parameters; we need the instances of these argument types
that apply to type of the variable at hand, which usually binds concrete
types to those type parameters.
We used to apply the type-parameter-to-actual-type substitution to
each argument of each data constructor in the type before we compared
the resulting filled-in data constructor descriptions against the list of
bound_functors. However, in cases where the comparison fails, the
substitution applications to arguments beyond the point of failure
are all wasted work. This diff therefore applies the substitution
only when its result is about to be needed.
This diff leads to a speedup of about 3.5% on tools/speedtest,
and about 38% (yes, more than a third) when compiling options.m.
compiler/hlds_data.m:
Add the new field to the representation of du types.
Add a utility predicate that helps construct that field, since it is
now needed by two modules (add_type.m and equiv_type_hlds.m).
Delete two functions that were used only by det_check_switch.m,
which this diff moves to that module (in modified form).
compiler/inst_match.m:
Implement the first and third changes listed above, and take advantage
of the second.
The old call to all_du_ctor_arg_types, which this diff replaces,
effectively lied about the list of constructors it returned,
by simply not returning any constructors containing existentially
quantified types, on the grounds that they "were not handled yet".
We now fail explicitly when we find any such constructors.
Perform the check for one-to-one match between bound_functors and
constructors with less argument passing.
compiler/det_check_switch.m:
Move the code deleted from hlds_data.m here, and simplify it,
taking advantage of the new field in du types.
compiler/Mercury.options:
Specify --optimize-constructor-last-call for det_check_switch.m
to optimize the updated moved code.
compiler/add_foreign_enum.m:
compiler/add_special_pred.m:
compiler/add_type.m:
compiler/check_typeclass.m:
compiler/code_info.m:
compiler/dead_proc_elim.m:
compiler/direct_arg_in_out.m:
compiler/du_type_layout.m:
compiler/equiv_type_hlds.m:
compiler/hlds_out_type_table.m:
compiler/inst_check.m:
compiler/intermod.m:
compiler/intermod_decide.m:
compiler/lookup_switch_util.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen_test.m:
compiler/ml_unify_gen_util.m:
compiler/mlds.m:
compiler/post_term_analysis.m:
compiler/recompilation.usage.m:
compiler/resolve_unify_functor.m:
compiler/simplify_goal_ite.m:
compiler/table_gen.m:
compiler/tag_switch_util.m:
compiler/term_norm.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
compiler/typecheck_coerce.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Conform to the changes above. This mostly means handling
the new field in du types (usually by ignoring it).
549 lines
20 KiB
Mathematica
549 lines
20 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1997-2012 The University of Melbourne.
|
|
% Copyright (C) 2015-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: term_norm.m.
|
|
% Main author: crs.
|
|
%
|
|
% This modules defines predicates for computing functor norms.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.term_norm.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The functor_info type contains information about how the weight
|
|
% of a term is calculated.
|
|
%
|
|
:- type functor_info.
|
|
|
|
% This predicate sets the functor_info depending on the value of the
|
|
% termination_norm or termination2_norm option.
|
|
%
|
|
:- func set_functor_info(module_info, globals.termination_norm) = functor_info.
|
|
|
|
% This predicate computes the weight of a functor and the set of arguments
|
|
% of that functor whose sizes should be counted towards the size of the
|
|
% whole term.
|
|
%
|
|
% NOTE: the list of arguments and the list of modes must have the same
|
|
% length. They must also *not* contain any typeinfo related arguments as
|
|
% this may cause an exception to be thrown when using the
|
|
% `--num-data-elems' norm. (This is because the weight table does not
|
|
% keep track of typeinfo related variables - it used to, but intervening
|
|
% compiler passes tend to do things to the code in the mean time, so the
|
|
% whole lot becomes inconsistent - in the end it is just easier to ignore
|
|
% them).
|
|
%
|
|
:- pred functor_norm(module_info::in, functor_info::in, type_ctor::in,
|
|
cons_id::in, int::out, list(prog_var)::in, list(prog_var)::out,
|
|
list(unify_mode)::in, list(unify_mode)::out) is det.
|
|
|
|
% This function computes a lower bound on the weight of a functor.
|
|
% If the lower bound is zero then the weight of that functor is also zero.
|
|
% If the lower bound is non-zero then there may be no upper bound
|
|
% on the size of the functor. (And if there were, this function
|
|
% would not tell you about it anyhow).
|
|
%
|
|
:- func functor_lower_bound(module_info, functor_info, type_ctor, cons_id)
|
|
= int.
|
|
|
|
% Succeeds if all values of the given type are zero size (for all norms).
|
|
%
|
|
:- pred zero_size_type(module_info::in, mer_type::in) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.const_struct.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.type_util.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_type_test.
|
|
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module one_or_more.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% We use semilinear norms (denoted by ||) to compute the sizes of terms.
|
|
% These have the form
|
|
%
|
|
% |f(t1, ... tn)| = weight(f) + sum of |ti|
|
|
% where i is an element of a set I, and I is a subset of {1, ... n}
|
|
%
|
|
% We currently support four kinds of semilinear norms.
|
|
% XXX Actually we currently only use three of them. `use_map/1' is unused.
|
|
|
|
:- type functor_info
|
|
---> simple
|
|
% All non-constant functors have weight 1, while constants
|
|
% have weight 0. Use the size of all subterms (I = {1, ..., n}.
|
|
|
|
; total
|
|
% All functors have weight = arity of the functor.
|
|
% Use the size of all subterms (I = {1, ..., n}.
|
|
|
|
; use_map(weight_table)
|
|
% The weight of each functor is given by the table.
|
|
% Use the size of all subterms (I = {1, ..., n}.
|
|
|
|
; use_map_and_args(weight_table).
|
|
% The weight of each functor is given by the table, and so is
|
|
% the set of arguments of the functor whose size should be counted
|
|
% (I is given by the table entry of the functor).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Calculate the weight to be assigned to each function symbol for the
|
|
% use_map and use_map_and_args semilinear norms.
|
|
%
|
|
% Given a type definition such as
|
|
%
|
|
% :- type t(Tk)
|
|
% ---> f1(a11, ... a1n1) where n1 is the arity of f1
|
|
% ; ...
|
|
% ; fm(am1, ... amnm) where nm is the arity of fm
|
|
%
|
|
% we check, for each aij, whether its type is recursive (i.e. it is t with
|
|
% type variable arguments that are a permutation of Tk). The weight info
|
|
% we compute for each functor will have a boolean list that has a `yes'
|
|
% for each recursive argument and a `no' for each nonrecursive argument.
|
|
% The weight to be assigned to the functor is the number of nonrecursive
|
|
% arguments, except that we assign a weight of at least 1 to all functors
|
|
% which are not constants.
|
|
|
|
% XXX Next time we have a reason to update this module, we should replace
|
|
% the cons_id type here with du_ctor.
|
|
:- type weight_table == map(pair(type_ctor, cons_id), weight_info).
|
|
|
|
:- type weight_info
|
|
---> weight(int, list(bool)).
|
|
|
|
:- pred find_weights(module_info::in, weight_table::out) is det.
|
|
|
|
find_weights(ModuleInfo, Weights) :-
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
get_all_type_ctor_defns(TypeTable, TypeCtorsDefns),
|
|
map.init(Weights0),
|
|
list.foldl(find_weights_for_type, TypeCtorsDefns, Weights0, Weights).
|
|
|
|
:- pred find_weights_for_type(pair(type_ctor, hlds_type_defn)::in,
|
|
weight_table::in, weight_table::out) is det.
|
|
|
|
find_weights_for_type(TypeCtor - TypeDefn, !Weights) :-
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
(
|
|
TypeBody = hlds_du_type(type_body_du(Constructors, _, _, _, _, _)),
|
|
hlds_data.get_type_defn_tparams(TypeDefn, TypeParams),
|
|
list.foldl(find_weights_for_cons(TypeCtor, TypeParams),
|
|
one_or_more_to_list(Constructors), !Weights)
|
|
;
|
|
% This type does not introduce any functors.
|
|
TypeBody = hlds_eqv_type(_)
|
|
;
|
|
% This type may introduce some functors,
|
|
% but we will never see them in this analysis.
|
|
TypeBody = hlds_abstract_type(_)
|
|
;
|
|
% This type does not introduce any functors.
|
|
TypeBody = hlds_foreign_type(_)
|
|
;
|
|
% This type does not introduce any functors.
|
|
TypeBody = hlds_solver_type(_)
|
|
).
|
|
|
|
:- pred find_weights_for_cons(type_ctor::in, list(type_param)::in,
|
|
constructor::in, weight_table::in, weight_table::out) is det.
|
|
|
|
find_weights_for_cons(TypeCtor, Params, Ctor, !Weights) :-
|
|
% For existentially typed data items the compiler may insert some
|
|
% typeinfo related arguments into the functor. We ignore these arguments
|
|
% when calculating the weight of a functor and we do not include them
|
|
% in the list of counted arguments.
|
|
Ctor = ctor(_Ordinal, _MaybeExistConstraints, SymName, Args, Arity,
|
|
_Context),
|
|
( if Arity > 0 then
|
|
find_and_count_nonrec_args(Args, TypeCtor, Params,
|
|
NumNonRec, ArgInfos0),
|
|
( if NumNonRec = 0 then
|
|
Weight = 1,
|
|
list.duplicate(Arity, yes, ArgInfos)
|
|
else
|
|
Weight = NumNonRec,
|
|
ArgInfos = ArgInfos0
|
|
),
|
|
WeightInfo = weight(Weight, ArgInfos)
|
|
else
|
|
WeightInfo = weight(0, [])
|
|
),
|
|
ConsId = du_data_ctor(du_ctor(SymName, Arity, TypeCtor)),
|
|
map.det_insert(TypeCtor - ConsId, WeightInfo, !Weights).
|
|
|
|
:- pred find_weights_for_tuple(arity::in, weight_info::out) is det.
|
|
|
|
find_weights_for_tuple(Arity, weight(Weight, ArgInfos)) :-
|
|
% None of the tuple arguments are recursive.
|
|
Weight = Arity,
|
|
list.duplicate(Arity, yes, ArgInfos).
|
|
|
|
:- pred find_and_count_nonrec_args(list(constructor_arg)::in,
|
|
type_ctor::in, list(type_param)::in,
|
|
int::out, list(bool)::out) is det.
|
|
|
|
find_and_count_nonrec_args([], _, _, 0, []).
|
|
find_and_count_nonrec_args([Arg | Args], Id, Params, NonRecArgs, ArgInfo) :-
|
|
find_and_count_nonrec_args(Args, Id, Params, NonRecArgs0, ArgInfo0),
|
|
( if is_arg_recursive(Arg, Id, Params) then
|
|
NonRecArgs = NonRecArgs0,
|
|
ArgInfo = [yes | ArgInfo0]
|
|
else
|
|
NonRecArgs = NonRecArgs0 + 1,
|
|
ArgInfo = [no | ArgInfo0]
|
|
).
|
|
|
|
:- pred is_arg_recursive(constructor_arg::in, type_ctor::in,
|
|
list(type_param)::in) is semidet.
|
|
|
|
is_arg_recursive(Arg, TypeCtor, Params) :-
|
|
ArgType = Arg ^ arg_type,
|
|
type_to_ctor_and_args(ArgType, ArgTypeCtor, ArgTypeArgs),
|
|
TypeCtor = ArgTypeCtor,
|
|
prog_type.type_list_to_var_list(ArgTypeArgs, ArgTypeParams),
|
|
list.perm(Params, ArgTypeParams).
|
|
|
|
:- pred search_weight_table(weight_table::in, type_ctor::in, cons_id::in,
|
|
weight_info::out) is semidet.
|
|
|
|
search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) :-
|
|
( if map.search(WeightMap, TypeCtor - ConsId, WeightInfo0) then
|
|
WeightInfo = WeightInfo0
|
|
else if type_ctor_is_tuple(TypeCtor) then
|
|
TypeCtor = type_ctor(_, Arity),
|
|
find_weights_for_tuple(Arity, WeightInfo)
|
|
else
|
|
fail
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
set_functor_info(_ModuleInfo, norm_total) = total.
|
|
set_functor_info(_ModuleInfo, norm_simple) = simple.
|
|
set_functor_info(ModuleInfo, norm_num_data_elems) = FunctorInfo :-
|
|
find_weights(ModuleInfo, WeightMap),
|
|
FunctorInfo = use_map_and_args(WeightMap).
|
|
set_functor_info(ModuleInfo, norm_size_data_elems) = FunctorInfo :-
|
|
find_weights(ModuleInfo, WeightMap),
|
|
FunctorInfo = use_map(WeightMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
functor_norm(ModuleInfo, FunctorInfo, TypeCtor, ConsId, Gamma,
|
|
!Args, !Modes) :-
|
|
(
|
|
FunctorInfo = simple,
|
|
( if
|
|
ConsId = du_data_ctor(du_ctor(_, Arity, _)),
|
|
Arity \= 0
|
|
then
|
|
Gamma = 1
|
|
else if
|
|
ConsId = ground_term_const(ConstNum, _)
|
|
then
|
|
module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
|
|
const_struct_count_cells(ConstStructDb, ConstNum, 0, Gamma)
|
|
else
|
|
% XXX This does the wrong thing for tuples.
|
|
Gamma = 0
|
|
)
|
|
;
|
|
FunctorInfo = total,
|
|
( if ConsId = du_data_ctor(du_ctor(_, Arity, _)) then
|
|
Gamma = Arity
|
|
else if ConsId = ground_term_const(ConstNum, _) then
|
|
module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
|
|
const_struct_count_cell_arities(ConstStructDb, ConstNum, 0, Gamma)
|
|
else
|
|
% XXX This does the wrong thing for tuples.
|
|
Gamma = 0
|
|
)
|
|
;
|
|
FunctorInfo = use_map(WeightMap),
|
|
( if search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) then
|
|
WeightInfo = weight(Gamma, _)
|
|
else if ConsId = ground_term_const(ConstNum, _) then
|
|
module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
|
|
const_struct_count_cell_weights(ConstStructDb, WeightMap,
|
|
ConstNum, 0, Gamma)
|
|
else
|
|
Gamma = 0
|
|
)
|
|
;
|
|
FunctorInfo = use_map_and_args(WeightMap),
|
|
( if search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) then
|
|
WeightInfo = weight(Gamma, UseArgList),
|
|
( if functor_norm_filter_args(UseArgList, !Args, !Modes) then
|
|
true
|
|
else
|
|
unexpected($pred, "unmatched lists")
|
|
)
|
|
else if ConsId = ground_term_const(ConstNum, _) then
|
|
% XXX Since ground_term_consts have no argument variables,
|
|
% we cannot filter those argument variables. I (zs) *think* that
|
|
% returning the !.Args and !.Modes (which should both be empty
|
|
% to begin with) does the right thing, but I am not sure.
|
|
module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
|
|
const_struct_count_cell_filtered_weights(ConstStructDb, WeightMap,
|
|
ConstNum, 0, Gamma)
|
|
else
|
|
Gamma = 0
|
|
)
|
|
).
|
|
|
|
% This predicate will fail if the length of the input lists are not
|
|
% matched.
|
|
%
|
|
:- pred functor_norm_filter_args(list(bool)::in, list(prog_var)::in,
|
|
list(prog_var)::out, list(unify_mode)::in, list(unify_mode)::out)
|
|
is semidet.
|
|
|
|
functor_norm_filter_args([], [], [], [], []).
|
|
functor_norm_filter_args([yes | Bools], [Arg0 | Args0], [Arg0 | Args],
|
|
[Mode0 | Modes0], [Mode0 | Modes]) :-
|
|
functor_norm_filter_args(Bools, Args0, Args, Modes0, Modes).
|
|
functor_norm_filter_args([no | Bools], [_Arg0 | Args0], Args,
|
|
[_Mode0 | Modes0], Modes) :-
|
|
functor_norm_filter_args(Bools, Args0, Args, Modes0, Modes).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred const_struct_count_cells(const_struct_db::in, int::in,
|
|
int::in, int::out) is det.
|
|
|
|
const_struct_count_cells(ConstStructDb, ConstNum, !Gamma) :-
|
|
lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
|
|
ConstStruct = const_struct(_ConsId, Args, _, _, _),
|
|
!:Gamma = !.Gamma + 1,
|
|
const_struct_count_cells_args(ConstStructDb, Args, !Gamma).
|
|
|
|
:- pred const_struct_count_cells_args(const_struct_db::in,
|
|
list(const_struct_arg)::in, int::in, int::out) is det.
|
|
|
|
const_struct_count_cells_args(_ConstStructDb, [], !Gamma).
|
|
const_struct_count_cells_args(ConstStructDb, [Arg | Args], !Gamma) :-
|
|
(
|
|
Arg = csa_constant(_, _)
|
|
;
|
|
Arg = csa_const_struct(ArgConstNum),
|
|
const_struct_count_cells(ConstStructDb, ArgConstNum, !Gamma)
|
|
),
|
|
const_struct_count_cells_args(ConstStructDb, Args, !Gamma).
|
|
|
|
:- pred const_struct_count_cell_arities(const_struct_db::in, int::in,
|
|
int::in, int::out) is det.
|
|
|
|
const_struct_count_cell_arities(ConstStructDb, ConstNum, !Gamma) :-
|
|
lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
|
|
ConstStruct = const_struct(_ConsId, Args, _, _, _),
|
|
!:Gamma = !.Gamma + list.length(Args),
|
|
const_struct_count_cell_arities_args(ConstStructDb, Args, !Gamma).
|
|
|
|
:- pred const_struct_count_cell_arities_args(const_struct_db::in,
|
|
list(const_struct_arg)::in, int::in, int::out) is det.
|
|
|
|
const_struct_count_cell_arities_args(_ConstStructDb, [], !Gamma).
|
|
const_struct_count_cell_arities_args(ConstStructDb, [Arg | Args], !Gamma) :-
|
|
(
|
|
Arg = csa_constant(_, _)
|
|
;
|
|
Arg = csa_const_struct(ArgConstNum),
|
|
const_struct_count_cell_arities(ConstStructDb, ArgConstNum, !Gamma)
|
|
),
|
|
const_struct_count_cell_arities_args(ConstStructDb, Args, !Gamma).
|
|
|
|
:- pred const_struct_count_cell_weights(const_struct_db::in,
|
|
weight_table::in, int::in, int::in, int::out) is det.
|
|
|
|
const_struct_count_cell_weights(ConstStructDb, WeightMap, ConstNum, !Gamma) :-
|
|
lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
|
|
ConstStruct = const_struct(ConsId, Args, Type, _, _),
|
|
type_to_ctor_det(Type, TypeCtor),
|
|
( if search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) then
|
|
WeightInfo = weight(ConsIdGamma, _),
|
|
!:Gamma = !.Gamma + ConsIdGamma,
|
|
const_struct_count_cell_weights_args(ConstStructDb, WeightMap,
|
|
Args, !Gamma)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred const_struct_count_cell_weights_args(const_struct_db::in,
|
|
weight_table::in, list(const_struct_arg)::in, int::in, int::out) is det.
|
|
|
|
const_struct_count_cell_weights_args(_ConstStructDb, _WeightMap, [], !Gamma).
|
|
const_struct_count_cell_weights_args(ConstStructDb, WeightMap,
|
|
[Arg | Args], !Gamma) :-
|
|
(
|
|
Arg = csa_constant(ConsId, Type),
|
|
type_to_ctor_det(Type, TypeCtor),
|
|
( if search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) then
|
|
WeightInfo = weight(ConsIdGamma, _),
|
|
!:Gamma = !.Gamma + ConsIdGamma
|
|
else
|
|
true
|
|
)
|
|
;
|
|
Arg = csa_const_struct(ArgConstNum),
|
|
const_struct_count_cell_weights(ConstStructDb, WeightMap,
|
|
ArgConstNum, !Gamma)
|
|
),
|
|
const_struct_count_cell_weights_args(ConstStructDb, WeightMap,
|
|
Args, !Gamma).
|
|
|
|
:- pred const_struct_count_cell_filtered_weights(const_struct_db::in,
|
|
weight_table::in, int::in, int::in, int::out) is det.
|
|
|
|
const_struct_count_cell_filtered_weights(ConstStructDb, WeightMap,
|
|
ConstNum, !Gamma) :-
|
|
lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
|
|
ConstStruct = const_struct(ConsId, Args, Type, _, _),
|
|
type_to_ctor_det(Type, TypeCtor),
|
|
( if search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) then
|
|
WeightInfo = weight(ConsIdGamma, UseArgs),
|
|
!:Gamma = !.Gamma + ConsIdGamma,
|
|
const_struct_count_cell_filtered_weights_args(ConstStructDb, WeightMap,
|
|
Args, UseArgs, !Gamma)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred const_struct_count_cell_filtered_weights_args(const_struct_db::in,
|
|
weight_table::in, list(const_struct_arg)::in, list(bool)::in,
|
|
int::in, int::out) is det.
|
|
|
|
const_struct_count_cell_filtered_weights_args(_ConstStructDb, _WeightMap,
|
|
[], [], !Gamma).
|
|
const_struct_count_cell_filtered_weights_args(_ConstStructDb, _WeightMap,
|
|
[], [_ | _], !Gamma) :-
|
|
unexpected($pred, "mismatched lists").
|
|
const_struct_count_cell_filtered_weights_args(_ConstStructDb, _WeightMap,
|
|
[_ | _], [], !Gamma) :-
|
|
unexpected($pred, "mismatched lists").
|
|
const_struct_count_cell_filtered_weights_args(ConstStructDb, WeightMap,
|
|
[Arg | Args], [UseArg | UseArgs], !Gamma) :-
|
|
(
|
|
UseArg = no
|
|
;
|
|
UseArg = yes,
|
|
(
|
|
Arg = csa_constant(ConsId, Type),
|
|
type_to_ctor_det(Type, TypeCtor),
|
|
( if
|
|
search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo)
|
|
then
|
|
WeightInfo = weight(ConsIdGamma, _),
|
|
!:Gamma = !.Gamma + ConsIdGamma
|
|
else
|
|
true
|
|
)
|
|
;
|
|
Arg = csa_const_struct(ArgConstNum),
|
|
const_struct_count_cell_filtered_weights(ConstStructDb, WeightMap,
|
|
ArgConstNum, !Gamma)
|
|
)
|
|
),
|
|
const_struct_count_cell_filtered_weights_args(ConstStructDb, WeightMap,
|
|
Args, UseArgs, !Gamma).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
functor_lower_bound(_ModuleInfo, FunctorInfo, TypeCtor, ConsId) = Weight :-
|
|
(
|
|
FunctorInfo = simple,
|
|
( if ConsId = du_data_ctor(du_ctor(_, Arity, _)), Arity \= 0 then
|
|
Weight = 1
|
|
else
|
|
% XXX This does the wrong thing for tuples.
|
|
Weight = 0
|
|
)
|
|
;
|
|
FunctorInfo = total,
|
|
( if ConsId = du_data_ctor(du_ctor(_, Arity, _)) then
|
|
Weight = Arity
|
|
else
|
|
% XXX This does the wrong thing for tuples.
|
|
Weight = 0
|
|
)
|
|
;
|
|
FunctorInfo = use_map(WeightMap),
|
|
( if search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) then
|
|
WeightInfo = weight(Weight, _)
|
|
else
|
|
Weight = 0
|
|
)
|
|
;
|
|
FunctorInfo = use_map_and_args(WeightMap),
|
|
( if search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) then
|
|
WeightInfo = weight(Weight, _)
|
|
else
|
|
Weight = 0
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
zero_size_type(ModuleInfo, Type) :-
|
|
CtorCat = classify_type(ModuleInfo, Type),
|
|
zero_size_type_category(CtorCat, yes).
|
|
|
|
:- pred zero_size_type_category(type_ctor_category::in, bool::out) is det.
|
|
|
|
zero_size_type_category(CtorCat, ZeroSize) :-
|
|
(
|
|
( CtorCat = ctor_cat_builtin(_)
|
|
; CtorCat = ctor_cat_user(cat_user_direct_dummy)
|
|
; CtorCat = ctor_cat_user(cat_user_abstract_dummy)
|
|
; CtorCat = ctor_cat_void
|
|
; CtorCat = ctor_cat_system(_)
|
|
; CtorCat = ctor_cat_higher_order
|
|
; CtorCat = ctor_cat_enum(_)
|
|
; CtorCat = ctor_cat_builtin_dummy
|
|
),
|
|
ZeroSize = yes
|
|
;
|
|
( CtorCat = ctor_cat_user(cat_user_notag)
|
|
; CtorCat = ctor_cat_user(cat_user_abstract_notag)
|
|
; CtorCat = ctor_cat_user(cat_user_general)
|
|
; CtorCat = ctor_cat_tuple
|
|
; CtorCat = ctor_cat_variable
|
|
),
|
|
ZeroSize = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.term_norm.
|
|
%-----------------------------------------------------------------------------%
|