mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 14:25:56 +00:00
fcf0847a91
Estimated hours taken: 8
Branches: main
My previous fix to dead proc elimination helped fixed some compiler aborts,
but a related problem remained.
The problem involved an unused procedure that was kept around so that the code
generator would create the table associated with it. Since the procedure was
unused, its body was thought to be unused too. If it contained a reference to a
procedure that wasn't referred to from anywhere else, that procedure would be
removed, leaving a dangling reference. This would cause a code generator abort.
We can't fix the abort by replacing the kept-around procedure's body with
"true", since that would cause a different code generator abort when moving the
(now unbound) output variables to their argument registers. We could avoid
generating any code for the procedure at all by e.g. marking it as
opt_imported, but this would (a) be inconsistent and (b) require special case
coding to still generate the table structure.
The fix is to generate the global variable used for tabling *independently* of
the procedure that enters things in the table.
compiler/hlds_module.m:
Add a field to the module_info (actually module_sub_info) that records
the information the backends need to create the global variables
representing call tables.
Name all the fields of the module_info and module_sub_info during
initialization, to make it easier to know where to add a new field.
Put the initializations of the fields in the same order as the fields
themselves.
compiler/hlds_pred.m:
Keep only the info for I/O tabling in procedures, since such tabling
does not require defining a per-procedure global variable.
Since the info for the forms of tabling that *do* require a
per-procedure global variable are now divorced from the procedure,
change their definition to avoid storing prog_vars in them, since
those prog_vars would be separated from their varset. Instead, we
record their numbers and their names (both are used only for debug
support).
On the other hand, some info from the pred_info and proc_info are
to create the global variable; copy them into the data structure stored
in hlds_module.
Rename some fields to avoid ambiguities.
compiler/table_gen.m:
Continue to record information about I/O tabling in the proc_info,
but record information about other forms of tabling in the new field
in the module_info.
compiler/rtti.m:
compiler/hlds_rtti.m:
Move the functions for constructing and deconstructing rtti_proc_labels
from rtti.m (which is in backend_libs) to hlds_rtti.m (which is in
hlds); the definition of rtti_proc_label was already in hlds_rtti.m.
The move is needed to allow table_gen to put an rtti_proc_label
in the data structures it puts in the module_info.
compiler/hlds_out.m:
Print out the new module_info field, and conform to the change to
hlds_pred and table_arg_info.
Always print variable numbers for type variables in table_arg_infos.
compiler/continuation_info.m:
Make room for either kind of tabling info for a procedure.
(While the LLDS code generator doesn't need to know about the global
variable representing the call table in order to create it, it does
need to know about it in order to describe it to the debugger.)
Conform to the change in table_arg_info.
Rename some fields to avoid ambiguities.
compiler/proc_gen.m:
When generating code for procedures, do not try to create a
per-procedure tabling struct, but do fill in the slot describing it
in the continuation_info.
Add a predicate to define all the tabling structs in a module.
compiler/mercury_compile.m:
Call proc_gen separately to define all the tabling structs.
compiler/ml_code_gen.m:
As with proc_gen, define tabling structs directly from the module_info
and not when generating code from each proc_info.
(The code for handling each proc is now logically not contiguous;
I will address that in a separate change, to make the diff for this one
easier to read.)
compiler/dead_proc_elim.m:
Don't keep unused tabled procedures alive, since that leads to the
problem described up top.
Keep track of which tabling structs are live, but don't yet act on that
information, since some uses are hidden (for now).
Add conditionally compiled tracing code that helped me trace down the
problem.
Fix an oversight in the severity level of an error spec.
compiler/base_typeclass_info.m:
compiler/code_util.m:
compiler/deep_profiling.m:
compiler/ml_code_util.m:
compiler/proc_label.m:
compiler/type_ctor_info.m:
Conform to the move of make_rtti_proc_label.
compiler/optimize.m:
Conform to the change to continuation_info.
compiler/stack_layout.m:
Conform to the data structure changes above.
doc/user_guide.texi:
Document 'Z' as the character in -D arguments that tells hlds_out
to dump the global structures needed for tabling.
Fix an old oversight: document 'S' as the character in -D arguments
that tells hlds_out to dump info about structure sharing.
compiler/handle_options.m:
Include 'Z' in -DALL -and -Dall.
tests/tabling/mercury_java_parser_dead_proc_elim_bug.{m,exp}:
Move this test case here from valid, since compiling all the way to
executable doesn't work in valid (in yields link errors unrelated to
the bug we are testing for).
tests/tabling/mercury_java_parser_dead_proc_elim_bug2.{m,exp}:
Add this new test case that in unfixed compilers gives the problem
described up top.
tests/tabling/Mmakefile:
Enable the new tests.
tests/valid/Mmakefile:
tests/valid/Mercury.options:
tests/valid/mercury_java_parser_dead_proc_elim_bug.m:
Remove references to the moved test and the test itself.
780 lines
30 KiB
Mathematica
780 lines
30 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-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: hlds_rtti.m.
|
|
% Main authors: Mark Brown.
|
|
%
|
|
% This module defines the part of the HLDS that keeps track of information
|
|
% relating to RTTI.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.hlds_rtti.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module set.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type prog_var_name == string.
|
|
|
|
% The rtti_proc_label type holds all the information about a procedure
|
|
% that we need to compute the entry label for that procedure
|
|
% in the target language (the llds.code_addr or mlds.code_addr).
|
|
|
|
:- type rtti_proc_label
|
|
---> rtti_proc_label(
|
|
pred_or_func :: pred_or_func,
|
|
this_module :: module_name,
|
|
proc_module :: module_name,
|
|
proc_name :: string,
|
|
proc_arity :: arity,
|
|
proc_arg_types :: list(mer_type),
|
|
pred_id :: pred_id,
|
|
proc_id :: proc_id,
|
|
proc_headvars :: assoc_list(prog_var,
|
|
prog_var_name),
|
|
proc_arg_modes :: list(arg_mode),
|
|
proc_interface_detism :: determinism,
|
|
|
|
% The following booleans hold values computed from the
|
|
% pred_info, using procedures
|
|
% pred_info_is_imported/1,
|
|
% pred_info_is_pseudo_imported/1,
|
|
% pred_info_get_origin/1
|
|
% respectively.
|
|
% We store booleans here, rather than storing the
|
|
% pred_info, to avoid retaining a reference to the
|
|
% parts of the pred_info that we aren't interested in,
|
|
% so that those parts can be garbage collected.
|
|
% We use booleans rather than an import_status
|
|
% so that we can continue to use the above-mentioned
|
|
% abstract interfaces rather than hard-coding tests
|
|
% on the import_status.
|
|
|
|
pred_is_imported :: bool,
|
|
pred_is_pseudo_imported :: bool,
|
|
pred_info_origin :: pred_origin,
|
|
|
|
% The following boolean holds a value computed from the
|
|
% proc_info, using procedure_is_exported/2
|
|
|
|
proc_is_exported :: bool,
|
|
|
|
% The following bool is true if the procedure was
|
|
% imported, either because the containing predicate
|
|
% was imported, or because it was pseudoimported
|
|
% and the procedure is an in-in unify procedure.
|
|
|
|
proc_is_imported :: bool
|
|
).
|
|
|
|
% Construct an rtti_proc_label for a given procedure.
|
|
%
|
|
:- func make_rtti_proc_label(module_info, pred_id, proc_id) = rtti_proc_label.
|
|
|
|
% The inverse of make_rtti_proc_label.
|
|
%
|
|
:- pred proc_label_pred_proc_id(rtti_proc_label::in,
|
|
pred_id::out, proc_id::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Types and predicates to store information about RTTI.
|
|
%
|
|
|
|
% Describes the class constraints on an instance method implementation.
|
|
% This information is used by polymorphism.m to ensure that the
|
|
% type_info and typeclass_info arguments are added in the order in
|
|
% which they will be passed in by do_call_class_method.
|
|
%
|
|
:- type instance_method_constraints
|
|
---> instance_method_constraints(
|
|
class_id,
|
|
list(mer_type), % The types in the head of the
|
|
% instance declaration.
|
|
list(prog_constraint), % The universal constraints
|
|
% on the instance declaration.
|
|
prog_constraints % The contraints on the method's
|
|
% type declaration in the
|
|
% `:- typeclass' declaration.
|
|
).
|
|
|
|
% A type_info_locn specifies how to access a type_info.
|
|
%
|
|
:- type type_info_locn
|
|
---> type_info(prog_var)
|
|
% It is a normal type_info, i.e. the type
|
|
% is not constrained.
|
|
|
|
; typeclass_info(prog_var, int).
|
|
% The type_info is packed inside a
|
|
% typeclass_info. If the int is N, it is
|
|
% the Nth type_info inside the typeclass_info,
|
|
% but there may be several superclass pointers
|
|
% before the block of type_infos, so it won't
|
|
% be the Nth word of the typeclass_info.
|
|
%
|
|
% To find the type_info inside the
|
|
% typeclass_info, use the predicate
|
|
% type_info_from_typeclass_info from Mercury
|
|
% code; from C code use the macro
|
|
% MR_typeclass_info_superclass_info.
|
|
|
|
% type_info_locn_var(TypeInfoLocn, Var):
|
|
%
|
|
% Var is the variable corresponding to the TypeInfoLocn. Note
|
|
% that this does *not* mean that Var is a type_info; it may be
|
|
% a typeclass_info in which the type_info is nested.
|
|
%
|
|
:- pred type_info_locn_var(type_info_locn::in, prog_var::out) is det.
|
|
|
|
:- pred type_info_locn_set_var(prog_var::in,
|
|
type_info_locn::in, type_info_locn::out) is det.
|
|
|
|
% This type describes the contents of a prog_var.
|
|
%
|
|
:- type rtti_var_info
|
|
---> type_info_var(mer_type)
|
|
% The variable holds a type_info for the given type.
|
|
|
|
; typeclass_info_var(prog_constraint)
|
|
% The variable holds a typeclass_info for the given
|
|
% constraint.
|
|
|
|
; non_rtti_var.
|
|
% The variable does not directly hold any run time
|
|
% type information.
|
|
|
|
% This records information about how type_infos and typeclass_infos
|
|
% were introduced in the polymorphism transformation.
|
|
%
|
|
:- type rtti_varmaps.
|
|
|
|
% Returns an empty rtti_varmaps structure.
|
|
%
|
|
:- pred rtti_varmaps_init(rtti_varmaps::out) is det.
|
|
|
|
% Succeeds iff the rtti_varmaps contain no information about any
|
|
% type variables.
|
|
%
|
|
:- pred rtti_varmaps_no_tvars(rtti_varmaps::in) is semidet.
|
|
|
|
% Find the location of a type_info.
|
|
%
|
|
:- pred rtti_lookup_type_info_locn(rtti_varmaps::in, tvar::in,
|
|
type_info_locn::out) is det.
|
|
|
|
% Find the location of a type_info, if it is known.
|
|
%
|
|
:- pred rtti_search_type_info_locn(rtti_varmaps::in, tvar::in,
|
|
type_info_locn::out) is semidet.
|
|
|
|
% Find the prog_var which contains the typeclass_info for a given
|
|
% constraint and which can be reused.
|
|
%
|
|
:- pred rtti_lookup_typeclass_info_var(rtti_varmaps::in, prog_constraint::in,
|
|
prog_var::out) is det.
|
|
|
|
% Find the prog_var which contains the typeclass_info for a given
|
|
% constraint and which can be reused, if it is known.
|
|
%
|
|
:- pred rtti_search_typeclass_info_var(rtti_varmaps::in, prog_constraint::in,
|
|
prog_var::out) is semidet.
|
|
|
|
% Find what RTTI, if any, is stored in a prog_var.
|
|
%
|
|
:- pred rtti_varmaps_var_info(rtti_varmaps::in, prog_var::in,
|
|
rtti_var_info::out) is det.
|
|
|
|
% Insert the location of a type_info. Abort if such information
|
|
% already exists.
|
|
%
|
|
:- pred rtti_det_insert_type_info_locn(tvar::in, type_info_locn::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% Set the location of a type_info, overwriting any previous
|
|
% information.
|
|
%
|
|
:- pred rtti_set_type_info_locn(tvar::in, type_info_locn::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% Insert the prog_var which contains the typeclass_info for a
|
|
% given constraint. Abort if such information already exists.
|
|
%
|
|
:- pred rtti_det_insert_typeclass_info_var(prog_constraint::in, prog_var::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% Set the prog_var which contains the typeclass_info for a given
|
|
% constraint, overwriting any previous information.
|
|
%
|
|
:- pred rtti_set_typeclass_info_var(prog_constraint::in, prog_var::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% Make the given typeclass_info var available for reuse in later
|
|
% goals. Abort if we know nothing about this variable.
|
|
%
|
|
:- pred rtti_reuse_typeclass_info_var(prog_var::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% For a prog_var which holds a type_info, set the type that the
|
|
% type_info is for. Abort if such information already exists.
|
|
%
|
|
:- pred rtti_det_insert_type_info_type(prog_var::in, mer_type::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% For a prog_var which holds a type_info, set the type that the
|
|
% type_info is for, overwriting any previous information.
|
|
%
|
|
:- pred rtti_set_type_info_type(prog_var::in, mer_type::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% rtti_var_info_duplicate(Var, NewVar, !RttiVarMaps)
|
|
%
|
|
% Duplicate the rtti_var_info we have about Var for NewVar.
|
|
%
|
|
:- pred rtti_var_info_duplicate(prog_var::in, prog_var::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% Returns all of the tvars that we have information about in the
|
|
% rtti_varmaps structure.
|
|
%
|
|
:- pred rtti_varmaps_tvars(rtti_varmaps::in, list(tvar)::out) is det.
|
|
|
|
% Returns all of the types that we have information about in the
|
|
% rtti_varmaps structure, including those types which appear in the
|
|
% arguments of constraints.
|
|
%
|
|
:- pred rtti_varmaps_types(rtti_varmaps::in, list(mer_type)::out) is det.
|
|
|
|
% Returns all of the prog_constraints which have typeclass_infos
|
|
% stored in a prog_var we can reuse.
|
|
%
|
|
:- pred rtti_varmaps_reusable_constraints(rtti_varmaps::in,
|
|
list(prog_constraint)::out) is det.
|
|
|
|
% Returns all of the prog_vars which are known to contain a type_info
|
|
% or typeclass_info.
|
|
%
|
|
:- pred rtti_varmaps_rtti_prog_vars(rtti_varmaps::in, list(prog_var)::out)
|
|
is det.
|
|
|
|
% apply_substitutions_to_rtti_varmaps(TRenaming, TSubst, Subst,
|
|
% !RttiVarMaps)
|
|
%
|
|
% Apply substitutions to the rtti_varmaps data. TRenaming is applied
|
|
% to all types first, then TSubst is applied to all types. Subst
|
|
% is applied to all prog_vars.
|
|
%
|
|
:- pred apply_substitutions_to_rtti_varmaps(tvar_renaming::in, tsubst::in,
|
|
map(prog_var, prog_var)::in, rtti_varmaps::in, rtti_varmaps::out)
|
|
is det.
|
|
|
|
% rtti_varmaps_transform_types(Pred, !RttiVarMaps)
|
|
%
|
|
% Apply the transformation predicate to every type appearing in the
|
|
% rtti_varmaps structure, including those in the arguments of constraints.
|
|
%
|
|
:- pred rtti_varmaps_transform_types(
|
|
pred(mer_type, mer_type)::in(pred(in, out) is det),
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% rtti_varmaps_overlay(A, B, C)
|
|
%
|
|
% Merge the information in rtti_varmaps A and B to produce C. Where
|
|
% information conflicts, use the information in B rather than A.
|
|
%
|
|
:- pred rtti_varmaps_overlay(rtti_varmaps::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
% For a set of variables V, find all the type variables in the types
|
|
% of the variables in V, and return set of typeinfo variables for
|
|
% those type variables. (find all typeinfos for variables in V).
|
|
%
|
|
% This set of typeinfos is often needed in liveness computation
|
|
% for accurate garbage collection - live variables need to have
|
|
% their typeinfos stay live too.
|
|
%
|
|
:- pred get_typeinfo_vars(set(prog_var)::in, vartypes::in, rtti_varmaps::in,
|
|
set(prog_var)::out) is det.
|
|
|
|
:- pred maybe_complete_with_typeinfo_vars(set(prog_var)::in,
|
|
bool::in, vartypes::in, rtti_varmaps::in, set(prog_var)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_type_subst.
|
|
|
|
:- import_module pair.
|
|
:- import_module solutions.
|
|
:- import_module svmap.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
make_rtti_proc_label(ModuleInfo, PredId, ProcId) = ProcLabel :-
|
|
module_info_get_name(ModuleInfo, ThisModule),
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
PredModule = pred_info_module(PredInfo),
|
|
PredName = pred_info_name(PredInfo),
|
|
Arity = pred_info_orig_arity(PredInfo),
|
|
pred_info_get_arg_types(PredInfo, ArgTypes),
|
|
proc_info_get_varset(ProcInfo, ProcVarSet),
|
|
proc_info_get_headvars(ProcInfo, ProcHeadVars),
|
|
proc_info_get_argmodes(ProcInfo, ProcModes),
|
|
proc_info_interface_determinism(ProcInfo, ProcDetism),
|
|
modes_to_arg_modes(ModuleInfo, ProcModes, ArgTypes, ProcArgModes),
|
|
PredIsImported = (pred_info_is_imported(PredInfo) -> yes ; no),
|
|
PredIsPseudoImp = (pred_info_is_pseudo_imported(PredInfo) -> yes ; no),
|
|
ProcIsExported = (procedure_is_exported(ModuleInfo, PredInfo, ProcId)
|
|
-> yes ; no),
|
|
pred_info_get_origin(PredInfo, Origin),
|
|
ProcHeadVarsWithNames = list.map((func(Var) = Var - Name :-
|
|
Name = varset.lookup_name(ProcVarSet, Var)
|
|
), ProcHeadVars),
|
|
(
|
|
(
|
|
PredIsImported = yes
|
|
;
|
|
PredIsPseudoImp = yes,
|
|
hlds_pred.in_in_unification_proc_id(ProcId)
|
|
)
|
|
->
|
|
ProcIsImported = yes
|
|
;
|
|
ProcIsImported = no
|
|
),
|
|
ProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
|
|
PredName, Arity, ArgTypes, PredId, ProcId,
|
|
ProcHeadVarsWithNames, ProcArgModes, ProcDetism,
|
|
PredIsImported, PredIsPseudoImp, Origin,
|
|
ProcIsExported, ProcIsImported).
|
|
|
|
proc_label_pred_proc_id(ProcLabel, PredId, ProcId) :-
|
|
PredId = ProcLabel ^ pred_id,
|
|
ProcId = ProcLabel ^ proc_id.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
type_info_locn_var(type_info(Var), Var).
|
|
type_info_locn_var(typeclass_info(Var, _), Var).
|
|
|
|
type_info_locn_set_var(Var, type_info(_), type_info(Var)).
|
|
type_info_locn_set_var(Var, typeclass_info(_, Num), typeclass_info(Var, Num)).
|
|
|
|
:- type rtti_varmaps
|
|
---> rtti_varmaps(
|
|
tci_varmap :: typeclass_info_varmap,
|
|
ti_varmap :: type_info_varmap,
|
|
ti_type_map :: type_info_type_map,
|
|
tci_constraint_map :: typeclass_info_constraint_map
|
|
).
|
|
|
|
% A typeclass_info_varmap is a map which for each type class constraint
|
|
% records which variable contains the typeclass_info for that
|
|
% constraint. The constraints covered by this map are those which
|
|
% are passed in as head arguments and those which are produced as
|
|
% existential constraints from calls or deconstructions. These are
|
|
% the constraints for which it is safe to reuse the variable associated
|
|
% with the constraint.
|
|
%
|
|
:- type typeclass_info_varmap == map(prog_constraint, prog_var).
|
|
|
|
% A type_info_varmap is a map which for each type variable
|
|
% records where the type_info for that type variable is stored.
|
|
%
|
|
% XXX this doesn't record the information that we want. For a
|
|
% constraint such as foo(list(T)) we can't properly record the
|
|
% location of the type_info for T, since it does not occupy a slot
|
|
% in the typeclass_info directly, but is inside the type_info for
|
|
% list(T).
|
|
%
|
|
:- type type_info_varmap == map(tvar, type_info_locn).
|
|
|
|
% Every program variable which holds a type_info is a key in this
|
|
% map. The value associated with a given key is the type that the
|
|
% type_info is for.
|
|
%
|
|
:- type type_info_type_map == map(prog_var, mer_type).
|
|
|
|
% Every program variable which holds a typeclass_info is a key in this
|
|
% map. The value associated with a given key is the prog_constraint
|
|
% that the typeclass_info is for.
|
|
%
|
|
:- type typeclass_info_constraint_map == map(prog_var, prog_constraint).
|
|
|
|
rtti_varmaps_init(rtti_varmaps(TCIMap, TIMap, TypeMap, ConstraintMap)) :-
|
|
map.init(TCIMap),
|
|
map.init(TIMap),
|
|
map.init(TypeMap),
|
|
map.init(ConstraintMap).
|
|
|
|
rtti_varmaps_no_tvars(VarMaps) :-
|
|
map.is_empty(VarMaps ^ ti_varmap).
|
|
|
|
rtti_lookup_type_info_locn(VarMaps, TVar, Locn) :-
|
|
map.lookup(VarMaps ^ ti_varmap, TVar, Locn).
|
|
|
|
rtti_search_type_info_locn(VarMaps, TVar, Locn) :-
|
|
map.search(VarMaps ^ ti_varmap, TVar, Locn).
|
|
|
|
rtti_lookup_typeclass_info_var(VarMaps, Constraint, ProgVar) :-
|
|
map.lookup(VarMaps ^ tci_varmap, Constraint, ProgVar).
|
|
|
|
rtti_search_typeclass_info_var(VarMaps, Constraint, ProgVar) :-
|
|
map.search(VarMaps ^ tci_varmap, Constraint, ProgVar).
|
|
|
|
rtti_varmaps_var_info(VarMaps, Var, VarInfo) :-
|
|
( map.search(VarMaps ^ ti_type_map, Var, Type) ->
|
|
VarInfo = type_info_var(Type)
|
|
; map.search(VarMaps ^ tci_constraint_map, Var, Constraint) ->
|
|
VarInfo = typeclass_info_var(Constraint)
|
|
;
|
|
VarInfo = non_rtti_var
|
|
).
|
|
|
|
rtti_det_insert_type_info_locn(TVar, Locn, !VarMaps) :-
|
|
Map0 = !.VarMaps ^ ti_varmap,
|
|
map.det_insert(Map0, TVar, Locn, Map),
|
|
!:VarMaps = !.VarMaps ^ ti_varmap := Map,
|
|
maybe_check_type_info_var(Locn, TVar, !VarMaps).
|
|
|
|
rtti_set_type_info_locn(TVar, Locn, !VarMaps) :-
|
|
Map0 = !.VarMaps ^ ti_varmap,
|
|
map.set(Map0, TVar, Locn, Map),
|
|
!:VarMaps = !.VarMaps ^ ti_varmap := Map,
|
|
maybe_check_type_info_var(Locn, TVar, !VarMaps).
|
|
|
|
:- pred maybe_check_type_info_var(type_info_locn::in, tvar::in,
|
|
rtti_varmaps::in, rtti_varmaps::out) is det.
|
|
|
|
maybe_check_type_info_var(type_info(Var), TVar, !VarMaps) :-
|
|
( map.search(!.VarMaps ^ ti_type_map, Var, Type) ->
|
|
( Type = type_variable(TVar, _) ->
|
|
true
|
|
;
|
|
unexpected(this_file, "inconsistent info in rtti_varmaps")
|
|
)
|
|
;
|
|
unexpected(this_file, "missing info in rtti_varmaps")
|
|
).
|
|
maybe_check_type_info_var(typeclass_info(_, _), _, !VarMaps).
|
|
|
|
rtti_det_insert_typeclass_info_var(Constraint, ProgVar, !VarMaps) :-
|
|
Map0 = !.VarMaps ^ tci_constraint_map,
|
|
map.det_insert(Map0, ProgVar, Constraint, Map),
|
|
!:VarMaps = !.VarMaps ^ tci_constraint_map := Map.
|
|
|
|
rtti_set_typeclass_info_var(Constraint, ProgVar, !VarMaps) :-
|
|
Map0 = !.VarMaps ^ tci_constraint_map,
|
|
map.set(Map0, ProgVar, Constraint, Map),
|
|
!:VarMaps = !.VarMaps ^ tci_constraint_map := Map.
|
|
|
|
rtti_reuse_typeclass_info_var(ProgVar, !VarMaps) :-
|
|
( map.search(!.VarMaps ^ tci_constraint_map, ProgVar, Constraint) ->
|
|
Map0 = !.VarMaps ^ tci_varmap,
|
|
map.set(Map0, Constraint, ProgVar, Map),
|
|
!:VarMaps = !.VarMaps ^ tci_varmap := Map
|
|
;
|
|
unexpected(this_file,
|
|
"rtti_reuse_typeclass_info_var: variable not known")
|
|
).
|
|
|
|
rtti_det_insert_type_info_type(ProgVar, Type, !VarMaps) :-
|
|
Map0 = !.VarMaps ^ ti_type_map,
|
|
map.det_insert(Map0, ProgVar, Type, Map),
|
|
!:VarMaps = !.VarMaps ^ ti_type_map := Map.
|
|
|
|
rtti_set_type_info_type(ProgVar, Type, !VarMaps) :-
|
|
Map0 = !.VarMaps ^ ti_type_map,
|
|
map.set(Map0, ProgVar, Type, Map),
|
|
!:VarMaps = !.VarMaps ^ ti_type_map := Map.
|
|
|
|
rtti_var_info_duplicate(Var, NewVar, !VarMaps) :-
|
|
rtti_varmaps_var_info(!.VarMaps, Var, VarInfo),
|
|
(
|
|
VarInfo = type_info_var(Type),
|
|
rtti_det_insert_type_info_type(NewVar, Type, !VarMaps)
|
|
;
|
|
VarInfo = typeclass_info_var(Constraint),
|
|
rtti_det_insert_typeclass_info_var(Constraint, NewVar, !VarMaps)
|
|
;
|
|
VarInfo = non_rtti_var
|
|
).
|
|
|
|
rtti_varmaps_tvars(VarMaps, TVars) :-
|
|
map.keys(VarMaps ^ ti_varmap, TVars).
|
|
|
|
rtti_varmaps_types(VarMaps, Types) :-
|
|
solutions.solutions(rtti_varmaps_is_known_type(VarMaps), Types).
|
|
|
|
:- pred rtti_varmaps_is_known_type(rtti_varmaps::in, mer_type::out) is nondet.
|
|
|
|
rtti_varmaps_is_known_type(VarMaps, Type) :-
|
|
map.values(VarMaps ^ ti_type_map, Types),
|
|
list.member(Type, Types).
|
|
rtti_varmaps_is_known_type(VarMaps, Type) :-
|
|
map.values(VarMaps ^ tci_constraint_map, Constraints),
|
|
list.member(constraint(_, Types), Constraints),
|
|
list.member(Type, Types).
|
|
|
|
rtti_varmaps_reusable_constraints(VarMaps, Constraints) :-
|
|
map.keys(VarMaps ^ tci_varmap, Constraints).
|
|
|
|
rtti_varmaps_rtti_prog_vars(VarMaps, Vars) :-
|
|
map.keys(VarMaps ^ ti_type_map, TIVars),
|
|
map.keys(VarMaps ^ tci_constraint_map, TCIVars),
|
|
list.append(TIVars, TCIVars, Vars).
|
|
|
|
apply_substitutions_to_rtti_varmaps(TRenaming, TSubst, Subst, !RttiVarMaps) :-
|
|
(
|
|
% Optimize the simple case.
|
|
map.is_empty(Subst),
|
|
map.is_empty(TSubst),
|
|
map.is_empty(TRenaming)
|
|
->
|
|
true
|
|
;
|
|
!.RttiVarMaps = rtti_varmaps(TCIMap0, TIMap0, TypeMap0,
|
|
ConstraintMap0),
|
|
map.foldl(apply_substs_to_tci_map(TRenaming, TSubst, Subst),
|
|
TCIMap0, map.init, TCIMap),
|
|
map.foldl(apply_substs_to_ti_map(TRenaming, TSubst, Subst),
|
|
TIMap0, map.init, TIMap),
|
|
map.foldl(apply_substs_to_type_map(TRenaming, TSubst, Subst),
|
|
TypeMap0, map.init, TypeMap),
|
|
map.foldl(apply_substs_to_constraint_map(TRenaming, TSubst, Subst),
|
|
ConstraintMap0, map.init, ConstraintMap),
|
|
!:RttiVarMaps = rtti_varmaps(TCIMap, TIMap, TypeMap, ConstraintMap)
|
|
).
|
|
|
|
:- pred apply_subst_to_prog_var(map(prog_var, prog_var)::in,
|
|
prog_var::in, prog_var::out) is det.
|
|
|
|
apply_subst_to_prog_var(Subst, Var0, Var) :-
|
|
( map.search(Subst, Var0, Var1) ->
|
|
Var = Var1
|
|
;
|
|
Var = Var0
|
|
).
|
|
|
|
:- pred apply_substs_to_tci_map(tvar_renaming::in, tsubst::in,
|
|
map(prog_var, prog_var)::in, prog_constraint::in, prog_var::in,
|
|
typeclass_info_varmap::in, typeclass_info_varmap::out) is det.
|
|
|
|
apply_substs_to_tci_map(TRenaming, TSubst, Subst, Constraint0, Var0, !Map) :-
|
|
apply_variable_renaming_to_prog_constraint(TRenaming, Constraint0,
|
|
Constraint1),
|
|
apply_rec_subst_to_prog_constraint(TSubst, Constraint1, Constraint),
|
|
apply_subst_to_prog_var(Subst, Var0, Var),
|
|
svmap.set(Constraint, Var, !Map).
|
|
|
|
% Update a map entry from tvar to type_info_locn, using the type renaming
|
|
% and substitution to rename tvars and a variable substitution to rename
|
|
% vars. The type renaming is applied before the type substitution.
|
|
%
|
|
% If tvar maps to a another type variable, we keep the new variable, if
|
|
% it maps to a type, we remove it from the map.
|
|
%
|
|
:- pred apply_substs_to_ti_map(tvar_renaming::in, tsubst::in,
|
|
map(prog_var, prog_var)::in, tvar::in, type_info_locn::in,
|
|
type_info_varmap::in, type_info_varmap::out) is det.
|
|
|
|
apply_substs_to_ti_map(TRenaming, TSubst, Subst, TVar, Locn, !Map) :-
|
|
type_info_locn_var(Locn, Var),
|
|
apply_subst_to_prog_var(Subst, Var, NewVar),
|
|
type_info_locn_set_var(NewVar, Locn, NewLocn),
|
|
apply_variable_renaming_to_tvar(TRenaming, TVar, NewTVar1),
|
|
% We don't use the correct kinds here, but that doesn't matter because
|
|
% the resulting kind will be thrown away anyway.
|
|
apply_rec_subst_to_tvar(map.init, TSubst, NewTVar1, NewType),
|
|
(
|
|
% If the tvar is still a variable, insert it into the map with the
|
|
% new var.
|
|
NewType = type_variable(NewTVar, _)
|
|
->
|
|
% Don't abort if two old type variables map to the same new type
|
|
% variable.
|
|
svmap.set(NewTVar, NewLocn, !Map)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred apply_substs_to_type_map(tvar_renaming::in, tsubst::in,
|
|
map(prog_var, prog_var)::in, prog_var::in, mer_type::in,
|
|
type_info_type_map::in, type_info_type_map::out) is det.
|
|
|
|
apply_substs_to_type_map(TRenaming, TSubst, Subst, Var0, Type0, !Map) :-
|
|
apply_variable_renaming_to_type(TRenaming, Type0, Type1),
|
|
apply_rec_subst_to_type(TSubst, Type1, Type),
|
|
apply_subst_to_prog_var(Subst, Var0, Var),
|
|
( map.search(!.Map, Var, ExistingType) ->
|
|
( Type = ExistingType ->
|
|
true
|
|
;
|
|
unexpected(this_file, "inconsistent type_infos")
|
|
)
|
|
;
|
|
svmap.det_insert(Var, Type, !Map)
|
|
).
|
|
|
|
:- pred apply_substs_to_constraint_map(tvar_renaming::in, tsubst::in,
|
|
map(prog_var, prog_var)::in, prog_var::in, prog_constraint::in,
|
|
typeclass_info_constraint_map::in, typeclass_info_constraint_map::out)
|
|
is det.
|
|
|
|
apply_substs_to_constraint_map(TRenaming, TSubst, Subst, Var0, Constraint0,
|
|
!Map) :-
|
|
apply_variable_renaming_to_prog_constraint(TRenaming, Constraint0,
|
|
Constraint1),
|
|
apply_rec_subst_to_prog_constraint(TSubst, Constraint1, Constraint),
|
|
apply_subst_to_prog_var(Subst, Var0, Var),
|
|
( map.search(!.Map, Var, ExistingConstraint) ->
|
|
( Constraint = ExistingConstraint ->
|
|
true
|
|
;
|
|
unexpected(this_file, "inconsistent typeclass_infos")
|
|
)
|
|
;
|
|
svmap.det_insert(Var, Constraint, !Map)
|
|
).
|
|
|
|
rtti_varmaps_transform_types(Pred, !RttiVarMaps) :-
|
|
TciMap0 = !.RttiVarMaps ^ tci_varmap,
|
|
TypeMap0 = !.RttiVarMaps ^ ti_type_map,
|
|
ConstraintMap0 = !.RttiVarMaps ^ tci_constraint_map,
|
|
map.foldl(apply_constraint_key_transformation(Pred), TciMap0,
|
|
map.init, TciMap),
|
|
Pred2 = (pred(_::in, V::in, W::out) is det :-
|
|
Pred(V, W)
|
|
),
|
|
map.map_values(Pred2, TypeMap0, TypeMap),
|
|
map.map_values(apply_constraint_value_transformation(Pred),
|
|
ConstraintMap0, ConstraintMap),
|
|
!:RttiVarMaps = !.RttiVarMaps ^ tci_varmap := TciMap,
|
|
!:RttiVarMaps = !.RttiVarMaps ^ ti_type_map := TypeMap,
|
|
!:RttiVarMaps = !.RttiVarMaps ^ tci_constraint_map := ConstraintMap.
|
|
|
|
:- pred apply_constraint_key_transformation(
|
|
pred(mer_type, mer_type)::in(pred(in, out) is det),
|
|
prog_constraint::in, prog_var::in,
|
|
typeclass_info_varmap::in, typeclass_info_varmap::out) is det.
|
|
|
|
apply_constraint_key_transformation(Pred, Constraint0, Var, !Map) :-
|
|
Constraint0 = constraint(Name, Args0),
|
|
list.map(Pred, Args0, Args),
|
|
Constraint = constraint(Name, Args),
|
|
svmap.set(Constraint, Var, !Map).
|
|
|
|
:- pred apply_constraint_value_transformation(
|
|
pred(mer_type, mer_type)::in(pred(in, out) is det),
|
|
prog_var::in, prog_constraint::in, prog_constraint::out) is det.
|
|
|
|
apply_constraint_value_transformation(Pred, _, Constraint0, Constraint) :-
|
|
Constraint0 = constraint(Name, Args0),
|
|
list.map(Pred, Args0, Args),
|
|
Constraint = constraint(Name, Args).
|
|
|
|
rtti_varmaps_overlay(VarMapsA, VarMapsB, VarMaps) :-
|
|
VarMapsA = rtti_varmaps(TCImapA, TImapA, TypeMapA, ConstraintMapA),
|
|
VarMapsB = rtti_varmaps(TCImapB, TImapB, TypeMapB, ConstraintMapB),
|
|
|
|
% Prefer VarMapsB for this information.
|
|
%
|
|
map.overlay(TCImapA, TCImapB, TCImap),
|
|
map.overlay(TImapA, TImapB, TImap),
|
|
|
|
% On the other hand, we insist that this information is consistent.
|
|
%
|
|
map.old_merge(TypeMapA, TypeMapB, TypeMap),
|
|
map.old_merge(ConstraintMapA, ConstraintMapB, ConstraintMap),
|
|
|
|
VarMaps = rtti_varmaps(TCImap, TImap, TypeMap, ConstraintMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
get_typeinfo_vars(Vars, VarTypes, RttiVarMaps, TypeInfoVars) :-
|
|
TVarMap = RttiVarMaps ^ ti_varmap,
|
|
set.to_sorted_list(Vars, VarList),
|
|
get_typeinfo_vars_2(VarList, VarTypes, TVarMap, TypeInfoVarList),
|
|
set.list_to_set(TypeInfoVarList, TypeInfoVars).
|
|
|
|
% Auxiliary predicate - traverses variables and builds a list of
|
|
% variables that store typeinfos for these variables.
|
|
%
|
|
:- pred get_typeinfo_vars_2(list(prog_var)::in,
|
|
vartypes::in, type_info_varmap::in, list(prog_var)::out) is det.
|
|
|
|
get_typeinfo_vars_2([], _, _, []).
|
|
get_typeinfo_vars_2([Var | Vars], VarTypes, TVarMap, TypeInfoVars) :-
|
|
( map.search(VarTypes, Var, Type) ->
|
|
type_vars(Type, TypeVars),
|
|
(
|
|
TypeVars = [],
|
|
% Optimize common case,
|
|
get_typeinfo_vars_2(Vars, VarTypes, TVarMap, TypeInfoVars)
|
|
;
|
|
TypeVars = [_ | _],
|
|
% XXX It's possible there are some complications with
|
|
% higher order pred types here -- if so, maybe
|
|
% treat them specially.
|
|
|
|
% The type_info is either stored in a variable, or in a
|
|
% typeclass_info. Either get the type_info variable or
|
|
% the typeclass_info variable.
|
|
LookupVar = (pred(TVar::in, TVarVar::out) is det :-
|
|
map.lookup(TVarMap, TVar, Locn),
|
|
type_info_locn_var(Locn, TVarVar)
|
|
),
|
|
list.map(LookupVar, TypeVars, TypeInfoVarsHead),
|
|
|
|
get_typeinfo_vars_2(Vars, VarTypes, TVarMap, TypeInfoVarsTail),
|
|
TypeInfoVars = TypeInfoVarsHead ++ TypeInfoVarsTail
|
|
)
|
|
;
|
|
unexpected(this_file, "get_typeinfo_vars_2: var not found in typemap")
|
|
).
|
|
|
|
maybe_complete_with_typeinfo_vars(Vars0, TypeInfoLiveness, VarTypes,
|
|
RttiVarMaps, Vars) :-
|
|
(
|
|
TypeInfoLiveness = yes,
|
|
get_typeinfo_vars(Vars0, VarTypes, RttiVarMaps, TypeInfoVars),
|
|
set.union(Vars0, TypeInfoVars, Vars)
|
|
;
|
|
TypeInfoLiveness = no,
|
|
Vars = Vars0
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "hlds_rtti.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.hlds_rtti.
|
|
%-----------------------------------------------------------------------------%
|