[m-rev.] java back-end compiler fixes
Fergus Henderson
fjh at cs.mu.OZ.AU
Fri Nov 28 20:04:11 AEDT 2003
Estimated hours taken: 12
Branches: main
Bug fixes for the Java back-end.
compiler/mlds_to_java.m:
Fix a bug where we were outputting an incorrect type for nested
structure initializers
Fix a bug where we were outputting invalid syntax for some
array initializers.
Fix a bug where the code output for string comparisons was not properly
parenthesized.
compiler/mlds.m:
Add a new argument to init_struct that specifies the type of
the structure being initialized. This is needed to handled
nested structure initializers for the Java back-end.
compiler/rtti.m:
Add new alternatives to ctor_rtti_name for all the types which
are used as nested components of RTTI structures. This is
needed in order to have appropriate RTTI types to use in
rtti_to_mlds.m for the new field of init_struct.
compiler/rtti_to_mlds.m:
Substantial changes to fill in the new field of init_struct
in all the generated initializers.
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
Minor changes to handle the new argument to init_struct.
compiler/mlds_to_gcc.m:
compiler/opt_debug.m:
Minor changes to handle the new alternatives for ctor_rtti_name.
compiler/mlds_to_gcc.m:
Fix a bug where it was generating a structure type, rather
than an array thereof, for res_name_ordered_table.
Workspace: /home/jupiter/fjh/ws-jupiter/mercury
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.63
diff -u -d -r1.63 ml_elim_nested.m
--- compiler/ml_elim_nested.m 25 Sep 2003 07:56:28 -0000 1.63
+++ compiler/ml_elim_nested.m 28 Nov 2003 01:57:11 -0000
@@ -1028,7 +1028,7 @@
% rather than relying on initializers like this.
%
StackChain = ml_stack_chain_var,
- EnvInitializer = init_struct([
+ EnvInitializer = init_struct(EnvTypeName, [
init_obj(lval(StackChain)),
init_obj(const(code_addr_const(GCTraceFuncAddr)))
]),
@@ -1865,7 +1865,7 @@
fixup_initializer(no_initializer, no_initializer) --> [].
fixup_initializer(init_obj(Rval0), init_obj(Rval)) -->
fixup_rval(Rval0, Rval).
-fixup_initializer(init_struct(Members0), init_struct(Members)) -->
+fixup_initializer(init_struct(Type, Members0), init_struct(Type, Members)) -->
list__map_foldl(fixup_initializer, Members0, Members).
fixup_initializer(init_array(Elements0), init_array(Elements)) -->
list__map_foldl(fixup_initializer, Elements0, Elements).
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.22
diff -u -d -r1.22 ml_optimize.m
--- compiler/ml_optimize.m 15 Mar 2003 03:08:59 -0000 1.22
+++ compiler/ml_optimize.m 28 Nov 2003 01:57:19 -0000
@@ -956,7 +956,8 @@
eliminate_var_in_rval(Rval0, Rval).
eliminate_var_in_initializer(init_array(Elements0), init_array(Elements)) -->
list__map_foldl(eliminate_var_in_initializer, Elements0, Elements).
-eliminate_var_in_initializer(init_struct(Members0), init_struct(Members)) -->
+eliminate_var_in_initializer(init_struct(Type, Members0),
+ init_struct(Type, Members)) -->
list__map_foldl(eliminate_var_in_initializer, Members0, Members).
:- pred eliminate_var_in_rvals(
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.68
diff -u -d -r1.68 ml_unify_gen.m
--- compiler/ml_unify_gen.m 20 Oct 2003 07:29:08 -0000 1.68
+++ compiler/ml_unify_gen.m 28 Nov 2003 01:57:42 -0000
@@ -726,7 +726,7 @@
{ ConstType = mlds__array_type(_) ->
Initializer = init_array(ArgInits)
;
- Initializer = init_struct(ArgInits)
+ Initializer = init_struct(ConstType, ArgInits)
},
{ ConstDefn = ml_gen_static_const_defn(ConstName, ConstType,
local, Initializer, Context) },
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.27
diff -u -d -r1.27 ml_util.m
--- compiler/ml_util.m 12 Nov 2003 17:28:48 -0000 1.27
+++ compiler/ml_util.m 28 Nov 2003 01:57:54 -0000
@@ -569,7 +569,7 @@
% initializer_contains_var(no_initializer, _) :- fail.
initializer_contains_var(init_obj(Rval), Name) :-
rval_contains_var(Rval, Name).
-initializer_contains_var(init_struct(Inits), Name) :-
+initializer_contains_var(init_struct(_Type, Inits), Name) :-
list__member(Init, Inits),
initializer_contains_var(Init, Name).
initializer_contains_var(init_array(Inits), Name) :-
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.105
diff -u -d -r1.105 mlds.m
--- compiler/mlds.m 20 Oct 2003 07:29:08 -0000 1.105
+++ compiler/mlds.m 28 Nov 2003 04:21:30 -0000
@@ -510,9 +510,11 @@
% Note that `one_copy' variables *must* have an initializer
% (the GCC back-end relies on this).
+ % XXX Currently we only record the type for structs.
+ % We should do the same for objects and arrays.
:- type mlds__initializer
---> init_obj(mlds__rval)
- ; init_struct(list(mlds__initializer))
+ ; init_struct(mlds__type, list(mlds__initializer))
; init_array(list(mlds__initializer))
; no_initializer
.
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.155
diff -u -d -r1.155 mlds_to_c.m
--- compiler/mlds_to_c.m 12 Nov 2003 07:00:05 -0000 1.155
+++ compiler/mlds_to_c.m 28 Nov 2003 01:58:44 -0000
@@ -1435,8 +1435,8 @@
mlds_needs_initialization(no_initializer) = no.
mlds_needs_initialization(init_obj(_)) = yes.
-mlds_needs_initialization(init_struct([])) = no.
-mlds_needs_initialization(init_struct([_|_])) = yes.
+mlds_needs_initialization(init_struct(_Type, [])) = no.
+mlds_needs_initialization(init_struct(_Type, [_|_])) = yes.
mlds_needs_initialization(init_array(_)) = yes.
:- pred mlds_output_initializer_body(mlds__initializer, io__state, io__state).
@@ -1445,7 +1445,7 @@
mlds_output_initializer_body(no_initializer) --> [].
mlds_output_initializer_body(init_obj(Rval)) -->
mlds_output_rval(Rval).
-mlds_output_initializer_body(init_struct(FieldInits)) -->
+mlds_output_initializer_body(init_struct(_Type, FieldInits)) -->
% Note that standard ANSI/ISO C does not allow empty structs.
% But it is the responsibility of the MLDS code generator
% to not generate any. So we don't need to handle empty
@@ -2015,7 +2015,7 @@
:- func initializer_array_size(mlds__initializer) = initializer_array_size.
initializer_array_size(no_initializer) = no_size.
initializer_array_size(init_obj(_)) = no_size.
-initializer_array_size(init_struct(_)) = no_size.
+initializer_array_size(init_struct(_, _)) = no_size.
initializer_array_size(init_array(Elems)) = array_size(list__length(Elems)).
:- pred mlds_output_type_suffix(mlds__type, initializer_array_size,
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.89
diff -u -d -r1.89 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 24 Oct 2003 06:17:43 -0000 1.89
+++ compiler/mlds_to_gcc.m 28 Nov 2003 04:59:05 -0000
@@ -1217,7 +1217,7 @@
{ Initializer = init_obj(Rval) },
build_rval(Rval, DefnInfo, GCC_Expr)
;
- { Initializer = init_struct(InitList) },
+ { Initializer = init_struct(_Type, InitList) },
gcc__get_struct_field_decls(GCC_Type, GCC_FieldDecls),
build_struct_initializer(InitList, GCC_FieldDecls, DefnInfo,
GCC_InitList),
@@ -1938,7 +1938,7 @@
:- func initializer_array_size(mlds__initializer) = initializer_array_size.
initializer_array_size(no_initializer) = no_size.
initializer_array_size(init_obj(_)) = no_size.
-initializer_array_size(init_struct(_)) = no_size.
+initializer_array_size(init_struct(_, _)) = no_size.
initializer_array_size(init_array(Elems)) = array_size(list__length(Elems)).
%-----------------------------------------------------------------------------%
@@ -1972,6 +1972,8 @@
build_rtti_type_name(exist_locns(_), Size, GCC_Type) -->
build_du_exist_locn_type(MR_DuExistLocn),
build_sized_array_type(MR_DuExistLocn, Size, GCC_Type).
+build_rtti_type_name(exist_locn, _, GCC_Type) -->
+ build_du_exist_locn_type(GCC_Type).
build_rtti_type_name(exist_info(_), _, MR_DuExistInfo) -->
build_du_exist_info_type(MR_DuExistInfo).
build_rtti_type_name(field_names(_), Size, GCC_Type) -->
@@ -2056,6 +2058,9 @@
{ MR_DuFunctorDescPtr = gcc__ptr_type_node },
build_sized_array_type(MR_DuFunctorDescPtr, Size, GCC_Type).
build_rtti_type_name(du_ptag_ordered_table, Size, GCC_Type) -->
+ build_rtti_type_name(du_ptag_layout(0), Size, MR_DuPtagLayout),
+ build_sized_array_type(MR_DuPtagLayout, Size, GCC_Type).
+build_rtti_type_name(du_ptag_layout(_), _, GCC_Type) -->
% typedef struct {
% MR_int_least32_t MR_sectag_sharers;
% MR_Sectag_Locn MR_sectag_locn;
@@ -2065,8 +2070,7 @@
['MR_int_least32_t' - "MR_sectag_sharers",
'MR_Sectag_Locn' - "MR_sectag_locn",
gcc__ptr_type_node - "MR_sectag_alternatives"],
- MR_DuPtagLayout),
- build_sized_array_type(MR_DuPtagLayout, Size, GCC_Type).
+ GCC_Type).
build_rtti_type_name(res_value_ordered_table, _, GCC_Type) -->
% typedef struct {
% MR_int_least16_t MR_ra_num_res_numeric_addrs;
@@ -2082,7 +2086,11 @@
gcc__ptr_type_node - "MR_ra_constants",
gcc__ptr_type_node - "MR_ra_other_functors"
], GCC_Type).
-build_rtti_type_name(res_name_ordered_table, _, GCC_Type) -->
+build_rtti_type_name(res_name_ordered_table, Size, GCC_Type) -->
+ build_rtti_type_name(maybe_res_addr_functor_desc, Size,
+ MR_MaybeResAddrFunctorDesc),
+ build_sized_array_type(MR_MaybeResAddrFunctorDesc, Size, GCC_Type).
+build_rtti_type_name(maybe_res_addr_functor_desc, _, GCC_Type) -->
% typedef union {
% MR_DuFunctorDesc *MR_maybe_res_du_ptr;
% MR_ReservedAddrFunctorDesc *MR_maybe_res_res_ptr;
@@ -2094,16 +2102,24 @@
% MR_bool MR_maybe_res_is_res;
% MR_MaybeResFunctorDescPtr MR_maybe_res_ptr;
% } MR_MaybeResAddrFunctorDesc;
- build_struct_type("MR_MaybeResAddrFunctorDesc",
+ build_struct_type("MR_MaybeResFunctorDesc",
[gcc__ptr_type_node - "MR_maybe_res_init"],
- MR_MaybeResAddrFunctorDesc),
- build_struct_type("MR_ReservedAddrFunctorDesc",
+ MR_MaybeResFunctorDescPtr),
+ build_struct_type("MR_MaybeResAddrFunctorDesc",
['MR_ConstString' - "MR_maybe_res_name",
'MR_Integer' - "MR_maybe_res_arity",
'MR_bool' - "MR_maybe_res_is_res",
- MR_MaybeResAddrFunctorDesc - "MR_maybe_res_ptr"
+ MR_MaybeResFunctorDescPtr - "MR_maybe_res_ptr"
], GCC_Type).
-build_rtti_type_name(type_ctor_info, _, GCC_Type) -->
+build_rtti_type_name(type_functors, _, GCC_Type) -->
+ build_struct_type("MR_TypeFunctors",
+ [gcc__ptr_type_node - "MR_functors_init"],
+ GCC_Type).
+build_rtti_type_name(type_layout, _, GCC_Type) -->
+ build_struct_type("MR_TypeLayout",
+ [gcc__ptr_type_node - "MR_layout_init"],
+ GCC_Type).
+build_rtti_type_name(type_ctor_info, Size, GCC_Type) -->
% 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 */
@@ -2116,14 +2132,9 @@
% MR_TypeLayout MR_type_ctor_layout;
% MR_int_least32_t MR_type_ctor_num_functors;
% MR_int_least16_t MR_type_ctor_flags;
-
{ MR_ProcAddr = gcc__ptr_type_node },
- build_struct_type("MR_TypeFunctors",
- [gcc__ptr_type_node - "MR_functors_init"],
- MR_TypeFunctors),
- build_struct_type("MR_TypeLayout",
- [gcc__ptr_type_node - "MR_layout_init"],
- MR_TypeLayout),
+ build_rtti_type_name(type_functors, Size, MR_TypeFunctors),
+ build_rtti_type_name(type_layout, Size, MR_TypeLayout),
build_struct_type("MR_TypeCtorInfo_Struct",
['MR_Integer' - "MR_type_ctor_arity",
'MR_int_least8_t' - "MR_type_ctor_version",
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.136
diff -u -d -r1.136 mlds_to_il.m
--- compiler/mlds_to_il.m 20 Nov 2003 11:35:41 -0000 1.136
+++ compiler/mlds_to_il.m 28 Nov 2003 02:00:07 -0000
@@ -544,8 +544,8 @@
:- func rename_initializer(mlds__initializer) = mlds__initializer.
rename_initializer(init_obj(Rval)) = init_obj(rename_rval(Rval)).
-rename_initializer(init_struct(Inits))
- = init_struct(list__map(rename_initializer, Inits)).
+rename_initializer(init_struct(Type, Inits))
+ = init_struct(Type, list__map(rename_initializer, Inits)).
rename_initializer(init_array(Inits))
= init_array(list__map(rename_initializer, Inits)).
rename_initializer(no_initializer) = no_initializer.
@@ -1431,7 +1431,7 @@
% (this may have to be re-visited if used to initialise high-level
% data).
-data_initializer_to_instrs(init_struct(InitList0), Type,
+data_initializer_to_instrs(init_struct(_StructType, InitList0), Type,
AllocInstrs, InitInstrs) -->
{ InitList = flatten_inits(InitList0) },
@@ -1510,7 +1510,7 @@
% array already boxed
maybe_box_initializer(init_array(X), init_array(X)) --> [].
% struct already boxed
-maybe_box_initializer(init_struct(X), init_struct(X)) --> [].
+maybe_box_initializer(init_struct(Type, X), init_struct(Type, X)) --> [].
% single items need to be boxed
maybe_box_initializer(init_obj(Rval), init_obj(NewRval)) -->
{ rval_to_type(Rval, BoxType) },
@@ -1523,7 +1523,7 @@
:- func flatten_init(mlds__initializer) = list(mlds__initializer).
flatten_init(I) = Inits :-
- ( I = init_struct(Inits0) ->
+ ( I = init_struct(_Type, Inits0) ->
Inits = flatten_inits(Inits0)
; I = init_array(Inits0) ->
Inits = flatten_inits(Inits0)
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.45
diff -u -d -r1.45 mlds_to_java.m
--- compiler/mlds_to_java.m 24 Oct 2003 06:17:43 -0000 1.45
+++ compiler/mlds_to_java.m 28 Nov 2003 07:50:20 -0000
@@ -614,7 +614,7 @@
:- mode method_ptrs_in_initializer(in, in, out) is det.
method_ptrs_in_initializer(mlds__no_initializer) --> [].
-method_ptrs_in_initializer(mlds__init_struct(Initializers)) -->
+method_ptrs_in_initializer(mlds__init_struct(_Type, Initializers)) -->
method_ptrs_in_initializers(Initializers).
method_ptrs_in_initializer(mlds__init_array(Initializers)) -->
method_ptrs_in_initializers(Initializers).
@@ -1408,8 +1408,8 @@
needs_initialization(no_initializer) = no.
needs_initialization(init_obj(_)) = yes.
-needs_initialization(init_struct([])) = no.
-needs_initialization(init_struct([_|_])) = yes.
+needs_initialization(init_struct(_Type, [])) = no.
+needs_initialization(init_struct(_Type, [_|_])) = yes.
needs_initialization(init_array(_)) = yes.
:- pred output_initializer_body(mlds__initializer, maybe(mlds__type),
@@ -1451,34 +1451,30 @@
;
output_rval_maybe_with_enum(Rval, ModuleName)
).
-output_initializer_body(init_struct(FieldInits), MaybeType, ModuleName) -->
+output_initializer_body(init_struct(StructType, FieldInits), _MaybeType,
+ ModuleName) -->
+ io__write_string("new "),
+ output_type(StructType),
(
- { MaybeType = yes(Type) },
- { not ( Type = mercury_type(MercuryType, _, _),
- hand_defined_type(MercuryType, _, yes) ) }
+ { StructType = mercury_type(MercuryType, _, _) },
+ { hand_defined_type(MercuryType, _, IsArray0) }
->
- io__write_string("new "),
- output_type(Type),
- io__write_char('('),
- io__write_list(FieldInits, ",\n\t\t",
- (pred(FieldInit::in, di, uo) is det -->
- output_initializer_body(FieldInit, no, ModuleName))),
- io__write_char(')')
+ { IsArray = IsArray0 }
;
- % XXX we need to know the type here
- io__write_string("new Object[] {"),
- io__write_list(FieldInits, ",\n\t\t",
- (pred(FieldInit::in, di, uo) is det -->
- output_initializer_body(FieldInit, no, ModuleName))),
- io__write_string("}")
- ).
+ { IsArray = no }
+ ),
+ io__write_string(if IsArray = yes then " {" else "("),
+ io__write_list(FieldInits, ",\n\t\t",
+ (pred(FieldInit::in, di, uo) is det -->
+ output_initializer_body(FieldInit, no, ModuleName))),
+ io__write_char(if IsArray = yes then '}' else ')').
output_initializer_body(init_array(ElementInits), MaybeType, ModuleName) -->
io__write_string("new "),
( { MaybeType = yes(Type) } ->
output_type(Type)
;
% XXX we need to know the type here
- io__write_string("Object[]")
+ io__write_string("/* XXX init_array */ Object[]")
),
io__write_string(" {\n\t\t"),
io__write_list(ElementInits, ",\n\t\t",
@@ -2695,7 +2691,13 @@
%
% Generate class constructor name.
%
- ( { MaybeCtorName = yes(QualifiedCtorId) } ->
+ (
+ { MaybeCtorName = yes(QualifiedCtorId) },
+ { \+ (
+ Type = mlds__mercury_type(MercuryType, _, _),
+ hand_defined_type(MercuryType, _, yes)
+ ) }
+ ->
output_type(Type),
io__write_char('.'),
{ QualifiedCtorId = qual(_ModuleName, CtorDefn) },
@@ -3124,14 +3126,13 @@
;
{ java_util__string_compare_op(Op, OpStr) }
->
+ io__write_string("("),
output_rval(X, ModuleName),
io__write_string(".compareTo("),
output_rval(Y, ModuleName),
- io__write_string(")"),
- io__write_string(" "),
+ io__write_string(") "),
io__write_string(OpStr),
- io__write_string(" "),
- io__write_string("0")
+ io__write_string(" 0)")
;
( { java_util__float_compare_op(Op, OpStr1) } ->
{ OpStr = OpStr1 }
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.135
diff -u -d -r1.135 opt_debug.m
--- compiler/opt_debug.m 23 Oct 2003 02:02:09 -0000 1.135
+++ compiler/opt_debug.m 28 Nov 2003 04:35:05 -0000
@@ -383,6 +383,8 @@
opt_debug__dump_rtti_name(exist_locns(Ordinal), Str) :-
string__int_to_string(Ordinal, Ordinal_str),
string__append("exist_locns_", Ordinal_str, Str).
+opt_debug__dump_rtti_name(exist_locn, Str) :-
+ Str = "exist_loc".
opt_debug__dump_rtti_name(exist_info(Ordinal), Str) :-
string__int_to_string(Ordinal, Ordinal_str),
string__append("exist_info_", Ordinal_str, Str).
@@ -418,10 +420,19 @@
string__append("du_stag_ordered_table_", Ptag_str, Str).
opt_debug__dump_rtti_name(du_ptag_ordered_table, Str) :-
Str = "du_ptag_ordered_table".
+opt_debug__dump_rtti_name(du_ptag_layout(Ptag), Str) :-
+ string__int_to_string(Ptag, Ptag_str),
+ string__append("du_ptag_layout", Ptag_str, Str).
opt_debug__dump_rtti_name(res_value_ordered_table, Str) :-
Str = "res_value_ordered_table".
opt_debug__dump_rtti_name(res_name_ordered_table, Str) :-
Str = "res_name_ordered_table".
+opt_debug__dump_rtti_name(maybe_res_addr_functor_desc, Str) :-
+ Str = "maybe_res_addr_functor_desc".
+opt_debug__dump_rtti_name(type_layout, Str) :-
+ Str = "type_layout".
+opt_debug__dump_rtti_name(type_functors, Str) :-
+ Str = "type_functors".
opt_debug__dump_rtti_name(type_ctor_info, Str) :-
Str = "type_ctor_info".
opt_debug__dump_rtti_name(type_info(_TypeInfo), Str) :-
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.36
diff -u -d -r1.36 rtti.m
--- compiler/rtti.m 24 Oct 2003 06:17:48 -0000 1.36
+++ compiler/rtti.m 28 Nov 2003 04:34:30 -0000
@@ -595,6 +595,7 @@
:- type ctor_rtti_name
---> exist_locns(int) % functor ordinal
+ ; exist_locn
; exist_info(int) % functor ordinal
; field_names(int) % functor ordinal
; field_types(int) % functor ordinal
@@ -609,8 +610,12 @@
; du_name_ordered_table
; du_stag_ordered_table(int) % primary tag
; du_ptag_ordered_table
+ ; du_ptag_layout(int) % primary tag
; res_value_ordered_table
; res_name_ordered_table
+ ; maybe_res_addr_functor_desc
+ ; type_functors
+ ; type_layout
; type_ctor_info
; type_info(rtti_type_info)
; pseudo_type_info(rtti_pseudo_type_info)
@@ -874,28 +879,33 @@
tc_rtti_name_is_exported(TCRttiName).
ctor_rtti_name_is_exported(exist_locns(_)) = no.
-ctor_rtti_name_is_exported(exist_info(_)) = no.
-ctor_rtti_name_is_exported(field_names(_)) = no.
-ctor_rtti_name_is_exported(field_types(_)) = no.
+ctor_rtti_name_is_exported(exist_locn) = no.
+ctor_rtti_name_is_exported(exist_info(_)) = no.
+ctor_rtti_name_is_exported(field_names(_)) = no.
+ctor_rtti_name_is_exported(field_types(_)) = no.
ctor_rtti_name_is_exported(res_addrs) = no.
ctor_rtti_name_is_exported(res_addr_functors) = no.
-ctor_rtti_name_is_exported(enum_functor_desc(_)) = no.
-ctor_rtti_name_is_exported(notag_functor_desc) = no.
-ctor_rtti_name_is_exported(du_functor_desc(_)) = no.
+ctor_rtti_name_is_exported(enum_functor_desc(_)) = no.
+ctor_rtti_name_is_exported(notag_functor_desc) = no.
+ctor_rtti_name_is_exported(du_functor_desc(_)) = no.
ctor_rtti_name_is_exported(res_functor_desc(_)) = no.
-ctor_rtti_name_is_exported(enum_name_ordered_table) = no.
-ctor_rtti_name_is_exported(enum_value_ordered_table) = no.
-ctor_rtti_name_is_exported(du_name_ordered_table) = no.
-ctor_rtti_name_is_exported(du_stag_ordered_table(_)) = no.
-ctor_rtti_name_is_exported(du_ptag_ordered_table) = no.
-ctor_rtti_name_is_exported(res_value_ordered_table) = no.
-ctor_rtti_name_is_exported(res_name_ordered_table) = no.
-ctor_rtti_name_is_exported(type_ctor_info) = yes.
+ctor_rtti_name_is_exported(enum_name_ordered_table) = no.
+ctor_rtti_name_is_exported(enum_value_ordered_table) = no.
+ctor_rtti_name_is_exported(du_name_ordered_table) = no.
+ctor_rtti_name_is_exported(du_stag_ordered_table(_)) = no.
+ctor_rtti_name_is_exported(du_ptag_ordered_table) = no.
+ctor_rtti_name_is_exported(du_ptag_layout(_)) = no.
+ctor_rtti_name_is_exported(res_value_ordered_table) = no.
+ctor_rtti_name_is_exported(res_name_ordered_table) = no.
+ctor_rtti_name_is_exported(maybe_res_addr_functor_desc) = no.
+ctor_rtti_name_is_exported(type_functors) = no.
+ctor_rtti_name_is_exported(type_layout) = no.
+ctor_rtti_name_is_exported(type_ctor_info) = yes.
ctor_rtti_name_is_exported(type_info(TypeInfo)) =
type_info_is_exported(TypeInfo).
ctor_rtti_name_is_exported(pseudo_type_info(PseudoTypeInfo)) =
pseudo_type_info_is_exported(PseudoTypeInfo).
-ctor_rtti_name_is_exported(type_hashcons_pointer) = no.
+ctor_rtti_name_is_exported(type_hashcons_pointer) = no.
tc_rtti_name_is_exported(base_typeclass_info(_, _, _)) = yes.
tc_rtti_name_is_exported(type_class_id(_)) = no.
@@ -969,6 +979,10 @@
string__append_list([ModuleName, "__exist_locns_",
TypeName, "_", A_str, "_", O_str], Str)
;
+ RttiName = exist_locn,
+ string__append_list([ModuleName, "__exist_locn_",
+ TypeName, "_", A_str], Str)
+ ;
RttiName = exist_info(Ordinal),
string__int_to_string(Ordinal, O_str),
string__append_list([ModuleName, "__exist_info_",
@@ -1033,6 +1047,12 @@
string__append_list([ModuleName, "__du_ptag_ordered_",
TypeName, "_", A_str], Str)
;
+ RttiName = du_ptag_layout(Ptag),
+ string__int_to_string(Ptag, P_str),
+ string__append_list([ModuleName,
+ "__du_ptag_layout_",
+ TypeName, "_", A_str, "_", P_str], Str)
+ ;
RttiName = res_value_ordered_table,
string__append_list([ModuleName, "__res_layout_ordered_table_",
TypeName, "_", A_str], Str)
@@ -1041,6 +1061,19 @@
string__append_list([ModuleName, "__res_name_ordered_table_",
TypeName, "_", A_str], Str)
;
+ RttiName = maybe_res_addr_functor_desc,
+ string__append_list([ModuleName,
+ "__maybe_res_addr_functor_desc_",
+ TypeName, "_", A_str], Str)
+ ;
+ RttiName = type_functors,
+ string__append_list([ModuleName, "__type_functors",
+ TypeName, "_", A_str], Str)
+ ;
+ RttiName = type_layout,
+ string__append_list([ModuleName, "__type_layout",
+ TypeName, "_", A_str], Str)
+ ;
RttiName = type_ctor_info,
string__append_list([ModuleName, "__type_ctor_info_",
TypeName, "_", A_str], Str)
@@ -1511,6 +1544,7 @@
tc_rtti_name_would_include_code_addr(TCRttiName).
ctor_rtti_name_would_include_code_addr(exist_locns(_)) = no.
+ctor_rtti_name_would_include_code_addr(exist_locn) = no.
ctor_rtti_name_would_include_code_addr(exist_info(_)) = no.
ctor_rtti_name_would_include_code_addr(field_names(_)) = no.
ctor_rtti_name_would_include_code_addr(field_types(_)) = no.
@@ -1525,9 +1559,13 @@
ctor_rtti_name_would_include_code_addr(du_name_ordered_table) = no.
ctor_rtti_name_would_include_code_addr(du_stag_ordered_table(_)) = no.
ctor_rtti_name_would_include_code_addr(du_ptag_ordered_table) = no.
+ctor_rtti_name_would_include_code_addr(du_ptag_layout(_)) = no.
ctor_rtti_name_would_include_code_addr(res_value_ordered_table) = no.
ctor_rtti_name_would_include_code_addr(res_name_ordered_table) = no.
+ctor_rtti_name_would_include_code_addr(maybe_res_addr_functor_desc) = no.
ctor_rtti_name_would_include_code_addr(type_hashcons_pointer) = no.
+ctor_rtti_name_would_include_code_addr(type_functors) = no.
+ctor_rtti_name_would_include_code_addr(type_layout) = no.
ctor_rtti_name_would_include_code_addr(type_ctor_info) = yes.
ctor_rtti_name_would_include_code_addr(type_info(TypeInfo)) =
type_info_would_incl_code_addr(TypeInfo).
@@ -1607,6 +1645,7 @@
:- pred ctor_rtti_name_type(ctor_rtti_name::in, string::out, bool::out) is det.
ctor_rtti_name_type(exist_locns(_), "DuExistLocn", yes).
+ctor_rtti_name_type(exist_locn, "DuExistLocn", no).
ctor_rtti_name_type(exist_info(_), "DuExistInfo", no).
ctor_rtti_name_type(field_names(_), "ConstString", yes).
ctor_rtti_name_type(field_types(_), "PseudoTypeInfo", yes).
@@ -1622,8 +1661,13 @@
ctor_rtti_name_type(du_name_ordered_table, "DuFunctorDescPtr", yes).
ctor_rtti_name_type(du_stag_ordered_table(_), "DuFunctorDescPtr", yes).
ctor_rtti_name_type(du_ptag_ordered_table, "DuPtagLayout", yes).
+ctor_rtti_name_type(du_ptag_layout(_), "DuPtagLayout", no).
ctor_rtti_name_type(res_value_ordered_table, "ReservedAddrTypeLayout", no).
ctor_rtti_name_type(res_name_ordered_table, "MaybeResAddrFunctorDesc", yes).
+ctor_rtti_name_type(maybe_res_addr_functor_desc,
+ "MaybeResAddrFunctorDesc", no).
+ctor_rtti_name_type(type_functors, "TypeFunctors", no).
+ctor_rtti_name_type(type_layout, "TypeLayout", no).
ctor_rtti_name_type(type_ctor_info, "TypeCtorInfo_Struct", no).
ctor_rtti_name_type(type_hashcons_pointer, "TrieNodePtr", no).
ctor_rtti_name_type(type_info(TypeInfo), TypeName, no) :-
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.42
diff -u -d -r1.42 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 23 Oct 2003 02:02:09 -0000 1.42
+++ compiler/rtti_to_mlds.m 28 Nov 2003 04:56:06 -0000
@@ -76,8 +76,8 @@
;
rtti_data_to_id(RttiData, RttiId),
Name = data(rtti(RttiId)),
- gen_init_rtti_data_defn(RttiData, ModuleInfo, Initializer,
- ExtraDefns),
+ gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo,
+ Initializer, ExtraDefns),
rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
MLDS_Defn),
MLDS_Defns = [MLDS_Defn | ExtraDefns]
@@ -88,6 +88,12 @@
rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Initializer, MLDS_Defn) :-
RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ rtti_id_and_init_to_defn(RttiId, Initializer, MLDS_Defn).
+
+:- pred rtti_id_and_init_to_defn(rtti_id::in, mlds__initializer::in,
+ mlds__defn::out) is det.
+
+rtti_id_and_init_to_defn(RttiId, Initializer, MLDS_Defn) :-
Name = data(rtti(RttiId)),
rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
MLDS_Defn).
@@ -148,10 +154,10 @@
% Return an MLDS initializer for the given RTTI definition
% occurring in the given module.
-:- pred gen_init_rtti_data_defn(rtti_data::in, module_info::in,
+:- pred gen_init_rtti_data_defn(rtti_data::in, rtti_id::in, module_info::in,
mlds__initializer::out, list(mlds__defn)::out) is det.
-gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, ExtraDefns) :-
+gen_init_rtti_data_defn(RttiData, _RttiId, ModuleInfo, Init, ExtraDefns) :-
RttiData = base_typeclass_info(_InstanceModule, _ClassId, _InstanceStr,
BaseTypeClassInfo),
BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5,
@@ -167,20 +173,21 @@
gen_init_boxed_int(N5)
| MethodInitializers
]).
-gen_init_rtti_data_defn(RttiData, _ModuleInfo, _Init, _SubDefns) :-
+gen_init_rtti_data_defn(RttiData, _RttiId, _ModuleInfo, _Init, _SubDefns) :-
RttiData = type_class_decl(_),
error("gen_init_rtti_data_defn: type_class_decl NYI").
-gen_init_rtti_data_defn(RttiData, _ModuleInfo, _Init, _SubDefns) :-
+gen_init_rtti_data_defn(RttiData, _RttiId, _ModuleInfo, _Init, _SubDefns) :-
RttiData = type_class_instance(_),
error("gen_init_rtti_data_defn: type_class_instance NYI").
-gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, SubDefns) :-
+gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
RttiData = type_info(TypeInfo),
- gen_type_info_defn(ModuleInfo, TypeInfo, Init, SubDefns).
-gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, SubDefns) :-
+ gen_type_info_defn(ModuleInfo, TypeInfo, RttiId, Init, SubDefns).
+gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
RttiData = pseudo_type_info(PseudoTypeInfo),
- gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, Init, SubDefns).
+ gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, RttiId,
+ Init, SubDefns).
-gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, SubDefns) :-
+gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
RttiData = type_ctor_info(TypeCtorData),
TypeCtorData = type_ctor_data(Version, TypeModule, TypeName,
TypeArity, UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
@@ -190,7 +197,9 @@
NumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
gen_functors_layout_info(ModuleInfo, RttiTypeCtor, TypeCtorDetails,
FunctorsInfo, LayoutInfo, SubDefns),
- Init = init_struct([
+ FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, type_functors),
+ LayoutRttiId = ctor_rtti_id(RttiTypeCtor, type_layout),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_int(TypeArity),
gen_init_int(Version),
gen_init_int(NumPtags),
@@ -202,10 +211,10 @@
% 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([
+ init_struct(mlds__rtti_type(FunctorsRttiId), [
FunctorsInfo
]),
- init_struct([
+ init_struct(mlds__rtti_type(LayoutRttiId), [
LayoutInfo
]),
gen_init_int(NumFunctors),
@@ -220,32 +229,32 @@
%-----------------------------------------------------------------------------%
-:- pred gen_type_info_defn(module_info::in, rtti_type_info::in,
+:- pred gen_type_info_defn(module_info::in, rtti_type_info::in, rtti_id::in,
mlds__initializer::out, list(mlds__defn)::out) is det.
-gen_type_info_defn(_, plain_arity_zero_type_info(_), _, _) :-
+gen_type_info_defn(_, plain_arity_zero_type_info(_), _, _, _) :-
error("gen_type_info_defn: plain_arity_zero_type_info").
gen_type_info_defn(ModuleInfo, plain_type_info(RttiTypeCtor, ArgTypes),
- Init, SubDefns) :-
+ RttiId, Init, SubDefns) :-
ArgRttiDatas = list__map(type_info_to_rtti_data, ArgTypes),
RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
SubDefnLists = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
SubDefns = list__condense(SubDefnLists),
module_info_name(ModuleInfo, ModuleName),
- Init = init_struct([
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_cast_rtti_datas_array(mlds__type_info_type,
ModuleName, ArgRttiDatas)
]).
gen_type_info_defn(ModuleInfo, var_arity_type_info(VarArityId, ArgTypes),
- Init, SubDefns) :-
+ RttiId, Init, SubDefns) :-
ArgRttiDatas = list__map(type_info_to_rtti_data, ArgTypes),
RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
SubDefnLists = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
SubDefns = list__condense(SubDefnLists),
RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
module_info_name(ModuleInfo, ModuleName),
- Init = init_struct([
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_int(list__length(ArgTypes)),
gen_init_cast_rtti_datas_array(mlds__type_info_type,
@@ -253,23 +262,23 @@
]).
:- pred gen_pseudo_type_info_defn(module_info::in, rtti_pseudo_type_info::in,
- mlds__initializer::out, list(mlds__defn)::out) is det.
+ rtti_id::in, mlds__initializer::out, list(mlds__defn)::out) is det.
-gen_pseudo_type_info_defn(_, plain_arity_zero_pseudo_type_info(_), _, _) :-
+gen_pseudo_type_info_defn(_, plain_arity_zero_pseudo_type_info(_), _, _, _) :-
error("gen_pseudo_type_info_defn: plain_arity_zero_pseudo_type_info").
-gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, Init, SubDefns) :-
+gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, RttiId, Init, SubDefns) :-
PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, ArgTypes),
ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
SubDefnLists = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
SubDefns = list__condense(SubDefnLists),
module_info_name(ModuleInfo, ModuleName),
- Init = init_struct([
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_cast_rtti_datas_array(mlds__pseudo_type_info_type,
ModuleName, ArgRttiDatas)
]).
-gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, Init, SubDefns) :-
+gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, RttiId, Init, SubDefns) :-
PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, ArgTypes),
ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
RealRttiDatas = list__filter(real_rtti_data, ArgRttiDatas),
@@ -277,13 +286,13 @@
SubDefns = list__condense(SubDefnLists),
RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
module_info_name(ModuleInfo, ModuleName),
- Init = init_struct([
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_int(list__length(ArgTypes)),
gen_init_cast_rtti_datas_array(mlds__pseudo_type_info_type,
ModuleName, ArgRttiDatas)
]).
-gen_pseudo_type_info_defn(_, type_var(_), _, _) :-
+gen_pseudo_type_info_defn(_, type_var(_), _, _, _) :-
error("gen_pseudo_type_info_defn: type_var").
%-----------------------------------------------------------------------------%
@@ -387,12 +396,13 @@
gen_enum_functor_desc(_ModuleInfo, RttiTypeCtor, EnumFunctor) = MLDS_Defn :-
EnumFunctor = enum_functor(FunctorName, Ordinal),
- Init = init_struct([
+ RttiName = enum_functor_desc(Ordinal),
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_string(FunctorName),
gen_init_int(Ordinal)
]),
- RttiName = enum_functor_desc(Ordinal),
- rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+ rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn).
:- func gen_notag_functor_desc(module_info, rtti_type_ctor, notag_functor)
= list(mlds__defn).
@@ -402,14 +412,15 @@
NotagFunctorDesc = notag_functor(FunctorName, ArgType, MaybeArgName),
module_info_name(ModuleInfo, ModuleName),
ArgTypeRttiData = maybe_pseudo_type_info_to_rtti_data(ArgType),
- Init = init_struct([
+ RttiName = notag_functor_desc,
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_string(FunctorName),
gen_init_cast_rtti_data(mlds__pseudo_type_info_type,
ModuleName, ArgTypeRttiData),
gen_init_maybe(ml_string_type, gen_init_string, MaybeArgName)
]),
- RttiName = notag_functor_desc,
- rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn),
RealRttiDatas = list__filter(real_rtti_data, [ArgTypeRttiData]),
SubDefnsList = list__map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
SubDefns = list__condense(SubDefnsList),
@@ -485,7 +496,9 @@
SectagAndLocn = sectag_remote(Stag),
Locn = sectag_remote
),
- Init = init_struct([
+ RttiName = du_functor_desc(Ordinal),
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_string(FunctorName),
gen_init_int(Arity),
gen_init_int(ContainsVarBitVector),
@@ -497,8 +510,7 @@
ArgNameInit,
ExistInfoInit
]),
- RttiName = du_functor_desc(Ordinal),
- rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn),
MLDS_Defns = [MLDS_Defn | SubDefns].
:- func gen_res_addr_functor_desc(module_info, rtti_type_ctor,
@@ -506,13 +518,14 @@
gen_res_addr_functor_desc(ModuleInfo, RttiTypeCtor, ResFunctor) = MLDS_Defn :-
ResFunctor = reserved_functor(FunctorName, Ordinal, ReservedAddress),
- Init = init_struct([
+ RttiName = res_functor_desc(Ordinal),
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_string(FunctorName),
gen_init_int(Ordinal),
gen_init_reserved_address(ModuleInfo, ReservedAddress)
]),
- RttiName = res_functor_desc(Ordinal),
- rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
+ rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn).
:- func gen_maybe_res_functor_desc(module_info, rtti_type_ctor,
maybe_reserved_functor) = list(mlds__defn).
@@ -532,15 +545,18 @@
%-----------------------------------------------------------------------------%
-:- func gen_init_exist_locn(exist_typeinfo_locn) = mlds__initializer.
+:- func gen_init_exist_locn(rtti_type_ctor, exist_typeinfo_locn) =
+ mlds__initializer.
-gen_init_exist_locn(plain_typeinfo(SlotInCell)) =
- init_struct([
- gen_init_int(SlotInCell),
- gen_init_int(-1)
- ]).
-gen_init_exist_locn(typeinfo_in_tci(SlotInCell, SlotInTci)) =
- init_struct([
+gen_init_exist_locn(RttiTypeCtor, ExistTypeInfoLocn) = Init :-
+ (
+ ExistTypeInfoLocn = typeinfo_in_tci(SlotInCell, SlotInTci)
+ ;
+ ExistTypeInfoLocn = plain_typeinfo(SlotInCell),
+ SlotInTci = -1
+ ),
+ RttiId = ctor_rtti_id(RttiTypeCtor, exist_locn),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_int(SlotInCell),
gen_init_int(SlotInTci)
]).
@@ -549,7 +565,7 @@
list(exist_typeinfo_locn)) = mlds__defn.
gen_exist_locns_array(_ModuleInfo, RttiTypeCtor, Ordinal, Locns) = MLDS_Defn :-
- Init = gen_init_array(gen_init_exist_locn, Locns),
+ Init = gen_init_array(gen_init_exist_locn(RttiTypeCtor), Locns),
RttiName = exist_locns(Ordinal),
rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn).
@@ -559,15 +575,16 @@
gen_exist_info(ModuleInfo, RttiTypeCtor, Ordinal, ExistInfo) = MLDS_Defns :-
ExistInfo = exist_info(Plain, InTci, Tci, Locns),
module_info_name(ModuleInfo, ModuleName),
- Init = init_struct([
+ RttiName = exist_info(Ordinal),
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_int(Plain),
gen_init_int(InTci),
gen_init_int(Tci),
gen_init_rtti_name(ModuleName, RttiTypeCtor,
exist_locns(Ordinal))
]),
- RttiName = exist_info(Ordinal),
- rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn),
Sub_Defn = gen_exist_locns_array(ModuleInfo, RttiTypeCtor, Ordinal,
Locns),
MLDS_Defns = [MLDS_Defn, Sub_Defn].
@@ -640,7 +657,9 @@
( PtagList = [1 - _ | _] ->
% Output a dummy ptag definition for the
% reserved tag first.
- PtagInitPrefix = [init_struct([
+ RttiElemName = du_ptag_layout(0),
+ RttiElemId = ctor_rtti_id(RttiTypeCtor, RttiElemName),
+ PtagInitPrefix = [init_struct(mlds__rtti_type(RttiElemId), [
gen_init_int(0),
gen_init_builtin_const("MR_SECTAG_VARIABLE"),
gen_init_null_pointer(
@@ -659,8 +678,8 @@
),
PtagInits = gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor,
PtagList, FirstPtag),
- Init = init_array(list__append(PtagInitPrefix, PtagInits)),
RttiName = du_ptag_ordered_table,
+ Init = init_array(list__append(PtagInitPrefix, PtagInits)),
rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
MLDS_Defns = [MLDS_Defn | SubDefns].
@@ -673,7 +692,9 @@
require(unify(Ptag, CurPtag),
"gen_du_ptag_ordered_table_body: ptag mismatch"),
SectagTable = sectag_table(SectagLocn, NumSharers, _SectagMap),
- Init = init_struct([
+ RttiName = du_ptag_layout(Ptag),
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_int(NumSharers),
gen_init_sectag_locn(SectagLocn),
gen_init_rtti_name(ModuleName, RttiTypeCtor,
@@ -735,7 +756,9 @@
DuDefns = gen_du_ptag_ordered_table(ModuleInfo, RttiTypeCtor,
DuByPtag),
SubDefns = list__condense([ResDefns, ResAddrDefns, DuDefns]),
- Init = init_struct([
+ RttiName = res_value_ordered_table,
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Init = init_struct(mlds__rtti_type(RttiId), [
gen_init_int(NumNumericResFunctorReps),
gen_init_int(NumSymbolicResFunctorReps),
ResAddrInit,
@@ -744,8 +767,7 @@
gen_init_rtti_name(ModuleName, RttiTypeCtor,
du_ptag_ordered_table)
]),
- RttiName = res_value_ordered_table,
- rtti_name_and_init_to_defn(RttiTypeCtor, RttiName, Init, MLDS_Defn),
+ rtti_id_and_init_to_defn(RttiId, Init, MLDS_Defn),
MLDS_Defns = [MLDS_Defn | SubDefns].
:- func gen_res_addr_functor_table(module_name, rtti_type_ctor,
@@ -787,10 +809,13 @@
gen_maybe_res_name_ordered_table_element(ModuleName, RttiTypeCtor,
MaybeResFunctor) = Init :-
+ RttiName = maybe_res_addr_functor_desc,
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName),
+ Type = mlds__rtti_type(RttiId),
(
MaybeResFunctor = res_func(ResFunctor),
Name = ResFunctor ^ res_name,
- Init = init_struct([
+ Init = init_struct(Type, [
gen_init_string(Name),
gen_init_int(0), % arity=0
gen_init_bool(yes), % is_reserved = true
@@ -800,7 +825,7 @@
;
MaybeResFunctor = du_func(DuFunctor),
Name = DuFunctor ^ du_name,
- Init = init_struct([
+ Init = init_struct(Type, [
gen_init_string(Name),
gen_init_int(DuFunctor ^ du_orig_arity),
gen_init_bool(no), % is_reserved = false
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list