[m-rev.] for review: MLDS back-end: generate closure layouts

[Fergus Henderson]

On 03-Mar-2002, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> I will go ahead and commit this now.

Unfortunately further testing revealed two more bugs with the
generation of pseudo_type_infos for the MLDS back-end.
One was that I was generating duplicate definitions for pseudo_type_infos
referred to from multiple places.
Another is that I was not generate definitions of the argument
pseudo_type_infos referred to by compound pseudo_type_infos.

Here's a relative diff that fixes both of these problems.
This time I really *will* commit it.

diff -u compiler/ml_elim_nested.m compiler/ml_elim_nested.m
--- compiler/ml_elim_nested.m
+++ compiler/ml_elim_nested.m
@@ -389,7 +389,13 @@
 		ml_elim_nested_defns(Action, MLDS_ModuleName, Globals,
 			OuterVars),
 		Defns0) },
-	{ Defns = list__condense(DefnsList) }.
+	{ Defns1 = list__condense(DefnsList) },
+	% The MLDS code generator sometimes generates two definitions of the
+	% same RTTI constant as local constants in two different functions.
+	% When we hoist them out, that leads to duplicate definitions here.
+	% So we need to check for and eliminate any duplicate definitions
+	% of constants.
+	{ Defns = list__remove_dups(Defns1) }.
 
 	% Either eliminated nested functions:
 	% Hoist out any nested function occurring in a single mlds__defn.
diff -u compiler/ml_unify_gen.m compiler/ml_unify_gen.m
--- compiler/ml_unify_gen.m
+++ compiler/ml_unify_gen.m
@@ -740,11 +740,29 @@
 	NumUnivQTvars = -1,
 
 	pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
-			ExistQTvars, Pseudo),
+			ExistQTvars, PseudoTypeInfo),
+	ml_gen_pseudo_type_info(ModuleInfo, PseudoTypeInfo, ArgRval, ArgType,
+			MLDS_Defns0, MLDS_Defns),
+	CastArgRval = unop(box(ArgType), ArgRval),
+	ArgInit = init_obj(CastArgRval).
+
+:- pred ml_gen_pseudo_type_info_defn(module_info::in, pseudo_type_info::in,
+		mlds__defns::in, mlds__defns::out) is det.
+
+ml_gen_pseudo_type_info_defn(ModuleInfo, Pseudo, Defns0, Defns) :-
+	ml_gen_pseudo_type_info(ModuleInfo, Pseudo, _Rval, _Type,
+		Defns0, Defns).
+
+:- pred ml_gen_pseudo_type_info(module_info::in, pseudo_type_info::in,
+		mlds__rval::out, mlds__type::out,
+		mlds__defns::in, mlds__defns::out) is det.
+
+ml_gen_pseudo_type_info(ModuleInfo, Pseudo, Rval, Type,
+		MLDS_Defns0, MLDS_Defns) :-
 	( Pseudo = type_var(N) ->
 		% type variables are represented just as integers
-		ArgRval = const(int_const(N)),
-		ArgType = mlds__native_int_type,
+		Rval = const(int_const(N)),
+		Type = mlds__native_int_type,
 		MLDS_Defns = MLDS_Defns0
 	;
 		( Pseudo = type_ctor_info(RttiTypeId0) ->
@@ -762,16 +780,37 @@
 			module_info_name(ModuleInfo, ModuleName),
 			RttiData = pseudo_type_info(Pseudo),
 			rtti_data_to_name(RttiData, RttiTypeId, RttiName),
-			MLDS_Defns = rtti_data_list_to_mlds(ModuleInfo,
-				[RttiData]) ++ MLDS_Defns0
+			RttiDefns0 = rtti_data_list_to_mlds(ModuleInfo,
+				[RttiData]),
+			% rtti_data_list_to_mlds assumes that the result
+			% will be at file scope, but here we're generating it
+			% as a local, so we need to convert the access
+			% to `local'
+			RttiDefns = list__map(convert_to_local, RttiDefns0),
+			MLDS_Defns1 = RttiDefns ++ MLDS_Defns0,
+			% Generate definitions of any pseudo_type_infos
+			% referenced by this pseudotypeinfo.
+			list__foldl(ml_gen_pseudo_type_info_defn(ModuleInfo),
+				arg_pseudo_type_infos(Pseudo),
+				MLDS_Defns1, MLDS_Defns)
 		),
 		MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
-		ArgRval = const(data_addr_const(data_addr(MLDS_ModuleName,
+		Rval = const(data_addr_const(data_addr(MLDS_ModuleName,
 			rtti(RttiTypeId, RttiName)))),
-		ArgType = mlds__rtti_type(RttiName)
-	),
-	CastArgRval = unop(box(ArgType), ArgRval),
-	ArgInit = init_obj(CastArgRval).
+		Type = mlds__rtti_type(RttiName)
+	).
+
+:- func arg_pseudo_type_infos(pseudo_type_info) = list(pseudo_type_info).
+arg_pseudo_type_infos(type_var(_)) = [].
+arg_pseudo_type_infos(type_ctor_info(_)) = [].
+arg_pseudo_type_infos(type_info(_TypeId, ArgPTIs)) = ArgPTIs.
+arg_pseudo_type_infos(higher_order_type_info(_TypeId, _Arity, ArgPTIs)) =
+	ArgPTIs.
+
+:- func convert_to_local(mlds__defn) = mlds__defn.
+convert_to_local(mlds__defn(Name, Context, Flags0, Body)) =
+		mlds__defn(Name, Context, Flags, Body) :-
+	Flags = set_access(Flags0, local).
 
 :- pred ml_stack_layout_construct_tvar_vector(module_info::in,
 	mlds__var_name::in, prog_context::in, map(tvar, set(layout_locn))::in,

-- 
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
--------------------------------------------------------------------------