mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 23:05:21 +00:00
86f563a94d
compiler/du_type_layout.m:
If the --allow-packing-remote-sectag option is set, then try to pack
an initial subsequence of subword-sized arguments next to remote sectags.
To allow the polymorphism transformation to put the type_infos and/or
typeclass_infos it adds to a function symbol's argument list at the
*front* of that argument list, pack arguments next to remote sectags
only in function symbols that won't have any such extra arguments
added to them.
Do not write all new code for the new optimization; instead, generalize
the code that already does a very similar job for packing args next to
local sectags.
Delete the code we used to have that picked the packed representation
over the base unpacked representation only if it reduced the
"rounded-to-even" number of words. A case could be made for its usefulness,
but in the presence of the new optimization the extra code complexity
it requires is not worth it (in my opinion).
Extend the code that informs users about possible argument order
rearrangements that yield better packing to take packing next to sectags
into account.
compiler/hlds_data.m:
Provide a representation for cons_tags that use the new optimization.
Instead of adding a new cons_tag, we do this by replacing several old
cons_tags that all represent pointers to memory cells with a single
cons_tag named remote_args_tag with an argument that selects among
the old cons_tags being replaced, and adding a new alternative inside
this new type. The new alternative is remote_args_shared with a
remote_sectag whose size is rsectag_subword(...).
Instead of representing the value of the "data" field in classes
on the Java and C# backends as a strange kind of secondary tag
that is added to a memory cell by a class constructor instead of
having to be explicitly added to the front of the argument vector
by the code of a unification, represent it more directly as separate
kind of remote_args_tag. Continuing to treat it as a sectag would have
been very confusing to readers of the code of ml_unify_gen_*.m in the
presence of the new optimization.
Replacing several cons_tags that were usually treated similarly with
one cons_tag simplifies many switches. Instead of an switch with that
branches to the same switch arm for single_functor_tag, unshared_tag
and shared_remote_tag, and then switches on these three tags again
to get e.g. the primary tag of each, the new code of the switch arm
is executed for just cons_tag value (remote_args_tag), and switches
on the various kinds of remote args tags only when it needs to.
In is also more natural to pass around the argument of remote_args_tag
than to pass around a variable of type cons_tag that can be bound to only
single_functor_tag, unshared_tag or shared_remote_tag.
Add an XXX about possible further steps along these lines, such as
making a new cons_tag named something like "user_const_tag" represent
all user-visible constants.
compiler/unify_gen_construct.m:
compiler/unify_gen_deconstruct.m:
compiler/unify_gen_test.m:
compiler/unify_gen_util.m:
compiler/ml_unify_gen_construct.m:
compiler/ml_unify_gen_deconstruct.m:
compiler/ml_unify_gen_test.m:
compiler/ml_unify_gen_util.m:
Implement X = f(Yi) unifications where f uses the new representation,
i.e. some of its arguments are stored next to a remote sectag.
Some of the Yi are stored in a tagword (a word that also contains a tag,
in this case the remote secondary tag), while some are stored in other
words in a memory cell. This means that such unifications have similarities
both to unifications involving arguments being packed next to local
sectags, and to unifications involving ordinary arguments in memory cells.
Therefore wherever possible, their implemenation uses suitably generalized
versions of existing code that did those two jobs for two separate kinds of
cons_tags.
Making such generalizations possible in some cases required shifting the
boundary between predicates, moving work from a caller to a callee
or vice versa.
In unify_gen_deconstruct.m, stop using uni_vals to represent *either* a var
*or* a word in a memory cell. While this enabled us to factor out some
common code, the predicate boundaries it lead to are unsuitable for the
generalizations we now need.
Consistently use unsigned ints to represent both the whole and the parts
of words containing packed arguments (and maybe sectags), except when
comparing ptag constants with the result of applying the "tag" unop
to a word, (since that unop returns an int, at least for now).
In a few cases, avoid the recomputation of some information that we
already know. The motivation is not efficiency, since the recomputation
we avoid is usually cheap, but the simplification of the code's correctness
argument.
Use more consistent terminology in things such as variable names.
Note the possibility of further future improvements in several places.
compiler/ml_foreign_proc_gen.m:
Delete a long unused predicate.
compiler/mlds.m:
Add an XXX documenting a possible improvement.
compiler/rtti.m:
Update the compiler's internal representation of RTTI data structures
to make them able to describe secondary tags that are smaller than
a full word.
compiler/rtti_out.m:
Conform to the changes above, and delete a long-unused predicate.
compiler/type_ctor_info.m:
Use the RTTI's du_hl_rep to represent cons_tags that distinguish
between function symbols using a field in a class.
compiler/ml_type_gen.m:
Provide a specialized form of a function for code in ml_unify_gen_*.m.
Conform to the changes above.
compiler/add_special_pred.m:
compiler/bytecode_gen.m:
compiler/export.m:
compiler/hlds_code_util.m:
compiler/lco.m:
compiler/ml_closure_gen.m:
compiler/ml_switch_gen.m:
compiler/ml_tag_switch.m:
compiler/rtti_to_mlds.m:
compiler/switch_util.m:
compiler/tag_switch.m:
Conform to the changes above.
runtime/mercury_type_info.h:
Update the runtime's representation of RTTI data structures to make them
able to describe remote secondary tags that are smaller than a full word.
runtime/mercury_deconstruct.[ch]:
runtime/mercury_deconstruct.h:
runtime/mercury_deconstruct_macros.h:
runtime/mercury_ml_expand_body.h:
runtime/mercury_ml_arg_body.h:
runtime/mercury_ml_deconstruct_body.h:
runtime/mercury_ml_functor_body.h:
These modules collectively implement the predicates in deconstruct.m
in the library, and provide access to its functionality to other C code,
e.g. in the debugger. Update these to be able to handle terms with the
new data representation optimization.
This update requires a significant change in the distribution of work
between these files for the predicates deconstruct.deconstruct and
deconstruct.limited_deconstruct. We used to have mercury_ml_expand_body.h
fill in the fields of their expand_info structures (whose types are
defined in mercury_deconstruct.h) with pointers to three vectors:
(a) a vector of arg_locns with one element per argument, with a NULL
pointer being equivalent to a vector with a given element in every slot;
(b) a vector of type_infos with one element per argument, constructed
dynamically (and later freed) if necessary; and (c) a vector of argument
words. Once upon a time, before double-word and sub-word arguments,
vector (c) also had one word per argument, but that hasn't been true
for a while; we added vector (a) help the consumers of the expand_info
decode the difference. The consumers of this info always used these
vectors to build up a Mercury term containing a list of univs,
with one univ for each argument.
This structure could be stretched to handle function symbols that store
*all* their arguments in a tagword next to a local sectag, but I found
that stretching it to cover function symbols that have *some* of their
arguments packed next to a remote sectag and *some other* of their
arguments in a memory cell as usual would have required a well-nigh
incomprehensibly complex, and therefore almost undebuggable, interface
between mercury_ml_expand_body.h and the other files above. This diff
therefore changes the interface to have mercury_ml_expand_body.h
build the list of univs directly. This make its code relatively simple
and self-contained, and it should be somewhat faster then the old code
as well, since it never needs to allocate, fill in and then free
vectors of type_infos (each such typeinfo now gets put into a univ
as soon as it is constructed). The downside is that if we ever wanted
to get all the arguments at once for a purpose other than constructing
a list of univs from them, it would nevertheless require constructing
that list of univs anyway as an intermediate data structure. I don't see
this downside is significant, because (a) I don't think such a use case
is very likely, and (b) even if one arises, debuggable but a bit slow
is probably preferable to faster but very hard to debug.
Reduce the level of indentation of some of these files to make the code
easier to edit. Do this by
- not adding an indent level from switch statements to their cases; and
- not adding an indent level when a case in a switch has a local block.
Move the break or return ending a case inside that case's block,
if it has one.
runtime/mercury_deep_copy_body.h:
runtime/mercury_table_type_body.h:
Update these to enable the copying or tabling of terms whose
representations uses the new optimization.
Use the techniques listed above to reduce the level of indentation
make the code easier to edit.
runtime/mercury_tabling.c:
runtime/mercury_term_size.c:
Conform to the changes above.
runtime/mercury_unify_compare_body.h:
Make this code compile after the changes above. It does need to work
correctly, since we only ever used this code to compare the speed
of unify-by-rtti with the speed of unify-by-compiler-generated-code,
and in real life, we always use the latter. (It hasn't been updated
to work right with previous arg packing changes either.)
library/construct.m:
Update to enable the code to construct terms whose representations
uses the new optimization.
Add some sanity checks.
library/private_builtin.m:
runtime/mercury_dotnet.cs.in:
java/runtime/Sectag_Locn.java:
Update the list of possible sectag kinds.
library/store.m:
Conform to the changes above.
trace/mercury_trace_vars.c:
Conform to the changes above.
tests/hard_coded/deconstruct_arg.{m,exp,exp2}:
Extend this test to test the deconstruction of terms whose
representations uses the new optimization.
Modify some of the existing terms being tested to make them more diverse,
in order to make the output easier to navigate.
tests/hard_coded/construct_packed.{m,exp}:
A new test case to test the construction of terms whose
representations uses the new optimization.
tests/debugger/browse_packed.{m,exp}:
A new test case to test access to the fields of terms whose
representations uses the new optimization.
tests/tabling/test_packed.{m,exp}:
A new test case to test the tabling of terms whose
representations uses the new optimization.
tests/debugger/Mmakefile:
tests/hard_coded/Mmakefile:
tests/tabling/Mmakefile:
Enable the new test cases.
547 lines
23 KiB
Mathematica
547 lines
23 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2011 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: add_special_pred.m.
|
|
%
|
|
% This module handles the declaration of unify, compare and (if needed)
|
|
% index predicates for the types defined or imported by the module
|
|
% being compiled.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module hlds.add_special_pred.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.status.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred add_special_pred_decl_defns_for_type_maybe_lazily(type_ctor::in,
|
|
hlds_type_defn::in, module_info::in, module_info::out) is det.
|
|
|
|
% This predicate defines unify and compare predicates for the given type.
|
|
% This can be any type when invoked from the _maybe_lazily version.
|
|
% When invoked from make_hlds_passes.m, which is the only place outside
|
|
% this module from where it should be invoked, it is used to generate
|
|
% unify and compare predicates for some builtin types, using an abstract
|
|
% type body to signal the fact that these types are builtins.
|
|
%
|
|
:- pred add_special_pred_decl_defns_for_type_eagerly(tvarset::in,
|
|
mer_type::in, type_ctor::in, hlds_type_body::in, type_status::in,
|
|
prog_context::in, module_info::in, module_info::out) is det.
|
|
|
|
% add_special_pred_decl_defn(SpecialPredId, TVarSet, Type, TypeCtor,
|
|
% TypeBody, TypeStatus, TypeContext, !ModuleInfo).
|
|
%
|
|
% Add declarations and clauses for a special predicate.
|
|
% This is used by unify_proc.m to add a unification predicate
|
|
% for an imported type for which special predicates are being
|
|
% generated only when a unification procedure is requested
|
|
% during mode analysis.
|
|
%
|
|
:- pred add_special_pred_decl_defn(special_pred_id::in, tvarset::in,
|
|
mer_type::in, type_ctor::in, hlds_type_body::in, type_status::in,
|
|
prog_context::in, module_info::in, module_info::out) is det.
|
|
|
|
% add_special_pred_decl(SpecialPredId, TVarSet, Type, TypeCtor,
|
|
% TypeStatus, TypeContext, !ModuleInfo).
|
|
%
|
|
% Add declarations for a special predicate.
|
|
% This is used by higher_order.m when specializing an in-in
|
|
% unification for an imported type for which unification procedures
|
|
% are generated lazily.
|
|
%
|
|
:- pred add_special_pred_decl(special_pred_id::in,
|
|
tvarset::in, mer_type::in, type_ctor::in, type_status::in,
|
|
prog_context::in, module_info::in, module_info::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% add_lazily_generated_unify_pred(TypeCtor, UnifyPredId_for_Type,
|
|
% !ModuleInfo):
|
|
%
|
|
% For most imported unification procedures, we delay generating
|
|
% declarations and clauses until we know whether they are actually needed
|
|
% because there is a complicated unification involving the type.
|
|
% This predicate is exported for use by higher_order.m when it is
|
|
% specializing calls to unify/2.
|
|
%
|
|
:- pred add_lazily_generated_unify_pred(type_ctor::in, pred_id::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
% add_lazily_generated_compare_pred_decl(TypeCtor, ComparePredId_for_Type,
|
|
% !ModuleInfo):
|
|
%
|
|
% Add declarations, but not clauses, for a compare or index predicate.
|
|
%
|
|
:- pred add_lazily_generated_compare_pred_decl(type_ctor::in, pred_id::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.polymorphism.
|
|
:- import_module check_hlds.post_typecheck.
|
|
:- import_module check_hlds.unify_proc.
|
|
:- import_module hlds.add_pred.
|
|
:- import_module hlds.hlds_clauses.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module hlds.special_pred.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.prog_item.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
add_special_pred_decl_defns_for_type_maybe_lazily(TypeCtor, TypeDefn,
|
|
!ModuleInfo) :-
|
|
get_type_defn_body(TypeDefn, TypeBody),
|
|
get_type_defn_status(TypeDefn, TypeStatus),
|
|
( if
|
|
special_pred_is_generated_lazily(!.ModuleInfo, TypeCtor, TypeBody,
|
|
TypeStatus)
|
|
then
|
|
true
|
|
else
|
|
get_type_defn_tvarset(TypeDefn, TVarSet),
|
|
get_type_defn_kind_map(TypeDefn, KindMap),
|
|
get_type_defn_tparams(TypeDefn, TypeParams),
|
|
prog_type.var_list_to_type_list(KindMap, TypeParams, ArgTypes),
|
|
construct_type(TypeCtor, ArgTypes, Type),
|
|
get_type_defn_context(TypeDefn, Context),
|
|
add_special_pred_decl_defns_for_type_eagerly(TVarSet, Type, TypeCtor,
|
|
TypeBody, TypeStatus, Context, !ModuleInfo)
|
|
).
|
|
|
|
add_special_pred_decl_defns_for_type_eagerly(TVarSet, Type, TypeCtor, TypeBody,
|
|
TypeStatus, Context, !ModuleInfo) :-
|
|
% When we see an abstract type declaration, we do not declare an index
|
|
% predicate for that type, since the actual type definition may later
|
|
% turn out not to require one. If the type does turn out to need
|
|
% an index predicate, its declaration will be generated together with
|
|
% its implementation.
|
|
( if
|
|
can_generate_special_pred_clauses_for_type(!.ModuleInfo, TypeCtor,
|
|
TypeBody)
|
|
then
|
|
add_special_pred_decl_defn(spec_pred_unify, TVarSet, Type, TypeCtor,
|
|
TypeBody, TypeStatus, Context, !ModuleInfo),
|
|
ThisModule = type_status_defined_in_this_module(TypeStatus),
|
|
(
|
|
ThisModule = yes,
|
|
add_special_pred_decl_defn(spec_pred_compare, TVarSet, Type,
|
|
TypeCtor, TypeBody, TypeStatus, Context, !ModuleInfo)
|
|
;
|
|
ThisModule = no,
|
|
% Never add clauses for comparison predicates
|
|
% for imported types -- they will never be used.
|
|
module_info_get_special_pred_maps(!.ModuleInfo, SpecialPredMaps),
|
|
( if
|
|
search_special_pred_maps(SpecialPredMaps, spec_pred_compare,
|
|
TypeCtor, _)
|
|
then
|
|
true
|
|
else
|
|
add_special_pred_decl(spec_pred_compare, TVarSet, Type,
|
|
TypeCtor, TypeStatus, Context, !ModuleInfo)
|
|
)
|
|
)
|
|
else
|
|
SpecialPredIds = [spec_pred_unify, spec_pred_compare],
|
|
add_special_pred_decls(SpecialPredIds, TVarSet, Type,
|
|
TypeCtor, TypeStatus, Context, !ModuleInfo)
|
|
).
|
|
|
|
add_special_pred_decl_defn(SpecialPredId, TVarSet, Type0, TypeCtor, TypeBody,
|
|
TypeStatus0, Context, !ModuleInfo) :-
|
|
Type = adjust_types_with_special_preds_in_private_builtin(Type0),
|
|
adjust_special_pred_status(SpecialPredId, TypeStatus0, PredStatus),
|
|
module_info_get_special_pred_maps(!.ModuleInfo, SpecialPredMaps0),
|
|
( if
|
|
search_special_pred_maps(SpecialPredMaps0, SpecialPredId, TypeCtor, _)
|
|
then
|
|
true
|
|
else
|
|
% XXX STATUS
|
|
PredStatus = pred_status(PredOldStatus),
|
|
TypeStatus = type_status(PredOldStatus),
|
|
add_special_pred_decl(SpecialPredId, TVarSet, Type, TypeCtor,
|
|
TypeStatus, Context, !ModuleInfo)
|
|
),
|
|
module_info_get_special_pred_maps(!.ModuleInfo, SpecialPredMaps1),
|
|
lookup_special_pred_maps(SpecialPredMaps1, SpecialPredId, TypeCtor,
|
|
PredId),
|
|
module_info_get_preds(!.ModuleInfo, PredMap0),
|
|
map.lookup(PredMap0, PredId, PredInfo0),
|
|
% If the type was imported, then the special preds for that type
|
|
% should be imported too.
|
|
% XXX There are several different shades of "imported", and in this case,
|
|
% the above comment *should* go into detail about them.
|
|
% XXX Why isn't the status set correctly by add_special_pred_decl
|
|
% in the first place?
|
|
( if
|
|
( PredStatus = pred_status(status_imported(_))
|
|
; PredStatus = pred_status(status_pseudo_imported)
|
|
)
|
|
then
|
|
pred_info_set_status(PredStatus, PredInfo0, PredInfo1)
|
|
else if
|
|
TypeBody ^ du_type_canonical = noncanon(_),
|
|
pred_info_get_status(PredInfo0, OldPredStatus),
|
|
OldPredStatus = pred_status(status_pseudo_imported),
|
|
pred_status_is_imported(PredStatus) = no
|
|
then
|
|
% We can only get here with --no-special-preds if the old status
|
|
% is from an abstract declaration of the type.
|
|
% XXX The --no-special-preds option does not exist anymore.
|
|
% Since the compiler did not then know that the type definition
|
|
% will specify a user-defined equality predicate, it set up
|
|
% the status as pseudo_imported in order to prevent the
|
|
% generation of code for mode 0 of the unify predicate
|
|
% for the type. However, for types with user-defined equality,
|
|
% we *do* want to generate code for mode 0 of unify,
|
|
% so we fix the status.
|
|
pred_info_set_status(PredStatus, PredInfo0, PredInfo1)
|
|
else
|
|
PredInfo1 = PredInfo0
|
|
),
|
|
SpecDefnInfo = spec_pred_defn_info(SpecialPredId, PredId,
|
|
TVarSet, Type, TypeCtor, TypeBody, TypeStatus0, Context),
|
|
add_clauses_for_special_pred(SpecDefnInfo, PredInfo1, !ModuleInfo).
|
|
|
|
:- pred add_clauses_for_special_pred(spec_pred_defn_info::in,
|
|
pred_info::in, module_info::in, module_info::out) is det.
|
|
|
|
add_clauses_for_special_pred(SpecDefnInfo, !.PredInfo, !ModuleInfo) :-
|
|
generate_clauses_for_special_pred(SpecDefnInfo, ClausesInfo, !ModuleInfo),
|
|
pred_info_set_clauses_info(ClausesInfo, !PredInfo),
|
|
pred_info_get_markers(!.PredInfo, Markers0),
|
|
add_marker(marker_calls_are_fully_qualified, Markers0, Markers),
|
|
pred_info_set_markers(Markers, !PredInfo),
|
|
PredId = SpecDefnInfo ^ spdi_pred_id,
|
|
module_info_get_preds(!.ModuleInfo, PredMap0),
|
|
map.det_update(PredId, !.PredInfo, PredMap0, PredMap),
|
|
module_info_set_preds(PredMap, !ModuleInfo).
|
|
|
|
% These types need to have the builtin qualifier removed
|
|
% so that their special predicates type check.
|
|
%
|
|
% XXX TYPE_REPN Check that this operation is idempotent. Otherwise,
|
|
% storing only Type and not Type0 in spec_pred_defn_info won't work.
|
|
:- func adjust_types_with_special_preds_in_private_builtin(mer_type)
|
|
= mer_type.
|
|
|
|
adjust_types_with_special_preds_in_private_builtin(Type) = NormalizedType :-
|
|
( if
|
|
type_to_ctor_and_args(Type, TypeCtor, []),
|
|
is_builtin_type_special_preds_defined_in_mercury(TypeCtor, Name)
|
|
then
|
|
construct_type(type_ctor(unqualified(Name), 0), [], NormalizedType)
|
|
else
|
|
NormalizedType = Type
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred add_special_pred_decls(list(special_pred_id)::in, tvarset::in,
|
|
mer_type::in, type_ctor::in, type_status::in, prog_context::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
add_special_pred_decls([], _, _, _, _, _, !ModuleInfo).
|
|
add_special_pred_decls([SpecialPredId | SpecialPredIds], TVarSet, Type,
|
|
TypeCtor, TypeStatus, Context, !ModuleInfo) :-
|
|
add_special_pred_decl(SpecialPredId, TVarSet, Type,
|
|
TypeCtor, TypeStatus, Context, !ModuleInfo),
|
|
add_special_pred_decls(SpecialPredIds, TVarSet, Type,
|
|
TypeCtor, TypeStatus, Context, !ModuleInfo).
|
|
|
|
add_special_pred_decl(SpecialPredId, TVarSet, Type, TypeCtor, TypeStatus,
|
|
Context, !ModuleInfo) :-
|
|
module_info_get_name(!.ModuleInfo, ModuleName),
|
|
special_pred_interface(SpecialPredId, Type, ArgTypes, ArgModes, Det),
|
|
PredBaseName = special_pred_name(SpecialPredId, TypeCtor),
|
|
PredName = unqualified(PredBaseName),
|
|
Arity = get_special_pred_id_arity(SpecialPredId),
|
|
% XXX we probably shouldn't hardcode this as predicate but since
|
|
% all current special_preds are predicates at the moment it doesn't
|
|
% matter.
|
|
clauses_info_init(pf_predicate, Arity, init_clause_item_numbers_comp_gen,
|
|
ClausesInfo0),
|
|
Origin = origin_special_pred(SpecialPredId, TypeCtor),
|
|
adjust_special_pred_status(SpecialPredId, TypeStatus, PredStatus),
|
|
CurUserDecl = maybe.no,
|
|
map.init(Proofs),
|
|
map.init(ConstraintMap),
|
|
init_markers(Markers),
|
|
% XXX If/when we have "comparable" or "unifiable" typeclasses,
|
|
% this context might not be empty.
|
|
ClassContext = constraints([], []),
|
|
ExistQVars = [],
|
|
map.init(VarNameRemap),
|
|
pred_info_init(ModuleName, PredName, Arity, pf_predicate, Context,
|
|
Origin, PredStatus, CurUserDecl, goal_type_none, Markers, ArgTypes,
|
|
TVarSet, ExistQVars, ClassContext, Proofs, ConstraintMap,
|
|
ClausesInfo0, VarNameRemap, PredInfo0),
|
|
ItemNumber = -1,
|
|
varset.init(InstVarSet),
|
|
ArgLives = no,
|
|
% Should not be any inst vars here so it is ok to use a fresh inst_varset.
|
|
% Before the simplification pass, HasParallelConj is not meaningful.
|
|
HasParallelConj = has_no_parallel_conj,
|
|
add_new_proc(Context, ItemNumber, Arity,
|
|
InstVarSet, ArgModes, yes(ArgModes), ArgLives,
|
|
detism_decl_implicit, yes(Det), address_is_not_taken,
|
|
HasParallelConj, PredInfo0, PredInfo, _ProcId),
|
|
|
|
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
|
|
predicate_table_insert(PredInfo, PredId, PredicateTable0, PredicateTable),
|
|
module_info_set_predicate_table(PredicateTable, !ModuleInfo),
|
|
module_info_get_special_pred_maps(!.ModuleInfo, SpecialPredMaps0),
|
|
(
|
|
SpecialPredId = spec_pred_unify,
|
|
UnifyMap0 = SpecialPredMaps0 ^ spm_unify_map,
|
|
map.det_insert(TypeCtor, PredId, UnifyMap0, UnifyMap),
|
|
SpecialPredMaps = SpecialPredMaps0 ^ spm_unify_map := UnifyMap
|
|
;
|
|
SpecialPredId = spec_pred_index,
|
|
IndexMap0 = SpecialPredMaps0 ^ spm_index_map,
|
|
map.det_insert(TypeCtor, PredId, IndexMap0, IndexMap),
|
|
SpecialPredMaps = SpecialPredMaps0 ^ spm_index_map := IndexMap
|
|
;
|
|
SpecialPredId = spec_pred_compare,
|
|
CompareMap0 = SpecialPredMaps0 ^ spm_compare_map,
|
|
map.det_insert(TypeCtor, PredId, CompareMap0, CompareMap),
|
|
SpecialPredMaps = SpecialPredMaps0 ^ spm_compare_map := CompareMap
|
|
),
|
|
module_info_set_special_pred_maps(SpecialPredMaps, !ModuleInfo).
|
|
|
|
:- pred adjust_special_pred_status(special_pred_id::in,
|
|
type_status::in, pred_status::out) is det.
|
|
|
|
adjust_special_pred_status(SpecialPredId, TypeStatus, !:PredStatus) :-
|
|
( if
|
|
( TypeStatus = type_status(status_opt_imported)
|
|
; TypeStatus = type_status(status_abstract_imported)
|
|
)
|
|
then
|
|
!:PredStatus = pred_status(status_imported(import_locn_interface))
|
|
else if
|
|
TypeStatus = type_status(status_abstract_exported)
|
|
then
|
|
!:PredStatus = pred_status(status_exported)
|
|
else
|
|
TypeStatus = type_status(OldStatus),
|
|
!:PredStatus = pred_status(OldStatus)
|
|
),
|
|
|
|
% Unification predicates are special - they are
|
|
% "pseudo"-imported/exported (only mode 0 is imported/exported).
|
|
( if SpecialPredId = spec_pred_unify then
|
|
( if !.PredStatus = pred_status(status_imported(_)) then
|
|
!:PredStatus = pred_status(status_pseudo_imported)
|
|
else if !.PredStatus = pred_status(status_exported) then
|
|
!:PredStatus = pred_status(status_pseudo_exported)
|
|
else
|
|
true
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
add_lazily_generated_unify_pred(TypeCtor, PredId, !ModuleInfo) :-
|
|
( if type_ctor_is_tuple(TypeCtor) then
|
|
collect_type_defn_for_tuple(TypeCtor, Type, TVarSet, TypeBody,
|
|
Context)
|
|
else
|
|
collect_type_defn(!.ModuleInfo, TypeCtor, Type, TVarSet, TypeBody,
|
|
Context)
|
|
),
|
|
( if
|
|
can_generate_special_pred_clauses_for_type(!.ModuleInfo,
|
|
TypeCtor, TypeBody)
|
|
then
|
|
% If the unification predicate had a status other than TypeStatus,
|
|
% it should already have been generated.
|
|
% XXX STATUS this is not an appropriate status for a type.
|
|
TypeStatus = type_status(status_pseudo_imported),
|
|
DeclMaybeDefn = decl_and_clauses
|
|
else
|
|
TypeStatus = type_status(status_imported(import_locn_implementation)),
|
|
DeclMaybeDefn = declaration_only
|
|
),
|
|
add_lazily_generated_special_pred(spec_pred_unify, DeclMaybeDefn,
|
|
TVarSet, Type, TypeCtor, TypeBody, Context, TypeStatus, PredId,
|
|
!ModuleInfo).
|
|
|
|
add_lazily_generated_compare_pred_decl(TypeCtor, PredId, !ModuleInfo) :-
|
|
collect_type_defn(!.ModuleInfo, TypeCtor, Type, TVarSet, TypeBody,
|
|
Context),
|
|
|
|
% If the comparison predicate had a status other than TypeStatus,
|
|
% it should already have been generated.
|
|
% XXX STATUS This is NOT the same TypeStatus as in the similarly marked
|
|
% piece of code above.
|
|
TypeStatus = type_status(status_imported(import_locn_implementation)),
|
|
add_lazily_generated_special_pred(spec_pred_compare, declaration_only,
|
|
TVarSet, Type, TypeCtor, TypeBody, Context, TypeStatus, PredId,
|
|
!ModuleInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type decl_maybe_defn
|
|
---> declaration_only
|
|
; decl_and_clauses.
|
|
|
|
:- pred add_lazily_generated_special_pred(special_pred_id::in,
|
|
decl_maybe_defn::in, tvarset::in, mer_type::in, type_ctor::in,
|
|
hlds_type_body::in, prog_context::in, type_status::in, pred_id::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
add_lazily_generated_special_pred(SpecialId, Item, TVarSet, Type, TypeCtor,
|
|
TypeBody, Context, TypeStatus, PredId, !ModuleInfo) :-
|
|
% Add the declaration and maybe clauses.
|
|
(
|
|
Item = decl_and_clauses,
|
|
add_special_pred_decl_defn(SpecialId, TVarSet, Type, TypeCtor,
|
|
TypeBody, TypeStatus, Context, !ModuleInfo)
|
|
;
|
|
Item = declaration_only,
|
|
add_special_pred_decl(SpecialId, TVarSet, Type, TypeCtor,
|
|
TypeStatus, Context, !ModuleInfo)
|
|
),
|
|
|
|
module_info_get_special_pred_maps(!.ModuleInfo, SpecialPredMaps),
|
|
lookup_special_pred_maps(SpecialPredMaps, SpecialId, TypeCtor, PredId),
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
|
|
|
|
% The clauses are generated with all type information computed,
|
|
% so just go on to post_typecheck.
|
|
(
|
|
Item = decl_and_clauses,
|
|
PredInfo1 = PredInfo0
|
|
;
|
|
Item = declaration_only,
|
|
setup_vartypes_in_clauses_for_imported_pred(PredInfo0, PredInfo1)
|
|
),
|
|
propagate_types_into_modes(!.ModuleInfo, ErrorProcs, PredInfo1, PredInfo),
|
|
expect(unify(ErrorProcs, []), $pred, "ErrorProcs != []"),
|
|
|
|
% Call polymorphism to introduce type_info arguments for polymorphic types.
|
|
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
|
|
|
|
% Note that this will not work if the generated clauses call a polymorphic
|
|
% predicate which requires type_infos to be added. Such calls can be
|
|
% generated by generate_clause_info, but unification predicates which
|
|
% contain such calls are never generated lazily.
|
|
polymorphism_process_generated_pred(PredId, !ModuleInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred collect_type_defn(module_info::in, type_ctor::in, mer_type::out,
|
|
tvarset::out, hlds_type_body::out, prog_context::out) is det.
|
|
|
|
collect_type_defn(ModuleInfo, TypeCtor, Type, TVarSet, TypeBody, Context) :-
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
lookup_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_tvarset(TypeDefn, TVarSet),
|
|
hlds_data.get_type_defn_tparams(TypeDefn, TypeParams),
|
|
hlds_data.get_type_defn_kind_map(TypeDefn, KindMap),
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
hlds_data.get_type_defn_status(TypeDefn, TypeStatus),
|
|
hlds_data.get_type_defn_context(TypeDefn, Context),
|
|
|
|
expect(
|
|
special_pred_is_generated_lazily(ModuleInfo, TypeCtor, TypeBody,
|
|
TypeStatus),
|
|
$pred, "not generated lazily"),
|
|
prog_type.var_list_to_type_list(KindMap, TypeParams, TypeArgs),
|
|
construct_type(TypeCtor, TypeArgs, Type).
|
|
|
|
:- pred collect_type_defn_for_tuple(type_ctor::in, mer_type::out,
|
|
tvarset::out, hlds_type_body::out, prog_context::out) is det.
|
|
|
|
collect_type_defn_for_tuple(TypeCtor, Type, TVarSet, TypeBody, Context) :-
|
|
TypeCtor = type_ctor(_, TupleArity),
|
|
|
|
% Build a hlds_type_body for the tuple constructor, which will
|
|
% be used by generate_clause_info.
|
|
varset.init(TVarSet0),
|
|
varset.new_vars(TupleArity, TupleArgTVars, TVarSet0, TVarSet),
|
|
prog_type.var_list_to_type_list(map.init, TupleArgTVars,
|
|
TupleArgTypes),
|
|
|
|
% Tuple constructors can't be existentially quantified.
|
|
MaybeExistConstraints = no_exist_constraints,
|
|
|
|
make_tuple_args_and_repns(Context, TupleArgTypes, CtorArgs, CtorArgRepns),
|
|
|
|
Ordinal = 0,
|
|
CtorSymName = unqualified("{}"),
|
|
Ctor = ctor(Ordinal, MaybeExistConstraints, CtorSymName,
|
|
CtorArgs, TupleArity, Context),
|
|
CtorRepn = ctor_repn(Ordinal, MaybeExistConstraints, CtorSymName,
|
|
remote_args_tag(remote_args_only_functor), CtorArgRepns,
|
|
TupleArity, Context),
|
|
|
|
map.from_assoc_list(["{}" - one_or_more(CtorRepn, [])], ConsCtorMap),
|
|
DirectArgCtors = no,
|
|
Repn = du_type_repn([CtorRepn], ConsCtorMap, no_cheaper_tag_test,
|
|
du_type_kind_general, DirectArgCtors),
|
|
MaybeCanonical = canon,
|
|
IsForeign = no,
|
|
TypeBody = hlds_du_type([Ctor], MaybeCanonical, yes(Repn), IsForeign),
|
|
construct_type(TypeCtor, TupleArgTypes, Type),
|
|
|
|
term.context_init(Context).
|
|
|
|
:- pred make_tuple_args_and_repns(prog_context::in, list(mer_type)::in,
|
|
list(constructor_arg)::out, list(constructor_arg_repn)::out) is det.
|
|
|
|
make_tuple_args_and_repns(Context, ArgTypes, CtorArgs, CtorArgRepns) :-
|
|
make_tuple_args_and_repns_loop(Context, ArgTypes, 0,
|
|
CtorArgs, CtorArgRepns).
|
|
|
|
:- pred make_tuple_args_and_repns_loop(prog_context::in, list(mer_type)::in,
|
|
int::in, list(constructor_arg)::out, list(constructor_arg_repn)::out)
|
|
is det.
|
|
|
|
make_tuple_args_and_repns_loop(_Context, [], _ArgNum, [], []).
|
|
make_tuple_args_and_repns_loop(Context, [ArgType | ArgTypes], ArgNum,
|
|
[CtorArg | CtorArgs], [CtorArgRepn | CtorArgRepns]) :-
|
|
CtorArg = ctor_arg(no, ArgType, Context),
|
|
ArgPosWidth = apw_full(arg_only_offset(ArgNum), cell_offset(ArgNum)),
|
|
CtorArgRepn = ctor_arg_repn(no, ArgType, ArgPosWidth, Context),
|
|
make_tuple_args_and_repns_loop(Context, ArgTypes, ArgNum + 1,
|
|
CtorArgs, CtorArgRepns).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module hlds.add_special_pred.
|
|
%---------------------------------------------------------------------------%
|