[m-dev.] for review: fix MLDS bootstrapping problems

[Fergus Henderson]

Pete, can you please review this one?

----------

Estimated hours taken: 1.5

runtime/mercury.h:
compiler/rtti_to_mlds.m:
compiler/mlds_to_c.m:
	Don't include the `[]' in the RTTI type name typedefs.
	Instead, for array types, print out the array element type,
	followed by an explicit `[N]', where N is the size of the
	object's initializer, if any.

compiler/mlds_to_c.m:
	Re-apply my changes to output `static' in the right places.
	These should now work portably, since the types that we output
	for forward declarations of static variables should all be
	complete types.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.61
diff -u -d -r1.61 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/10/31 16:56:00	1.61
+++ compiler/mlds_to_c.m	2000/11/02 16:24:40
@@ -702,14 +702,7 @@
 		% Now output the declaration for this mlds__defn.
 		%
 		mlds_indent(Context, Indent),
-		( { Name = data(_) } ->
-			% XXX for private data and private functions,
-			% we should use "static"
-			io__write_string("extern ")
-		;
-			[]
-		),
-		mlds_output_decl_flags(Flags),
+		mlds_output_decl_flags(Flags, forward_decl, Name),
 		mlds_output_decl_body(Indent, qual(ModuleName, Name), Context,
 			DefnBody)
 	).
@@ -789,7 +782,7 @@
 		[]
 	),
 	mlds_indent(Context, Indent),
-	mlds_output_decl_flags(Flags),
+	mlds_output_decl_flags(Flags, definition, Name),
 	mlds_output_defn_body(Indent, qual(ModuleName, Name), Context,
 			DefnBody).
 
@@ -799,8 +792,8 @@
 
 mlds_output_decl_body(Indent, Name, Context, DefnBody) -->
 	(
-		{ DefnBody = mlds__data(Type, _Initializer) },
-		mlds_output_data_decl(Name, Type)
+		{ DefnBody = mlds__data(Type, Initializer) },
+		mlds_output_data_decl(Name, Type, initializer_array_size(Initializer))
 	;
 		{ DefnBody = mlds__function(MaybePredProcId, Signature,
 			_MaybeBody) },
@@ -990,12 +983,14 @@
 %
 
 :- pred mlds_output_data_decl(mlds__qualified_entity_name, mlds__type,
-			io__state, io__state).
-:- mode mlds_output_data_decl(in, in, di, uo) is det.
+			initializer_array_size, io__state, io__state).
+:- mode mlds_output_data_decl(in, in, in, di, uo) is det.
 
-mlds_output_data_decl(Name, Type) -->
+mlds_output_data_decl(Name, Type, InitializerSize) -->
 	mlds_output_data_decl_ho(mlds_output_type_prefix,
-			mlds_output_type_suffix, Name, Type).
+			(pred(Tp::in, di, uo) is det -->
+				mlds_output_type_suffix(Tp, InitializerSize)),
+			Name, Type).
 
 :- pred mlds_output_data_decl_ho(output_type, output_type,
 		mlds__qualified_entity_name, mlds__type, io__state, io__state).
@@ -1013,7 +1008,7 @@
 :- mode mlds_output_data_defn(in, in, in, di, uo) is det.
 
 mlds_output_data_defn(Name, Type, Initializer) -->
-	mlds_output_data_decl(Name, Type),
+	mlds_output_data_decl(Name, Type, initializer_array_size(Initializer)),
 	mlds_output_initializer(Type, Initializer),
 	io__write_string(";\n").
 
@@ -1550,21 +1545,40 @@
 :- pred mlds_output_type_suffix(mlds__type, io__state, io__state).
 :- mode mlds_output_type_suffix(in, di, uo) is det.
 
-mlds_output_type_suffix(mercury_type(_, _)) --> [].
-mlds_output_type_suffix(mlds__native_int_type) --> [].
-mlds_output_type_suffix(mlds__native_float_type) --> [].
-mlds_output_type_suffix(mlds__native_bool_type) --> [].
-mlds_output_type_suffix(mlds__native_char_type) --> [].
-mlds_output_type_suffix(mlds__class_type(_, _, _)) --> [].
-mlds_output_type_suffix(mlds__ptr_type(_)) --> [].
-mlds_output_type_suffix(mlds__array_type(_)) -->
-	io__write_string("[]").
-mlds_output_type_suffix(mlds__func_type(FuncParams)) -->
+mlds_output_type_suffix(Type) -->
+	mlds_output_type_suffix(Type, no_size).
+
+:- type initializer_array_size
+	--->	array_size(int)
+	;	no_size.	% either the size is unknown,
+				% or the data is not an array
+
+:- 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_array(Elems)) = array_size(list__length(Elems)).
+
+:- pred mlds_output_type_suffix(mlds__type, initializer_array_size,
+		io__state, io__state).
+:- mode mlds_output_type_suffix(in, in, di, uo) is det.
+
+
+mlds_output_type_suffix(mercury_type(_, _), _) --> [].
+mlds_output_type_suffix(mlds__native_int_type, _) --> [].
+mlds_output_type_suffix(mlds__native_float_type, _) --> [].
+mlds_output_type_suffix(mlds__native_bool_type, _) --> [].
+mlds_output_type_suffix(mlds__native_char_type, _) --> [].
+mlds_output_type_suffix(mlds__class_type(_, _, _), _) --> [].
+mlds_output_type_suffix(mlds__ptr_type(_), _) --> [].
+mlds_output_type_suffix(mlds__array_type(_), ArraySize) -->
+	mlds_output_array_type_suffix(ArraySize).
+mlds_output_type_suffix(mlds__func_type(FuncParams), _) -->
 	mlds_output_func_type_suffix(FuncParams).
-mlds_output_type_suffix(mlds__generic_type) --> [].
-mlds_output_type_suffix(mlds__generic_env_ptr_type) --> [].
-mlds_output_type_suffix(mlds__pseudo_type_info_type) --> [].
-mlds_output_type_suffix(mlds__cont_type(ArgTypes)) -->
+mlds_output_type_suffix(mlds__generic_type, _) --> [].
+mlds_output_type_suffix(mlds__generic_env_ptr_type, _) --> [].
+mlds_output_type_suffix(mlds__pseudo_type_info_type, _) --> [].
+mlds_output_type_suffix(mlds__cont_type(ArgTypes), _) -->
 	( { ArgTypes = [] } ->
 		[]
 	;
@@ -1581,49 +1595,108 @@
 		),
 		io__write_string(")")
 	).
-mlds_output_type_suffix(mlds__commit_type) --> [].
-mlds_output_type_suffix(mlds__rtti_type(_)) --> [].
+mlds_output_type_suffix(mlds__commit_type, _) --> [].
+mlds_output_type_suffix(mlds__rtti_type(RttiName), ArraySize) -->
+	( { rtti_name_has_array_type(RttiName) = yes } ->
+		mlds_output_array_type_suffix(ArraySize)
+	;
+		[]
+	).
 
+:- pred mlds_output_array_type_suffix(initializer_array_size::in,
+		io__state::di, io__state::uo) is det.
+mlds_output_array_type_suffix(no_size) -->
+	io__write_string("[]").
+mlds_output_array_type_suffix(array_size(Size)) -->
+	io__format("[%d]", [i(Size)]).
+
 %-----------------------------------------------------------------------------%
 %
 % Code to output declaration specifiers
 %
 
-:- pred mlds_output_decl_flags(mlds__decl_flags, io__state, io__state).
-:- mode mlds_output_decl_flags(in, di, uo) is det.
+:- type decl_or_defn
+	--->	forward_decl
+	;	definition.
 
-mlds_output_decl_flags(Flags) -->
-	mlds_output_access(access(Flags)),
-	mlds_output_per_instance(per_instance(Flags)),
+:- pred mlds_output_decl_flags(mlds__decl_flags, decl_or_defn,
+		mlds__entity_name, io__state, io__state).
+:- mode mlds_output_decl_flags(in, in, in, di, uo) is det.
+
+mlds_output_decl_flags(Flags, DeclOrDefn, Name) -->
+	%
+	% mlds_output_extern_or_static handles both the
+	% `access' and the `per_instance' fields of the mlds__decl_flags.
+	% We have to handle them together because C overloads `static'
+	% to mean both `private' and `one_copy', rather than having
+	% separate keywords for each.  To make it clear which MLDS
+	% construct each `static' keyword means, we precede the `static'
+	% without (optionally-enabled) comments saying whether it is
+	% `private', `one_copy', or both.
+	%
+	mlds_output_access_comment(access(Flags)),
+	mlds_output_per_instance_comment(per_instance(Flags)),
+	mlds_output_extern_or_static(access(Flags), per_instance(Flags),
+		DeclOrDefn, Name),
 	mlds_output_virtuality(virtuality(Flags)),
 	mlds_output_finality(finality(Flags)),
 	mlds_output_constness(constness(Flags)),
 	mlds_output_abstractness(abstractness(Flags)).
 
-:- pred mlds_output_access(access, io__state, io__state).
-:- mode mlds_output_access(in, di, uo) is det.
+:- pred mlds_output_access_comment(access, io__state, io__state).
+:- mode mlds_output_access_comment(in, di, uo) is det.
 
-mlds_output_access(Access) -->
+mlds_output_access_comment(Access) -->
 	globals__io_lookup_bool_option(auto_comments, Comments),
 	( { Comments = yes } ->
-		mlds_output_access_2(Access)
+		mlds_output_access_comment_2(Access)
 	;
 		[]
 	).
 
-:- pred mlds_output_access_2(access, io__state, io__state).
-:- mode mlds_output_access_2(in, di, uo) is det.
+:- pred mlds_output_access_comment_2(access, io__state, io__state).
+:- mode mlds_output_access_comment_2(in, di, uo) is det.
 
-mlds_output_access_2(public)    --> [].
-mlds_output_access_2(private)   --> io__write_string("/* private: */ ").
-mlds_output_access_2(protected) --> io__write_string("/* protected: */ ").
-mlds_output_access_2(default)   --> io__write_string("/* default access */ ").
+mlds_output_access_comment_2(public)    --> [].
+mlds_output_access_comment_2(private)   --> io__write_string("/* private: */ ").
+mlds_output_access_comment_2(protected) --> io__write_string("/* protected: */ ").
+mlds_output_access_comment_2(default)   --> io__write_string("/* default access */ ").
 
-:- pred mlds_output_per_instance(per_instance, io__state, io__state).
-:- mode mlds_output_per_instance(in, di, uo) is det.
+:- pred mlds_output_per_instance_comment(per_instance, io__state, io__state).
+:- mode mlds_output_per_instance_comment(in, di, uo) is det.
 
-mlds_output_per_instance(one_copy)     --> io__write_string("static ").
-mlds_output_per_instance(per_instance) --> [].
+mlds_output_per_instance_comment(PerInstance) -->
+	globals__io_lookup_bool_option(auto_comments, Comments),
+	( { Comments = yes } ->
+		mlds_output_per_instance_comment_2(PerInstance)
+	;
+		[]
+	).
+
+:- pred mlds_output_per_instance_comment_2(per_instance, io__state, io__state).
+:- mode mlds_output_per_instance_comment_2(in, di, uo) is det.
+
+mlds_output_per_instance_comment_2(per_instance) --> [].
+mlds_output_per_instance_comment_2(one_copy)     --> io__write_string("/* one_copy */ ").
+
+:- pred mlds_output_extern_or_static(access, per_instance, decl_or_defn,
+		mlds__entity_name, io__state, io__state).
+:- mode mlds_output_extern_or_static(in, in, in, in, di, uo) is det.
+
+mlds_output_extern_or_static(Access, PerInstance, DeclOrDefn, Name) -->
+	(
+		{ Access = private ; PerInstance = one_copy },
+		{ Name \= type(_, _) }
+	->
+		io__write_string("static ")
+	;
+		{ DeclOrDefn = forward_decl },
+		{ Name = data(_) }
+	->
+		io__write_string("extern ")
+	;
+		[]
+	).
 
 :- pred mlds_output_virtuality(virtuality, io__state, io__state).
 :- mode mlds_output_virtuality(in, di, uo) is det.
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.7
diff -u -d -r1.7 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m	2000/11/01 05:12:14	1.7
+++ compiler/rtti_to_mlds.m	2000/11/02 16:14:37
@@ -22,9 +22,11 @@
 	% return a list of MLDS definitions for the given rtti_data list.
 :- func rtti_data_list_to_mlds(module_info, list(rtti_data)) = mlds__defns.
 
-	% return a name, consisting only of alphabetic characters,
+	% Return a name, consisting only of alphabetic characters,
 	% that would be suitable for the type name for the type
-	% of the given rtti_name.
+	% of the given rtti_name.  If rtti_name_has_array_type(Name) = yes,
+	% then the name returned by mlds_rtti_type_name(Name) is the
+	% array element type, otherwise it is the complete type.
 :- func mlds_rtti_type_name(rtti_name) = string.
 
 :- implementation.
@@ -596,18 +598,18 @@
 
 %-----------------------------------------------------------------------------%
 
-mlds_rtti_type_name(exist_locns(_)) =		"DuExistLocnArray".
+mlds_rtti_type_name(exist_locns(_)) =		"DuExistLocn".
 mlds_rtti_type_name(exist_info(_)) =		"DuExistInfo".
-mlds_rtti_type_name(field_names(_)) =		"ConstStringArray".
-mlds_rtti_type_name(field_types(_)) =		"PseudoTypeInfoArray".
+mlds_rtti_type_name(field_names(_)) =		"ConstString".
+mlds_rtti_type_name(field_types(_)) =		"PseudoTypeInfo".
 mlds_rtti_type_name(enum_functor_desc(_)) =	"EnumFunctorDesc".
 mlds_rtti_type_name(notag_functor_desc) =	"NotagFunctorDesc".
 mlds_rtti_type_name(du_functor_desc(_)) =	"DuFunctorDesc".
-mlds_rtti_type_name(enum_name_ordered_table) =	"EnumFunctorDescPtrArray".
-mlds_rtti_type_name(enum_value_ordered_table) =	"EnumFunctorDescPtrArray".
-mlds_rtti_type_name(du_name_ordered_table) =	"DuFunctorDescPtrArray".
-mlds_rtti_type_name(du_stag_ordered_table(_)) =	"DuFunctorDescPtrArray".
-mlds_rtti_type_name(du_ptag_ordered_table) =	"DuPtagLayoutArray".
+mlds_rtti_type_name(enum_name_ordered_table) =	"EnumFunctorDescPtr".
+mlds_rtti_type_name(enum_value_ordered_table) =	"EnumFunctorDescPtr".
+mlds_rtti_type_name(du_name_ordered_table) =	"DuFunctorDescPtr".
+mlds_rtti_type_name(du_stag_ordered_table(_)) =	"DuFunctorDescPtr".
+mlds_rtti_type_name(du_ptag_ordered_table) =	"DuPtagLayout".
 mlds_rtti_type_name(type_ctor_info) =		"TypeCtorInfo_Struct".
 mlds_rtti_type_name(base_typeclass_info(_, _, _)) = "BaseTypeclassInfo".
 mlds_rtti_type_name(pseudo_type_info(Pseudo)) =
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.22
diff -u -d -r1.22 mercury.h
--- runtime/mercury.h	2000/10/23 15:08:31	1.22
+++ runtime/mercury.h	2000/11/02 15:28:38
@@ -137,14 +137,10 @@
 ** are defined here.
 */
 typedef struct MR_TypeCtorInfo_Struct	MR_TypeCtorInfo_Struct;
-typedef MR_DuExistLocn			MR_DuExistLocnArray[];
-typedef MR_ConstString			MR_ConstStringArray[];
-typedef MR_PseudoTypeInfo		MR_PseudoTypeInfoArray[];
-typedef const MR_EnumFunctorDesc *	MR_EnumFunctorDescPtrArray[];
-typedef const MR_DuFunctorDesc *	MR_DuFunctorDescPtrArray[];
-typedef MR_DuPtagLayout			MR_DuPtagLayoutArray[];
-typedef union MR_TableNode_Union * *	MR_TableNodePtrPtr[];
-typedef MR_Box				MR_BaseTypeclassInfo[];
+typedef const MR_EnumFunctorDesc *	MR_EnumFunctorDescPtr;
+typedef const MR_DuFunctorDesc *	MR_DuFunctorDescPtr;
+typedef union MR_TableNode_Union * *	MR_TableNodePtrPtr;
+typedef MR_Box				MR_BaseTypeclassInfo;
 
 /*
 ** XXX Currently we hard-code the declarations of the first

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------