[m-dev.] for review: RTTI support for MLDS back-end

[Fergus Henderson]

Estimated hours taken: 10

Implement RTTI support for the MLDS back-end using the rtti module.

compiler/ml_base_type_info.m:
	Delete this file.

compiler/rtti_to_mlds.m:
	New file, replaces ml_base_type_info.
	This generates MLDS code from the RTTI data structures.

compiler/ml_code_gen.m:
	Don't call ml_base_type_info.

compiler/mercury_compile.m:
	Call rtti_to_mlds.
	Also add a few more comments to the list of
	imported modules.

compiler/mercury_compile.m:
compiler/type_ctor_info.m:
	Delete the unnecessary second `module_info' parameter from
	type_ctor_info_generate_rtti.

compiler/ml_code_util.m:
	Add ml_gen_proc_params_from_rtti, for use by gen_init_proc_id
	in rtti_to_mlds.
	Fix a bug where it was using Arity for both the PredArity
	and the TypeArity.

compiler/rtti.m:
compiler/rtti_out.m:
	Change the documentation for rtti_out.m to say that it
	_is_ intended to depend on LLDS.
	Move rtti_data_to_name from rtti_out.m to rtti.m,
	since that does not depend on the LLDS.
	Add rtti__name_is_exported/1, and implement
	rtti_name_linkage using that.
	Add some new fields to rtti_proc_label, for use by
	ml_gen_proc_params_from_rtti.

compiler/mlds.m:
	Add a new alternative `rtti_type(rtti_name)' to mlds__type type,
	and a new alternative `rtti_data(rtti_type_id, rtti_name)' to
	the mlds__data_name type, so we can represent the names and
	types of the RTTI data.
	Change the mlds__initializer type to make it a bit more expressive,
	so that it can represent e.g. initializers for arrays of structs,
	since this is needed for some of the RTTI data.

compiler/ml_code_util.m:
compiler/ml_elim_nested.m:
compiler/mlds_to_c.m:
	Handle the new definition of mlds__initializer,
	and the new alternatives in the rtti_name and
	mlds__data_name types. 

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.155
diff -u -d -r1.155 mercury_compile.m
--- compiler/mercury_compile.m	2000/04/02 08:09:20	1.155
+++ compiler/mercury_compile.m	2000/04/17 17:50:31
@@ -29,25 +29,42 @@
 :- import_module library, getopt, set_bbbtree, term, varset.
 :- import_module gc.
 
+	%
 	% the main compiler passes (mostly in order of execution)
+	%
+
+	% semantic analysis
 :- import_module handle_options, prog_io, prog_out, modules, module_qual.
 :- import_module equiv_type, make_hlds, typecheck, purity, polymorphism, modes.
 :- import_module switch_detection, cse_detection, det_analysis, unique_modes.
-:- import_module stratify, check_typeclass, simplify, intermod, trans_opt.
-:- import_module table_gen.
-:- import_module bytecode_gen, bytecode.
-:- import_module (lambda), termination, higher_order, accumulator, inlining.
-:- import_module deforest, dnf, magic, dead_proc_elim.
-:- import_module unused_args, lco, saved_vars, liveness.
+:- import_module stratify, simplify.
+
+	% high-level HLDS transformations
+:- import_module check_typeclass, intermod, trans_opt, table_gen, (lambda).
+:- import_module type_ctor_info, termination, higher_order, accumulator.
+:- import_module inlining, deforest, dnf, magic, dead_proc_elim.
+:- import_module unused_args, lco.
+
+	% the LLDS back-end
+:- import_module saved_vars, liveness.
 :- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
 :- import_module code_gen, optimize, export.
-:- import_module type_ctor_info, base_typeclass_info.
-:- import_module rl_gen, rl_opt, rl_out.
+:- import_module base_typeclass_info.
 :- import_module llds_common, transform_llds, llds_out.
 :- import_module continuation_info, stack_layout.
 
-:- import_module mlds, ml_code_gen, ml_elim_nested, ml_tailcall, mlds_to_c.
+	% the Aditi-RL back-end
+:- import_module rl_gen, rl_opt, rl_out.
 
+	% the bytecode back-end
+:- import_module bytecode_gen, bytecode.
+
+	% the MLDS back-end
+:- import_module mlds.
+:- import_module ml_code_gen, ml_elim_nested, ml_tailcall.
+:- import_module rtti_to_mlds.
+:- import_module mlds_to_c.
+
 	% miscellaneous compiler modules
 :- import_module prog_data, hlds_module, hlds_pred, hlds_out, llds, rl.
 :- import_module mercury_to_mercury, mercury_to_goedel.
@@ -2027,11 +2044,23 @@
 	globals__io_lookup_bool_option(verbose, Verbose),
 	globals__io_lookup_bool_option(statistics, Stats),
 	globals__io_lookup_bool_option(common_data, CommonData),
-	{ type_ctor_info__generate_rtti(HLDS0, HLDS1, TypeCtorRttiData) },
+	%
+	% Here we generate the LLDS representations for
+	% various data structures used for RTTI, type classes,
+	% and stack layouts.
+	% XXX this should perhaps be part of backend_pass
+	% rather than output_pass.
+	%
+	{ type_ctor_info__generate_rtti(HLDS0, TypeCtorRttiData) },
 	{ list__map(llds__wrap_rtti_data, TypeCtorRttiData, TypeCtorTables) },
-	{ base_typeclass_info__generate_llds(HLDS1, TypeClassInfos) },
-	{ stack_layout__generate_llds(HLDS1, HLDS, GlobalData,
+	{ base_typeclass_info__generate_llds(HLDS0, TypeClassInfos) },
+	{ stack_layout__generate_llds(HLDS0, HLDS, GlobalData,
 		PossiblyDynamicLayouts, StaticLayouts, LayoutLabels) },
+	%
+	% Here we perform some optimizations on the LLDS data.
+	% XXX this should perhaps be part of backend_pass
+	% rather than output_pass.
+	%
 	{ get_c_interface_info(HLDS, C_InterfaceInfo) },
 	{ global_data_get_all_proc_vars(GlobalData, GlobalVars) },
 	{ global_data_get_all_non_common_static_data(GlobalData,
@@ -2044,6 +2073,10 @@
 		{ CommonableData = CommonableData0 },
 		{ Procs1 = Procs0 }
 	),
+
+	%
+	% Next we put it all together and output it to one or more C files.
+	%
 	{ list__condense([CommonableData, NonCommonStaticData,
 		TypeCtorTables, TypeClassInfos, PossiblyDynamicLayouts],
 		AllData) },
@@ -2055,6 +2088,9 @@
 	{ C_InterfaceInfo = c_interface_info(_, _, _, C_ExportDecls, _) },
 	export__produce_header_file(C_ExportDecls, ModuleName),
 
+	%
+	% Finally we invoke the C compiler to compile it.
+	%
 	globals__io_lookup_bool_option(compile_to_c, CompileToC),
 	( { CompileToC = no } ->
 		mercury_compile__c_to_obj(ModuleName, NumChunks, CompileOK),
@@ -2209,15 +2245,34 @@
 
 	maybe_write_string(Verbose, "% Detecting tail calls...\n"),
 	ml_mark_tailcalls(MLDS0, MLDS1),
+	maybe_write_string(Verbose, "% done.\n"),
+	maybe_report_stats(Stats),
 
 	globals__io_lookup_bool_option(gcc_nested_functions, NestedFuncs),
 	( { NestedFuncs = no } ->
 		maybe_write_string(Verbose,
 			"% Flattening nested functions...\n"),
-		ml_elim_nested(MLDS1, MLDS)
+		ml_elim_nested(MLDS1, MLDS2)
 	;
-		{ MLDS = MLDS1 }
-	).
+		{ MLDS2 = MLDS1 }
+	),
+	maybe_write_string(Verbose, "% done.\n"),
+	maybe_report_stats(Stats),
+
+	maybe_write_string(Verbose, "% Generating RTTI data...\n"),
+	{ mercury_compile__mlds_gen_rtti_data(HLDS, MLDS2, MLDS) },
+	maybe_write_string(Verbose, "% done.\n"),
+	maybe_report_stats(Stats).
+
+:- pred mercury_compile__mlds_gen_rtti_data(module_info, mlds, mlds).
+:- mode mercury_compile__mlds_gen_rtti_data(in, in, out) is det.
+
+mercury_compile__mlds_gen_rtti_data(HLDS, MLDS0, MLDS) :-
+	type_ctor_info__generate_rtti(HLDS, TypeCtorRtti),
+	TypeCtorDefns = rtti_data_list_to_mlds(TypeCtorRtti),
+	MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0),
+	list__append(TypeCtorDefns, Defns0, Defns),
+	MLDS = mlds(ModuleName, ForeignCode, Imports, Defns).
 
 % The `--high-level-C' MLDS output pass
 
cvs diff: cannot find compiler/ml_base_type_info.m
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.32
diff -u -d -r1.32 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/03/30 05:41:47	1.32
+++ compiler/ml_code_gen.m	2000/04/17 16:56:57
@@ -599,7 +599,7 @@
 
 :- implementation.
 
-:- import_module ml_base_type_info, ml_call_gen, ml_unify_gen, ml_code_util.
+:- import_module ml_call_gen, ml_unify_gen, ml_code_util.
 :- import_module llds. % XXX needed for `code_model'.
 :- import_module export, llds_out. % XXX needed for pragma C code
 :- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
@@ -660,8 +660,10 @@
 :- pred ml_gen_types(module_info, mlds__defns, io__state, io__state).
 :- mode ml_gen_types(in, out, di, uo) is det.
 
-ml_gen_types(ModuleInfo, MLDS_BaseTypeInfoDefns) -->
-	{ ml_base_type_info__generate_mlds(ModuleInfo, MLDS_BaseTypeInfoDefns) }.
+ml_gen_types(_ModuleInfo, MLDS_TypeDefns) -->
+	% XXX currently we use a low-level data representation,
+	% so we don't map Mercury types to MLDS types.
+	{ MLDS_TypeDefns = [] }.
 
 %-----------------------------------------------------------------------------%
 %
@@ -1813,7 +1815,10 @@
 		string__append_list(["*", MangledModuleName, "__",
 			MangledVarName], Var_ArgName)
 	;
-		sorry("complicated pragma c_code")
+		% XXX don't complain until run-time
+		% sorry("complicated pragma c_code")
+		Var_ArgName =
+		"*(fatal_error(""complicated pragma c_code""),(Word *)0)"
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.5
diff -u -d -r1.5 ml_code_util.m
--- compiler/ml_code_util.m	2000/04/17 10:32:08	1.5
+++ compiler/ml_code_util.m	2000/04/17 21:35:49
@@ -101,6 +101,8 @@
 	%
 :- func ml_gen_proc_params(module_info, pred_id, proc_id) = mlds__func_params.
 
+:- func ml_gen_proc_params_from_rtti(rtti_proc_label) = mlds__func_params.
+
 	% Generate the function prototype for a procedure with the
 	% given argument types, modes, and code model.
 	%
@@ -616,17 +618,52 @@
 	FuncParams = ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes,
 		HeadModes, CodeModel).
 
+	% As above, but from the rtti_proc_id rather than
+	% from the module_info, pred_id, and proc_id.
+	%
+ml_gen_proc_params_from_rtti(RttiProcId) = FuncParams :-
+	VarSet = RttiProcId^proc_varset,
+	HeadVars = RttiProcId^proc_headvars,
+	ArgTypes = RttiProcId^arg_types,
+	ArgModes = RttiProcId^proc_arg_modes,
+	CodeModel = RttiProcId^proc_interface_code_model,
+
+	HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
+
+	% XXX The setting of `UseNestedFunctions' to `no' is wrong!
+	%     We ought to thread the globals through here.
+	%     However, the UseNestedFunctions setting here
+	%     is only used to compute the source type for a cast,
+	%     and our current back-ends don't make use of that,
+	%     so currently it's not a big deal.
+	UseNestedFunctions = no,
+
+	FuncParams = ml_gen_params_base(UseNestedFunctions, HeadVarNames,
+		ArgTypes, ArgModes, CodeModel).
+	
 	% Generate the function prototype for a procedure with the
 	% given argument types, modes, and code model.
 	%
 ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, CodeModel) =
 		FuncParams :-
+	modes_to_arg_modes(ModuleInfo, HeadModes, HeadTypes, ArgModes),
+	module_info_globals(ModuleInfo, Globals),
+	globals__lookup_bool_option(Globals, gcc_nested_functions,
+		NestedFunctions),
+	FuncParams = ml_gen_params_base(NestedFunctions, HeadVarNames,
+		HeadTypes, ArgModes, CodeModel).
+
+:- func ml_gen_params_base(bool, list(string), list(prog_type),
+		list(arg_mode), code_model) = mlds__func_params.
+
+ml_gen_params_base(NestedFunctions, HeadVarNames, HeadTypes, HeadModes,
+		CodeModel) = FuncParams :-
 	( CodeModel = model_semi ->
 		RetTypes = [mlds__native_bool_type]
 	;
 		RetTypes = []
 	),
-	ml_gen_arg_decls(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
+	ml_gen_arg_decls(HeadVarNames, HeadTypes, HeadModes,
 		FuncArgs0),
 	( CodeModel = model_non ->
 		ContType = mlds__cont_type,
@@ -636,9 +673,7 @@
 		ContEnvName = data(var("cont_env_ptr")),
 		ContEnvArg = ContEnvName - ContEnvType,
 		(
-			module_info_globals(ModuleInfo, Globals),
-			globals__lookup_bool_option(Globals,
-				gcc_nested_functions, yes)
+			NestedFunctions = yes
 		->
 			FuncArgs = list__append(FuncArgs0, [ContArg])
 		;
@@ -653,11 +688,11 @@
 	% Given the argument variable names, and corresponding lists of their
 	% types and modes, generate the MLDS argument list declaration.
 	%
-:- pred ml_gen_arg_decls(module_info, list(mlds__var_name), list(prog_type),
-		list(mode), mlds__arguments).
-:- mode ml_gen_arg_decls(in, in, in, in, out) is det.
+:- pred ml_gen_arg_decls(list(mlds__var_name), list(prog_type), list(arg_mode),
+		mlds__arguments).
+:- mode ml_gen_arg_decls(in, in, in, out) is det.
 
-ml_gen_arg_decls(ModuleInfo, HeadVars, HeadTypes, HeadModes, FuncArgs) :-
+ml_gen_arg_decls(HeadVars, HeadTypes, HeadModes, FuncArgs) :-
 	(
 		HeadVars = [], HeadTypes = [], HeadModes = []
 	->
@@ -667,12 +702,12 @@
 		HeadTypes = [Type | Types],
 		HeadModes = [Mode | Modes]
 	->
-		ml_gen_arg_decls(ModuleInfo, Vars, Types, Modes, FuncArgs0),
+		ml_gen_arg_decls(Vars, Types, Modes, FuncArgs0),
 		% exclude types such as io__state, etc.
 		( type_util__is_dummy_argument_type(Type) ->
 			FuncArgs = FuncArgs0
 		;
-			ml_gen_arg_decl(ModuleInfo, Var, Type, Mode, FuncArg),
+			ml_gen_arg_decl(Var, Type, Mode, FuncArg),
 			FuncArgs = [FuncArg | FuncArgs0]
 		)
 	;
@@ -682,13 +717,13 @@
 	% Given an argument variable, and its type and mode,
 	% generate an MLDS argument declaration for it.
 	%
-:- pred ml_gen_arg_decl(module_info, var_name, prog_type, mode,
+:- pred ml_gen_arg_decl(var_name, prog_type, arg_mode,
 			pair(mlds__entity_name, mlds__type)).
-:- mode ml_gen_arg_decl(in, in, in, in, out) is det.
+:- mode ml_gen_arg_decl(in, in, in, out) is det.
 
-ml_gen_arg_decl(ModuleInfo, Var, Type, Mode, FuncArg) :-
+ml_gen_arg_decl(Var, Type, ArgMode, FuncArg) :-
 	MLDS_Type = mercury_type_to_mlds_type(Type),
-	( \+ mode_to_arg_mode(ModuleInfo, Mode, Type, top_in) ->
+	( ArgMode \= top_in ->
 		MLDS_ArgType = mlds__ptr_type(MLDS_Type)
 	;
 		MLDS_ArgType = MLDS_Type
@@ -754,8 +789,10 @@
 
 ml_gen_pred_label_from_rtti(RttiProcLabel, MLDS_PredLabel, MLDS_Module) :-
 	RttiProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,	
-		PredName, Arity, ArgTypes, _PredId, ProcId, IsImported,
-		_IsPseudoImported, _IsExported, IsSpecialPredInstance),
+		PredName, PredArity, ArgTypes, _PredId, ProcId,
+		_VarSet, _HeadVars, _ArgModes, _CodeModel,
+		IsImported, _IsPseudoImported, _IsExported,
+		IsSpecialPredInstance),
 	(
 		IsSpecialPredInstance = yes
 	->
@@ -765,7 +802,7 @@
 			% All type_ids here should be module qualified,
 			% since builtin types are handled separately in
 			% polymorphism.m.
-			TypeId = qualified(TypeModule, TypeName) - Arity
+			TypeId = qualified(TypeModule, TypeName) - TypeArity
 		->
 			(
 				ThisModule \= TypeModule,
@@ -779,7 +816,7 @@
 				DeclaringModule = no
 			),
 			MLDS_PredLabel = special_pred(PredName,
-				DeclaringModule, TypeName, Arity),
+				DeclaringModule, TypeName, TypeArity),
 			MLDS_Module = mercury_module_name_to_mlds(TypeModule)
 		;
 			string__append_list(["ml_gen_pred_label:\n",
@@ -803,7 +840,7 @@
 			MaybeDeclaringModule = no
 		),
 		MLDS_PredLabel = pred(PredOrFunc, MaybeDeclaringModule,
-				PredName, Arity),
+				PredName, PredArity),
 		MLDS_Module = mercury_module_name_to_mlds(PredModule)
 	).
 
@@ -890,8 +927,7 @@
 	%
 ml_gen_mlds_var_decl(DataName, MLDS_Type, Context) = MLDS_Defn :-
 	Name = data(DataName),
-	MaybeInitializer = no,
-	Defn = data(MLDS_Type, MaybeInitializer),
+	Defn = data(MLDS_Type, no_initializer),
 	DeclFlags = ml_gen_var_decl_flags,
 	MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
 
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.18
diff -u -d -r1.18 mlds.m
--- compiler/mlds.m	2000/03/30 05:41:51	1.18
+++ compiler/mlds.m	2000/04/17 16:59:17
@@ -261,7 +261,7 @@
 
 :- interface.
 
-:- import_module hlds_pred, hlds_data, prog_data, builtin_ops.
+:- import_module hlds_pred, hlds_data, prog_data, builtin_ops, rtti.
 
 % To avoid duplication, we use a few things from the LLDS.
 % It would be nice to avoid this dependency...
@@ -380,7 +380,7 @@
 		% constants or variables
 	--->	mlds__data(
 			mlds__type,
-			maybe(mlds__initializer)
+			mlds__initializer
 		)
 		% functions
 	;	mlds__function(
@@ -395,7 +395,12 @@
 			mlds__class_defn
 		).
 
-:- type mlds__initializer == list(mlds__rval).
+:- type mlds__initializer
+	--->	init_obj(mlds__rval)
+	;	init_struct(list(mlds__initializer))
+	;	init_array(list(mlds__initializer))
+	;	no_initializer
+	.
 
 :- type mlds__func_params
 	---> mlds__func_params(
@@ -497,7 +502,9 @@
 		% closures for higher-order code.
 	;	mlds__generic_env_ptr_type
 
-	;	mlds__base_type_info_type.
+	;	mlds__base_type_info_type
+	
+	;	mlds__rtti_type(rtti_name).
 
 :- type mercury_type == prog_data__type.
 
@@ -1005,8 +1012,10 @@
 			% global constants.  These are called "common"
 			% because they may be common sub-expressions.
 	%
-	% Stuff for handling polymorphism and type classes
+	% Stuff for handling polymorphism and type classes,
+	% and RTTI.
 	%
+	;	rtti(rtti_type_id, rtti_name)
 	;	type_ctor(mlds__base_data, string, arity)
 			% base_data, type name, type arity
 	;	base_typeclass_info(hlds_data__class_id, string)
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.23
diff -u -d -r1.23 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/03/30 05:41:52	1.23
+++ compiler/mlds_to_c.m	2000/04/17 17:27:32
@@ -32,11 +32,13 @@
 
 :- implementation.
 
-:- import_module llds. % XXX needed for C interface types
-:- import_module llds_out. % XXX needed for llds_out__name_mangle.
+:- import_module llds.		% XXX needed for C interface types
+:- import_module llds_out.	% XXX needed for llds_out__name_mangle.
+:- import_module rtti.		% for rtti__addr_to_string.
+:- import_module rtti_to_mlds.	% for mlds_rtti_type_name.
+:- import_module hlds_pred.	% for `pred_proc_id'.
 :- import_module globals, options, passes_aux.
 :- import_module builtin_ops, c_util, modules.
-:- import_module hlds_pred. % for `pred_proc_id'.
 :- import_module prog_data, prog_out.
 
 :- import_module bool, int, string, list, term, std_util, require.
@@ -356,7 +358,7 @@
 
 mlds_output_decl_body(Indent, Name, DefnBody) -->
 	(
-		{ DefnBody = mlds__data(Type, _MaybeInitializer) },
+		{ DefnBody = mlds__data(Type, _Initializer) },
 		mlds_output_data_decl(Name, Type)
 	;
 		{ DefnBody = mlds__function(MaybePredProcId, Signature,
@@ -375,8 +377,8 @@
 
 mlds_output_defn_body(Indent, Name, Context, DefnBody) -->
 	(
-		{ DefnBody = mlds__data(Type, MaybeInitializer) },
-		mlds_output_data_defn(Name, Type, MaybeInitializer)
+		{ DefnBody = mlds__data(Type, Initializer) },
+		mlds_output_data_defn(Name, Type, Initializer)
 	;
 		{ DefnBody = mlds__function(MaybePredProcId, Signature,
 			MaybeBody) },
@@ -431,13 +433,12 @@
 	mlds_output_fully_qualified_name(Name).
 
 :- pred mlds_output_data_defn(mlds__qualified_entity_name, mlds__type,
-			maybe(mlds__initializer), io__state, io__state).
+			mlds__initializer, io__state, io__state).
 :- mode mlds_output_data_defn(in, in, in, di, uo) is det.
 
-mlds_output_data_defn(Name, Type, MaybeInitializer) -->
+mlds_output_data_defn(Name, Type, Initializer) -->
 	mlds_output_data_decl(Name, Type),
-	mlds_output_maybe(MaybeInitializer,
-		mlds_output_initializer(Type)),
+	mlds_output_initializer(Type, Initializer),
 	io__write_string(";\n").
 
 :- pred mlds_output_maybe(maybe(T), pred(T, io__state, io__state),
@@ -456,15 +457,28 @@
 :- mode mlds_output_initializer(in, in, di, uo) is det.
 
 mlds_output_initializer(_Type, Initializer) -->
-	( { Initializer = [SingleValue] } ->
-		io__write_string(" = "),
-		mlds_output_rval(SingleValue)
+	( { Initializer = no_initializer } ->
+		[]
 	;
-		io__write_string(" = {\n\t\t"),
-		io__write_list(Initializer, ",\n\t\t", mlds_output_rval),
-		io__write_string("}")
+		io__write_string(" = "),
+		mlds_output_initializer_body(Initializer)
 	).
 
+:- pred mlds_output_initializer_body(mlds__initializer, io__state, io__state).
+:- mode mlds_output_initializer_body(in, di, uo) is det.
+
+mlds_output_initializer_body(no_initializer) --> [].
+mlds_output_initializer_body(init_obj(Rval)) -->
+	mlds_output_rval(Rval).
+mlds_output_initializer_body(init_struct(FieldInits)) -->
+	io__write_string("{\n\t\t"),
+	io__write_list(FieldInits, ",\n\t\t", mlds_output_initializer_body),
+	io__write_string("}").
+mlds_output_initializer_body(init_array(ElementInits)) -->
+	io__write_string("{\n\t\t"),
+	io__write_list(ElementInits, ",\n\t\t", mlds_output_initializer_body),
+	io__write_string("}").
+
 %-----------------------------------------------------------------------------%
 %
 % Code to output function declarations/definitions
@@ -739,6 +753,9 @@
 mlds_output_data_name(common(Num)) -->
 	io__write_string("common_"),
 	io__write_int(Num).
+mlds_output_data_name(rtti(RttiTypeId, RttiName)) -->
+	{ rtti__addr_to_string(RttiTypeId, RttiName, RttiAddrName) },
+	io__write_string(RttiAddrName).
 mlds_output_data_name(type_ctor(BaseData, Name, Arity)) -->
 	{ llds_out__name_mangle(Name, MangledName) },
 	io__write_string("base_type_"),
@@ -820,6 +837,9 @@
 	;
 		io__write_string("jmp_buf")
 	).
+mlds_output_type(mlds__rtti_type(RttiName)) -->
+	io__write_string("MR_"),
+	io__write_string(mlds_rtti_type_name(RttiName)).
 
 %-----------------------------------------------------------------------------%
 %
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.5
diff -u -d -r1.5 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2000/03/30 05:41:50	1.5
+++ compiler/ml_elim_nested.m	2000/04/17 16:47:07
@@ -330,8 +330,7 @@
 	EnvVarName = data(var("env")),
 	EnvVarFlags = env_decl_flags,
 	EnvVarType = mlds__class_type(qual(ModuleName, EnvClassName), 0),
-	EnvVarInitializer = no,
-	EnvVarDefnBody = mlds__data(EnvVarType, EnvVarInitializer),
+	EnvVarDefnBody = mlds__data(EnvVarType, no_initializer),
 	EnvVarDecl = mlds__defn(EnvVarName, Context, EnvVarFlags, EnvVarDefnBody),
 
 	%
@@ -405,8 +404,7 @@
 	EnvPtrVarName = data(var("env_ptr")),
 	EnvPtrVarFlags = env_decl_flags,
 	EnvPtrVarType = mlds__ptr_type(EnvVarType),
-	EnvPtrVarInitializer = no,
-	EnvPtrVarDefnBody = mlds__data(EnvPtrVarType, EnvPtrVarInitializer),
+	EnvPtrVarDefnBody = mlds__data(EnvPtrVarType, no_initializer),
 	EnvPtrVarDecl = mlds__defn(EnvPtrVarName, Context, EnvPtrVarFlags,
 		EnvPtrVarDefnBody),
 
@@ -431,8 +429,7 @@
 
 ml_conv_arg_to_var(Context, Name - Type, LocalVar) :-
 	Flags = env_decl_flags,
-	Initializer = no,
-	DefnBody = mlds__data(Type, Initializer),
+	DefnBody = mlds__data(Type, no_initializer),
 	LocalVar = mlds__defn(Name, Context, Flags, DefnBody).
 
 	% Return the declaration flags appropriate for a local variable.
@@ -1079,8 +1076,8 @@
 :- pred defn_body_contains_var(mlds__entity_defn, mlds__var).
 :- mode defn_body_contains_var(in, in) is semidet.
 
-defn_body_contains_var(mlds__data(_Type, yes(Initializer)), Name) :-
-	rvals_contains_var(Initializer, Name).
+defn_body_contains_var(mlds__data(_Type, Initializer), Name) :-
+	initializer_contains_var(Initializer, Name).
 defn_body_contains_var(mlds__function(_PredProcId, _Params, MaybeBody),
 		Name) :-
 	maybe_statement_contains_var(MaybeBody, Name).
@@ -1088,6 +1085,19 @@
 	ClassDefn = mlds__class_defn(_Kind, _Imports, _Inherits, _Implements,
 		FieldDefns),
 	defns_contains_var(FieldDefns, Name).
+
+:- pred initializer_contains_var(mlds__initializer, mlds__var).
+:- mode initializer_contains_var(in, in) is semidet.
+
+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) :-
+	list__member(Init, Inits),
+	initializer_contains_var(Init, Name).
+initializer_contains_var(init_array(Inits), Name) :-
+	list__member(Init, Inits),
+	initializer_contains_var(Init, Name).
 
 :- pred maybe_statement_contains_var(maybe(mlds__statement), mlds__var).
 :- mode maybe_statement_contains_var(in, in) is semidet.
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.4
diff -u -d -r1.4 rtti.m
--- compiler/rtti.m	2000/04/17 10:32:09	1.4
+++ compiler/rtti.m	2000/04/17 20:39:32
@@ -24,6 +24,7 @@
 
 :- interface.
 
+:- import_module llds.	% XXX for code_model
 :- import_module hlds_module, hlds_pred.
 :- import_module prog_data, pseudo_type_info.
 
@@ -317,6 +318,16 @@
 	;	pseudo_type_info(pseudo_type_info)
 	;	type_hashcons_pointer.
 
+	% convert a rtti_data to an rtti_type_id and an rtti_name.
+	% This calls error/1 if the argument is a type_var/1 rtti_data,
+	% since there is no rtti_type_id to return in that case.
+:- pred rtti_data_to_name(rtti_data::in, rtti_type_id::out, rtti_name::out)
+	is det.
+
+	% return yes iff the specified rtti_name should be exported
+	% for use by other modules.
+:- func rtti_name_is_exported(rtti_name) = bool.
+
 	% The rtti_proc_label type holds all the information about a procedure
 	% that we need to compute the entry label for that procedure
 	% in the target language (the llds__code_addr or mlds__code_addr).
@@ -330,6 +341,10 @@
 			arg_types		::	list(type),
 			pred_id			::	pred_id,
 			proc_id			::	proc_id,
+			proc_varset		::	prog_varset,
+			proc_headvars		::	list(prog_var),
+			proc_arg_modes		::	list(arg_mode),
+			proc_interface_code_model ::	code_model,
 			%
 			% The following booleans hold values computed from the
 			% pred_info, using procedures
@@ -354,49 +369,112 @@
 		).
 
 	% Construct an rtti_proc_label for a given procedure.
-
 :- func rtti__make_proc_label(module_info, pred_id, proc_id) = rtti_proc_label.
 
 	% Return the C variable name of the RTTI data structure identified
 	% by the input arguments.
 	% XXX this should be in rtti_out.m
-
 :- pred rtti__addr_to_string(rtti_type_id::in, rtti_name::in, string::out)
 	is det.
 
 	% Return the C representation of a secondary tag location.
 	% XXX this should be in rtti_out.m
-
 :- pred rtti__sectag_locn_to_string(sectag_locn::in, string::out) is det.
 
 	% Return the C representation of a type_ctor_rep value.
 	% XXX this should be in rtti_out.m
-
 :- pred rtti__type_ctor_rep_to_string(type_ctor_rep::in, string::out) is det.
 
 :- implementation.
 
-:- import_module code_util.	% for code_util__compiler_defined
+:- import_module code_util.	% for code_util__compiler_generated
 :- import_module llds_out.	% for name_mangle and sym_name_mangle
-:- import_module hlds_data, type_util.
+:- import_module hlds_data, type_util, mode_util.
 
 :- import_module string, require.
 
+rtti_data_to_name(exist_locns(RttiTypeId, Ordinal, _),
+	RttiTypeId, exist_locns(Ordinal)).
+rtti_data_to_name(exist_info(RttiTypeId, Ordinal, _, _, _, _),
+	RttiTypeId, exist_info(Ordinal)).
+rtti_data_to_name(field_names(RttiTypeId, Ordinal, _),
+	RttiTypeId, field_names(Ordinal)).
+rtti_data_to_name(field_types(RttiTypeId, Ordinal, _),
+	RttiTypeId, field_types(Ordinal)).
+rtti_data_to_name(enum_functor_desc(RttiTypeId, _, Ordinal),
+	RttiTypeId, enum_functor_desc(Ordinal)).
+rtti_data_to_name(notag_functor_desc(RttiTypeId, _, _),
+	RttiTypeId, notag_functor_desc).
+rtti_data_to_name(du_functor_desc(RttiTypeId, _,_,_,_, Ordinal, _,_,_,_,_),
+	RttiTypeId, du_functor_desc(Ordinal)).
+rtti_data_to_name(enum_name_ordered_table(RttiTypeId, _),
+	RttiTypeId, enum_name_ordered_table).
+rtti_data_to_name(enum_value_ordered_table(RttiTypeId, _),
+	RttiTypeId, enum_value_ordered_table).
+rtti_data_to_name(du_name_ordered_table(RttiTypeId, _),
+	RttiTypeId, du_name_ordered_table).
+rtti_data_to_name(du_stag_ordered_table(RttiTypeId, Ptag, _),
+	RttiTypeId, du_stag_ordered_table(Ptag)).
+rtti_data_to_name(du_ptag_ordered_table(RttiTypeId, _),
+	RttiTypeId, du_ptag_ordered_table).
+rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_),
+	RttiTypeId, type_ctor_info).
+rtti_data_to_name(pseudo_type_info(PseudoTypeInfo), RttiTypeId,
+		pseudo_type_info(PseudoTypeInfo)) :-
+	RttiTypeId = pti_get_rtti_type_id(PseudoTypeInfo).
+
+:- func pti_get_rtti_type_id(pseudo_type_info) = rtti_type_id.
+pti_get_rtti_type_id(type_ctor_info(RttiTypeId)) = RttiTypeId.
+pti_get_rtti_type_id(type_info(RttiTypeId, _)) = RttiTypeId.
+pti_get_rtti_type_id(higher_order_type_info(RttiTypeId, _, _)) = RttiTypeId.
+pti_get_rtti_type_id(type_var(_)) = _ :-
+	error("rtti_data_to_name: type_var").
+
+rtti_name_is_exported(exist_locns(_))		= no.
+rtti_name_is_exported(exist_info(_))            = no.
+rtti_name_is_exported(field_names(_))           = no.
+rtti_name_is_exported(field_types(_))           = no.
+rtti_name_is_exported(enum_functor_desc(_))     = no.
+rtti_name_is_exported(notag_functor_desc)       = no.
+rtti_name_is_exported(du_functor_desc(_))       = no.
+rtti_name_is_exported(enum_name_ordered_table)  = no.
+rtti_name_is_exported(enum_value_ordered_table) = no.
+rtti_name_is_exported(du_name_ordered_table)    = no.
+rtti_name_is_exported(du_stag_ordered_table(_)) = no.
+rtti_name_is_exported(du_ptag_ordered_table)    = no.
+rtti_name_is_exported(type_ctor_info)           = yes.
+rtti_name_is_exported(pseudo_type_info(Pseudo)) =
+	pseudo_type_info_is_exported(Pseudo).
+rtti_name_is_exported(type_hashcons_pointer)    = no.
+
+:- func pseudo_type_info_is_exported(pseudo_type_info) = bool.
+pseudo_type_info_is_exported(type_var(_))			= no.
+pseudo_type_info_is_exported(type_ctor_info(_))			= yes.
+pseudo_type_info_is_exported(type_info(_, _))			= no.
+pseudo_type_info_is_exported(higher_order_type_info(_, _, _))	= no.
+
 rtti__make_proc_label(ModuleInfo, PredId, ProcId) = ProcLabel :-
 	module_info_name(ModuleInfo, ThisModule),
-	module_info_pred_info(ModuleInfo, PredId, PredInfo),
+	module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+		PredInfo, ProcInfo),
 	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
 	pred_info_module(PredInfo, PredModule),
 	pred_info_name(PredInfo, PredName),
 	pred_info_arity(PredInfo, Arity),
 	pred_info_arg_types(PredInfo, ArgTypes),
+	proc_info_varset(ProcInfo, ProcVarSet),
+	proc_info_headvars(ProcInfo, ProcHeadVars),
+	proc_info_argmodes(ProcInfo, ProcModes),
+	proc_info_interface_code_model(ProcInfo, ProcCodeModel),
+	modes_to_arg_modes(ModuleInfo, ProcModes, ArgTypes, ProcArgModes),
 	IsImported = (pred_info_is_imported(PredInfo) -> yes ; no),
 	IsPseudoImp = (pred_info_is_pseudo_imported(PredInfo) -> yes ; no),
-	IsExported = (pred_info_is_exported(PredInfo) -> yes ; no),
+	IsExported = (procedure_is_exported(PredInfo, ProcId) -> yes ; no),
 	IsSpecialPredInstance =
 		(code_util__compiler_generated(PredInfo) -> yes ; no),
 	ProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
 		PredName, Arity, ArgTypes, PredId, ProcId,
+		ProcVarSet, ProcHeadVars, ProcArgModes, ProcCodeModel,
 		IsImported, IsPseudoImp, IsExported, IsSpecialPredInstance).
 
 rtti__addr_to_string(RttiTypeId, RttiName, Str) :-
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.8
diff -u -d -r1.8 rtti_out.m
--- compiler/rtti_out.m	2000/04/17 10:32:09	1.8
+++ compiler/rtti_out.m	2000/04/17 17:33:04
@@ -4,14 +4,19 @@
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
 %
-% Definitions of data structures for representing run-time type information
-% within the compiler, and code to output them.
+% This module contains code to output the RTTI data structures
+% defined in rtti.m as C code.
 %
-% Eventually, this module will be independent of whether we are compiling
-% to LLDS or MLDS. For the time being, it depends on LLDS.
+% This module is part of the LLDS back-end.  The decl_set data type
+% that it uses, which is defined in llds_out.m, represents a set of LLDS
+% declarations, and thus depends on the LLDS.  Also the code to output
+% code_addrs depends on the LLDS.
 %
-% Author: zs.
-
+% The MLDS back-end does not use this module; instead it converts the RTTI
+% data structures to MLDS (and then to C or Java, etc.).
+%
+% Main author: zs.
+%
 %-----------------------------------------------------------------------------%
 
 :- module rtti_out.
@@ -51,12 +56,6 @@
 :- pred output_rtti_addr_storage_type_name(rtti_type_id::in, rtti_name::in,
 	bool::in, io__state::di, io__state::uo) is det.
 
-	% convert a rtti_data to an rtti_type_id and an rtti_name.
-	% This calls error/1 if the argument is a type_var/1 rtti_data,
-	% since there is no rtti_type_id to return in that case.
-:- pred rtti_data_to_name(rtti_data::in, rtti_type_id::out, rtti_name::out)
-	is det.
-
         % Return true iff the given type of RTTI data structure includes
 	% code addresses.
 :- pred rtti_name_would_include_code_addr(rtti_name::in, bool::out) is det.
@@ -468,43 +467,6 @@
 			DeclSet0, DeclSet)
 	).
 
-rtti_data_to_name(exist_locns(RttiTypeId, Ordinal, _),
-	RttiTypeId, exist_locns(Ordinal)).
-rtti_data_to_name(exist_info(RttiTypeId, Ordinal, _, _, _, _),
-	RttiTypeId, exist_info(Ordinal)).
-rtti_data_to_name(field_names(RttiTypeId, Ordinal, _),
-	RttiTypeId, field_names(Ordinal)).
-rtti_data_to_name(field_types(RttiTypeId, Ordinal, _),
-	RttiTypeId, field_types(Ordinal)).
-rtti_data_to_name(enum_functor_desc(RttiTypeId, _, Ordinal),
-	RttiTypeId, enum_functor_desc(Ordinal)).
-rtti_data_to_name(notag_functor_desc(RttiTypeId, _, _),
-	RttiTypeId, notag_functor_desc).
-rtti_data_to_name(du_functor_desc(RttiTypeId, _,_,_,_, Ordinal, _,_,_,_,_),
-	RttiTypeId, du_functor_desc(Ordinal)).
-rtti_data_to_name(enum_name_ordered_table(RttiTypeId, _),
-	RttiTypeId, enum_name_ordered_table).
-rtti_data_to_name(enum_value_ordered_table(RttiTypeId, _),
-	RttiTypeId, enum_value_ordered_table).
-rtti_data_to_name(du_name_ordered_table(RttiTypeId, _),
-	RttiTypeId, du_name_ordered_table).
-rtti_data_to_name(du_stag_ordered_table(RttiTypeId, Ptag, _),
-	RttiTypeId, du_stag_ordered_table(Ptag)).
-rtti_data_to_name(du_ptag_ordered_table(RttiTypeId, _),
-	RttiTypeId, du_ptag_ordered_table).
-rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_),
-	RttiTypeId, type_ctor_info).
-rtti_data_to_name(pseudo_type_info(PseudoTypeInfo), RttiTypeId,
-		pseudo_type_info(PseudoTypeInfo)) :-
-	RttiTypeId = pti_get_rtti_type_id(PseudoTypeInfo).
-
-:- func pti_get_rtti_type_id(pseudo_type_info) = rtti_type_id.
-pti_get_rtti_type_id(type_ctor_info(RttiTypeId)) = RttiTypeId.
-pti_get_rtti_type_id(type_info(RttiTypeId, _)) = RttiTypeId.
-pti_get_rtti_type_id(higher_order_type_info(RttiTypeId, _, _)) = RttiTypeId.
-pti_get_rtti_type_id(type_var(_)) = _ :-
-	error("rtti_data_to_name: type_var").
-
 %-----------------------------------------------------------------------------%
 
 :- pred output_generic_rtti_data_decl(rtti_type_id::in, rtti_name::in,
@@ -857,27 +819,11 @@
 pseudo_type_info_would_incl_code_addr(type_info(_, _))			= no.
 pseudo_type_info_would_incl_code_addr(higher_order_type_info(_, _, _))	= no.
 
-rtti_name_linkage(exist_locns(_),            static).
-rtti_name_linkage(exist_info(_),             static).
-rtti_name_linkage(field_names(_),            static).
-rtti_name_linkage(field_types(_),            static).
-rtti_name_linkage(enum_functor_desc(_),      static).
-rtti_name_linkage(notag_functor_desc,        static).
-rtti_name_linkage(du_functor_desc(_),        static).
-rtti_name_linkage(enum_name_ordered_table,   static).
-rtti_name_linkage(enum_value_ordered_table,  static).
-rtti_name_linkage(du_name_ordered_table,     static).
-rtti_name_linkage(du_stag_ordered_table(_),  static).
-rtti_name_linkage(du_ptag_ordered_table,     static).
-rtti_name_linkage(type_ctor_info,            extern).
-rtti_name_linkage(pseudo_type_info(Pseudo),  pseudo_type_info_linkage(Pseudo)).
-rtti_name_linkage(type_hashcons_pointer,     static).
-
-:- func pseudo_type_info_linkage(pseudo_type_info) = linkage.
-pseudo_type_info_linkage(type_var(_))				= static.
-pseudo_type_info_linkage(type_ctor_info(_))			= extern.
-pseudo_type_info_linkage(type_info(_, _))			= static.
-pseudo_type_info_linkage(higher_order_type_info(_, _, _))	= static.
+rtti_name_linkage(RttiName, Linkage) :-
+	Exported = rtti_name_is_exported(RttiName),
+	( Exported = yes, Linkage = extern
+	; Exported = no, Linkage = static
+        ).
 
 rtti_name_c_type(exist_locns(_),           "MR_DuExistLocn", "[]").
 rtti_name_c_type(exist_info(_),            "MR_DuExistInfo", "").
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: rtti_to_mlds.m
diff -N rtti_to_mlds.m
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ rtti_to_mlds.m	Tue Apr 18 05:41:59 2000
@@ -0,0 +1,436 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% rtti_to_mlds.m: convert RTTI data structures to MLDS.
+% Author: fjh
+%
+% 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
+% for handling RTTI, polymorphism, and typeclasses.
+%
+%-----------------------------------------------------------------------------%
+
+:- module rtti_to_mlds.
+:- interface.
+:- import_module rtti, mlds.
+:- import_module list.
+
+	% return a list of MLDS definitions for the given rtti_data list.
+:- func rtti_data_list_to_mlds(list(rtti_data)) = mlds__defns.
+
+	% return a name, consisting only of alphabetic characters,
+	% that would be suitable for the type name for the type
+	% of the given rtti_name.
+:- func mlds_rtti_type_name(rtti_name) = string.
+
+:- implementation.
+:- import_module pseudo_type_info, ml_code_util, prog_util, prog_out.
+:- import_module bool, list, std_util, string, term, require.
+
+rtti_data_list_to_mlds(RttiDatas) =
+	list__condense(list__map(rtti_data_to_mlds, RttiDatas)).
+
+	% return a list of MLDS definitions for the given rtti_data.
+:- func rtti_data_to_mlds(rtti_data) = mlds__defns.
+rtti_data_to_mlds(RttiData) = MLDS_Defns :-
+	( RttiData = pseudo_type_info(type_var(_)) ->
+		% These just get represented as integers,
+		% so we don't need to define them.
+		% Also rtti_data_to_name/3 does not handle this case.
+		MLDS_Defns = []
+    	;
+		%
+		% Generate the name
+		%
+		rtti_data_to_name(RttiData, RttiTypeId, RttiName),
+		Name = data(rtti(RttiTypeId, RttiName)),
+
+		%
+		% Generate the context
+		%
+		% XXX the rtti_data ought to include a prog_context
+		% (the context of the corresponding type definition).
+		term__context_init(Context),
+		MLDS_Context = mlds__make_context(Context),
+
+		%
+		% Generate the declaration flags
+		%
+		Exported = rtti_name_is_exported(RttiName),
+		Flags = rtti_data_decl_flags(Exported),
+
+		%
+		% Generate the declaration body,
+		% i.e. the type and the initializer
+		%
+		MLDS_Type = rtti_type(RttiName),
+		Initializer = gen_init_rtti_data_defn(RttiData),
+		DefnBody = mlds__data(MLDS_Type, Initializer),
+
+		%
+		% put it all together
+		%
+		MLDS_Defn = mlds__defn(Name, MLDS_Context, Flags, DefnBody),
+		MLDS_Defns = [MLDS_Defn]
+	).
+
+
+	% Return the declaration flags appropriate for an rtti_data.
+	%
+:- func rtti_data_decl_flags(bool) = mlds__decl_flags.
+rtti_data_decl_flags(Exported) = MLDS_DeclFlags :-
+	( Exported = yes ->
+		Access = public
+	;
+		Access = private
+	),
+	PerInstance = per_instance,
+	Virtuality = non_virtual,
+	Finality = overridable,
+	Constness = const,
+	Abstractness = concrete,
+	MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+		Virtuality, Finality, Constness, Abstractness).
+
+%-----------------------------------------------------------------------------%
+
+	% Return an MLDS initializer for the given RTTI definition.
+:- func gen_init_rtti_data_defn(rtti_data) = mlds__initializer.
+
+gen_init_rtti_data_defn(exist_locns(_RttiTypeId, _Ordinal, Locns)) =
+	gen_init_array(gen_init_exist_locn, Locns).
+gen_init_rtti_data_defn(exist_info(RttiTypeId, _Ordinal, Plain, InTci, Tci,
+		Locns)) =
+	init_struct([
+		gen_init_int(Plain),
+		gen_init_int(InTci),
+		gen_init_int(Tci),
+		gen_init_rtti_name(RttiTypeId, Locns)
+	]).
+gen_init_rtti_data_defn(field_names(_RttiTypeId, _Ordinal, MaybeNames)) =
+	gen_init_array(gen_init_maybe(gen_init_string), MaybeNames).
+gen_init_rtti_data_defn(field_types(_RttiTypeId, _Ordinal, Types)) =
+	gen_init_array(gen_init_cast_rtti_data, Types).
+gen_init_rtti_data_defn(enum_functor_desc(_RttiTypeId, FunctorName, Ordinal)) =
+	init_struct([
+		gen_init_string(FunctorName),
+		gen_init_int(Ordinal)
+	]).
+gen_init_rtti_data_defn(notag_functor_desc(_RttiTypeId, FunctorName, ArgType)) =
+	init_struct([
+		gen_init_string(FunctorName),
+		gen_init_cast_rtti_data(ArgType)
+	]).
+gen_init_rtti_data_defn(du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
+		Locn, Ordinal, Arity, ContainsVarBitVector, ArgTypes,
+		MaybeNames, MaybeExist)) =
+	init_struct([
+		gen_init_string(FunctorName),
+		gen_init_int(Arity),
+		gen_init_int(ContainsVarBitVector),
+		gen_init_sectag_locn(Locn),
+		gen_init_int(Ptag),
+		gen_init_int(Stag),
+		gen_init_int(Ordinal),
+		gen_init_rtti_name(RttiTypeId, ArgTypes),
+		gen_init_maybe(gen_init_rtti_name(RttiTypeId), MaybeNames),
+		gen_init_maybe(gen_init_rtti_name(RttiTypeId), MaybeExist)
+	]).
+gen_init_rtti_data_defn(enum_name_ordered_table(RttiTypeId, Functors)) =
+	gen_init_rtti_names_array(RttiTypeId, Functors).
+gen_init_rtti_data_defn(enum_value_ordered_table(RttiTypeId, Functors)) =
+	gen_init_rtti_names_array(RttiTypeId, Functors).
+gen_init_rtti_data_defn(du_name_ordered_table(RttiTypeId, Functors)) =
+	gen_init_rtti_names_array(RttiTypeId, Functors).
+gen_init_rtti_data_defn(du_stag_ordered_table(RttiTypeId, _Ptag, Sharers)) =
+	gen_init_rtti_names_array(RttiTypeId, Sharers).
+gen_init_rtti_data_defn(du_ptag_ordered_table(RttiTypeId, PtagLayouts)) =
+	gen_init_array(gen_init_ptag_layout_defn(RttiTypeId), PtagLayouts).
+gen_init_rtti_data_defn(type_ctor_info(RttiTypeId, UnifyProc, CompareProc,
+		CtorRep, SolverProc, InitProc, Version, NumPtags, NumFunctors,
+		FunctorsInfo, LayoutInfo, _MaybeHashCons,
+		_PrettyprinterProc)) = Initializer :-
+	RttiTypeId = rtti_type_id(Module, Type, TypeArity),
+	prog_out__sym_name_to_string(Module, ModuleName),
+	Initializer = init_struct([
+		gen_init_int(TypeArity),
+		gen_init_maybe_proc_id(UnifyProc),
+		gen_init_maybe_proc_id(UnifyProc),
+		gen_init_maybe_proc_id(CompareProc),
+		gen_init_type_ctor_rep(CtorRep),
+		gen_init_maybe_proc_id(SolverProc),
+		gen_init_maybe_proc_id(InitProc),
+		gen_init_string(ModuleName),
+		gen_init_string(Type),
+		gen_init_int(Version),
+		gen_init_functors_info(FunctorsInfo, RttiTypeId),
+		gen_init_layout_info(LayoutInfo, RttiTypeId),
+		gen_init_int(NumFunctors),
+		gen_init_int(NumPtags)
+			% 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(RttiTypeId),
+		%	MaybeHashCons),
+		% gen_init_maybe_proc_id(PrettyprinterProc)
+	]).
+gen_init_rtti_data_defn(pseudo_type_info(Pseudo)) =
+	gen_init_pseudo_type_info_defn(Pseudo).
+
+:- func gen_init_functors_info(type_ctor_functors_info, rtti_type_id) =
+	mlds__initializer.
+
+gen_init_functors_info(enum_functors(EnumFunctorsInfo), RttiTypeId) =
+	gen_init_cast_rtti_name(RttiTypeId, EnumFunctorsInfo).
+gen_init_functors_info(notag_functors(NotagFunctorsInfo), RttiTypeId) =
+	gen_init_cast_rtti_name(RttiTypeId, NotagFunctorsInfo).
+gen_init_functors_info(du_functors(DuFunctorsInfo), RttiTypeId) =
+	gen_init_cast_rtti_name(RttiTypeId, DuFunctorsInfo).
+gen_init_functors_info(no_functors, _) =
+	gen_init_null_pointer.
+
+:- func gen_init_layout_info(type_ctor_layout_info, rtti_type_id) =
+	mlds__initializer.
+
+gen_init_layout_info(enum_layout(EnumLayoutInfo), RttiTypeId) =
+	gen_init_cast_rtti_name(RttiTypeId, EnumLayoutInfo).
+gen_init_layout_info(notag_layout(NotagLayoutInfo), RttiTypeId) =
+	gen_init_cast_rtti_name(RttiTypeId, NotagLayoutInfo).
+gen_init_layout_info(du_layout(DuLayoutInfo), RttiTypeId) =
+	gen_init_cast_rtti_name(RttiTypeId, DuLayoutInfo).
+gen_init_layout_info(equiv_layout(EquivTypeInfo), _RttiTypeId) =
+	gen_init_cast_rtti_data(EquivTypeInfo).
+gen_init_layout_info(no_layout, _RttiTypeId) =
+	gen_init_null_pointer.
+
+:- func gen_init_maybe_proc_id(maybe(rtti_proc_label)) = mlds__initializer.
+
+gen_init_maybe_proc_id(MaybeProcLabel) =
+	gen_init_maybe(gen_init_proc_id, MaybeProcLabel).
+
+:- func gen_init_pseudo_type_info_defn(pseudo_type_info) = mlds__initializer.
+
+gen_init_pseudo_type_info_defn(type_var(_)) = _ :-
+	error("gen_init_pseudo_type_info_defn: type_var").
+gen_init_pseudo_type_info_defn(type_ctor_info(_)) = _ :-
+	error("gen_init_pseudo_type_info_defn: type_ctor_info").
+gen_init_pseudo_type_info_defn(type_info(RttiTypeId, ArgTypes)) = Init :-
+	ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes),
+	Init = init_struct([
+		gen_init_rtti_name(RttiTypeId, type_ctor_info),
+		gen_init_cast_rtti_datas_array(ArgRttiDatas)
+	]).
+gen_init_pseudo_type_info_defn(higher_order_type_info(RttiTypeId,
+		Arity, ArgTypes)) = Init :-
+	ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes),
+	Init = init_struct([
+		gen_init_rtti_name(RttiTypeId, type_ctor_info),
+		gen_init_int(Arity),
+		gen_init_cast_rtti_datas_array(ArgRttiDatas)
+	]).
+
+:- func gen_init_ptag_layout_defn(rtti_type_id, du_ptag_layout) =
+	mlds__initializer.
+
+gen_init_ptag_layout_defn(RttiTypeId, DuPtagLayout) = Init :-
+	DuPtagLayout = du_ptag_layout(NumSharers, Locn, Descriptors) ,
+	Init = init_struct([
+		gen_init_int(NumSharers),
+		gen_init_sectag_locn(Locn),
+		gen_init_rtti_name(RttiTypeId, Descriptors)
+	]).
+
+%-----------------------------------------------------------------------------%
+
+:- func gen_init_rtti_names_array(rtti_type_id, list(rtti_name)) =
+	mlds__initializer.
+gen_init_rtti_names_array(RttiTypeId, RttiNames) =
+	gen_init_array(gen_init_rtti_name(RttiTypeId), RttiNames).
+
+:- func gen_init_rtti_datas_array(list(rtti_data)) = mlds__initializer.
+gen_init_rtti_datas_array(RttiDatas) =
+	gen_init_array(gen_init_rtti_data, RttiDatas).
+
+:- func gen_init_cast_rtti_datas_array(list(rtti_data)) = mlds__initializer.
+gen_init_cast_rtti_datas_array(RttiDatas) =
+	gen_init_array(gen_init_cast_rtti_data, RttiDatas).
+
+	% Generate the MLDS initializer comprising the rtti_name
+	% for a given rtti_data, converted to mlds__generic_type.
+:- func gen_init_cast_rtti_data(rtti_data) = mlds__initializer.
+
+gen_init_cast_rtti_data(RttiData) = Initializer :-
+	( RttiData = pseudo_type_info(type_var(VarNum)) ->
+		% rtti_data_to_name/3 does not handle this case
+		Initializer = init_obj(unop(box(mlds__native_int_type),
+			const(int_const(VarNum))))
+	;
+		rtti_data_to_name(RttiData, RttiTypeId, RttiName),
+		Initializer = gen_init_cast_rtti_name(RttiTypeId, RttiName)
+	).
+
+	% Generate the MLDS initializer comprising the rtti_name
+	% for a given rtti_data.
+:- func gen_init_rtti_data(rtti_data) = mlds__initializer.
+
+gen_init_rtti_data(RttiData) = Initializer :-
+	rtti_data_to_name(RttiData, RttiTypeId, RttiName),
+	Initializer = gen_init_rtti_name(RttiTypeId, RttiName).
+
+	% Generate an MLDS initializer comprising just the
+	% the rval for a given rtti_name
+:- func gen_init_rtti_name(rtti_type_id, rtti_name) = mlds__initializer.
+
+gen_init_rtti_name(RttiTypeId, RttiName) =
+	init_obj(gen_rtti_name(RttiTypeId, RttiName)).
+
+	% Generate the MLDS initializer comprising the rtti_name
+	% for a given rtti_name, converted to mlds__generic_type.
+:- func gen_init_cast_rtti_name(rtti_type_id, rtti_name) = mlds__initializer.
+
+gen_init_cast_rtti_name(RttiTypeId, RttiName) =
+	init_obj(unop(box(rtti_type(RttiName)), 
+		gen_rtti_name(RttiTypeId, RttiName))).
+
+	% Generate the MLDS rval for an rtti_name.
+:- func gen_rtti_name(rtti_type_id, rtti_name) = mlds__rval.
+
+gen_rtti_name(RttiTypeId, RttiName) = Rval :-
+	RttiTypeId = rtti_type_id(ModuleName, _Type, _TypeArity),
+	MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+	MLDS_DataName = rtti(RttiTypeId, RttiName),
+	DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
+	Rval = const(data_addr_const(DataAddr)).
+
+:- func gen_init_exist_locn(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_int(SlotInCell),
+		gen_init_int(SlotInTci)
+	]).
+
+%-----------------------------------------------------------------------------%
+
+:- func gen_init_proc_id(rtti_proc_label) = mlds__initializer.
+gen_init_proc_id(RttiProcId) = Init :-
+	%
+	% construct an rval for the address of this procedure
+	% (this is similar to ml_gen_proc_addr_rval)
+	%
+        ml_gen_pred_label_from_rtti(RttiProcId, PredLabel, PredModule),
+	ProcId = RttiProcId^proc_id,
+        QualifiedProcLabel = qual(PredModule, PredLabel - ProcId),
+	Params = ml_gen_proc_params_from_rtti(RttiProcId),
+	Signature = mlds__get_func_signature(Params),
+	ProcAddrRval = const(code_addr_const(proc(QualifiedProcLabel, 
+		Signature))),
+	%
+	% Convert the procedure address to a generic type.
+	% We need to use a generic type because since the actual type
+	% for the procedure will depend on how many type_info parameters
+	% it takes, which will depend on the type's arity.
+	%
+        ProcAddrArg = unop(box(mlds__func_type(Params)), ProcAddrRval),
+	Init = init_obj(ProcAddrArg).
+
+%-----------------------------------------------------------------------------%
+%
+% Conversion functions for builtin enumeration types.
+%
+% This handles sectag_locn and type_ctor_rep.
+% The rvals generated are just named constants in
+% the private_builtin module, which the Mercury
+% runtime is expected to define.
+
+:- func gen_init_sectag_locn(sectag_locn) = mlds__initializer.
+gen_init_sectag_locn(Locn) = gen_init_builtin_const(Name) :-
+	rtti__sectag_locn_to_string(Locn, Name).
+
+:- func gen_init_type_ctor_rep(type_ctor_rep) = mlds__initializer.
+gen_init_type_ctor_rep(Rep) = gen_init_builtin_const(Name) :-
+	rtti__type_ctor_rep_to_string(Rep, Name).
+
+:- func gen_init_builtin_const(string) = mlds__initializer.
+gen_init_builtin_const(Name) = init_obj(Rval) :-
+        mercury_private_builtin_module(PrivateBuiltin),
+	MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
+	Rval = lval(var(qual(MLDS_Module, Name))).
+
+%-----------------------------------------------------------------------------%
+%
+% Conversion functions for the basic types.
+%
+% This handles arrays, maybe, null pointers, strings, and ints.
+%
+
+:- func gen_init_array(func(T) = mlds__initializer, list(T)) =
+	mlds__initializer.
+
+gen_init_array(Conv, List) = init_array(list__map(Conv, List)).
+
+:- func gen_init_maybe(func(T) = mlds__initializer, maybe(T)) =
+	mlds__initializer.
+
+gen_init_maybe(Conv, yes(X)) = Conv(X).
+gen_init_maybe(_, no) = gen_init_null_pointer.
+	
+:- func gen_init_null_pointer = mlds__initializer.
+
+gen_init_null_pointer =
+	% XXX the MLDS ought to have a null pointer constant
+	init_obj(mlds__unop(cast(mlds__generic_type), const(int_const(0)))).
+
+:- func gen_init_string(string) = mlds__initializer.
+
+gen_init_string(String) = init_obj(const(string_const(String))).
+
+:- func gen_init_int(int) = mlds__initializer.
+
+gen_init_int(Int) = init_obj(const(int_const(Int))).
+
+%-----------------------------------------------------------------------------%
+
+mlds_rtti_type_name(exist_locns(_)) =		"DuExistLocnArray".
+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(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(type_ctor_info) =		"TypeCtorInfo_Struct".
+mlds_rtti_type_name(pseudo_type_info(Pseudo)) =
+	mlds_pseudo_type_info_type_name(Pseudo).
+mlds_rtti_type_name(type_hashcons_pointer) =	"TableNodePtrPtr".
+
+:- func mlds_pseudo_type_info_type_name(pseudo_type_info) = string.
+
+mlds_pseudo_type_info_type_name(type_var(_)) = _ :-
+	% we use small integers to represent type_vars,
+	% rather than pointers, so there is no pointed-to type
+	error("mlds_rtti_type_name: type_var").
+mlds_pseudo_type_info_type_name(type_ctor_info(_)) =
+	"TypeCtorInfo_Struct".
+mlds_pseudo_type_info_type_name(type_info(_TypeId, ArgTypes)) =
+	string__format("FO_PseudoTypeInfo_Struct%d",
+		[i(list__length(ArgTypes))]).
+mlds_pseudo_type_info_type_name(higher_order_type_info(_TypeId, _Arity,
+		ArgTypes)) =
+	string__format("HO_PseudoTypeInfo_Struct%d",
+		[i(list__length(ArgTypes))]).
+
+%-----------------------------------------------------------------------------%
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.6
diff -u -d -r1.6 type_ctor_info.m
--- compiler/type_ctor_info.m	2000/04/17 10:32:10	1.6
+++ compiler/type_ctor_info.m	2000/04/17 11:06:45
@@ -45,8 +45,8 @@
 :- pred type_ctor_info__generate_hlds(module_info::in, module_info::out)
 	is det.
 
-:- pred type_ctor_info__generate_rtti(module_info::in, module_info::out,
-	list(rtti_data)::out) is det.
+:- pred type_ctor_info__generate_rtti(module_info::in, list(rtti_data)::out)
+	is det.
 
 :- implementation.
 
@@ -145,7 +145,7 @@
 
 %---------------------------------------------------------------------------%
 
-type_ctor_info__generate_rtti(ModuleInfo, ModuleInfo, Tables) :-
+type_ctor_info__generate_rtti(ModuleInfo, Tables) :-
 	module_info_type_ctor_gen_infos(ModuleInfo, TypeCtorGenInfos),
 	type_ctor_info__construct_type_ctor_infos(TypeCtorGenInfos,
 		ModuleInfo, [], Dynamic, [], Static0),
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- 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
--------------------------------------------------------------------------