mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 21:35:49 +00:00
f519e26173
Add the new builtin types: int64 and uint64.
Support for these new types will need to be bootstrapped over several changes.
This is the first such change and does the following:
- Extends the compiler to recognise 'int64' and 'uint64' as builtin types.
- Extends the set of builtin arithmetic, bitwise and relational operators
to cover the new types.
- Adds the new internal option '--unboxed-int64s' to the compiler; this will be
used to control whether 64-bit integer types are boxed or not.
- Extends all of the code generators to handle the new types.
- Extends the runtimes to support the new types.
- Adds new modules to the standard library intend to contain basic operations
on the new types. (These are currently empty and not documented.)
There are bunch of limitations marks with "XXX INT64"; these will be lifted in
part 2 of this change. Also, 64-bit integer types are currently always boxed,
again this limitation will be lifted in later changes.
compiler/options.m:
Add the new option --unboxed-int64s.
compiler/prog_type.m:
compiler/prog_data.m:
compiler/builtin_lib_types.m:
Recognise int64 and uint64 as builtin types.
compiler/builtin_ops.m:
Add builtin operations for the new types.
compiler/hlds_data.m:
Add new tag types for the new types.
compiler/ctgc.selector.m:
compiler/dead_proc_elim.m:
compiler/export.m:
compiler/foreign.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_code_util.m:
compiler/hlds_dependency_graph.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/implementation_defined_literals.m:
compiler/inst_check.m:
compiler/mercury_to_mercury.m:
compiler/mode_util.m:
compiler/module_qual.qualify_items.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/parse_tree_to_term.m:
compiler/parse_type_name.m:
compiler/polymorphism.m:
compiler/prog_out.m:
compiler/prog_util.m:
compiler/rbmm.execution_path.m:
compiler/rtti.m:
compiler/table_gen.m:
compiler/type_util.m:
compiler/typecheck.m:
compiler/unify_gen.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Conform to the above changes to the parse tree and HLDS.
compiler/c_util.m:
Support writing out constants of the new types.
compiler/llds.m:
Add a representation for constants of the new types to the LLDS.
compiler/stack_layout.m:
Add a new field to the stack layout params that records whether
64-bit integers are boxed or not.
compiler/call_gen.:m
compiler/code_info.m:
compiler/disj_gen.m:
compiler/dupproc.m:
compiler/exprn_aux.m:
compiler/global_data.m:
compiler/jumpopt.m:
compiler/llds_out_data.m:
compiler/llds_out_instr.m:
compiler/lookup_switch.m:
compiler/mercury_compile_llds_back_end.m:
compiler/prog_rep.m:
compiler/prog_rep_tables.m:
compiler/var_locn.m b/compiler/var_locn.m:
Support the new types in the LLDS code generator.
compiler/mlds.m:
Support constants of the new types in the MLDS.
compiler/ml_call_gen.m:
compiler/ml_code_util.m:
compiler/ml_global_data.m:
compiler/ml_rename_classes.m:
compiler/ml_top_gen.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/mlds_to_target_util.m:
compiler/rtti_to_mlds.m:
Conform to the above changes to the MLDS.
compiler/mlds_to_c.m:
compiler/mlds_to_cs.m:
compiler/mlds_to_java.m:
Generate the appropriate target code for constants of the new types
and operations involving them.
compiler/bytecode.m:
compiler/bytecode_gen.m:
Handle the new types in the bytecode generator; we just abort if we
encounter them for now.
compiler/elds.m:
compiler/elds_to_erlang.m:
compiler/erl_call_gen.m:
compiler/erl_code_util.m:
compiler/erl_unify_gen.m:
Handle the new types in the Erlang code generator.
library/private_builtin.m:
Add placeholders for the builtin unify and compare operations for
the new types. Since the bootstrapping compiler will not recognise
the new types we give them polymorphic arguments. These can be
replaced after this change has bootstrapped.
Update the Java list of TypeCtorRep constants here.
library/int64.m:
library/uint64.m:
New modules that will eventually contain builtin operations on the new
types.
library/library.m:
library/MODULES_UNDOC:
Do not include the above modules in the library documentation for now.
library/construct.m:
library/erlang_rtti_implementation.m:
library/rtti_implementation.m:
library/table_statistics.m:
deep_profiler/program_representation_utils.m:
mdbcomp/program_representation.m:
Handle the new types.
configure.ac:
runtime/mercury_conf.h.in:
Define the macro MR_BOXED_INT64S. For now it is always defined, support for
unboxed 64-bit integers will be enabled in a later change.
runtime/mercury_dotnet.cs.in:
java/runtime/TypeCtorRep.java:
runtime/mercury_type_info.h:
Update the list of type_ctor reps.
runtime/mercury.h:
runtime/mercury_int.[ch]:
Add macros for int64 / uint64 -> MR_Word conversion, boxing and
unboxing.
Add functions for hashing 64-bit integer types suitable for use
with the tabling mechanism.
runtime/mercury_tabling.[ch]:
Add additional HashTableSlot structs for 64-bit integer types.
Omit the '%' character from the conversion specifiers we pass via
the 'key_format' argument to the macros that generate the table lookup
function. This is so we can use the C99 exact size integer conversion
specifiers (e.g. PRIu64 etc.) directly here.
runtime/mercury_hash_lookup_or_add_body.h:
Add the '%' character that was omitted above to the call to debug_key_msg.
runtime/mercury_memory.h:
Add new builtin allocation sites for boxed 64-bit integer types.
runtime/mercury_builtin_types.[ch]:
runtime/mercury_builitn_types_proc_layouts.h:
runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_deep_copy_body.h:
runtime/mercury_ml_expand_body.h:
runtime/mercury_table_type_body.h:
runtime/mercury_tabling_macros.h:
runtime/mercury_tabling_preds.h:
runtime/mercury_term_size.c:
runtime/mercury_unify_compare_body.h:
Add the new builtin types and handle them throughout the runtime.
runtime/Mmakefile:
Add mercury_int.c to the list of .c files.
doc/reference_manual.texi:
Add the new types to the list of reserved type names.
Add the mapping from the new types to their target language types.
These are commented out for now.
496 lines
19 KiB
Mathematica
496 lines
19 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-2012 The University of Melbourne.
|
|
% Copyright (C) 2015 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: hlds_code_util.m.
|
|
%
|
|
% Various utilities routines for use during HLDS generation.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.hlds_code_util.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Find out how a function symbol (constructor) is represented
|
|
% in the given type.
|
|
%
|
|
:- func cons_id_to_tag(module_info, cons_id) = cons_tag.
|
|
|
|
% Given a list of types, mangle the names so into a string which
|
|
% identifies them. The types must all have their top level functor
|
|
% bound, with any arguments free variables.
|
|
%
|
|
:- pred make_instance_string(list(mer_type)::in, string::out) is det.
|
|
|
|
% Given a type_ctor, return the cons_id that represents its type_ctor_info.
|
|
%
|
|
:- func type_ctor_info_cons_id(type_ctor) = cons_id.
|
|
|
|
% Given a type_ctor, return the cons_id that represents its type_ctor_info.
|
|
%
|
|
:- func base_typeclass_info_cons_id(instance_table,
|
|
prog_constraint, int, list(mer_type)) = cons_id.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Find the procedure with argmodes which match the ones we want.
|
|
%
|
|
:- pred get_procedure_matching_argmodes(assoc_list(proc_id, proc_info)::in,
|
|
list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
|
|
|
|
% Find the procedure with declared argmodes which match the ones we want.
|
|
% If there was no mode declaration, then use the inferred argmodes.
|
|
% Allow for a renaming between the inst vars.
|
|
%
|
|
:- pred get_procedure_matching_declmodes_with_renaming(
|
|
assoc_list(proc_id, proc_info)::in, list(mer_mode)::in,
|
|
module_info::in, proc_id::out) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module char.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
cons_id_to_tag(ModuleInfo, ConsId) = Tag:-
|
|
(
|
|
ConsId = int_const(Int),
|
|
Tag = int_tag(int_tag_int(Int))
|
|
;
|
|
ConsId = uint_const(UInt),
|
|
Tag = int_tag(int_tag_uint(UInt))
|
|
;
|
|
ConsId = int8_const(Int8),
|
|
Tag = int_tag(int_tag_int8(Int8))
|
|
;
|
|
ConsId = uint8_const(UInt8),
|
|
Tag = int_tag(int_tag_uint8(UInt8))
|
|
;
|
|
ConsId = int16_const(Int16),
|
|
Tag = int_tag(int_tag_int16(Int16))
|
|
;
|
|
ConsId = uint16_const(UInt16),
|
|
Tag = int_tag(int_tag_uint16(UInt16))
|
|
;
|
|
ConsId = int32_const(Int32),
|
|
Tag = int_tag(int_tag_int32(Int32))
|
|
;
|
|
ConsId = uint32_const(UInt32),
|
|
Tag = int_tag(int_tag_uint32(UInt32))
|
|
;
|
|
ConsId = int64_const(Int64),
|
|
Tag = int_tag(int_tag_int64(Int64))
|
|
;
|
|
ConsId = uint64_const(UInt64),
|
|
Tag = int_tag(int_tag_uint64(UInt64))
|
|
;
|
|
ConsId = float_const(Float),
|
|
Tag = float_tag(Float)
|
|
;
|
|
ConsId = char_const(Char),
|
|
char.to_int(Char, CharCode),
|
|
Tag = int_tag(int_tag_int(CharCode))
|
|
;
|
|
ConsId = string_const(String),
|
|
Tag = string_tag(String)
|
|
;
|
|
ConsId = impl_defined_const(_),
|
|
unexpected($module, $pred, "implementation_defined_const")
|
|
;
|
|
ConsId = closure_cons(ShroudedPredProcId, EvalMethod),
|
|
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
|
|
Tag = closure_tag(PredId, ProcId, EvalMethod)
|
|
;
|
|
ConsId = type_ctor_info_const(ModuleName, TypeName, Arity),
|
|
Tag = type_ctor_info_tag(ModuleName, TypeName, Arity)
|
|
;
|
|
ConsId = base_typeclass_info_const(ModuleName, ClassName,
|
|
_Instance, EncodedArgs),
|
|
Tag = base_typeclass_info_tag(ModuleName, ClassName, EncodedArgs)
|
|
;
|
|
( ConsId = type_info_cell_constructor(_)
|
|
; ConsId = typeclass_info_cell_constructor
|
|
),
|
|
Tag = unshared_tag(0)
|
|
;
|
|
ConsId = type_info_const(TIConstNum),
|
|
Tag = type_info_const_tag(TIConstNum)
|
|
;
|
|
ConsId = typeclass_info_const(TCIConstNum),
|
|
Tag = typeclass_info_const_tag(TCIConstNum)
|
|
;
|
|
ConsId = ground_term_const(ConstNum, SubConsId),
|
|
SubConsTag = cons_id_to_tag(ModuleInfo, SubConsId),
|
|
Tag = ground_term_const_tag(ConstNum, SubConsTag)
|
|
;
|
|
ConsId = tabling_info_const(ShroudedPredProcId),
|
|
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
|
|
Tag = tabling_info_tag(PredId, ProcId)
|
|
;
|
|
ConsId = deep_profiling_proc_layout(ShroudedPredProcId),
|
|
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
|
|
Tag = deep_profiling_proc_layout_tag(PredId, ProcId)
|
|
;
|
|
ConsId = table_io_entry_desc(ShroudedPredProcId),
|
|
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
|
|
Tag = table_io_entry_tag(PredId, ProcId)
|
|
;
|
|
ConsId = tuple_cons(Arity),
|
|
% Tuples do not need a tag. Note that unary tuples are not treated
|
|
% as no_tag types. There is no reason why they couldn't be, it is
|
|
% just not worth the effort.
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_target(Globals, TargetLang),
|
|
(
|
|
( TargetLang = target_c
|
|
; TargetLang = target_erlang
|
|
),
|
|
( if Arity = 0 then
|
|
Tag = int_tag(int_tag_int(0))
|
|
else
|
|
Tag = single_functor_tag
|
|
)
|
|
;
|
|
% For these target languages, converting arity-zero tuples into
|
|
% dummy integer tags results in invalid code being generated.
|
|
( TargetLang = target_csharp
|
|
; TargetLang = target_java
|
|
),
|
|
Tag = single_functor_tag
|
|
)
|
|
;
|
|
ConsId = cons(_Name, _Arity, TypeCtor),
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
lookup_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
(
|
|
TypeBody = hlds_du_type(_, ConsTagTable, _, _, _, _, _, _, _),
|
|
map.lookup(ConsTagTable, ConsId, Tag)
|
|
;
|
|
( TypeBody = hlds_eqv_type(_)
|
|
; TypeBody = hlds_foreign_type(_)
|
|
; TypeBody = hlds_solver_type(_)
|
|
; TypeBody = hlds_abstract_type(_)
|
|
),
|
|
unexpected($module, $pred, "type is not d.u. type")
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
make_instance_string(InstanceTypes, InstanceString) :-
|
|
% Note that for historical reasons, builtin types are treated as being
|
|
% unqualified (`int') rather than being qualified (`builtin.int')
|
|
% at this point.
|
|
list.map(type_to_string, InstanceTypes, InstanceStrings),
|
|
string.append_list(InstanceStrings, InstanceString).
|
|
|
|
:- pred type_to_string(mer_type::in, string::out) is det.
|
|
|
|
type_to_string(Type, String) :-
|
|
type_to_ctor_det(Type, TypeCtor),
|
|
TypeCtor = type_ctor(TypeName, TypeArity),
|
|
TypeNameString = sym_name_to_string_sep(TypeName, "__"),
|
|
string.int_to_string(TypeArity, TypeArityString),
|
|
String = TypeNameString ++ "__arity" ++ TypeArityString ++ "__".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
type_ctor_info_cons_id(TypeCtor) = ConsId :-
|
|
type_ctor_module_name_arity(TypeCtor, ModuleName, Name, Arity),
|
|
ConsId = type_ctor_info_const(ModuleName, Name, Arity).
|
|
|
|
base_typeclass_info_cons_id(InstanceTable, Constraint, InstanceNum,
|
|
InstanceTypes) = ConsId :-
|
|
Constraint = constraint(ClassName, ConstraintArgTypes),
|
|
ClassId = class_id(ClassName, list.length(ConstraintArgTypes)),
|
|
map.lookup(InstanceTable, ClassId, InstanceList),
|
|
list.det_index1(InstanceList, InstanceNum, InstanceDefn),
|
|
InstanceModuleName = InstanceDefn ^ instdefn_module,
|
|
make_instance_string(InstanceTypes, InstanceString),
|
|
ConsId = base_typeclass_info_const(InstanceModuleName, ClassId,
|
|
InstanceNum, InstanceString).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
get_procedure_matching_argmodes(Procs, Modes0, ModuleInfo, ProcId) :-
|
|
list.map(constrain_inst_vars_in_mode, Modes0, Modes),
|
|
get_procedure_matching_argmodes_2(Procs, Modes, ModuleInfo, ProcId).
|
|
|
|
:- pred get_procedure_matching_argmodes_2(assoc_list(proc_id, proc_info)::in,
|
|
list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
|
|
|
|
get_procedure_matching_argmodes_2([P | Procs], Modes, ModuleInfo, OurProcId) :-
|
|
P = ProcId - ProcInfo,
|
|
proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
( if mode_list_matches(Modes, ArgModes, ModuleInfo) then
|
|
OurProcId = ProcId
|
|
else
|
|
get_procedure_matching_argmodes_2(Procs, Modes, ModuleInfo, OurProcId)
|
|
).
|
|
|
|
:- pred mode_list_matches(list(mer_mode)::in, list(mer_mode)::in,
|
|
module_info::in) is semidet.
|
|
|
|
mode_list_matches([], [], _).
|
|
mode_list_matches([Mode1 | Modes1], [Mode2 | Modes2], ModuleInfo) :-
|
|
% Use mode_get_insts_semidet instead of mode_get_insts to avoid
|
|
% aborting if there are undefined modes.
|
|
% XXX
|
|
mode_get_insts_semidet(ModuleInfo, Mode1, Inst1, Inst2),
|
|
mode_get_insts_semidet(ModuleInfo, Mode2, Inst1, Inst2),
|
|
mode_list_matches(Modes1, Modes2, ModuleInfo).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%----------------------------------------------------------------------------%
|
|
|
|
get_procedure_matching_declmodes_with_renaming(Procs, Modes0,
|
|
ModuleInfo, ProcId) :-
|
|
list.map(constrain_inst_vars_in_mode, Modes0, Modes),
|
|
get_procedure_matching_declmodes_with_renaming_2(Procs, Modes,
|
|
ModuleInfo, ProcId).
|
|
|
|
:- pred get_procedure_matching_declmodes_with_renaming_2(
|
|
assoc_list(proc_id, proc_info)::in, list(mer_mode)::in,
|
|
module_info::in, proc_id::out) is semidet.
|
|
|
|
get_procedure_matching_declmodes_with_renaming_2([P | Procs], Modes,
|
|
ModuleInfo, OurProcId) :-
|
|
P = ProcId - ProcInfo,
|
|
proc_info_declared_argmodes(ProcInfo, ArgModes),
|
|
( if mode_list_matches_with_renaming(Modes, ArgModes, ModuleInfo) then
|
|
OurProcId = ProcId
|
|
else
|
|
get_procedure_matching_declmodes_with_renaming_2(Procs, Modes,
|
|
ModuleInfo, OurProcId)
|
|
).
|
|
|
|
:- type inst_var_renaming == map(inst_var, inst_var).
|
|
:- type inst_var_renamings == list(inst_var_renaming).
|
|
|
|
% Succeeds if two lists of modes match allowing for a renaming
|
|
% of inst variables between the two lists.
|
|
%
|
|
:- pred mode_list_matches_with_renaming(list(mer_mode)::in,
|
|
list(mer_mode)::in, module_info::in) is semidet.
|
|
|
|
mode_list_matches_with_renaming(ModesA, ModesB, ModuleInfo) :-
|
|
mode_list_matches_with_renaming(ModesA, ModesB, _, ModuleInfo).
|
|
|
|
:- pred mode_list_matches_with_renaming(list(mer_mode)::in,
|
|
list(mer_mode)::in, inst_var_renaming::out, module_info::in)
|
|
is semidet.
|
|
|
|
mode_list_matches_with_renaming(ModesA, ModesB, Renaming, ModuleInfo) :-
|
|
mode_list_matches_with_renaming_2(ModesA, ModesB, [], Renamings,
|
|
ModuleInfo),
|
|
list.foldl(merge_inst_var_renamings, Renamings, map.init, Renaming).
|
|
|
|
:- pred mode_list_matches_with_renaming_2(
|
|
list(mer_mode)::in, list(mer_mode)::in,
|
|
inst_var_renamings::in, inst_var_renamings::out,
|
|
module_info::in) is semidet.
|
|
|
|
mode_list_matches_with_renaming_2([], [], !Renaming, _).
|
|
mode_list_matches_with_renaming_2([ModeA | ModesA], [ModeB | ModesB],
|
|
!Substs, ModuleInfo) :-
|
|
% We use mode_get_insts_semidet instead of mode_get_insts to avoid
|
|
% aborting if there are undefined modes. (Undefined modes get
|
|
% reported later).
|
|
|
|
mode_get_insts_semidet(ModuleInfo, ModeA, InstAInitial, InstAFinal),
|
|
mode_get_insts_semidet(ModuleInfo, ModeB, InstBInitial, InstBFinal),
|
|
match_insts_with_renaming(ModuleInfo, InstAInitial, InstBInitial,
|
|
InitialSubst),
|
|
match_insts_with_renaming(ModuleInfo, InstAFinal, InstBFinal,
|
|
FinalSubst),
|
|
list.append([InitialSubst, FinalSubst], !Substs),
|
|
mode_list_matches_with_renaming_2(ModesA, ModesB, !Substs, ModuleInfo).
|
|
|
|
:- pred match_corresponding_inst_lists_with_renaming(module_info::in,
|
|
list(mer_inst)::in, list(mer_inst)::in,
|
|
inst_var_renaming::in, inst_var_renaming::out) is semidet.
|
|
|
|
match_corresponding_inst_lists_with_renaming(_, [], [], !Renaming).
|
|
match_corresponding_inst_lists_with_renaming(ModuleInfo, [A | As], [B | Bs],
|
|
!Renaming) :-
|
|
match_insts_with_renaming(ModuleInfo, A, B, Renaming0),
|
|
merge_inst_var_renamings(Renaming0, !Renaming),
|
|
match_corresponding_inst_lists_with_renaming(ModuleInfo, As, Bs,
|
|
!Renaming).
|
|
|
|
:- pred match_corresponding_bound_inst_lists_with_renaming(module_info::in,
|
|
list(bound_inst)::in, list(bound_inst)::in,
|
|
inst_var_renaming::in, inst_var_renaming::out) is semidet.
|
|
|
|
match_corresponding_bound_inst_lists_with_renaming(_, [], [], !Renaming).
|
|
match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
|
|
[A | As], [B | Bs], !Renaming) :-
|
|
A = bound_functor(ConsId, ArgsA),
|
|
B = bound_functor(ConsId, ArgsB),
|
|
match_corresponding_inst_lists_with_renaming(ModuleInfo, ArgsA, ArgsB,
|
|
map.init, Renaming0),
|
|
merge_inst_var_renamings(Renaming0, !Renaming),
|
|
match_corresponding_bound_inst_lists_with_renaming(ModuleInfo, As, Bs,
|
|
!Renaming).
|
|
|
|
:- pred match_insts_with_renaming(module_info::in, mer_inst::in, mer_inst::in,
|
|
map(inst_var, inst_var)::out) is semidet.
|
|
|
|
match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
|
|
(
|
|
InstA = not_reached,
|
|
InstB = not_reached,
|
|
map.init(Renaming)
|
|
;
|
|
InstA = free,
|
|
InstB = free,
|
|
map.init(Renaming)
|
|
;
|
|
InstA = free(Type),
|
|
InstB = free(Type),
|
|
map.init(Renaming)
|
|
;
|
|
InstA = any(Uniq, HOInstInfoA),
|
|
InstB = any(Uniq, HOInstInfoB),
|
|
match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
|
|
Renaming)
|
|
;
|
|
InstA = ground(Uniq, HOInstInfoA),
|
|
InstB = ground(Uniq, HOInstInfoB),
|
|
match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
|
|
Renaming)
|
|
;
|
|
InstA = bound(Uniq, _, BoundInstsA),
|
|
InstB = bound(Uniq, _, BoundInstsB),
|
|
match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
|
|
BoundInstsA, BoundInstsB, map.init, Renaming)
|
|
;
|
|
InstA = inst_var(VarA),
|
|
InstB = inst_var(VarB),
|
|
Renaming = map.singleton(VarA, VarB)
|
|
;
|
|
InstA = constrained_inst_vars(InstVarSetA, SpecInstA),
|
|
InstB = constrained_inst_vars(InstVarSetB, SpecInstB),
|
|
|
|
% We will deal with the specified inst first.
|
|
match_insts_with_renaming(ModuleInfo, SpecInstA, SpecInstB, Renaming0),
|
|
ListVarA = set.to_sorted_list(InstVarSetA),
|
|
ListVarB = set.to_sorted_list(InstVarSetB),
|
|
( if
|
|
ListVarA = [VarA0],
|
|
ListVarB = [VarB0]
|
|
then
|
|
VarA = VarA0,
|
|
VarB = VarB0
|
|
else
|
|
unexpected($module, $pred, "non-singleton sets")
|
|
),
|
|
( if map.search(Renaming0, VarA, SpecVarB) then
|
|
% If VarA was already in the renaming then check that it is
|
|
% consistent with the renaming from the set of inst vars.
|
|
VarB = SpecVarB,
|
|
Renaming = Renaming0
|
|
else
|
|
map.det_insert(VarA, VarB, Renaming0, Renaming)
|
|
)
|
|
;
|
|
InstA = defined_inst(InstNameA),
|
|
InstB = defined_inst(InstNameB),
|
|
match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB,
|
|
Renaming)
|
|
;
|
|
InstA = abstract_inst(Name, ArgsA),
|
|
InstB = abstract_inst(Name, ArgsB),
|
|
match_corresponding_inst_lists_with_renaming(ModuleInfo, ArgsA, ArgsB,
|
|
map.init, Renaming)
|
|
).
|
|
|
|
:- pred match_ho_inst_infos_with_renaming(module_info::in, ho_inst_info::in,
|
|
ho_inst_info::in, map(inst_var, inst_var)::out) is semidet.
|
|
|
|
match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
|
|
Renaming) :-
|
|
(
|
|
HOInstInfoA = none_or_default_func,
|
|
HOInstInfoB = none_or_default_func,
|
|
Renaming = map.init
|
|
;
|
|
HOInstInfoA = higher_order(PredInstInfoA),
|
|
HOInstInfoB = higher_order(PredInstInfoB),
|
|
PredInstInfoA = pred_inst_info(PredOrFunc, ModesA, _, Detism),
|
|
PredInstInfoB = pred_inst_info(PredOrFunc, ModesB, _, Detism),
|
|
mode_list_matches_with_renaming(ModesA, ModesB, Renaming, ModuleInfo)
|
|
).
|
|
|
|
:- pred match_inst_names_with_renaming(module_info::in,
|
|
inst_name::in, inst_name::in, inst_var_renaming::out) is semidet.
|
|
|
|
match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB, Renaming) :-
|
|
(
|
|
InstNameA = user_inst(Name, ArgsA),
|
|
InstNameB = user_inst(Name, ArgsB),
|
|
match_corresponding_inst_lists_with_renaming(ModuleInfo,
|
|
ArgsA, ArgsB, map.init, Renaming)
|
|
;
|
|
% XXX The rest of these are introduced by the compiler, it doesn't
|
|
% look like they need any special treatment.
|
|
( InstNameA = unify_inst(_, _, _, _)
|
|
; InstNameA = merge_inst(_, _)
|
|
; InstNameA = ground_inst(_, _, _, _)
|
|
; InstNameA = any_inst(_, _, _, _)
|
|
; InstNameA = shared_inst(_)
|
|
; InstNameA = mostly_uniq_inst(_)
|
|
),
|
|
InstNameB = InstNameA,
|
|
Renaming = map.init
|
|
).
|
|
|
|
:- pred merge_inst_var_renamings(inst_var_renaming::in,
|
|
inst_var_renaming::in, inst_var_renaming::out) is semidet.
|
|
|
|
merge_inst_var_renamings(RenamingA, RenamingB, Result) :-
|
|
map.union(merge_common_inst_vars, RenamingA, RenamingB, Result).
|
|
|
|
:- pred merge_common_inst_vars(inst_var::in, inst_var::in, inst_var::out)
|
|
is semidet.
|
|
|
|
merge_common_inst_vars(A, A, A).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
:- end_module hlds.hlds_code_util.
|
|
%----------------------------------------------------------------------------%
|