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

[Peter Ross]

On Fri, Nov 03, 2000 at 04:27:34AM +1100, Fergus Henderson wrote:
> 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.
> 

Here is the change which bootstraps using MSVC as the C compiler.
It is essentially the same change except we now output
MR_BOOTSTRAP_RTTI_CHANGE at the start of each C file and modify
mercury.h so that the correct set of typedefs is selected.

The other change is that arrays of size 0 are illegal so we make the
minimum array size be one.

===================================================================


Estimated hours taken: 5.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.  This change requires bootstrapping so we define
    MR_BOOTSTRAP_RTTI_CHANGE in the source C files.

compiler/mlds_to_c.m:
    Re-apply fjh's 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.



Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.62
diff -u -r1.62 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/11/03 05:37:23	1.62
+++ compiler/mlds_to_c.m	2000/11/03 15:40:38
@@ -284,10 +284,16 @@
 	io__write_string(". */\n"),
 	mlds_indent(Indent),
 	io__write_string("/* :- implementation. */\n"),
+	mlds_output_src_bootstrap_defines, io__nl,
 	mlds_output_src_import(Indent,
 		mercury_module_name_to_mlds(ModuleName)),
 	io__nl.
 
+:- pred mlds_output_src_bootstrap_defines(io__state::di, io__state::uo) is det.
+
+mlds_output_src_bootstrap_defines -->
+	io__write_string("#define MR_BOOTSTRAP_RTTI_CHANGE\n").
+
 :- pred mlds_output_hdr_end(indent, mercury_module_name,
 		io__state, io__state).
 :- mode mlds_output_hdr_end(in, in, di, uo) is det.
@@ -717,14 +723,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)
 	).
@@ -804,7 +803,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).
 
@@ -814,8 +813,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) },
@@ -1005,12 +1004,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).
@@ -1028,7 +1029,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").
 
@@ -1565,21 +1566,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 = [] } ->
 		[]
 	;
@@ -1595,50 +1615,113 @@
 			[]
 		),
 		io__write_string(")")
+	).
+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)
+	;
+		[]
 	).
-mlds_output_type_suffix(mlds__commit_type) --> [].
-mlds_output_type_suffix(mlds__rtti_type(_)) --> [].
 
+:- 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(Size0)) -->
+	%
+	% ANSI/ISO C forbids arrays of size 0.
+	%
+	{ int__max(Size0, 1, 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.
 
-mlds_output_decl_flags(Flags) -->
-	mlds_output_access(access(Flags)),
-	mlds_output_per_instance(per_instance(Flags)),
+:- type decl_or_defn
+	--->	forward_decl
+	;	definition.
+
+:- 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_comment(access, io__state, io__state).
+:- mode mlds_output_access_comment(in, di, uo) is det.
+
+mlds_output_access_comment(Access) -->
+	globals__io_lookup_bool_option(auto_comments, Comments),
+	( { Comments = yes } ->
+		mlds_output_access_comment_2(Access)
+	;
+		[]
+	).
 
-:- pred mlds_output_access(access, io__state, io__state).
-:- mode mlds_output_access(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(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_comment(per_instance, io__state, io__state).
+:- mode mlds_output_per_instance_comment(in, di, uo) is det.
+
+mlds_output_per_instance_comment(PerInstance) -->
 	globals__io_lookup_bool_option(auto_comments, Comments),
 	( { Comments = yes } ->
-		mlds_output_access_2(Access)
+		mlds_output_per_instance_comment_2(PerInstance)
 	;
 		[]
 	).
 
-:- pred mlds_output_access_2(access, io__state, io__state).
-:- mode mlds_output_access_2(in, di, uo) is det.
+:- 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_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_per_instance_comment_2(per_instance) --> [].
+mlds_output_per_instance_comment_2(one_copy)     --> io__write_string("/* one_copy */ ").
 
-:- pred mlds_output_per_instance(per_instance, io__state, io__state).
-:- mode mlds_output_per_instance(in, di, uo) is det.
+:- 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_per_instance(one_copy)     --> io__write_string("static ").
-mlds_output_per_instance(per_instance) --> [].
+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 -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/03 15:40:39
@@ -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.23
diff -u -r1.23 mercury.h
--- runtime/mercury.h	2000/11/03 05:38:31	1.23
+++ runtime/mercury.h	2000/11/03 15:40:41
@@ -138,14 +138,23 @@
 ** 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[];
+
+#ifdef MR_BOOTSTRAP_RTTI_CHANGE
+  typedef const MR_EnumFunctorDesc *	MR_EnumFunctorDescPtr;
+  typedef const MR_DuFunctorDesc *	MR_DuFunctorDescPtr;
+  typedef union MR_TableNode_Union * *	MR_TableNodePtrPtr;
+  typedef MR_Box				MR_BaseTypeclassInfo;
+#else
+  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[];
+#endif
+
 
 /*
 ** XXX Currently we hard-code the declarations of the first

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