[m-rev.] for review: Use consistent integer types for some RTTI fields.
Peter Wang
novalazy at gmail.com
Sat Nov 17 15:05:58 AEDT 2018
runtime/mercury_type_info.h:
Use unsigned integer types for a few RTTI structure fields that
are known to hold non-negative values.
Add comments for other field types that could be changed later.
compiler/rtti.m:
Use fixed size integer types for fields matching the size
and signedness of the corresponding C RTTI structure fields.
Encode type ctor flags in a uint16 instead of int.
Make type_ctor_details_num_ptags and type_ctor_details_num_functors
return a maybe value, instead of a negative value to represent no
primary tags or no function symbols, respectively.
compiler/type_ctor_info.m:
Conform to type changes.
Use uint16 to represent the "contains var" bit vector.
compiler/rtti_out.m:
compiler/rtti_to_mlds.m:
Conform to type changes.
Add comments to make it easier to find the code that writes out
each particular RTTI structure field.
compiler/ml_util.m:
Add helper functions.
compiler/erl_rtti.m:
compiler/erlang_rtti.m:
Conform to type changes.
library/rtti_implementation.m:
Use fixed size integer types for RTTI field accessor functions,
and update callers.
java/runtime/DuArgLocn.java:
java/runtime/DuExistInfo.java:
java/runtime/DuExistLocn.java:
java/runtime/DuFunctorDesc.java:
java/runtime/TypeCtorInfo_Struct.java:
Use integer types in RTTI structure definitions for Java that match
the types in the C versions of the same structures.
runtime/mercury_dotnet.cs.in:
Use integer types in RTTI structure definitions for C# that match
the types in the C versions of the same structures.
---
compiler/erl_rtti.m | 6 +-
compiler/erlang_rtti.m | 5 +-
compiler/ml_util.m | 14 +++
compiler/rtti.m | 82 +++++++++--------
compiler/rtti_out.m | 97 ++++++++++++++++---
compiler/rtti_to_mlds.m | 128 +++++++++++++++-----------
compiler/type_ctor_info.m | 54 ++++++-----
java/runtime/DuArgLocn.java | 8 +-
java/runtime/DuExistInfo.java | 12 +--
java/runtime/DuExistLocn.java | 6 +-
java/runtime/DuFunctorDesc.java | 12 +--
java/runtime/TypeCtorInfo_Struct.java | 21 ++---
library/rtti_implementation.m | 55 ++++++-----
runtime/mercury_dotnet.cs.in | 60 ++++++------
runtime/mercury_type_info.h | 40 ++++----
15 files changed, 361 insertions(+), 239 deletions(-)
diff --git a/compiler/erl_rtti.m b/compiler/erl_rtti.m
index d63b86e3f..ad42f5458 100644
--- a/compiler/erl_rtti.m
+++ b/compiler/erl_rtti.m
@@ -146,21 +146,21 @@ erlang_type_ctor_details_2(CtorDetails) = Details :-
CtorDetails = tcd_foreign_enum(_, _, _, _, _, _),
sorry($module, $pred, "NYI foreign enumerations for Erlang.")
;
CtorDetails = tcd_du(_, Functors, _, _, FunctorNums),
list.map_corresponding(convert_du_functor, Functors, FunctorNums,
ErlangFunctors),
Details = erlang_du(ErlangFunctors)
;
CtorDetails = tcd_notag(_, NoTagFunctor),
NoTagFunctor = notag_functor(Name, TypeInfo, ArgName, SubtypeInfo),
- OrigArity = 1,
+ OrigArity = 1i16,
Ordinal = 0,
FunctorNum = 0,
ArgTypeInfo = convert_to_rtti_maybe_pseudo_type_info_or_self(TypeInfo),
ArgPosWidth = apw_full(arg_only_offset(0), cell_offset(0)),
ArgInfos = [du_arg_info(ArgName, ArgTypeInfo, ArgPosWidth)],
DUFunctor = erlang_du_functor(Name, OrigArity, Ordinal, FunctorNum,
erlang_atom_raw(Name), ArgInfos, no, SubtypeInfo),
Details = erlang_du([DUFunctor])
;
CtorDetails = tcd_eqv(Type),
@@ -176,21 +176,21 @@ erlang_type_ctor_details_2(CtorDetails) = Details :-
Details = erlang_foreign
).
% Convert an enum_functor into the equivalent erlang_du_functor
%
:- pred convert_enum_functor(enum_functor::in, int::in, erlang_du_functor::out)
is det.
convert_enum_functor(EnumFunctor, FunctorNum, ErlangFunctor) :-
EnumFunctor = enum_functor(Name, Ordinal),
- ErlangFunctor = erlang_du_functor(Name, 0, Ordinal, FunctorNum,
+ ErlangFunctor = erlang_du_functor(Name, 0i16, Ordinal, FunctorNum,
erlang_atom_raw(Name), [], no, functor_subtype_none).
% Convert a du_functor into the equivalent erlang_du_functor
%
:- pred convert_du_functor(du_functor::in, int::in, erlang_du_functor::out)
is det.
convert_du_functor(Functor, FunctorNum, ErlangFunctor) :-
Functor = du_functor(Name, Arity, Ordinal, _, ArgInfos, Exist,
SubtypeInfo),
@@ -568,21 +568,21 @@ type_ctor_data_to_elds(ModuleInfo, TypeCtorData, RttiDefns) :-
erlang_type_ctor_details(ModuleInfo, Details, ELDSDetails0,
RttiDefns0),
reduce_list_term_complexity(ELDSDetails0, ELDSDetails,
[], RevAssignments, !VarSet),
VarSet = !.VarSet
),
ELDSTypeCtorData = elds_tuple([
elds_term(elds_int(Arity)),
- elds_term(elds_int(Version)),
+ elds_term(elds_int8(Version)),
UnifyExpr,
CompareExpr,
elds_term(elds_list_of_ints(sym_name_to_string(ModuleName))),
elds_term(elds_list_of_ints(TypeName)),
erlang_type_ctor_rep(Details),
ELDSDetails
]),
ClauseBody = elds_block(list.reverse(RevAssignments) ++
[elds_term(ELDSTypeCtorData)]),
diff --git a/compiler/erlang_rtti.m b/compiler/erlang_rtti.m
index a0e41f06d..1ccf3ffcf 100644
--- a/compiler/erlang_rtti.m
+++ b/compiler/erlang_rtti.m
@@ -1,14 +1,15 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2007, 2011 The University of Melbourne.
+% Copyright (C) 2018 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: erlang_rtti.m.
% Authors: petdr, zs.
%
% Definitions of data structures for representing run-time type information
% in the Erlang backend.
%
@@ -38,21 +39,21 @@
%-----------------------------------------------------------------------------%
%
% The data structures representing type constructors
%
% A type_ctor_data structure contains all the information that the
% runtime system needs to know about a type constructor.
%
:- type erlang_type_ctor_data
---> erlang_type_ctor_data(
- etcr_version :: int,
+ etcr_version :: int8,
etcr_module_name :: module_name,
etcr_type_name :: string,
etcr_arity :: int,
%
% It is possible that the type doesn't have
% a unify or compare predicate.
% eg one cannot unify higher-order types.
%
etcr_unify :: maybe(rtti_proc_label),
@@ -101,21 +102,21 @@
; erlang_impl_artifact(
eimpl_ctor :: erlang_impl_ctor
)
; erlang_foreign
.
:- type erlang_du_functor
---> erlang_du_functor(
edu_name :: string,
- edu_orig_arity :: int,
+ edu_orig_arity :: int16,
% The declaration order of the functor.
edu_ordinal :: int,
% The lexicographic order of the functor.
edu_lex :: int,
% erlang atom which represents the functor
% currently encoded version of name
% in the future maybe name_arity
diff --git a/compiler/ml_util.m b/compiler/ml_util.m
index 8fc47f771..e8c52329b 100644
--- a/compiler/ml_util.m
+++ b/compiler/ml_util.m
@@ -112,20 +112,27 @@
%---------------------------------------------------------------------------%
%
% Functions for generating initializers.
%
% This handles arrays, maybe, null pointers, strings, ints, and builtin enums.
:- func gen_init_bool(bool) = mlds_initializer.
:- func gen_init_int(int) = mlds_initializer.
+:- func gen_init_uint(uint) = mlds_initializer.
+
+:- func gen_init_int8(int8) = mlds_initializer.
+:- func gen_init_uint8(uint8) = mlds_initializer.
+
+:- func gen_init_int16(int16) = mlds_initializer.
+:- func gen_init_uint16(uint16) = mlds_initializer.
:- func gen_init_boxed_int(int) = mlds_initializer.
:- func gen_init_string(string) = mlds_initializer.
:- func gen_init_builtin_const(target_prefixes, string) = mlds_initializer.
:- func gen_init_foreign(foreign_language, string) = mlds_initializer.
:- func gen_init_null_pointer(mlds_type) = mlds_initializer.
@@ -855,20 +862,27 @@ lval_contains_var(Lval, SearchVarName) = ContainsVar :-
ContainsVar =no
)
).
%---------------------------------------------------------------------------%
gen_init_bool(no) = init_obj(ml_const(mlconst_false)).
gen_init_bool(yes) = init_obj(ml_const(mlconst_true)).
gen_init_int(Int) = init_obj(ml_const(mlconst_int(Int))).
+gen_init_uint(Int) = init_obj(ml_const(mlconst_uint(Int))).
+
+gen_init_int8(Int) = init_obj(ml_const(mlconst_int8(Int))).
+gen_init_uint8(Int) = init_obj(ml_const(mlconst_uint8(Int))).
+
+gen_init_int16(Int) = init_obj(ml_const(mlconst_int16(Int))).
+gen_init_uint16(Int) = init_obj(ml_const(mlconst_uint16(Int))).
gen_init_boxed_int(Int) =
init_obj(ml_box(mlds_builtin_type_int(int_type_int),
ml_const(mlconst_int(Int)))).
gen_init_string(String) = init_obj(ml_const(mlconst_string(String))).
gen_init_builtin_const(TargetPrefixes, Name) = init_obj(Rval) :-
Rval = ml_const(mlconst_named_const(TargetPrefixes, Name)).
diff --git a/compiler/rtti.m b/compiler/rtti.m
index 43cce7dab..c91e34f17 100644
--- a/compiler/rtti.m
+++ b/compiler/rtti.m
@@ -1,14 +1,15 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2007, 2009-2011 The University of Melbourne.
+% Copyright (C) 2014-2018 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: rtti.m.
% Authors: zs, fjh.
%
% Definitions of data structures for representing run-time type information
% within the compiler. When output by rtti_out.m, values of most these types
% will correspond to the types defined in runtime/mercury_type_info.h; the
@@ -115,21 +116,21 @@
%-----------------------------------------------------------------------------%
%
% The data structures representing type constructors.
%
% A type_ctor_data structure contains all the information that the
% runtime system needs to know about a type constructor.
%
:- type type_ctor_data
---> type_ctor_data(
- tcr_version :: int,
+ tcr_version :: int8,
tcr_module_name :: module_name,
tcr_type_name :: string,
tcr_arity :: int,
tcr_unify_pred :: univ,
tcr_compare_pred :: univ,
tcr_flags :: set(type_ctor_flag),
tcr_rep_details :: type_ctor_details
).
% Each of the following values corresponds to one of the
@@ -185,21 +186,21 @@
foreign_enum_ordinal_table :: map(int, foreign_enum_functor),
foreign_enum_name_table :: map(string,
foreign_enum_functor),
foreign_enum_functor_number_mapping
:: list(int)
)
; tcd_du(
du_axioms :: equality_axioms,
du_functors :: list(du_functor),
du_value_table :: ptag_map,
- du_name_table :: map(string, map(int, du_functor)),
+ du_name_table :: map(string, map(int16, du_functor)),
du_functor_number_mapping
:: list(int)
)
; tcd_notag(
notag_axioms :: equality_axioms,
notag_functor :: notag_functor
)
; tcd_eqv(
eqv_type :: rtti_maybe_pseudo_type_info
)
@@ -257,21 +258,21 @@
nt_subtype_info :: functor_subtype_info
).
% Descriptor for a functor in a du type.
%
% This type mostly corresponds to the C type MR_DuFunctorDesc.
%
:- type du_functor
---> du_functor(
du_name :: string,
- du_orig_arity :: int,
+ du_orig_arity :: int16,
du_ordinal :: int,
du_rep :: du_rep,
du_arg_infos :: list(du_arg_info),
du_exist_info :: maybe(exist_info),
du_subtype_info :: functor_subtype_info
).
% Describes the representation of a functor in a general
% discriminated union type.
%
@@ -286,45 +287,45 @@
remote_sec_tag :: uint
).
% Describes the types of the existentially typed arguments of a
% discriminated union functor.
%
% This type corresponds to the C type MR_DuExistInfo.
%
:- type exist_info
---> exist_info(
- exist_num_plain_typeinfos :: int,
- exist_num_typeinfos_in_tcis :: int,
+ exist_num_plain_typeinfos :: int16,
+ exist_num_typeinfos_in_tcis :: int16,
exist_typeclass_constraints :: list(tc_constraint),
exist_typeinfo_locns :: list(exist_typeinfo_locn)
).
% Describes the location at which one can find the typeinfo for the
% type bound to an existentially quantified type variable in a
% discriminated union functor.
%
% This type corresponds to the C type MR_DuExistLocn.
%
:- type exist_typeinfo_locn
---> plain_typeinfo(
% The typeinfo is stored directly in the cell, at this offset.
- int
+ int16
)
; typeinfo_in_tci(
% The typeinfo is stored indirectly in the typeclass info
% stored at this offset in the cell.
- int,
+ int16,
% To find the typeinfo inside the typeclass info structure,
% give this integer to the MR_typeclass_info_type_info macro.
- int
+ int16
).
% These tables let the runtime system interpret values in memory
% of general discriminated union types.
%
% The runtime system should first use the primary tag to index into
% the type's ptag_map. It can then find the location (if any) of the
% secondary tag, and use the secondary tag (or zero if there isn't one)
% to index into the stag_map to find the functor descriptor.
%
@@ -665,21 +666,21 @@
; type_class_instance_constraint(list(tc_type), int, int)
% constraint ordinal, constraint arity
; type_class_instance_constraints(list(tc_type))
; type_class_instance_methods(list(tc_type)).
%-----------------------------------------------------------------------------%
%
% Functions operating on RTTI data.
%
-:- func encode_type_ctor_flags(set(type_ctor_flag)) = int.
+:- func encode_type_ctor_flags(set(type_ctor_flag)) = uint16.
% Return the id of the type constructor.
%
:- func tcd_get_rtti_type_ctor(type_ctor_data) = rtti_type_ctor.
% Convert a rtti_data to an rtti_id.
% This calls error/1 if the argument is a type_var/1 rtti_data,
% since there is no rtti_id to return in that case.
%
:- pred rtti_data_to_id(rtti_data::in, rtti_id::out) is det.
@@ -774,31 +775,32 @@
%
:- func maybe_pseudo_type_info_to_rtti_data(rtti_maybe_pseudo_type_info)
= rtti_data.
% Return the rtti_data containing the given type_info or
% pseudo_type_info or self.
%
:- func maybe_pseudo_type_info_or_self_to_rtti_data(
rtti_maybe_pseudo_type_info_or_self) = rtti_data.
- % Given a type constructor with the given details, return the number
- % of primary tag values used by the type. The return value will be
- % negative if the type constructor doesn't reserve primary tags.
+ % Given a type constructor with the given details, return `yes(NumPtags)'
+ % where NumPtags is the number of primary tag values used by the type,
+ % or `no' if the type constructor doesn't reserve primary tags.
%
-:- func type_ctor_details_num_ptags(type_ctor_details) = int.
+:- func type_ctor_details_num_ptags(type_ctor_details) = maybe(int).
- % Given a type constructor with the given details, return the number
- % of function symbols defined by the type. The return value will be
- % negative if the type constructor doesn't define any function symbols.
+ % Given a type constructor with the given details, return
+ % `yes(NumFunctors)' where NumFunctors is the number of function symbols
+ % defined by the type, or `no' if the type constructor doesn't define any
+ % function symbols.
%
-:- func type_ctor_details_num_functors(type_ctor_details) = int.
+:- func type_ctor_details_num_functors(type_ctor_details) = maybe(int).
% Extract the argument name (if any) from a du_arg_info.
%
:- func du_arg_info_name(du_arg_info) = maybe(string).
% Extract the argument type from a du_arg_info.
%
:- func du_arg_info_type(du_arg_info) = rtti_maybe_pseudo_type_info_or_self.
% Extract the argument position and width from the du_arg_info.
@@ -957,40 +959,42 @@
:- import_module backend_libs.name_mangle.
:- import_module mdbcomp.builtin_modules.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_type.
:- import_module int.
:- import_module require.
:- import_module string.
:- import_module table_builtin.
+:- import_module uint16.
:- import_module uint8.
%----------------------------------------------------------------------------%
encode_type_ctor_flags(FlagSet) = Encoding :-
set.to_sorted_list(FlagSet, FlagList),
- list.foldl(encode_type_ctor_flag, FlagList, 0, Encoding).
+ list.foldl(encode_type_ctor_flag, FlagList, 0u16, Encoding).
% NOTE: the encoding here must match the one in
% runtime/mercury_type_info.h.
%
% Also note: we used to use 1 to encode types that reserved a tag
% for constraint solvers.
%
-:- pred encode_type_ctor_flag(type_ctor_flag::in, int::in, int::out) is det.
+:- pred encode_type_ctor_flag(type_ctor_flag::in, uint16::in, uint16::out)
+ is det.
encode_type_ctor_flag(variable_arity_flag, !Encoding) :-
- !:Encoding = !.Encoding + 2.
+ !:Encoding = !.Encoding + 2u16.
encode_type_ctor_flag(kind_of_du_flag, !Encoding) :-
- !:Encoding = !.Encoding + 4.
+ !:Encoding = !.Encoding + 4u16.
rtti_data_to_id(RttiData, RttiId) :-
(
RttiData = rtti_data_type_ctor_info(TypeCtorData),
RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info)
;
RttiData = rtti_data_type_info(TypeInfo),
RttiTypeCtor = ti_get_rtti_type_ctor(TypeInfo),
RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_info(TypeInfo))
@@ -1738,59 +1742,63 @@ maybe_pseudo_type_info_to_rtti_data(pseudo(PseudoTypeInfo)) =
maybe_pseudo_type_info_to_rtti_data(plain(TypeInfo)) =
rtti_data_type_info(TypeInfo).
maybe_pseudo_type_info_or_self_to_rtti_data(pseudo(PseudoTypeInfo)) =
rtti_data_pseudo_type_info(PseudoTypeInfo).
maybe_pseudo_type_info_or_self_to_rtti_data(plain(TypeInfo)) =
rtti_data_type_info(TypeInfo).
maybe_pseudo_type_info_or_self_to_rtti_data(self) =
rtti_data_pseudo_type_info(type_var(0)).
-type_ctor_details_num_ptags(TypeCtorDetails) = NumPtags :-
+type_ctor_details_num_ptags(TypeCtorDetails) = MaybeNumPtags :-
(
( TypeCtorDetails = tcd_enum(_, _, _, _, _, _)
; TypeCtorDetails = tcd_foreign_enum(_, _, _, _, _, _)
; TypeCtorDetails = tcd_notag(_, _)
; TypeCtorDetails = tcd_eqv(_)
; TypeCtorDetails = tcd_builtin(_)
; TypeCtorDetails = tcd_impl_artifact(_)
; TypeCtorDetails = tcd_foreign(_)
),
- NumPtags = -1
+ MaybeNumPtags = no
;
TypeCtorDetails = tcd_du(_, _, PtagMap, _, _),
map.keys(PtagMap, Ptags),
list.det_last(Ptags, LastPtag),
LastPtag = ptag(LastPtagUint8),
- NumPtags = uint8.cast_to_int(LastPtagUint8) + 1
+ NumPtags = uint8.to_int(LastPtagUint8) + 1,
+ MaybeNumPtags = yes(NumPtags)
).
-type_ctor_details_num_functors(TypeCtorDetails) = NumFunctors :-
+type_ctor_details_num_functors(TypeCtorDetails) = MaybeNumFunctors :-
(
- TypeCtorDetails = tcd_enum(_, _, EnumFunctors, _, _, _),
- list.length(EnumFunctors, NumFunctors)
- ;
- TypeCtorDetails = tcd_foreign_enum(_, _, ForeignFunctors, _, _, _),
- list.length(ForeignFunctors, NumFunctors)
- ;
- TypeCtorDetails = tcd_du(_, DuFunctors, _, _, _),
- list.length(DuFunctors, NumFunctors)
- ;
- TypeCtorDetails = tcd_notag(_, _),
- NumFunctors = 1
+ (
+ TypeCtorDetails = tcd_enum(_, _, EnumFunctors, _, _, _),
+ list.length(EnumFunctors, NumFunctors)
+ ;
+ TypeCtorDetails = tcd_foreign_enum(_, _, ForeignFunctors, _, _, _),
+ list.length(ForeignFunctors, NumFunctors)
+ ;
+ TypeCtorDetails = tcd_du(_, DuFunctors, _, _, _),
+ list.length(DuFunctors, NumFunctors)
+ ;
+ TypeCtorDetails = tcd_notag(_, _),
+ NumFunctors = 1
+ ),
+ MaybeNumFunctors = yes(NumFunctors)
;
( TypeCtorDetails = tcd_eqv(_)
; TypeCtorDetails = tcd_builtin(_)
; TypeCtorDetails = tcd_impl_artifact(_)
; TypeCtorDetails = tcd_foreign(_)
),
- NumFunctors = -1
+ MaybeNumFunctors = no
).
du_arg_info_name(ArgInfo) = ArgInfo ^ du_arg_name.
du_arg_info_type(ArgInfo) = ArgInfo ^ du_arg_type.
du_arg_info_pos_width(ArgInfo) = ArgInfo ^ du_arg_pos_width.
enum_functor_rtti_name(EnumFunctor) =
type_ctor_enum_functor_desc(EnumFunctor ^ enum_ordinal).
diff --git a/compiler/rtti_out.m b/compiler/rtti_out.m
index 02f924fa3..fc1cff3c1 100644
--- a/compiler/rtti_out.m
+++ b/compiler/rtti_out.m
@@ -118,20 +118,21 @@
:- import_module ll_backend.llds_out.llds_out_code_addr.
:- import_module ll_backend.llds_out.llds_out_data.
:- import_module ll_backend.llds_out.llds_out_file.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_foreign.
:- import_module assoc_list.
:- import_module counter.
:- import_module int.
+:- import_module int8.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module uint.
:- import_module uint8.
:- import_module univ.
@@ -161,21 +162,21 @@ output_rtti_data_defn(Info, RttiDefn, !DeclSet, !IO) :-
).
%-----------------------------------------------------------------------------%
:- pred output_base_typeclass_info_defn(llds_out_info::in, tc_name::in,
module_name::in, string::in, base_typeclass_info::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_base_typeclass_info_defn(Info, TCName, InstanceModuleName,
InstanceString, BaseTypeClassInfo, !DeclSet, !IO) :-
- BaseTypeClassInfo =base_typeclass_info(N1, N2, N3, N4, N5, Methods),
+ BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5, Methods),
CodeAddrs = list.map(make_code_addr, Methods),
list.foldl2(output_record_code_addr_decls(Info), CodeAddrs, !DeclSet, !IO),
io.write_string("\n", !IO),
RttiId = tc_rtti_id(TCName,
type_class_base_typeclass_info(InstanceModuleName, InstanceString)),
output_rtti_id_storage_type_name(Info, RttiId, yes, !DeclSet, !IO),
% XXX It would be nice to avoid generating redundant declarations
% of base_typeclass_infos, but currently we don't.
io.write_string(" = {\n\t(MR_Code *) ", !IO),
io.write_list([N1, N2, N3, N4, N5], ",\n\t(MR_Code *) ", io.write_int,
@@ -620,71 +621,100 @@ output_type_ctor_arg_defns_and_decls(Info, ArgRttiDatas, !DeclSet, !IO) :-
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_ctor_data_defn(Info, TypeCtorData, !DeclSet, !IO) :-
RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
TypeCtorData = type_ctor_data(Version, Module, TypeName, TypeArity,
UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
output_type_ctor_details_defn(Info, RttiTypeCtor, TypeCtorDetails,
MaybeFunctorsName, MaybeLayoutName, HaveFunctorNumberMap,
!DeclSet, !IO),
det_univ_to_type(UnifyUniv, UnifyProcLabel),
- UnifyCodeAddr = make_code_addr(UnifyProcLabel),
+ UnifyCodeAddr = make_code_addr(UnifyProcLabel),
det_univ_to_type(CompareUniv, CompareProcLabel),
CompareCodeAddr = make_code_addr(CompareProcLabel),
CodeAddrs = [UnifyCodeAddr, CompareCodeAddr],
list.foldl2(output_record_code_addr_decls(Info), CodeAddrs, !DeclSet, !IO),
output_generic_rtti_data_defn_start(Info,
ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), !DeclSet, !IO),
io.write_string(" = {\n\t", !IO),
+ % MR_type_ctor_arity
io.write_int(TypeArity, !IO),
io.write_string(",\n\t", !IO),
- io.write_int(Version, !IO),
+ % MR_type_ctor_version
+ io.write_int8(Version, !IO),
io.write_string(",\n\t", !IO),
- io.write_int(type_ctor_details_num_ptags(TypeCtorDetails), !IO),
+ % MR_type_ctor_num_ptags
+ MaybeNumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
+ (
+ MaybeNumPtags = yes(NumPtags),
+ NumPtagsEncoding = int8.det_from_int(NumPtags)
+ ;
+ MaybeNumPtags = no,
+ NumPtagsEncoding = -1i8
+ ),
+ io.write_int8(NumPtagsEncoding, !IO),
io.write_string(",\n\t", !IO),
+ % MR_type_ctor_rep_CAST_ME
rtti.type_ctor_rep_to_string(TypeCtorData, _TargetPrefixes, CtorRepStr),
io.write_string(CtorRepStr, !IO),
io.write_string(",\n\t", !IO),
+ % MR_type_ctor_unify_pred
output_static_code_addr(UnifyCodeAddr, !IO),
io.write_string(",\n\t", !IO),
+ % MR_type_ctor_compare_pred
output_static_code_addr(CompareCodeAddr, !IO),
io.write_string(",\n\t""", !IO),
+ % MR_type_ctor_module_name
c_util.output_quoted_string_cur_stream(sym_name_to_string(Module), !IO),
io.write_string(""",\n\t""", !IO),
+ % MR_type_ctor_name
c_util.output_quoted_string_cur_stream(TypeName, !IO),
io.write_string(""",\n\t", !IO),
+ % MR_type_ctor_functors
(
MaybeFunctorsName = yes(FunctorsName),
FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, FunctorsName),
io.write_string("{ ", !IO),
output_cast_addr_of_rtti_id("(void *) ", FunctorsRttiId, !IO),
io.write_string(" }", !IO)
;
MaybeFunctorsName = no,
io.write_string("{ 0 }", !IO)
),
io.write_string(",\n\t", !IO),
+ % MR_type_ctor_layout
(
MaybeLayoutName = yes(LayoutName),
LayoutRttiId = ctor_rtti_id(RttiTypeCtor, LayoutName),
io.write_string("{ ", !IO),
output_cast_addr_of_rtti_id("(void *) ", LayoutRttiId, !IO),
io.write_string(" }", !IO)
;
MaybeLayoutName = no,
io.write_string("{ 0 }", !IO)
),
io.write_string(",\n\t", !IO),
- io.write_int(type_ctor_details_num_functors(TypeCtorDetails), !IO),
+ % MR_type_ctor_num_functors
+ MaybeNumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
+ (
+ MaybeNumFunctors = yes(NumFunctors),
+ NumFunctorsEncoding = NumFunctors
+ ;
+ MaybeNumFunctors = no,
+ NumFunctorsEncoding = -1
+ ),
+ io.write_int(NumFunctorsEncoding, !IO),
io.write_string(",\n\t", !IO),
- io.write_int(encode_type_ctor_flags(Flags), !IO),
+ % MR_type_ctor_flags
+ io.write_uint16(encode_type_ctor_flags(Flags), !IO),
io.write_string(",\n\t", !IO),
+ % MR_type_ctor_functor_number_map
(
HaveFunctorNumberMap = yes,
FunctorNumberMapRttiId =
ctor_rtti_id(RttiTypeCtor, type_ctor_functor_number_map),
output_rtti_id(FunctorNumberMapRttiId, !IO)
;
HaveFunctorNumberMap = no,
io.write_string("NULL", !IO)
),
% This code is commented out while the corresponding fields of the
@@ -793,82 +823,91 @@ output_type_ctor_details_defn(Info, RttiTypeCtor, TypeCtorDetails,
:- pred output_enum_functor_defn(llds_out_info::in, rtti_type_ctor::in,
enum_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det.
output_enum_functor_defn(Info, RttiTypeCtor, EnumFunctor, !DeclSet, !IO) :-
EnumFunctor = enum_functor(FunctorName, Ordinal),
output_generic_rtti_data_defn_start(Info,
ctor_rtti_id(RttiTypeCtor, type_ctor_enum_functor_desc(Ordinal)),
!DeclSet, !IO),
io.write_string(" = {\n\t""", !IO),
+ % MR_enum_functor_name
c_util.output_quoted_string_cur_stream(FunctorName, !IO),
io.write_string(""",\n\t", !IO),
+ % MR_enum_functor_ordinal
io.write_int(Ordinal, !IO),
io.write_string("\n};\n", !IO).
:- pred output_foreign_enum_functor_defn(llds_out_info::in, rtti_type_ctor::in,
foreign_enum_functor::in, decl_set::in, decl_set::out, io::di, io::uo)
is det.
output_foreign_enum_functor_defn(Info, RttiTypeCtor, ForeignEnumFunctor,
!DeclSet, !IO) :-
ForeignEnumFunctor = foreign_enum_functor(FunctorName, FunctorOrdinal,
FunctorValue),
RttiId = ctor_rtti_id(RttiTypeCtor,
type_ctor_foreign_enum_functor_desc(FunctorOrdinal)),
output_generic_rtti_data_defn_start(Info, RttiId, !DeclSet, !IO),
io.write_string(" = {\n\t""", !IO),
+ % MR_foreign_enum_functor_name
c_util.output_quoted_string_cur_stream(FunctorName, !IO),
io.write_string(""",\n\t", !IO),
+ % MR_foreign_enum_functor_ordinal
io.write_int(FunctorOrdinal, !IO),
io.write_string(",\n\t", !IO),
+ % MR_foreign_enum_functor_value
io.write_string(FunctorValue, !IO),
io.write_string("\n};\n", !IO).
:- pred output_notag_functor_defn(llds_out_info::in, rtti_type_ctor::in,
notag_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det.
output_notag_functor_defn(Info, RttiTypeCtor, NotagFunctor, !DeclSet, !IO) :-
NotagFunctor = notag_functor(FunctorName, ArgType, MaybeArgName,
FunctorSubtypeInfo),
output_maybe_pseudo_type_info_defn(Info, ArgType, !DeclSet, !IO),
ArgTypeData = maybe_pseudo_type_info_to_rtti_data(ArgType),
output_record_rtti_data_decls(Info, ArgTypeData, "", "", 0, _,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(Info,
ctor_rtti_id(RttiTypeCtor, type_ctor_notag_functor_desc),
!DeclSet, !IO),
io.write_string(" = {\n\t""", !IO),
+ % MR_notag_functor_name
c_util.output_quoted_string_cur_stream(FunctorName, !IO),
io.write_string(""",\n\t", !IO),
+ % MR_notag_functor_arg_type
(
ArgType = plain(ArgTypeInfo),
output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
rtti_data_type_info(ArgTypeInfo), !IO)
;
ArgType = pseudo(ArgPseudoTypeInfo),
% We need to cast the argument to MR_PseudoTypeInfo in case
% it turns out to be a small integer, not a pointer.
output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
rtti_data_pseudo_type_info(ArgPseudoTypeInfo), !IO)
),
io.write_string(",\n\t", !IO),
+ % MR_notag_functor_arg_name
(
MaybeArgName = yes(ArgName),
io.write_string("""", !IO),
io.write_string(ArgName, !IO),
io.write_string("""", !IO)
;
MaybeArgName = no,
io.write_string("NULL", !IO)
),
io.write_string(",\n\t", !IO),
+ % MR_notag_functor_subtype
output_functor_subtype_info(FunctorSubtypeInfo, !IO),
io.write_string("\n};\n", !IO).
:- pred output_du_functor_defn(llds_out_info::in, rtti_type_ctor::in,
du_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_functor_defn(Info, RttiTypeCtor, DuFunctor, !DeclSet, !IO) :-
DuFunctor = du_functor(FunctorName, OrigArity, Ordinal, Rep,
ArgInfos, MaybeExistInfo, FunctorSubtypeInfo),
ArgTypes = list.map(du_arg_info_type, ArgInfos),
@@ -894,26 +933,29 @@ output_du_functor_defn(Info, RttiTypeCtor, DuFunctor, !DeclSet, !IO) :-
MaybeExistInfo = yes(ExistInfo),
output_exist_info(Info, RttiTypeCtor, Ordinal, ExistInfo,
!DeclSet, !IO)
;
MaybeExistInfo = no
),
output_generic_rtti_data_defn_start(Info,
ctor_rtti_id(RttiTypeCtor, type_ctor_du_functor_desc(Ordinal)),
!DeclSet, !IO),
io.write_string(" = {\n\t""", !IO),
+ % MR_du_functor_name
c_util.output_quoted_string_cur_stream(FunctorName, !IO),
io.write_string(""",\n\t", !IO),
- io.write_int(OrigArity, !IO),
+ % MR_du_functor_orig_arity
+ io.write_int16(OrigArity, !IO),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_arg_type_contains_var
ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes),
- io.write_int(ContainsVarBitVector, !IO),
+ io.write_uint16(ContainsVarBitVector, !IO),
io.write_string(",\n\t", !IO),
(
Rep = du_ll_rep(Ptag, SectagAndLocn)
;
Rep = du_hl_rep(_),
unexpected($module, $pred, "du_hl_rep")
),
Ptag = ptag(PtagUint8),
(
SectagAndLocn = sectag_locn_none,
@@ -938,67 +980,77 @@ output_du_functor_defn(Info, RttiTypeCtor, DuFunctor, !DeclSet, !IO) :-
SectagAndLocn = sectag_locn_remote_word(StagUint),
Locn = "MR_SECTAG_REMOTE_FULL_WORD",
Stag = uint.cast_to_int(StagUint),
NumSectagBits = 0u8
;
SectagAndLocn = sectag_locn_remote_bits(StagUint, NumSectagBits,
_Mask),
Locn = "MR_SECTAG_REMOTE_BITS",
Stag = uint.cast_to_int(StagUint)
),
+ % MR_du_functor_sectag_locn
io.write_string(Locn, !IO),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_primary
io.write_uint8(PtagUint8, !IO),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_secondary
io.write_int(Stag, !IO),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_ordinal
io.write_int(Ordinal, !IO),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_arg_types
io.write_string("(MR_PseudoTypeInfo *) ", !IO), % cast away const
(
ArgInfos = [_ | _],
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_field_types(Ordinal), !IO)
;
ArgInfos = [],
io.write_string("NULL", !IO)
),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_arg_names
(
HaveArgNames = yes,
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_field_names(Ordinal), !IO)
;
HaveArgNames = no,
io.write_string("NULL", !IO)
),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_arg_locns
(
HaveArgLocns = yes,
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_field_locns(Ordinal), !IO)
;
HaveArgLocns = no,
io.write_string("NULL", !IO)
),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_exist_info
(
MaybeExistInfo = yes(_),
output_addr_of_ctor_rtti_id(RttiTypeCtor,
type_ctor_exist_info(Ordinal), !IO)
;
MaybeExistInfo = no,
io.write_string("NULL", !IO)
),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_subtype
output_functor_subtype_info(FunctorSubtypeInfo, !IO),
io.write_string(",\n\t", !IO),
+ % MR_du_functor_num_sectag_bits
io.write_uint8(NumSectagBits, !IO),
io.write_string("\n};\n", !IO).
:- pred output_functor_subtype_info(functor_subtype_info::in, io::di, io::uo)
is det.
output_functor_subtype_info(FunctorSubtypeInfo, !IO) :-
(
FunctorSubtypeInfo = functor_subtype_none,
io.write_string("MR_FUNCTOR_SUBTYPE_NONE", !IO)
@@ -1063,35 +1115,41 @@ output_exist_info(Info, RttiTypeCtor, Ordinal, ExistInfo, !DeclSet, !IO) :-
Constraints = [_ | _],
output_exist_constraints_data(Info, RttiTypeCtor, Ordinal, Constraints,
!DeclSet, !IO)
;
Constraints = []
),
output_generic_rtti_data_defn_start(Info,
ctor_rtti_id(RttiTypeCtor, type_ctor_exist_info(Ordinal)),
!DeclSet, !IO),
io.write_string(" = {\n\t", !IO),
- io.write_int(Plain, !IO),
+ % MR_exist_typeinfos_plain
+ io.write_int16(Plain, !IO),
io.write_string(",\n\t", !IO),
- io.write_int(InTci, !IO),
+ % MR_exist_typeinfos_in_tci
+ io.write_int16(InTci, !IO),
io.write_string(",\n\t", !IO),
+ % MR_exist_tcis
list.length(Constraints, Tci),
io.write_int(Tci, !IO),
io.write_string(",\n\t", !IO),
+ % MR_exist_typeinfo_locns
output_ctor_rtti_id(RttiTypeCtor, type_ctor_exist_locns(Ordinal), !IO),
io.write_string(",\n\t", !IO),
+ % MR_exist_constraints
(
Constraints = [_ | _],
output_ctor_rtti_id(RttiTypeCtor, type_ctor_exist_tc_constrs(Ordinal),
!IO)
;
- Constraints = []
+ Constraints = [],
+ io.write_string("NULL", !IO)
),
io.write_string("\n};\n", !IO).
:- pred output_du_arg_types(llds_out_info::in, rtti_type_ctor::in, int::in,
list(rtti_maybe_pseudo_type_info_or_self)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_arg_types(Info, RttiTypeCtor, Ordinal, ArgTypes, !DeclSet, !IO) :-
list.foldl2(output_maybe_pseudo_type_info_or_self_defn(Info), ArgTypes,
!DeclSet, !IO),
@@ -1215,20 +1273,21 @@ output_du_arg_locns_loop([ArgInfo | ArgInfos], !IO) :-
(
ArgWidth = apw_none_shifted(arg_only_offset(ArgOnlyOffset), _)
;
ArgWidth = apw_none_nowhere,
ArgOnlyOffset = -1
),
% NumBits = -10 is a special case meaning "dummy argument".
Shift = 0,
NumBits = -10
),
+ % MR_arg_offset, MR_arg_shift, MR_arg_bits
io.format("\t{ %d, %d, %d },\n",
[i(ArgOnlyOffset), i(Shift), i(NumBits)], !IO),
output_du_arg_locns_loop(ArgInfos, !IO).
%-----------------------------------------------------------------------------%
:- pred output_enum_value_ordered_table(llds_out_info::in, rtti_type_ctor::in,
map(int, enum_functor)::in, decl_set::in, decl_set::out,
io::di, io::uo) is det.
@@ -1282,21 +1341,21 @@ output_foreign_enum_name_ordered_table(Info, RttiTypeCtor, FunctorMap,
Functors = map.values(FunctorMap),
FunctorRttiNames = list.map(foreign_enum_functor_rtti_name, Functors),
output_generic_rtti_data_defn_start(Info,
ctor_rtti_id(RttiTypeCtor, type_ctor_foreign_enum_name_ordered_table),
!DeclSet, !IO),
io.write_string(" = {\n", !IO),
output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO),
io.write_string("};\n", !IO).
:- pred output_du_name_ordered_table(llds_out_info::in, rtti_type_ctor::in,
- map(string, map(int, du_functor))::in, decl_set::in, decl_set::out,
+ map(string, map(int16, du_functor))::in, decl_set::in, decl_set::out,
io::di, io::uo) is det.
output_du_name_ordered_table(Info, RttiTypeCtor, NameArityMap,
!DeclSet, !IO) :-
map.values(NameArityMap, ArityMaps),
list.map(map.values, ArityMaps, FunctorLists),
list.condense(FunctorLists, Functors),
FunctorRttiNames = list.map(du_functor_rtti_name, Functors),
output_generic_rtti_data_defn_start(Info,
ctor_rtti_id(RttiTypeCtor, type_ctor_du_name_ordered_table),
@@ -1345,28 +1404,32 @@ output_du_ptag_ordered_table(Info, RttiTypeCtor, PtagMap, !DeclSet, !IO) :-
:- pred output_du_ptag_ordered_table_body(rtti_type_ctor::in,
assoc_list(ptag, sectag_table)::in, ptag::in, io::di, io::uo) is det.
output_du_ptag_ordered_table_body(_RttiTypeCtor, [], _CurPtag, !IO).
output_du_ptag_ordered_table_body(RttiTypeCtor,
[Ptag - SectagTable | PtagTail], CurPtag, !IO) :-
expect(unify(Ptag, CurPtag), $module, $pred, "ptag mismatch"),
SectagTable = sectag_table(SectagLocn, NumSectagBits, NumSharers,
_SectagMap),
io.write_string("\t{ ", !IO),
+ % MR_sectag_sharers
io.write_uint(NumSharers, !IO),
io.write_string(", ", !IO),
+ % MR_sectag_locn
rtti.sectag_locn_to_string(SectagLocn, _TargetPrefixes, LocnStr),
io.write_string(LocnStr, !IO),
io.write_string(",\n\t", !IO),
+ % MR_sectag_alternatives
output_ctor_rtti_id(RttiTypeCtor, type_ctor_du_stag_ordered_table(Ptag),
!IO),
io.write_string(",\n\t", !IO),
+ % MR_sectag_numbits
io.write_int8(NumSectagBits, !IO),
(
PtagTail = [],
io.write_string(" }\n", !IO)
;
PtagTail = [_ | _],
io.write_string(" },\n", !IO),
CurPtag = ptag(CurPtagUint8),
NextPtag = ptag(CurPtagUint8 + 1u8),
output_du_ptag_ordered_table_body(RttiTypeCtor, PtagTail,
@@ -1898,28 +1961,32 @@ output_maybe_quoted_strings(MaybeNames, !IO) :-
io.write_string("\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_exist_locn(exist_typeinfo_locn::in, io::di, io::uo) is det.
output_exist_locn(Locn, !IO) :-
(
Locn = plain_typeinfo(SlotInCell),
io.write_string("{ ", !IO),
- io.write_int(SlotInCell, !IO),
+ % MR_exist_arg_num
+ io.write_int16(SlotInCell, !IO),
+ % MR_exist_offset_in_tci
io.write_string(", -1 }", !IO)
;
Locn = typeinfo_in_tci(SlotInCell, SlotInTci),
io.write_string("{ ", !IO),
- io.write_int(SlotInCell, !IO),
+ % MR_exist_arg_num
+ io.write_int16(SlotInCell, !IO),
io.write_string(", ", !IO),
- io.write_int(SlotInTci, !IO),
+ % MR_exist_offset_in_tci
+ io.write_int16(SlotInTci, !IO),
io.write_string(" }", !IO)
).
:- pred output_exist_locns(list(exist_typeinfo_locn)::in,
io::di, io::uo) is det.
output_exist_locns(Locns, !IO) :-
io.write_string("\t", !IO),
io.write_list(Locns, ",\n\t", output_exist_locn, !IO),
io.write_string("\n", !IO).
diff --git a/compiler/rtti_to_mlds.m b/compiler/rtti_to_mlds.m
index 33f5e85c8..0ea55abab 100644
--- a/compiler/rtti_to_mlds.m
+++ b/compiler/rtti_to_mlds.m
@@ -1,14 +1,15 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2012, 2014 The University of Melbourne.
+% Copyright (C) 2001-2012 The University of Melbourne.
+% Copyright (C) 2014-2018 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: rtti_to_mlds.m.
% Authors: fjh, zs.
%
% This module defines routines to convert from the back-end-independent
% RTTI data structures into MLDS definitions.
% The RTTI data structures are used for static data that is used
@@ -70,20 +71,22 @@
:- import_module ml_backend.ml_util.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module assoc_list.
:- import_module bool.
:- import_module counter.
:- import_module digraph.
:- import_module map.
:- import_module maybe.
+:- import_module int16.
+:- import_module int8.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module term.
:- import_module uint.
:- import_module uint8.
:- import_module univ.
%-----------------------------------------------------------------------------%
@@ -197,59 +200,74 @@ gen_init_rtti_data_defn(ModuleInfo, Target, RttiData, !GlobalData) :-
;
RttiData = rtti_data_type_class_instance(Instance),
gen_type_class_instance_defn(ModuleInfo, Target, Instance, Name,
RttiId, !GlobalData)
;
RttiData = rtti_data_type_ctor_info(TypeCtorData),
TypeCtorData = type_ctor_data(Version, TypeModule, TypeName,
TypeArity, UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName, TypeArity),
TypeModuleName = sym_name_to_string(TypeModule),
- NumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
- NumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
+ MaybeNumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
+ (
+ MaybeNumPtags = yes(NumPtags),
+ NumPtagsEncoding = int8.det_from_int(NumPtags)
+ ;
+ MaybeNumPtags = no,
+ NumPtagsEncoding = -1i8
+ ),
+ MaybeNumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
+ (
+ MaybeNumFunctors = yes(NumFunctors),
+ NumFunctorsEncoding = NumFunctors
+ ;
+ MaybeNumFunctors = no,
+ NumFunctorsEncoding = -1
+ ),
FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_functors),
LayoutRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_layout),
gen_functors_layout_info(ModuleInfo, Target, RttiTypeCtor,
TypeCtorDetails, FunctorsInfo, LayoutInfo, NumberMapInfo,
!GlobalData),
% Note that gen_init_special_pred will by necessity add an extra
% level of indirection to calling the special preds. However, the
% backend compiler should be smart enough to ensure that this is
% inlined away.
gen_init_special_pred(ModuleInfo, Target,
UnifyUniv, UnifyInitializer, !GlobalData),
gen_init_special_pred(ModuleInfo, Target,
CompareUniv, CompareInitializer, !GlobalData),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_int(TypeArity),
- gen_init_int(Version),
- gen_init_int(NumPtags),
- gen_init_type_ctor_rep(TypeCtorData),
- UnifyInitializer,
- CompareInitializer,
- gen_init_string(TypeModuleName),
- gen_init_string(TypeName),
+ gen_init_int(TypeArity), % MR_type_ctor_arity
+ gen_init_int8(Version), % MR_type_ctor_version
+ gen_init_int8(NumPtagsEncoding), % MR_type_ctor_num_ptags
+ gen_init_type_ctor_rep(TypeCtorData), % MR_type_ctor_rep_CAST_ME
+ UnifyInitializer, % MR_type_ctor_unify_pred
+ CompareInitializer, % MR_type_ctor_compare_pred
+ gen_init_string(TypeModuleName), % MR_type_ctor_module_name
+ gen_init_string(TypeName), % MR_type_ctor_name
% In the C back-end, these two "structs" are actually unions.
% We need to use `init_struct' here so that the initializers
% get enclosed in curly braces.
init_struct(mlds_rtti_type(item_type(FunctorsRttiId)), [
FunctorsInfo
- ]),
+ ]), % MR_type_ctor_functors
init_struct(mlds_rtti_type(item_type(LayoutRttiId)), [
LayoutInfo
- ]),
- gen_init_int(NumFunctors),
- gen_init_int(encode_type_ctor_flags(Flags)),
- NumberMapInfo
+ ]), % MR_type_ctor_layout
+ gen_init_int(NumFunctorsEncoding), % MR_type_ctor_num_functors
+ gen_init_uint16(encode_type_ctor_flags(Flags)),
+ % MR_type_ctor_flags
+ NumberMapInfo % MR_type_ctor_functor_number_map
% These two are commented out while the corresponding fields of the
% MR_TypeCtorInfo_Struct type are commented out.
% gen_init_maybe(gen_init_rtti_name(RttiTypeCtor), MaybeHashCons),
% XXX this may need to change to call
% gen_init_special_pred, if this is re-enabled.
% gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
]),
rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
!GlobalData)
@@ -688,59 +706,63 @@ gen_functors_layout_info(ModuleInfo, Target, RttiTypeCtor, TypeCtorDetails,
%-----------------------------------------------------------------------------%
:- pred gen_enum_functor_desc(module_info::in, rtti_type_ctor::in,
enum_functor::in, ml_global_data::in, ml_global_data::out) is det.
gen_enum_functor_desc(_ModuleInfo, RttiTypeCtor, EnumFunctor, !GlobalData) :-
EnumFunctor = enum_functor(FunctorName, Ordinal),
RttiName = type_ctor_enum_functor_desc(Ordinal),
RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_string(FunctorName),
- gen_init_int(Ordinal)
+ gen_init_string(FunctorName), % MR_enum_functor_name
+ gen_init_int(Ordinal) % MR_enum_functor_ordinal
]),
rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).
:- pred gen_foreign_enum_functor_desc(module_info::in, foreign_language::in,
rtti_type_ctor::in, foreign_enum_functor::in,
ml_global_data::in, ml_global_data::out) is det.
gen_foreign_enum_functor_desc(_ModuleInfo, Lang, RttiTypeCtor,
ForeignEnumFunctor, !GlobalData) :-
ForeignEnumFunctor = foreign_enum_functor(FunctorName, Ordinal, Value),
RttiName = type_ctor_foreign_enum_functor_desc(Ordinal),
RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_string(FunctorName),
- gen_init_int(Ordinal),
- gen_init_foreign(Lang, Value)
+ gen_init_string(FunctorName), % MR_foreign_enum_functor_name
+ gen_init_int(Ordinal), % MR_foreign_enum_functor_ordinal
+ gen_init_foreign(Lang, Value) % MR_foreign_enum_functor_value
]),
rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).
:- pred gen_notag_functor_desc(module_info::in, mlds_target_lang::in,
rtti_type_ctor::in, notag_functor::in,
ml_global_data::in, ml_global_data::out) is det.
gen_notag_functor_desc(ModuleInfo, Target, RttiTypeCtor, NotagFunctorDesc,
!GlobalData) :-
NotagFunctorDesc = notag_functor(FunctorName, ArgType, MaybeArgName,
FunctorSubtypeInfo),
ArgTypeRttiData = maybe_pseudo_type_info_to_rtti_data(ArgType),
gen_pseudo_type_info(ModuleInfo, Target, ArgTypeRttiData, PTIInitializer,
!GlobalData),
RttiName = type_ctor_notag_functor_desc,
RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
+ % MR_notag_functor_name
gen_init_string(FunctorName),
+ % MR_notag_functor_arg_type
PTIInitializer,
+ % MR_notag_functor_arg_name
gen_init_maybe(mlds_builtin_type_string, gen_init_string,
MaybeArgName),
+ % MR_notag_functor_subtype
gen_init_functor_subtype_info(FunctorSubtypeInfo)
]),
rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).
:- pred gen_du_functor_desc(module_info::in, mlds_target_lang::in,
rtti_type_ctor::in, du_functor::in,
ml_global_data::in, ml_global_data::out) is det.
gen_du_functor_desc(ModuleInfo, Target, RttiTypeCtor, DuFunctor,
!GlobalData) :-
@@ -794,25 +816,24 @@ gen_du_functor_desc(ModuleInfo, Target, RttiTypeCtor, DuFunctor,
ExistInfoInitializer = gen_init_rtti_name(ModuleName, RttiTypeCtor,
type_ctor_exist_info(Ordinal))
;
MaybeExistInfo = no,
ExistInfoInitializer = gen_init_null_pointer(
mlds_rtti_type(item_type(
ctor_rtti_id(RttiTypeCtor, type_ctor_exist_info(0)))))
),
(
Rep = du_ll_rep(Ptag, SectagAndLocn),
- Ptag = ptag(PtagUint8),
- PtagInt = uint8.cast_to_int(PtagUint8)
+ Ptag = ptag(PtagUint8)
;
Rep = du_hl_rep(Data),
- PtagInt = 0,
+ PtagUint8 = 0u8,
SectagAndLocn = sectag_locn_remote_word(Data)
),
(
SectagAndLocn = sectag_locn_none,
Locn = sectag_none,
Stag = -1,
NumSectagBits = 0u8
;
SectagAndLocn = sectag_locn_none_direct_arg,
Locn = sectag_none_direct_arg,
@@ -833,52 +854,54 @@ gen_du_functor_desc(ModuleInfo, Target, RttiTypeCtor, DuFunctor,
Stag = uint.cast_to_int(StagUint),
NumSectagBits = 0u8
;
SectagAndLocn = sectag_locn_remote_bits(StagUint, NumSectagBits, Mask),
Locn = sectag_remote_bits(NumSectagBits, Mask),
Stag = uint.cast_to_int(StagUint)
),
RttiName = type_ctor_du_functor_desc(Ordinal),
RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_string(FunctorName),
- gen_init_int(Arity),
- gen_init_int(ContainsVarBitVector),
- gen_init_sectag_locn(Locn),
- gen_init_int(PtagInt),
- gen_init_int(Stag),
- gen_init_int(Ordinal),
- ArgTypeInitializer,
- ArgNameInitializer,
- ArgLocnsInitializer,
- ExistInfoInitializer,
+ gen_init_string(FunctorName), % MR_du_functor_name
+ gen_init_int16(Arity), % MR_du_functor_orig_arity
+ gen_init_uint16(ContainsVarBitVector),
+ % MR_du_functor_arg_type_contains_var
+ gen_init_sectag_locn(Locn), % MR_du_functor_sectag_locn
+ gen_init_uint8(PtagUint8), % MR_du_functor_primary
+ gen_init_int(Stag), % MR_du_functor_secondary
+ gen_init_int(Ordinal), % MR_du_functor_ordinal
+ ArgTypeInitializer, % MR_du_functor_arg_types
+ ArgNameInitializer, % MR_du_functor_arg_names
+ ArgLocnsInitializer, % MR_du_functor_arg_locns
+ ExistInfoInitializer, % MR_du_functor_exist_info
gen_init_functor_subtype_info(FunctorSubtypeInfo),
- wrap_init_obj(ml_const(mlconst_uint8(NumSectagBits)))
+ % MR_du_functor_subtype
+ gen_init_uint8(NumSectagBits) % MR_du_functor_num_sectag_bits
]),
rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).
%-----------------------------------------------------------------------------%
:- func gen_init_exist_locn(rtti_type_ctor, exist_typeinfo_locn) =
mlds_initializer.
gen_init_exist_locn(RttiTypeCtor, ExistTypeInfoLocn) = Initializer :-
(
ExistTypeInfoLocn = typeinfo_in_tci(SlotInCell, SlotInTci)
;
ExistTypeInfoLocn = plain_typeinfo(SlotInCell),
- SlotInTci = -1
+ SlotInTci = -1i16
),
RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_exist_locn),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_int(SlotInCell),
- gen_init_int(SlotInTci)
+ gen_init_int16(SlotInCell), % MR_exist_arg_num
+ gen_init_int16(SlotInTci) % MR_exist_offset_in_tci
]).
:- pred gen_exist_locns_array(module_info::in, rtti_type_ctor::in, int::in,
list(exist_typeinfo_locn)::in, ml_global_data::in, ml_global_data::out)
is det.
gen_exist_locns_array(_ModuleInfo, RttiTypeCtor, Ordinal, Locns,
!GlobalData) :-
Initializer = gen_init_array(gen_init_exist_locn(RttiTypeCtor), Locns),
RttiName = type_ctor_exist_locns(Ordinal),
@@ -943,26 +966,28 @@ gen_exist_info(ModuleInfo, Target, RttiTypeCtor, Ordinal, ExistInfo,
TCConstrArrayRttiName),
ElementType = mlds_rtti_type(element_type(TCConstrArrayRttiId)),
TCConstrArrayInitializer = gen_init_array(
gen_init_cast_rtti_id(ElementType, ModuleName), TCConstrIds),
rtti_name_and_init_to_defn(RttiTypeCtor, TCConstrArrayRttiName,
TCConstrArrayInitializer, !GlobalData)
),
gen_exist_locns_array(ModuleInfo, RttiTypeCtor, Ordinal, Locns,
!GlobalData),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_int(Plain),
- gen_init_int(InTci),
- gen_init_int(Tci),
+ gen_init_int16(Plain), % MR_exist_typeinfos_plain
+ gen_init_int16(InTci), % MR_exist_typeinfos_in_tci
+ gen_init_int16(int16.det_from_int(Tci)),
+ % MR_exist_tcis
gen_init_rtti_name(ModuleName, RttiTypeCtor,
type_ctor_exist_locns(Ordinal)),
- ConstrInitializer
+ % MR_exist_typeinfo_locns
+ ConstrInitializer % MR_exist_constraints
]),
rtti_id_and_init_to_defn(RttiId, Initializer, !GlobalData).
:- pred gen_field_types(module_info::in, mlds_target_lang::in,
rtti_type_ctor::in, int::in, list(rtti_maybe_pseudo_type_info_or_self)::in,
ml_global_data::in, ml_global_data::out) is det.
gen_field_types(ModuleInfo, Target, RttiTypeCtor, Ordinal, Types,
!GlobalData) :-
TypeRttiDatas = list.map(maybe_pseudo_type_info_or_self_to_rtti_data,
@@ -1075,23 +1100,23 @@ gen_field_locn(RttiId, ArgInfo, ArgLocnInitializer) :-
;
ArgPosWidth = apw_none_nowhere,
ArgOnlyOffset = -1
),
% NumBits = -10 means the argument is of a dummy type,
% and takes no space at all.
Shift = 0,
NumBits = -10
),
ArgLocnInitializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_int(ArgOnlyOffset),
- gen_init_int(Shift),
- gen_init_int(NumBits)
+ gen_init_int(ArgOnlyOffset), % MR_arg_offset
+ gen_init_int(Shift), % MR_arg_shift
+ gen_init_int(NumBits) % MR_arg_bits
]).
%-----------------------------------------------------------------------------%
:- pred gen_enum_value_ordered_table(module_info::in, rtti_type_ctor::in,
map(int, enum_functor)::in,
ml_global_data::in, ml_global_data::out) is det.
gen_enum_value_ordered_table(ModuleInfo, RttiTypeCtor, EnumByValue,
!GlobalData) :-
@@ -1182,26 +1207,25 @@ gen_du_ptag_ordered_table(ModuleInfo, RttiTypeCtor, PtagMap, !GlobalData) :-
gen_du_ptag_ordered_table_body(_, _, _, [], []).
gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor, CurPtag,
[Ptag - SectagTable | PtagTail], [Initializer | Initializers]) :-
expect(unify(Ptag, CurPtag), $module, $pred, "ptag mismatch"),
SectagTable = sectag_table(SectagLocn, NumSectagBits, NumSharers,
_SectagMap),
RttiName = type_ctor_du_ptag_layout(Ptag),
RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
Initializer = init_struct(mlds_rtti_type(item_type(RttiId)), [
- % XXX ARG_PACK Why isn't the num_sharers field itself unsigned?
- gen_init_int(uint.cast_to_int(NumSharers)),
- gen_init_sectag_locn(SectagLocn),
+ gen_init_uint(NumSharers), % MR_sectag_sharers
+ gen_init_sectag_locn(SectagLocn), % MR_sectag_locn
gen_init_rtti_name(ModuleName, RttiTypeCtor,
- type_ctor_du_stag_ordered_table(Ptag)),
- init_obj(ml_const(mlconst_int8(NumSectagBits)))
+ type_ctor_du_stag_ordered_table(Ptag)), % MR_sectag_alternatives
+ gen_init_int8(NumSectagBits) % MR_sectag_numbits
]),
CurPtag = ptag(CurPtagUint8),
NextPtag = ptag(CurPtagUint8 + 1u8),
gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor, NextPtag,
PtagTail, Initializers).
:- pred gen_du_stag_ordered_table(module_name::in, rtti_type_ctor::in,
pair(ptag, sectag_table)::in,
ml_global_data::in, ml_global_data::out) is det.
@@ -1211,21 +1235,21 @@ gen_du_stag_ordered_table(ModuleName, RttiTypeCtor, Ptag - SectagTable,
SectagMap),
map.values(SectagMap, SectagFunctors),
FunctorRttiNames = list.map(du_functor_rtti_name, SectagFunctors),
Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
FunctorRttiNames),
RttiName = type_ctor_du_stag_ordered_table(Ptag),
rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer,
!GlobalData).
:- pred gen_du_name_ordered_table(module_info::in, rtti_type_ctor::in,
- map(string, map(int, du_functor))::in,
+ map(string, map(int16, du_functor))::in,
ml_global_data::in, ml_global_data::out) is det.
gen_du_name_ordered_table(ModuleInfo, RttiTypeCtor, NameArityMap,
!GlobalData) :-
map.values(NameArityMap, ArityMaps),
list.map(map.values, ArityMaps, FunctorLists),
list.condense(FunctorLists, Functors),
module_info_get_name(ModuleInfo, ModuleName),
FunctorRttiNames = list.map(du_functor_rtti_name, Functors),
Initializer = gen_init_rtti_names_array(ModuleName, RttiTypeCtor,
diff --git a/compiler/type_ctor_info.m b/compiler/type_ctor_info.m
index 6f943a46d..452ad1f63 100644
--- a/compiler/type_ctor_info.m
+++ b/compiler/type_ctor_info.m
@@ -51,21 +51,21 @@
% Compute the "contains var" bit vector. The input is a list describing
% the types of the arguments of a function symbol. The output is an
% bit vector (represented as a 16 bit integer) in which each bit is set
% if the type of the corresponding argument contains a type variable.
% If the function symbol has more than 16 arguments, then the last bit
% is true if any of the arguments after the 15th contain a type
% variable in their type.
%
:- func compute_contains_var_bit_vector(
- list(rtti_maybe_pseudo_type_info_or_self)) = int.
+ list(rtti_maybe_pseudo_type_info_or_self)) = uint16.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.foreign.
:- import_module backend_libs.pseudo_type_info.
:- import_module backend_libs.type_class_info.
:- import_module check_hlds.
@@ -82,29 +82,31 @@
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
+:- import_module int16.
:- import_module int8.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
:- import_module uint.
+:- import_module uint16.
:- import_module univ.
:- import_module varset.
%---------------------------------------------------------------------------%
generate_hlds(!ModuleInfo) :-
module_info_get_name(!.ModuleInfo, ModuleName),
module_info_get_type_table(!.ModuleInfo, TypeTable),
get_all_type_ctor_defns(TypeTable, TypeCtorsDefns),
gen_type_ctor_gen_infos(!.ModuleInfo, ModuleName, TypeCtorsDefns,
@@ -477,23 +479,23 @@ impl_type_ctor("table_builtin", "ml_subgoal", 0, impl_ctor_subgoal).
% can at least handle the previous version of the data
% structure, it makes it easier to bootstrap changes to the data
% structures used for RTTI.
%
% This number should be kept in sync with MR_RTTI_VERSION in
% runtime/mercury_type_info.h. This means you need to update
% the handwritten type_ctor_info structures (and the macros that
% generate them) as well as the code in the runtime that uses RTTI
% to conform to whatever changes the new version introduces.
%
-:- func type_ctor_info_rtti_version = int.
+:- func type_ctor_info_rtti_version = int8.
-type_ctor_info_rtti_version = 17.
+type_ctor_info_rtti_version = 17i8.
%---------------------------------------------------------------------------%
% Make the functor and layout tables for a notag type.
%
:- pred make_notag_details(int::in, sym_name::in, mer_type::in,
maybe(string)::in, equality_axioms::in, type_ctor_details::out) is det.
make_notag_details(TypeArity, SymName, ArgType, MaybeArgName, EqualityAxioms,
Details) :-
@@ -718,22 +720,22 @@ make_du_functors(ModuleInfo, [CtorRepn | CtorRepns],
MaybeExistInfo = no
;
MaybeExistConstraints = exist_constraints(ExistConstraints),
ExistConstraints = cons_exist_constraints(ExistTVars, _, _, _),
module_info_get_class_table(ModuleInfo, ClassTable),
generate_exist_info(ExistConstraints, ClassTable, ExistInfo),
MaybeExistInfo = yes(ExistInfo)
),
list.map_foldl(generate_du_arg_info(TypeArity, ExistTVars),
ConsArgRepns, ArgInfos, functor_subtype_none, FunctorSubtypeInfo),
- DuFunctor = du_functor(FunctorName, Arity, CurOrdinal, DuRep,
- ArgInfos, MaybeExistInfo, FunctorSubtypeInfo),
+ DuFunctor = du_functor(FunctorName, int16.det_from_int(Arity), CurOrdinal,
+ DuRep, ArgInfos, MaybeExistInfo, FunctorSubtypeInfo),
make_du_functors(ModuleInfo, CtorRepns,
CurOrdinal + 1, TypeArity, DuFunctors).
:- pred get_du_rep(cons_tag::in, du_rep::out) is det.
get_du_rep(ConsTag, DuRep) :-
(
ConsTag = dummy_tag,
DuRep = du_ll_rep(ptag(0u8), sectag_locn_none)
@@ -838,68 +840,69 @@ generate_du_arg_info(NumUnivTVars, ExistTVars, ConsArgRepn, ArgInfo,
MaybePseudoTypeInfo = pseudo(PseudoTypeInfo),
MaybePseudoTypeInfoOrSelf = pseudo(PseudoTypeInfo)
),
ArgInfo = du_arg_info(MaybeArgName, MaybePseudoTypeInfoOrSelf, ArgWidth),
( if ArgType = higher_order_type(_, _, higher_order(_), _, _) then
!:FunctorSubtypeInfo = functor_subtype_exists
else
true
).
- % This function gives the size of the MR_du_functor_arg_type_contains_var
- % field of the C type MR_DuFunctorDesc in bits.
- %
-:- func contains_var_bit_vector_size = int.
-
-contains_var_bit_vector_size = 16.
-
% Construct the RTTI structures that record information about the locations
% of the typeinfos describing the types of the existentially typed
% arguments of a functor.
%
:- pred generate_exist_info(cons_exist_constraints::in, class_table::in,
exist_info::out) is det.
generate_exist_info(ExistConstraints, ClassTable, ExistInfo) :-
ExistConstraints = cons_exist_constraints(ExistTVars, Constraints,
UnconstrainedTVars, ConstrainedTVars),
map.init(LocnMap0),
list.foldl2(
( pred(T::in, N0::in, N::out, Lm0::in, Lm::out) is det :-
- Locn = plain_typeinfo(N0),
+ Locn = plain_typeinfo(int16.det_from_int(N0)),
map.det_insert(T, Locn, Lm0, Lm),
N = N0 + 1
), UnconstrainedTVars, 0, TIsPlain, LocnMap0, LocnMap1),
list.length(ExistTVars, AllTIs),
TIsInTCIs = AllTIs - TIsPlain,
list.foldl(find_type_info_index(Constraints, ClassTable, TIsPlain),
ConstrainedTVars, LocnMap1, LocnMap),
TCConstraints = list.map(generate_class_constraint, Constraints),
list.map(
( pred(TVar::in, Locn::out) is det :-
map.lookup(LocnMap, TVar, Locn)
), ExistTVars, ExistLocns),
- ExistInfo = exist_info(TIsPlain, TIsInTCIs, TCConstraints, ExistLocns).
+ ExistInfo = exist_info(
+ int16.det_from_int(TIsPlain),
+ int16.det_from_int(TIsInTCIs),
+ TCConstraints,
+ ExistLocns
+ ).
:- pred find_type_info_index(list(prog_constraint)::in, class_table::in,
int::in, tvar::in, map(tvar, exist_typeinfo_locn)::in,
map(tvar, exist_typeinfo_locn)::out) is det.
find_type_info_index(Constraints, ClassTable, StartSlot, TVar, !LocnMap) :-
first_matching_type_class_info(Constraints, TVar,
StartSlot, Slot, FirstConstraint, TypeInfoIndex),
FirstConstraint = constraint(ClassName, ArgTypes),
list.length(ArgTypes, ClassArity),
map.lookup(ClassTable, class_id(ClassName, ClassArity), ClassDefn),
list.length(ClassDefn ^ classdefn_supers, NumSuperClasses),
RealTypeInfoIndex = TypeInfoIndex + NumSuperClasses,
- Locn = typeinfo_in_tci(Slot, RealTypeInfoIndex),
+ Locn = typeinfo_in_tci(
+ int16.det_from_int(Slot),
+ int16.det_from_int(RealTypeInfoIndex)
+ ),
map.det_insert(TVar, Locn, !LocnMap).
:- pred first_matching_type_class_info(list(prog_constraint)::in, tvar::in,
int::in, int::out, prog_constraint::out, int::out) is det.
first_matching_type_class_info([], _, !N, _, _) :-
unexpected($pred, "not found").
first_matching_type_class_info([Constraint | Constraints], TVar,
!N, MatchingConstraint, TypeInfoIndex) :-
Constraint = constraint(_, ArgTypes),
@@ -970,22 +973,22 @@ make_du_ptag_ordered_table(DuFunctor, !PtagTable) :-
SectagMap),
map.det_update(Ptag, SectagTable, !PtagTable)
else
SectagMap = map.singleton(Sectag, DuFunctor),
SectagTable = sectag_table(SectagLocn, NumSectagBits, 1u,
SectagMap),
map.det_insert(Ptag, SectagTable, !PtagTable)
).
:- pred make_du_name_ordered_table(du_functor::in,
- map(string, map(int, du_functor))::in,
- map(string, map(int, du_functor))::out) is det.
+ map(string, map(int16, du_functor))::in,
+ map(string, map(int16, du_functor))::out) is det.
make_du_name_ordered_table(DuFunctor, !NameTable) :-
Name = DuFunctor ^ du_name,
Arity = DuFunctor ^ du_orig_arity,
( if map.search(!.NameTable, Name, NameMap0) then
map.det_insert(Arity, DuFunctor, NameMap0, NameMap),
map.det_update(Name, NameMap, !NameTable)
else
NameMap = map.singleton(Arity, DuFunctor),
map.det_insert(Name, NameMap, !NameTable)
@@ -1007,44 +1010,51 @@ make_functor_number_map(OrdinalCtors) = OrdinalToLexicographicSeqNums :-
map.apply_to_list(OrdinalCtorNames, LexicographicCtorNameToSeqNumMap,
OrdinalToLexicographicSeqNums).
:- func ctor_name_arity(constructor_repn) = {sym_name, arity}.
ctor_name_arity(Ctor) = {Ctor ^ cr_name, list.length(Ctor ^ cr_args)}.
%---------------------------------------------------------------------------%
compute_contains_var_bit_vector(ArgTypes) = Vector :-
- compute_contains_var_bit_vector_2(ArgTypes, 0, 0, Vector).
+ compute_contains_var_bit_vector_2(ArgTypes, 0, 0u16, Vector).
:- pred compute_contains_var_bit_vector_2(
- list(rtti_maybe_pseudo_type_info_or_self)::in, int::in, int::in, int::out)
- is det.
+ list(rtti_maybe_pseudo_type_info_or_self)::in, int::in,
+ uint16::in, uint16::out) is det.
compute_contains_var_bit_vector_2([], _, !Vector).
compute_contains_var_bit_vector_2([ArgType | ArgTypes], ArgNum, !Vector) :-
(
ArgType = plain(_)
;
ArgType = pseudo(_),
update_contains_var_bit_vector(ArgNum, !Vector)
;
ArgType = self,
% The backend currently doesn't perform the optimization that
% lets it avoid memory allocation on self types.
update_contains_var_bit_vector(ArgNum, !Vector)
),
compute_contains_var_bit_vector_2(ArgTypes, ArgNum + 1, !Vector).
-:- pred update_contains_var_bit_vector(int::in, int::in, int::out) is det.
+:- pred update_contains_var_bit_vector(int::in, uint16::in, uint16::out) is det.
update_contains_var_bit_vector(ArgNum, !Vector) :-
( if ArgNum >= contains_var_bit_vector_size - 1 then
BitNum = contains_var_bit_vector_size - 1
else
BitNum = ArgNum
),
- !:Vector = !.Vector \/ (1 << BitNum).
+ !:Vector = !.Vector \/ (1u16 << BitNum).
+
+ % This function gives the size of the MR_du_functor_arg_type_contains_var
+ % field of the C type MR_DuFunctorDesc in bits.
+ %
+:- func contains_var_bit_vector_size = int.
+
+contains_var_bit_vector_size = 16.
%---------------------------------------------------------------------------%
:- end_module backend_libs.type_ctor_info.
%---------------------------------------------------------------------------%
diff --git a/java/runtime/DuArgLocn.java b/java/runtime/DuArgLocn.java
index f1e3fa027..7a88c1e74 100644
--- a/java/runtime/DuArgLocn.java
+++ b/java/runtime/DuArgLocn.java
@@ -2,21 +2,21 @@
//
// Copyright (C) 2011 The University of Melbourne.
// Copyright (C) 2018 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
//
package jmercury.runtime;
public class DuArgLocn implements java.io.Serializable {
- public int arg_offset;
- public int arg_shift;
- public int arg_bits;
+ public short arg_offset;
+ public byte arg_shift;
+ public byte arg_bits;
- public DuArgLocn(int arg_offset, int arg_shift, int arg_bits)
+ public DuArgLocn(short arg_offset, byte arg_shift, byte arg_bits)
{
this.arg_offset = arg_offset;
this.arg_shift = arg_shift;
this.arg_bits = arg_bits;
}
}
diff --git a/java/runtime/DuExistInfo.java b/java/runtime/DuExistInfo.java
index 898fdd4e0..1bc432528 100644
--- a/java/runtime/DuExistInfo.java
+++ b/java/runtime/DuExistInfo.java
@@ -2,33 +2,33 @@
//
// Copyright (C) 2001-2004 The University of Melbourne.
// Copyright (C) 2018 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
//
package jmercury.runtime;
public class DuExistInfo implements java.io.Serializable {
- public int exist_typeinfos_plain;
- public int exist_typeinfos_in_tci;
- public int exist_tcis;
+ public short exist_typeinfos_plain;
+ public short exist_typeinfos_in_tci;
+ public short exist_tcis;
public /* final */ DuExistLocn[] exist_typeinfo_locns;
public /* final */ TypeClassConstraint[] exist_constraints;
public DuExistInfo()
{
}
- public void init(int typeinfos_plain,
- int typeinfos_in_tci,
- int tcis,
+ public void init(short typeinfos_plain,
+ short typeinfos_in_tci,
+ short tcis,
DuExistLocn[] typeinfo_locns,
TypeClassConstraint constraints[])
{
exist_typeinfos_plain = typeinfos_plain;
exist_typeinfos_in_tci = typeinfos_in_tci;
exist_tcis = tcis;
exist_typeinfo_locns = typeinfo_locns;
exist_constraints = constraints;
}
}
diff --git a/java/runtime/DuExistLocn.java b/java/runtime/DuExistLocn.java
index 88dd2ba58..04803ff44 100644
--- a/java/runtime/DuExistLocn.java
+++ b/java/runtime/DuExistLocn.java
@@ -3,18 +3,18 @@
// Copyright (C) 2001-2003 The University of Melbourne.
// Copyright (C) 2018 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
//
package jmercury.runtime;
// Corresponds to MR_DuExistLocn in runtime/mercury_type_info.h.
public class DuExistLocn implements java.io.Serializable {
- public int exist_arg_num;
- public int exist_offset_in_tci;
+ public short exist_arg_num;
+ public short exist_offset_in_tci;
- public DuExistLocn(int arg_num, int offset_in_tci) {
+ public DuExistLocn(short arg_num, short offset_in_tci) {
exist_arg_num = arg_num;
exist_offset_in_tci = offset_in_tci;
}
}
diff --git a/java/runtime/DuFunctorDesc.java b/java/runtime/DuFunctorDesc.java
index 51d7f6813..9eba0fa8c 100644
--- a/java/runtime/DuFunctorDesc.java
+++ b/java/runtime/DuFunctorDesc.java
@@ -3,44 +3,44 @@
// Copyright (C) 2001-2004, 2011 The University of Melbourne.
// Copyright (C) 2015, 2018 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
//
package jmercury.runtime;
public class DuFunctorDesc implements java.io.Serializable {
public java.lang.String du_functor_name;
- public int du_functor_orig_arity;
- public int du_functor_arg_type_contains_var;
+ public short du_functor_orig_arity;
+ public short du_functor_arg_type_contains_var;
public Sectag_Locn du_functor_sectag_locn;
- public int du_functor_primary;
+ public byte du_functor_primary;
public int du_functor_secondary;
public int du_functor_ordinal;
// XXX PseudoTypeInfo's have not been implemented properly
// yet, so this may not be correct.
public /*final*/ PseudoTypeInfo[] du_functor_arg_types;
public /*final*/ java.lang.String[] du_functor_arg_names;
public /*final*/ DuArgLocn[] du_functor_arg_locns;
public /*final*/ DuExistInfo du_functor_exist_info;
public FunctorSubtypeInfo du_functor_subtype_info;
public byte du_functor_num_sectag_bits; // not used in Java grades
public DuFunctorDesc()
{
}
public void init(java.lang.String functor_name,
- int orig_arity,
- int arg_type_contains_var,
+ short orig_arity,
+ short arg_type_contains_var,
int sectag_locn,
- int primary,
+ byte primary,
int secondary,
int ordinal,
// XXX why do we need to use Object here?
java.lang.Object arg_types,
java.lang.Object arg_names,
java.lang.Object arg_locns,
java.lang.Object exist_info,
int functor_subtype_info,
byte num_sectag_bits)
{
diff --git a/java/runtime/TypeCtorInfo_Struct.java b/java/runtime/TypeCtorInfo_Struct.java
index 0b2212db0..824a9259e 100644
--- a/java/runtime/TypeCtorInfo_Struct.java
+++ b/java/runtime/TypeCtorInfo_Struct.java
@@ -7,31 +7,31 @@
package jmercury.runtime;
// This corresponds to the C type "struct MR_TypeCtorInfo_Struct"
// in runtime/mercury_type_info.h.
public class TypeCtorInfo_Struct extends PseudoTypeInfo
implements java.io.Serializable
{
public int arity;
- public int type_ctor_version;
- public int type_ctor_num_ptags; // if DU
+ public byte type_ctor_version;
+ public byte type_ctor_num_ptags; // if DU
public TypeCtorRep type_ctor_rep;
public MethodPtr unify_pred;
public MethodPtr compare_pred;
public java.lang.String type_ctor_module_name;
public java.lang.String type_ctor_name;
public TypeFunctors type_functors;
public TypeLayout type_layout;
public int type_ctor_num_functors;
- public /* short */ int type_ctor_flags;
+ public short type_ctor_flags;
public int[] type_functor_number_map;
public TypeCtorInfo_Struct()
{
}
// Constructor for variable arity type_ctor_infos,
// i.e. predicates, functions and tuples.
public TypeCtorInfo_Struct(TypeCtorInfo_Struct other, int arity)
{
@@ -47,32 +47,31 @@ public class TypeCtorInfo_Struct extends PseudoTypeInfo
other.type_functors,
other.type_layout,
other.type_ctor_num_functors,
other.type_ctor_flags,
other.type_functor_number_map
);
}
public void init(
int type_arity,
- int version,
- int num_ptags,
+ byte version,
+ byte num_ptags,
int rep,
Object unify_proc,
Object compare_proc,
- String module, String name,
- // TypeFunctors
- java.lang.Object name_ordered_functor_descs,
- // TypeLayout
- java.lang.Object value_ordered_functor_descs,
+ String module,
+ String name,
+ java.lang.Object name_ordered_functor_descs, // TypeFunctors
+ java.lang.Object value_ordered_functor_descs, // TypeLayout
int num_functors,
- int flags,
+ short flags,
int[] functor_number_map)
{
arity = type_arity;
type_ctor_version = version;
type_ctor_num_ptags = num_ptags;
type_ctor_rep = new TypeCtorRep(rep);
unify_pred = (MethodPtr) unify_proc;
compare_pred = (MethodPtr) compare_proc;
type_ctor_module_name = module;
type_ctor_name = name;
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index c2dcae839..8109290ea 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -135,20 +135,21 @@
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module array.
:- import_module bitmap.
:- import_module bool.
:- import_module char.
:- import_module int.
+:- import_module int16.
:- import_module maybe.
:- import_module require.
:- import_module string.
:- import_module term_io.
:- import_module type_desc.
%---------------------------------------------------------------------------%
% It is convenient to represent the type_ctor_rep as a Mercury
% enumeration, so we can switch on the values.
@@ -1060,21 +1061,21 @@ get_functor_impl(TypeInfo, FunctorNumber,
:- pred get_functor_du(type_ctor_rep::in(du), type_info::in,
type_ctor_info::in, int::in, string::out, int::out,
list(pseudo_type_info)::out, list(string)::out) is det.
get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo, FunctorNumber,
FunctorName, Arity, PseudoTypeInfoList, Names) :-
TypeFunctors = get_type_ctor_functors(TypeCtorInfo),
DuFunctorDesc = TypeFunctors ^ du_functor_desc(TypeCtorRep, FunctorNumber),
FunctorName = DuFunctorDesc ^ du_functor_name,
- Arity = DuFunctorDesc ^ du_functor_arity,
+ Arity = int16.to_int(DuFunctorDesc ^ du_functor_arity),
ArgTypes = DuFunctorDesc ^ du_functor_arg_types,
F =
( func(I) = ArgPseudoTypeInfo :-
PseudoTypeInfo = get_pti_from_arg_types(ArgTypes, I),
ArgPseudoTypeInfo =
create_pseudo_type_info(TypeInfo, PseudoTypeInfo)
),
PseudoTypeInfoList = iterate(0, Arity - 1, F),
@@ -2814,21 +2815,21 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
;
SecTagLocn = stag_none_direct_arg,
FunctorDesc = PTagEntry ^ du_sectag_alternatives(0)
;
SecTagLocn = stag_remote,
SecTag = get_remote_secondary_tag(Term),
FunctorDesc = PTagEntry ^ du_sectag_alternatives(SecTag)
),
Functor = FunctorDesc ^ du_functor_name,
Ordinal = FunctorDesc ^ du_functor_ordinal,
- Arity = FunctorDesc ^ du_functor_arity,
+ Arity = int16.to_int(FunctorDesc ^ du_functor_arity),
Arguments = iterate(0, Arity - 1,
get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo))
;
SecTagLocn = stag_local_rest_of_word,
Functor = "some_du_local_sectag",
% XXX incomplete
Ordinal = -1,
Arity = 0,
Arguments = []
;
@@ -3217,21 +3218,21 @@ univ_named_arg_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon, Name,
SecTagLocn = stag_none,
SecTag = 0
;
SecTagLocn = stag_none_direct_arg,
SecTag = 0
;
SecTagLocn = stag_remote,
SecTag = get_remote_secondary_tag(Term)
),
FunctorDesc = PTagEntry ^ du_sectag_alternatives(SecTag),
- Arity = FunctorDesc ^ du_functor_arity,
+ Arity = int16.to_int(FunctorDesc ^ du_functor_arity),
( if
get_du_functor_arg_names(FunctorDesc, Names),
search_arg_names(Names, 0, Arity, Name, Index)
then
ArgUniv = get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo,
Index),
MaybeArgument = yes(ArgUniv)
else
MaybeArgument = no
)
@@ -3391,22 +3392,22 @@ expand_type_name(TypeCtorInfo, Wrap) = Name :-
i(TypeCtorInfo ^ type_ctor_arity),
s(RightWrapper)]).
% Retrieve an argument number from a term, given the functor descriptor.
%
:- some [T] pred get_arg(U::in, sectag_locn::in, du_functor_desc::in,
type_info::in, int::in, T::out) is det.
get_arg(Term, SecTagLocn, FunctorDesc, TypeInfo, Index, Arg) :-
( if get_du_functor_exist_info(FunctorDesc, ExistInfo) then
- ExtraArgs = exist_info_typeinfos_plain(ExistInfo) +
- exist_info_tcis(ExistInfo)
+ ExtraArgs = int16.to_int(exist_info_typeinfos_plain(ExistInfo)) +
+ int16.to_int(exist_info_tcis(ExistInfo))
else
ExtraArgs = 0
),
ArgTypes = FunctorDesc ^ du_functor_arg_types,
PseudoTypeInfo = get_pti_from_arg_types(ArgTypes, Index),
get_arg_type_info(TypeInfo, PseudoTypeInfo, Term, FunctorDesc,
ArgTypeInfo),
( if
( SecTagLocn = stag_none
@@ -3603,21 +3604,21 @@ get_type_info_for_var(TypeInfo, VarNum, Term, FunctorDesc, ArgTypeInfo) :-
( if get_du_functor_exist_info(FunctorDesc, ExistInfo0) then
ExistInfo = ExistInfo0
else
unexpected($module, $pred, "no exist_info")
),
% We count variables from one so we need to add 1.
ExistVarNum = VarNum - first_exist_quant_varnum + 1,
ExistLocn = typeinfo_locns_index(ExistVarNum, ExistInfo),
Slot = ExistLocn ^ exist_arg_num,
- Offset = ExistLocn ^ exist_offset_in_tci,
+ Offset = int16.to_int(ExistLocn ^ exist_offset_in_tci),
( if Offset < 0 then
ArgTypeInfo = get_type_info_from_term(Term, Slot)
else
TypeClassInfo = get_typeclass_info_from_term(Term, Slot),
ArgTypeInfo = typeclass_info_type_info(TypeClassInfo, Offset)
)
).
% An unchecked cast to type_info (for pseudo-typeinfos).
@@ -3950,39 +3951,39 @@ same_pointer_value(X, Y) :- same_pointer_value_untyped(X, Y).
").
same_pointer_value_untyped(_, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
private_builtin.sorry("same_pointer_value_untyped").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
-:- func get_primary_tag(T) = int.
+:- func get_primary_tag(T) = uint8.
:- pragma foreign_proc("C#",
get_primary_tag(X::in) = (Tag::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
// We don't look at X to find the tag, for .NET low-level data
// there is no primary tag, so we always return zero.
Tag = 0;
").
:- pragma foreign_proc("Java",
get_primary_tag(_X::in) = (Tag::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
// For the Java back-end, there is no primary tag, so always return 0.
Tag = 0;
").
-get_primary_tag(_::in) = (0::out) :-
+get_primary_tag(_) = 0u8 :-
det_unimplemented("get_primary_tag").
:- func get_remote_secondary_tag(T) = int.
:- pragma foreign_proc("C#",
get_remote_secondary_tag(X::in) = (Tag::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
#if MR_HIGHLEVEL_DATA
Tag = (int) X.GetType().GetField(""data_tag"").GetValue(X);
@@ -4048,21 +4049,21 @@ get_remote_secondary_tag(_::in) = (0::out) :-
:- pragma foreign_type("Java", arg_names, "java.lang.String[]").
:- type exist_info ---> exist_info(c_pointer).
:- pragma foreign_type("C#", exist_info, "runtime.DuExistInfo").
:- pragma foreign_type("Java", exist_info, "jmercury.runtime.DuExistInfo").
:- type typeinfo_locn ---> typeinfo_locn(c_pointer).
:- pragma foreign_type("C#", typeinfo_locn, "runtime.DuExistLocn").
:- pragma foreign_type("Java", typeinfo_locn, "jmercury.runtime.DuExistLocn").
-:- func ptag_index(int, type_layout) = ptag_entry.
+:- func ptag_index(uint8, type_layout) = ptag_entry.
% This is an "unimplemented" definition in Mercury, which will be
% used by default.
ptag_index(_, _) = _ :-
private_builtin.sorry("ptag_index").
:- pragma foreign_proc("C#",
ptag_index(X::in, TypeLayout::in) = (PtagEntry::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -4152,115 +4153,113 @@ typeinfo_locns_index(_, _) = _ :-
").
:- pragma foreign_proc("Java",
typeinfo_locns_index(VarNum::in, ExistInfo::in) = (TypeInfoLocn::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
// Variables count from one.
TypeInfoLocn = ExistInfo.exist_typeinfo_locns[VarNum - 1];
").
-:- func exist_info_typeinfos_plain(exist_info) = int.
+:- func exist_info_typeinfos_plain(exist_info) = int16.
-exist_info_typeinfos_plain(_) = -1 :-
+exist_info_typeinfos_plain(_) = -1i16 :-
det_unimplemented("exist_info_typeinfos_plain").
:- pragma foreign_proc("C#",
exist_info_typeinfos_plain(ExistInfo::in) = (TypeInfosPlain::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
#if MR_HIGHLEVEL_DATA
TypeInfosPlain = ExistInfo.exist_typeinfos_plain;
#else
- TypeInfosPlain = (int)
- ExistInfo[(int) exist_info_field_nums.typeinfos_plain];
+ TypeInfosPlain = ExistInfo[(int) exist_info_field_nums.typeinfos_plain];
#endif
").
:- pragma foreign_proc("Java",
exist_info_typeinfos_plain(ExistInfo::in) = (TypeInfosPlain::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
TypeInfosPlain = ExistInfo.exist_typeinfos_plain;
").
-:- func exist_info_tcis(exist_info) = int.
+:- func exist_info_tcis(exist_info) = int16.
-exist_info_tcis(_) = -1 :-
+exist_info_tcis(_) = -1i16 :-
det_unimplemented("exist_info_tcis").
:- pragma foreign_proc("C#",
exist_info_tcis(ExistInfo::in) = (TCIs::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
#if MR_HIGHLEVEL_DATA
TCIs = ExistInfo.exist_tcis;
#else
- TCIs = (int) ExistInfo[(int) exist_info_field_nums.tcis];
+ TCIs = ExistInfo[(int) exist_info_field_nums.tcis];
#endif
").
:- pragma foreign_proc("Java",
exist_info_tcis(ExistInfo::in) = (TCIs::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
TCIs = ExistInfo.exist_tcis;
").
-:- func exist_arg_num(typeinfo_locn) = int.
+:- func exist_arg_num(typeinfo_locn) = int16.
-exist_arg_num(_) = -1 :-
+exist_arg_num(_) = -1i16 :-
det_unimplemented("exist_arg_num").
:- pragma foreign_proc("C#",
exist_arg_num(TypeInfoLocn::in) = (ArgNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
#if MR_HIGHLEVEL_DATA
ArgNum = TypeInfoLocn.exist_arg_num;
#else
- ArgNum = (int) TypeInfoLocn[(int) exist_locn_field_nums.exist_arg_num];
+ ArgNum = TypeInfoLocn[(int) exist_locn_field_nums.exist_arg_num];
#endif
").
:- pragma foreign_proc("Java",
exist_arg_num(TypeInfoLocn::in) = (ArgNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
ArgNum = TypeInfoLocn.exist_arg_num;
").
-:- func exist_offset_in_tci(typeinfo_locn) = int.
+:- func exist_offset_in_tci(typeinfo_locn) = int16.
-exist_offset_in_tci(_) = -1 :-
+exist_offset_in_tci(_) = -1i16 :-
det_unimplemented("exist_offset_in_tci").
:- pragma foreign_proc("C#",
exist_offset_in_tci(TypeInfoLocn::in) = (ArgNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
#if MR_HIGHLEVEL_DATA
ArgNum = TypeInfoLocn.exist_offset_in_tci;
#else
- ArgNum = (int)
- TypeInfoLocn[(int) exist_locn_field_nums.exist_offset_in_tci];
+ ArgNum = TypeInfoLocn[(int) exist_locn_field_nums.exist_offset_in_tci];
#endif
").
:- pragma foreign_proc("Java",
exist_offset_in_tci(TypeInfoLocn::in) = (ArgNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
ArgNum = TypeInfoLocn.exist_offset_in_tci;
").
-:- func get_type_info_from_term(U, int) = type_info.
+:- func get_type_info_from_term(U, int16) = type_info.
get_type_info_from_term(_, _) = _ :-
private_builtin.sorry("get_type_info_from_term").
:- pragma foreign_proc("C#",
get_type_info_from_term(Term::in, Index::in) = (TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
#if MR_HIGHLEVEL_DATA
if (Term is object[]) {
@@ -4297,21 +4296,21 @@ get_type_info_from_term(_, _) = _ :-
Field f = Term.getClass().getDeclaredField(""F"" + i);
TypeInfo = (jmercury.runtime.TypeInfo_Struct) f.get(Term);
} catch (IllegalAccessException e) {
throw new Error(e);
} catch (NoSuchFieldException e) {
throw new Error(e);
}
}
").
-:- func get_typeclass_info_from_term(U, int) = typeclass_info.
+:- func get_typeclass_info_from_term(U, int16) = typeclass_info.
get_typeclass_info_from_term(_, _) = _ :-
private_builtin.sorry("get_type_info_from_term").
:- pragma foreign_proc("C#",
get_typeclass_info_from_term(Term::in, Index::in) = (TypeClassInfo::out),
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
"
if (Term is object[]) {
TypeClassInfo = /*typeclass_info*/ (object[]) ((object[]) Term)[Index];
@@ -4969,39 +4968,39 @@ du_functor_name(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(0).
Name = DuFunctorDesc.du_functor_name;
").
:- pragma foreign_proc("Java",
du_functor_name(DuFunctorDesc::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Name = DuFunctorDesc.du_functor_name;
").
-:- func du_functor_arity(du_functor_desc) = int.
+:- func du_functor_arity(du_functor_desc) = int16.
du_functor_arity(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(1).
:- pragma foreign_proc("C#",
du_functor_arity(DuFunctorDesc::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Arity = DuFunctorDesc.du_functor_orig_arity;
").
:- pragma foreign_proc("Java",
du_functor_arity(DuFunctorDesc::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Arity = DuFunctorDesc.du_functor_orig_arity;
").
-:- func du_functor_arg_type_contains_var(du_functor_desc) = int.
+:- func du_functor_arg_type_contains_var(du_functor_desc) = uint16.
du_functor_arg_type_contains_var(DuFunctorDesc) =
DuFunctorDesc ^ unsafe_index(2).
:- pragma foreign_proc("C#",
du_functor_arg_type_contains_var(DuFunctorDesc::in) = (Contains::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Contains = DuFunctorDesc.du_functor_arg_type_contains_var;
").
@@ -5025,21 +5024,21 @@ du_functor_sectag_locn(DuFunctorDesc) =
SectagLocn = DuFunctorDesc.du_functor_sectag_locn;
").
:- pragma foreign_proc("Java",
du_functor_sectag_locn(DuFunctorDesc::in) = (SectagLocn::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
SectagLocn = DuFunctorDesc.du_functor_sectag_locn;
").
-:- func du_functor_primary(du_functor_desc) = int.
+:- func du_functor_primary(du_functor_desc) = uint8.
du_functor_primary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(4).
:- pragma foreign_proc("C#",
du_functor_primary(DuFunctorDesc::in) = (Primary::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Primary = DuFunctorDesc.du_functor_primary;
").
diff --git a/runtime/mercury_dotnet.cs.in b/runtime/mercury_dotnet.cs.in
index be20597b0..dc1e232cf 100644
--- a/runtime/mercury_dotnet.cs.in
+++ b/runtime/mercury_dotnet.cs.in
@@ -363,31 +363,31 @@ public class PseudoTypeInfo {
public PseudoTypeInfo() {
this.variable_number = -1;
}
public PseudoTypeInfo(int variable_number) {
this.variable_number = variable_number;
}
}
public class TypeCtorInfo_Struct : PseudoTypeInfo {
public int arity;
- public int type_ctor_version;
- public int type_ctor_num_ptags;
+ public sbyte type_ctor_version;
+ public sbyte type_ctor_num_ptags;
public TypeCtorRep type_ctor_rep;
public object unify_pred;
public object compare_pred;
public string type_ctor_module_name;
public string type_ctor_name;
public TypeFunctors type_functors;
public TypeLayout type_layout;
public int type_ctor_num_functors;
- public short type_ctor_flags;
+ public ushort type_ctor_flags;
public int[] type_functor_number_map;
// This attribute is also to prevent cyclic copying in deep_copy.
[System.NonSerialized]
private TypeInfo_Struct cached_type_info;
public TypeCtorInfo_Struct() {
}
public TypeCtorInfo_Struct(TypeCtorInfo_Struct other, int arity) {
@@ -403,31 +403,31 @@ public class TypeCtorInfo_Struct : PseudoTypeInfo {
other.type_functors,
other.type_layout,
other.type_ctor_num_functors,
other.type_ctor_flags,
other.type_functor_number_map
);
}
public void init(
int type_arity,
- int version,
- int num_ptags,
+ sbyte version,
+ sbyte num_ptags,
TypeCtorRep rep,
object unify_proc,
object compare_proc,
string module,
string name,
object name_ordered_functor_descs, // TypeFunctors
object value_ordered_functor_descs, // TypeLayout
int num_functors,
- short flags,
+ ushort flags,
int[] functor_number_map)
{
arity = type_arity;
type_ctor_version = version;
type_ctor_num_ptags = num_ptags;
type_ctor_rep = rep;
unify_pred = unify_proc;
compare_pred = compare_proc;
type_ctor_module_name = module;
type_ctor_name = name;
@@ -662,51 +662,51 @@ public class TypeFunctors {
public ForeignEnumFunctorDesc[] functors_foreign_enum() {
return (ForeignEnumFunctorDesc[]) functors_init;
}
public NotagFunctorDesc functors_notag() {
return (NotagFunctorDesc) functors_init;
}
}
public class DuFunctorDesc {
public string du_functor_name;
- public int du_functor_orig_arity;
- public int du_functor_arg_type_contains_var;
+ public short du_functor_orig_arity;
+ public ushort du_functor_arg_type_contains_var;
public Sectag_Locn du_functor_sectag_locn;
- public int du_functor_primary;
+ public byte du_functor_primary;
public int du_functor_secondary;
public int du_functor_ordinal;
public PseudoTypeInfo[] du_functor_arg_types;
public string[] du_functor_arg_names;
public DuArgLocn[] du_functor_arg_locns;
public DuExistInfo du_functor_exist_info;
public FunctorSubtypeInfo du_functor_subtype_info;
- public int du_functor_num_sectag_bits; // unused in C# grades
+ public byte du_functor_num_sectag_bits; // unused in C# grades
public DuFunctorDesc() {
}
public void init(
string functor_name,
- int orig_arity,
- int arg_type_contains_var,
+ short orig_arity,
+ ushort arg_type_contains_var,
Sectag_Locn sectag_locn,
- int primary,
+ byte primary,
int secondary,
int ordinal,
// XXX why do we need to use object here?
object arg_types,
object arg_names,
object arg_locns,
object exist_info,
FunctorSubtypeInfo functor_subtype_info,
- int num_sectag_bits)
+ byte num_sectag_bits)
{
du_functor_name = functor_name;
du_functor_orig_arity = orig_arity;
du_functor_ordinal = ordinal;
du_functor_arg_type_contains_var = arg_type_contains_var;
du_functor_sectag_locn = sectag_locn;
du_functor_primary = primary;
du_functor_secondary = secondary;
du_functor_ordinal = ordinal;
du_functor_arg_types = (PseudoTypeInfo []) arg_types;
@@ -731,89 +731,89 @@ public enum Sectag_Locn {
// MR_SECTAG_LOCAL_BITS = 5
// MR_SECTAG_REMOTE_BITS = 6
}
public enum FunctorSubtypeInfo {
MR_FUNCTOR_SUBTYPE_NONE = 0,
MR_FUNCTOR_SUBTYPE_EXISTS = 1
}
public class DuPtagLayout {
- public int sectag_sharers;
+ public uint sectag_sharers;
public Sectag_Locn sectag_locn;
public /* final */ DuFunctorDesc[] sectag_alternatives;
public sbyte sectag_numbits; // unused in C# grades
public DuPtagLayout(
- int sharers,
+ uint sharers,
Sectag_Locn locn,
DuFunctorDesc[] alts,
sbyte numbits)
{
sectag_sharers = sharers;
sectag_locn = locn;
sectag_alternatives = alts;
sectag_numbits = numbits;
}
public DuPtagLayout(
- int sharers,
+ uint sharers,
int locn,
DuFunctorDesc[] alts,
sbyte numbits)
: this(sharers, (Sectag_Locn) locn, alts, numbits)
{
}
}
public class DuArgLocn {
- public int arg_offset;
- public int arg_shift;
- public int arg_bits;
+ public short arg_offset;
+ public sbyte arg_shift;
+ public sbyte arg_bits;
- public DuArgLocn(int arg_offset, int arg_shift, int arg_bits) {
+ public DuArgLocn(short arg_offset, sbyte arg_shift, sbyte arg_bits) {
this.arg_offset = arg_offset;
this.arg_shift = arg_shift;
this.arg_bits = arg_bits;
}
}
public class DuExistInfo {
- public int exist_typeinfos_plain;
- public int exist_typeinfos_in_tci;
- public int exist_tcis;
+ public short exist_typeinfos_plain;
+ public short exist_typeinfos_in_tci;
+ public short exist_tcis;
public /* final */ DuExistLocn[] exist_typeinfo_locns;
public /* final */ TypeClassConstraint[] exist_constraints;
public DuExistInfo() {
}
public void init(
- int typeinfos_plain,
- int typeinfos_in_tci,
- int tcis,
+ short typeinfos_plain,
+ short typeinfos_in_tci,
+ short tcis,
DuExistLocn[] typeinfo_locns,
TypeClassConstraint[] constraints)
{
exist_typeinfos_plain = typeinfos_plain;
exist_typeinfos_in_tci = typeinfos_in_tci;
exist_tcis = tcis;
exist_typeinfo_locns = typeinfo_locns;
exist_constraints = constraints;
}
}
public class DuExistLocn {
- public int exist_arg_num;
- public int exist_offset_in_tci;
+ public short exist_arg_num;
+ public short exist_offset_in_tci;
- public DuExistLocn(int arg_num, int offset_in_tci) {
+ public DuExistLocn(short arg_num, short offset_in_tci) {
exist_arg_num = arg_num;
exist_offset_in_tci = offset_in_tci;
}
}
public class TypeClassConstraint {
public TypeClassDeclStruct tc_constr_type_class;
public PseudoTypeInfo[] tc_constr_arg_ptis;
public TypeClassConstraint() {
diff --git a/runtime/mercury_type_info.h b/runtime/mercury_type_info.h
index 0a91f88a8..a69b73e2c 100644
--- a/runtime/mercury_type_info.h
+++ b/runtime/mercury_type_info.h
@@ -738,22 +738,22 @@ typedef const MR_TypeClassConstraintStruct *MR_TypeClassConstraint;
((MR_TypeClassConstraint) &((p).MR_tc_constr_type_class_info))
// The argument number field gives the offset in the cell (in a form in which
// it can be given to the MR_field macro directly) of either of the typeinfo
// itself or of the typeclassinfo containing the typeinfo. If the former,
// the offset field will be negative; otherwise, it will be an integer
// which can be given as a second argument to the MR_typeclass_info_type_info
// macro.
typedef struct {
- MR_int_least16_t MR_exist_arg_num;
- MR_int_least16_t MR_exist_offset_in_tci;
+ MR_int_least16_t MR_exist_arg_num; // XXX make unsigned?
+ MR_int_least16_t MR_exist_offset_in_tci; // negative is possible
} MR_DuExistLocn;
// This structure contains information about the typeinfos of the
// existentially quantified type variables occurring in the types of some
// of the arguments of a functor in a du type.
//
// The MR_exist_typeinfos_plain field gives the number of typeinfos
// directly inserted at the start of the memory cell of the functor, while
// the MR_exist_tcis field gives the number of typeclassinfos
// inserted AFTER them. The arguments visible to the programmer start AFTER
@@ -773,20 +773,21 @@ typedef struct {
// The typeinfo for type variable N will be at the offset
// N - MR_PSEUDOTYPEINFO_EXIST_VAR_BASE - 1. (The one is subtracted to convert
// from type var numbering, which starts at 1, to array offset numbering).
//
// The MR_exist_constraints field points to an array of type class constraints
// (each of which is a pointer to a type class constraint structure). The array
// contains MR_exist_tci elements, giving the constraint from which each
// typeclass_info in the functor is derived.
typedef struct {
+ // XXX make first three fields unsigned?
MR_int_least16_t MR_exist_typeinfos_plain;
MR_int_least16_t MR_exist_typeinfos_in_tci;
MR_int_least16_t MR_exist_tcis;
const MR_DuExistLocn *MR_exist_typeinfo_locns;
const MR_TypeClassConstraint *MR_exist_constraints;
} MR_DuExistInfo;
// The MR_DuFunctorDesc type describes the implementation of a function symbol
// from a (proper) discriminated union type, whether it has standard
// or user-defined-equality.
@@ -881,21 +882,21 @@ typedef struct {
// so we should consider changing this. However, any such change
// would require a nontrivial bootstrapping sequence.
//
// In the special case of subword-sized arguments that are packed
// next to a remote secondary tag (MR_SECTAG_REMOTE_BITS), the value of
// the MR_arg_offset field will be -1.
// In the special case of subword-sized arguments that are packed
// next to a local secondary tag (MR_SECTAG_LOCAL_BITS), the value of
// the MR_arg_offset field will be -2.
- MR_int_least8_t MR_arg_shift;
+ MR_int_least8_t MR_arg_shift; // XXX make unsigned?
MR_int_least8_t MR_arg_bits;
// If MR_arg_bits is 0, then the argument occupies the entire word
// at the offset given by MR_arg_offset within the term's memory cell.
// In this case, which is the usual case, MR_arg_shift is not relevant.
//
// Nonzero values of MR_arg_bits mean that the size of the argument
// is not the same as the size of one word. These nonzero values
// fall into two categories: positive and negative.
//
// A strictly positive value of MR_arg_bits means that the argument
@@ -957,32 +958,32 @@ typedef struct {
// This type describes the subtype constraints on the arguments of a functor.
// Currently, we only record whether any such constraints exist.
typedef enum {
MR_DEFINE_BUILTIN_ENUM_CONST(MR_FUNCTOR_SUBTYPE_NONE),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_FUNCTOR_SUBTYPE_EXISTS)
} MR_FunctorSubtype;
typedef struct {
MR_ConstString MR_du_functor_name;
- MR_int_least16_t MR_du_functor_orig_arity;
- MR_int_least16_t MR_du_functor_arg_type_contains_var;
+ MR_int_least16_t MR_du_functor_orig_arity; // XXX make unsigned?
+ MR_uint_least16_t MR_du_functor_arg_type_contains_var;
MR_Sectag_Locn MR_du_functor_sectag_locn;
- MR_int_least8_t MR_du_functor_primary;
- MR_int_least32_t MR_du_functor_secondary;
- MR_int_least32_t MR_du_functor_ordinal;
+ MR_uint_least8_t MR_du_functor_primary;
+ MR_int_least32_t MR_du_functor_secondary; // -1 = no sectag
+ MR_int_least32_t MR_du_functor_ordinal; // XXX make unsigned?
const MR_PseudoTypeInfo *MR_du_functor_arg_types;
const MR_ConstString *MR_du_functor_arg_names;
const MR_DuArgLocn *MR_du_functor_arg_locns;
const MR_DuExistInfo *MR_du_functor_exist_info;
MR_FunctorSubtype MR_du_functor_subtype;
- MR_int_least8_t MR_du_functor_num_sectag_bits;
+ MR_uint_least8_t MR_du_functor_num_sectag_bits;
} MR_DuFunctorDesc;
typedef const MR_DuFunctorDesc *MR_DuFunctorDescPtr;
// This macro represents the number of bits in the
// MR_du_functor_arg_type_contains_var field of a MR_DuFunctorDesc.
// It should be kept in sync with contains_var_bit_vector_size
// in base_type_layout.m.
#define MR_ARG_TYPE_CONTAINS_VAR_BIT_VECTOR_SIZE 16
@@ -1007,30 +1008,30 @@ typedef const MR_DuFunctorDesc *MR_DuFunctorDescPtr;
((functor_desc)->MR_du_functor_arg_type_contains_var > 0)
#define MR_du_subtype_none(tci, functor_desc) \
((tci)->MR_type_ctor_version < MR_RTTI_VERSION__FUNCTOR_SUBTYPE || \
(functor_desc)->MR_du_functor_subtype == MR_FUNCTOR_SUBTYPE_NONE)
////////////////////////////////////////////////////////////////////////////
typedef struct {
MR_ConstString MR_enum_functor_name;
- MR_int_least32_t MR_enum_functor_ordinal;
+ MR_int_least32_t MR_enum_functor_ordinal; // XXX make unsigned?
} MR_EnumFunctorDesc;
typedef const MR_EnumFunctorDesc *MR_EnumFunctorDescPtr;
////////////////////////////////////////////////////////////////////////////
typedef struct {
MR_ConstString MR_foreign_enum_functor_name;
- MR_int_least32_t MR_foreign_enum_functor_ordinal;
+ MR_int_least32_t MR_foreign_enum_functor_ordinal; // XXX make unsigned?
MR_Integer MR_foreign_enum_functor_value;
} MR_ForeignEnumFunctorDesc;
typedef const MR_ForeignEnumFunctorDesc *MR_ForeignEnumFunctorDescPtr;
////////////////////////////////////////////////////////////////////////////
typedef struct {
MR_ConstString MR_notag_functor_name;
MR_PseudoTypeInfo MR_notag_functor_arg_type;
@@ -1056,30 +1057,29 @@ typedef const MR_NotagFunctorDesc *MR_NotagFunctorDescPtr;
// You then look at the locn field. If it is MR_SECTAG_NONE{,_DIRECT_ARG}, you
// index the alternatives field with zero; if it is MR_SECTAG_{LOCAL,REMOTE},
// you compute the secondary tag and index the alternatives field with that.
//
// A value of type MR_DuTypeLayout points to an array of MR_DuPtagLayout
// structures. The element at index k gives information about primary tag
// value k. The size of the array is recorded in the num_ptags field of the
// type_ctor_info.
typedef struct {
- MR_int_least32_t MR_sectag_sharers;
+ MR_uint_least32_t MR_sectag_sharers;
MR_Sectag_Locn MR_sectag_locn;
const MR_DuFunctorDesc * const *MR_sectag_alternatives;
// numbits = -1 means rest-of-word (for local) or full-word (for remote).
int8_t MR_sectag_numbits;
// XXX ARG_PACK The numbits field should be before MR_sectag_alternatives,
// but that requires nontrivial bootstrapping. The locn field should
- // also be something like a uint8_t, while the num_sharers field
- // should be MR_uint_least32_t (or MR_uint_least16_t, if want to make
- // a practical limit official).
+ // also be something like a uint8_t. The num_sharers field could be
+ // MR_uint_least16_t if we want to make a practical limit official.
// XXX ARG_PACK We should consider storing the value of the sectag mask
// ((1 << ptag_layout->MR_sectag_numbits) - 1) here, to avoid having to
// compute it potentially millions of times. It could be stored either as
// a MR_uint_least32_t or as a MR_uint_least16_t, depending on how
// conservative we want to be.
} MR_DuPtagLayout;
typedef const MR_DuPtagLayout *MR_DuTypeLayout;
////////////////////////////////////////////////////////////////////////////
@@ -1207,32 +1207,32 @@ typedef const MR_Integer *MR_FunctorNumberMap;
// Structs defining the structure of type_ctor_infos.
// A type_ctor_info describes the structure of a particular
// type constructor. One of these is generated for every
// `:- type' declaration.
//
// A change in the TypeCtorInfo structure also requires changes in the
// files listed at the top of this file, as well as in the macros below.
struct MR_TypeCtorInfo_Struct {
- MR_Integer MR_type_ctor_arity;
- MR_int_least8_t MR_type_ctor_version;
- MR_int_least8_t MR_type_ctor_num_ptags; // if DU
+ MR_Integer MR_type_ctor_arity; // XXX make unsigned?
+ MR_int_least8_t MR_type_ctor_version; // XXX make unsigned?
+ MR_int_least8_t MR_type_ctor_num_ptags; // negative if not DU
MR_TypeCtorRepInt MR_type_ctor_rep_CAST_ME;
MR_ProcAddr MR_type_ctor_unify_pred;
MR_ProcAddr MR_type_ctor_compare_pred;
MR_ConstString MR_type_ctor_module_name;
MR_ConstString MR_type_ctor_name;
MR_TypeFunctors MR_type_ctor_functors;
MR_TypeLayout MR_type_ctor_layout;
- MR_int_least32_t MR_type_ctor_num_functors;
- MR_int_least16_t MR_type_ctor_flags;
+ MR_int_least32_t MR_type_ctor_num_functors; // negative if no symbols
+ MR_uint_least16_t MR_type_ctor_flags;
MR_FunctorNumberMap MR_type_ctor_functor_number_map;
// The following fields will be added later, once we can exploit them:
// MR_TrieNodePtr MR_type_ctor_std_table;
// MR_ProcAddr MR_type_ctor_prettyprinter;
};
// Check whether an MR_TypeCtorRepInt is a valid MR_TypeCtorRep value.
--
2.19.1
More information about the reviews
mailing list