[m-dev.] for review: implement pragma export for MLDS backend

[Peter Ross]

OK here is the code which bootchecks.  Could Fergus please review it.

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


Estimated hours taken: 24

Implement `pragma export' for the MLDS backend.

compiler/mlds.m:
    Add a new type mlds__pragma_export.  It records the exported name,
    the MLDS name of the exported procedure, the function parameters
    of the MLDS entity and the context of the export declaration.
    Add a new mlds_entity_name type export, for names which come from
    pragma export.

compiler/ml_code_gen.m:
    For every pragma export declaration, we associate the information
    used to generate the function prototype for the MLDS entity.  We
    also record whether or not the procedure is a det function in the
    forward mode.
    
compiler/mlds_to_c.m:
    Output a declaration for the exported procedure to the header file.
    Output a definition for the exported procedure to the source file.
    Providing that the procedure is not a det func in the forward mode
    the declaration is constructed by outputing the function prototype
    for the MLDS function, but using the exported name instead and
    the definition is constructed by defining a function which directly
    calls the MLDS function.
    If the procedure is a det func in the forward mode then the output
    argument is returned by the function instead of being passed in call
    by reference.  The signature of the exported function is changed to
    this new convention.  This change is required so the an exported
    procedure can by re-imported.
    Define in each header file MR_BOOTSTRAPPED_PRAGMA_EXPORT, this code
    should be removed once the compiler has bootstrapped.
    Move output_c_defns so that it comes after all the declarations.
    Modify mlds_output_params so that it takes a module name, not an
    entity name as all it needs is the module name.
    When outputing an mlds_entity_name of type export, don't module
    qualify the name and just output the string.

compiler/hlds_module.m:
    Add a prog_context field to the type pragma_exported_proc.

compiler/make_hlds.m:
    Record the context of the pragma export.

compiler/dead_proc_elim.m:
compiler/export.m:
    Ignore extra field added to pragma_exported_proc.

compiler/ml_elim_nested.m:
    In ml_env_name report error for export mlds__entity_name's.

library/io.m:
runtime/mercury.c:
runtime/mercury.h:
runtime/mercury_init.h:
    Check to see if MR_BOOTSTRAPPED_PRAGMA_EXPORT is defined when
    deciding whether hacks to get around the lack of pragma export need
    to turned on.  This code should be removed once the compiler has
    bootstrapped.
    This also required some definitions to be moved from mercury.c to
    io.m so that MR_BOOTSTRAPPED_PRAGMA_EXPORT is defined when the
    definition is reached.

Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.56
diff -u -r1.56 dead_proc_elim.m
--- compiler/dead_proc_elim.m	2000/06/27 05:34:25	1.56
+++ compiler/dead_proc_elim.m	2000/07/17 12:57:25
@@ -163,7 +163,7 @@
 dead_proc_elim__initialize_pragma_exports([], Queue, Queue, Needed, Needed).
 dead_proc_elim__initialize_pragma_exports([PragmaProc | PragmaProcs],
 		Queue0, Queue, Needed0, Needed) :-
-	PragmaProc = pragma_exported_proc(PredId, ProcId, _CFunction),
+	PragmaProc = pragma_exported_proc(PredId, ProcId, _CFunction, _Ctxt),
 	queue__put(Queue0, proc(PredId, ProcId), Queue1),
 	map__set(Needed0, proc(PredId, ProcId), no, Needed1),
 	dead_proc_elim__initialize_pragma_exports(PragmaProcs,
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.32
diff -u -r1.32 export.m
--- compiler/export.m	2000/02/16 06:05:52	1.32
+++ compiler/export.m	2000/07/17 12:57:27
@@ -84,7 +84,7 @@
 
 export__get_c_export_decls_2(_Preds, [], []).
 export__get_c_export_decls_2(Preds, [E|ExportedProcs], C_ExportDecls) :-
-	E = pragma_exported_proc(PredId, ProcId, C_Function),
+	E = pragma_exported_proc(PredId, ProcId, C_Function, _Ctxt),
 	get_export_info(Preds, PredId, ProcId, _Exported, C_RetType,
 		_DeclareReturnVal, _FailureAction, _SuccessAction,
 		HeadArgInfoTypes),
@@ -164,7 +164,7 @@
 
 export__to_c(_Preds, [], _Module, []).
 export__to_c(Preds, [E|ExportedProcs], Module, ExportedProcsCode) :-
-	E = pragma_exported_proc(PredId, ProcId, C_Function),
+	E = pragma_exported_proc(PredId, ProcId, C_Function, _Ctxt),
 	get_export_info(Preds, PredId, ProcId, Exported,
 		C_RetType, MaybeDeclareRetval, MaybeFail, MaybeSucceed,
 		ArgInfoTypes),
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.56
diff -u -r1.56 hlds_module.m
--- compiler/hlds_module.m	2000/05/16 21:23:24	1.56
+++ compiler/hlds_module.m	2000/07/17 12:57:35
@@ -48,7 +48,8 @@
 	--->	pragma_exported_proc(
 			pred_id,
 			proc_id,
-			string	% the name of the C function
+			string,	% the name of the C function
+			prog_context
 		).
 
 	% This structure contains the information we need to generate
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.336
diff -u -r1.336 make_hlds.m
--- compiler/make_hlds.m	2000/06/06 05:45:08	1.336
+++ compiler/make_hlds.m	2000/07/17 12:58:11
@@ -786,7 +786,7 @@
 			{ module_info_get_pragma_exported_procs(Module0,
 				PragmaExportedProcs0) },
 			{ NewExportedProc = pragma_exported_proc(PredId,
-				ProcId, C_Function) },
+				ProcId, C_Function, Context) },
 			{ PragmaExportedProcs = 
 				[NewExportedProc|PragmaExportedProcs0]},
 			{ module_info_set_pragma_exported_procs(Module0,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.52
diff -u -r1.52 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/06/06 06:21:22	1.52
+++ compiler/ml_code_gen.m	2000/07/17 12:58:18
@@ -626,7 +626,6 @@
 %		- most cases of `pragma c_code'
 %	- RTTI
 % TODO:
-%	- `pragma export'
 %	- complicated `pragma c_code'
 %	- high level data representation
 %	  (i.e. generate MLDS type declarations for user-defined types)
@@ -662,13 +661,14 @@
 
 :- import_module ml_type_gen, 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 arg_info, export, llds_out. % XXX needed for pragma C code
 :- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
 :- import_module goal_util, type_util, mode_util, builtin_ops.
 :- import_module passes_aux, modules.
 :- import_module globals, options.
 
-:- import_module bool, string, list, map, set, term, require, std_util.
+:- import_module assoc_list, bool, string, list, map.
+:- import_module int, set, term, require, std_util.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -691,12 +691,9 @@
 	{ module_info_get_c_body_code(ModuleInfo, C_Body_Info) },
 	{ ConvBody = (func(S - C) = user_c_code(S, C)) },
 	{ User_C_Code = list__map(ConvBody, C_Body_Info) },
-	%
-	% XXX not yet implemented -- this is just a stub
-	%
-	{ C_Exports = [] },
+	{ ml_gen_pragma_export(ModuleInfo, MLDS_PragmaExports) },
 	{ MLDS_ForeignCode = mlds__foreign_code(C_Header_Info, User_C_Code,
-			C_Exports) }.
+			MLDS_PragmaExports) }.
 
 :- pred ml_gen_imports(module_info, mlds__imports).
 :- mode ml_gen_imports(in, out) is det.
@@ -716,6 +713,76 @@
 
 %-----------------------------------------------------------------------------%
 %
+% For each pragma export declaration we associate with it the 
+% information used to generate the function prototype for the MLDS
+% entity.
+%
+
+:- pred ml_gen_pragma_export(module_info, list(mlds__pragma_export)).
+:- mode ml_gen_pragma_export(in, out) is det.
+
+ml_gen_pragma_export(ModuleInfo, MLDS_PragmaExports) :-
+	module_info_get_pragma_exported_procs(ModuleInfo, PragmaExports),
+	list__map(ml_gen_pragma_export_proc(ModuleInfo),
+			PragmaExports, MLDS_PragmaExports).
+
+:- pred ml_gen_pragma_export_proc(module_info::in,
+		pragma_exported_proc::in, mlds__pragma_export::out) is det.
+
+ml_gen_pragma_export_proc(ModuleInfo,
+		pragma_exported_proc(PredId, ProcId, C_Name, ProgContext),
+		ML_Defn) :-
+
+	MLDS_Name = ml_gen_proc_label(ModuleInfo, PredId, ProcId),
+	MLDS_FuncParams = ml_gen_proc_params(ModuleInfo, PredId, ProcId),
+	MLDS_Context = mlds__make_context(ProgContext),
+
+	(
+		is_forward_mode_det_function(ModuleInfo, PredId, ProcId)
+	->
+		IsFwdModeDetFunc = yes
+	;
+		IsFwdModeDetFunc = no
+	),
+
+	ML_Defn = ml_pragma_export(C_Name, MLDS_Name, MLDS_FuncParams,
+			MLDS_Context, IsFwdModeDetFunc).
+
+
+	%
+	% Test to see if the procedure is of the following form
+	%   :- func (T::in, U::in) = V::out is det.
+	% as these need to handled specially.
+	%
+:- pred is_forward_mode_det_function(module_info, pred_id, proc_id).
+:- mode is_forward_mode_det_function(in, in, in) is semidet.
+
+is_forward_mode_det_function(ModuleInfo, PredId, ProcId) :-
+	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo,
+			ProcInfo),
+	
+	pred_info_get_is_pred_or_func(PredInfo, function),
+	proc_info_interface_code_model(ProcInfo, CodeModel),
+
+	CodeModel = model_det,
+
+		% XXX I am sure that there is a better way to do this,
+		% but this is how export.m figures it out!
+	proc_info_argmodes(ProcInfo, ArgModes),
+	pred_info_arg_types(PredInfo, ArgTypes),
+	make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfos),
+
+	assoc_list__from_corresponding_lists(ArgInfos, ArgTypes,
+			ArgInfoTypes),
+
+	pred_args_to_func_args(ArgInfoTypes, _InputArgInfoTypes,
+			arg_info(_RetArgLoc, RetArgMode) - RetType),
+
+	RetArgMode = top_out,
+	\+ type_util__is_dummy_argument_type(RetType).
+
+%-----------------------------------------------------------------------------%
+%
 % Stuff to generate MLDS code for HLDS predicates & functions.
 %
 
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.9
diff -u -r1.9 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2000/06/06 05:45:21	1.9
+++ compiler/ml_elim_nested.m	2000/07/17 12:58:24
@@ -489,6 +489,8 @@
 			[s(PredLabelString), i(ModeNum)],
 			ClassName)
 	).
+ml_env_name(export(_)) = _ :-
+	error("ml_env_name: expected function, got export").
 
 :- func ml_pred_label_name(mlds__pred_label) = string.
 
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.27
diff -u -r1.27 mlds.m
--- compiler/mlds.m	2000/06/06 05:45:20	1.27
+++ compiler/mlds.m	2000/07/17 12:58:30
@@ -371,6 +371,7 @@
 				% for additional information.
 			pred_id			% Specifies the HLDS pred_id.
 		)
+	;	export(string)	% A pragma export name.
 	.
 
 :- type mlds__func_sequence_num == int.
@@ -607,10 +608,23 @@
 	---> mlds__foreign_code(
 		c_header_info,
 		list(user_c_code),
-		list(c_export)		% XXX we will need to modify
-					% export.m to handle different
-					% target languages
+		list(mlds__pragma_export)
 	).
+
+	%
+	% Information required to generate code for each
+	% `pragma export'.
+	%
+:- type mlds__pragma_export
+	---> ml_pragma_export(
+		string,			% Exported name
+		mlds__entity_name,	% MLDS name for exported entity
+		mlds__func_params,	% MLDS function parameters
+		mlds__context,
+		bool			% is a det function in the
+					% forward mode
+	).
+
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.41
diff -u -r1.41 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/07/13 15:09:26	1.41
+++ compiler/mlds_to_c.m	2000/07/17 12:58:37
@@ -120,10 +120,13 @@
 :- mode mlds_output_hdr_file(in, in, di, uo) is det.
 
 mlds_output_hdr_file(Indent, MLDS) -->
+	% XXX for bootstrapping the use of pragma export.
+	io__write_string("#define MR_BOOTSTRAPPED_PRAGMA_EXPORT\n"),
+
 	{ MLDS = mlds(ModuleName, ForeignCode, Imports, Defns) },
 	mlds_output_hdr_start(Indent, ModuleName), io__nl,
 	mlds_output_hdr_imports(Indent, Imports), io__nl,
-	mlds_output_c_hdr_decls(Indent, ForeignCode), io__nl,
+	mlds_output_c_hdr_decls(MLDS_ModuleName, Indent, ForeignCode), io__nl,
 	%
 	% The header file must contain _definitions_ of all public types,
 	% but only _declarations_ of all public variables, constants,
@@ -206,7 +209,6 @@
 	mlds_output_src_start(Indent, ModuleName), io__nl,
 	mlds_output_src_imports(Indent, Imports), io__nl,
 	mlds_output_c_decls(Indent, ForeignCode), io__nl,
-	mlds_output_c_defns(Indent, ForeignCode), io__nl,
 	%
 	% The public types have already been defined in the
 	% header file, and the public vars, consts, and functions
@@ -232,6 +234,8 @@
 	{ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName) },
 	mlds_output_defns(Indent, MLDS_ModuleName, PrivateTypeDefns), io__nl,
 	mlds_output_decls(Indent, MLDS_ModuleName, PrivateNonTypeDefns), io__nl,
+
+	mlds_output_c_defns(MLDS_ModuleName, Indent, ForeignCode), io__nl,
 	mlds_output_defns(Indent, MLDS_ModuleName, NonTypeDefns), io__nl,
 	mlds_output_src_end(Indent, ModuleName).
 
@@ -308,16 +312,18 @@
 % C interface stuff
 %
 
-:- pred mlds_output_c_hdr_decls(indent, mlds__foreign_code,
+:- pred mlds_output_c_hdr_decls(mlds_module_name, indent, mlds__foreign_code,
 		io__state, io__state).
-:- mode mlds_output_c_hdr_decls(in, in, di, uo) is det.
+:- mode mlds_output_c_hdr_decls(in, in, in, di, uo) is det.
 
-mlds_output_c_hdr_decls(Indent, ForeignCode) -->
-	% XXX we don't yet handle `pragma export' decls
+mlds_output_c_hdr_decls(ModuleName, Indent, ForeignCode) -->
 	{ ForeignCode = mlds__foreign_code(RevHeaderCode, _RevBodyCode,
-		_ExportDefns) },
+		ExportDefns) },
 	{ HeaderCode = list__reverse(RevHeaderCode) },
-	io__write_list(HeaderCode, "\n", mlds_output_c_hdr_decl(Indent)).
+	io__write_list(HeaderCode, "\n", mlds_output_c_hdr_decl(Indent)),
+	io__write_string("\n"),
+	io__write_list(ExportDefns, "\n",
+			mlds_output_pragma_export_decl(ModuleName, Indent)).
 
 :- pred mlds_output_c_hdr_decl(indent, c_header_code, io__state, io__state).
 :- mode mlds_output_c_hdr_decl(in, in, di, uo) is det.
@@ -332,15 +338,18 @@
 % all of the declarations go in the header file or as c_code
 mlds_output_c_decls(_, _) --> [].
 
-:- pred mlds_output_c_defns(indent, mlds__foreign_code, io__state, io__state).
-:- mode mlds_output_c_defns(in, in, di, uo) is det.
+:- pred mlds_output_c_defns(mlds_module_name, indent, mlds__foreign_code,
+		io__state, io__state).
+:- mode mlds_output_c_defns(in, in, in, di, uo) is det.
 
-mlds_output_c_defns(Indent, ForeignCode) -->
-	% XXX export decls
+mlds_output_c_defns(ModuleName, Indent, ForeignCode) -->
 	{ ForeignCode = mlds__foreign_code(_RevHeaderCode, RevBodyCode,
-		_ExportDefns) },
+		ExportDefns) },
 	{ BodyCode = list__reverse(RevBodyCode) },
-	io__write_list(BodyCode, "\n", mlds_output_c_defn(Indent)).
+	io__write_list(BodyCode, "\n", mlds_output_c_defn(Indent)),
+	io__write_string("\n"),
+	io__write_list(ExportDefns, "\n",
+			mlds_output_pragma_export_defn(ModuleName, Indent)).
 
 :- pred mlds_output_c_defn(indent, user_c_code, io__state, io__state).
 :- mode mlds_output_c_defn(in, in, di, uo) is det.
@@ -349,6 +358,172 @@
 	mlds_output_context(mlds__make_context(Context)),
 	io__write_string(Code).
 
+:- pred mlds_output_pragma_export_decl(mlds_module_name, indent,
+		mlds__pragma_export, io__state, io__state).
+:- mode mlds_output_pragma_export_decl(in, in, in, di, uo) is det.
+
+mlds_output_pragma_export_decl(ModuleName, Indent,
+		ml_pragma_export(C_name, _MLDS_Name, Signature0, Context,
+			IsFunc)) -->
+	(
+		{ IsFunc = yes }
+	->
+		{ Signature = det_func_signature(Signature0) }
+	;
+		{ Signature = Signature0 }
+	),
+	{ Name = qual(ModuleName, export(C_name)) },
+	mlds_indent(Context, Indent),
+	mlds_output_func_decl(Indent, Name, Context, Signature),
+	io__write_string(";").
+
+:- pred mlds_output_pragma_export_defn(mlds_module_name, indent,
+		mlds__pragma_export, io__state, io__state).
+:- mode mlds_output_pragma_export_defn(in, in, in, di, uo) is det.
+
+mlds_output_pragma_export_defn(ModuleName, Indent,
+		ml_pragma_export(C_name, MLDS_Name, MLDS_Signature, Context,
+			IsFunc)) -->
+	(
+		{ IsFunc = yes },
+		{ Signature = det_func_signature(MLDS_Signature) }
+	;
+		{ IsFunc = no },
+		{ Signature = MLDS_Signature }
+	),
+	{ Name = qual(ModuleName, export(C_name)) },
+	mlds_indent(Context, Indent),
+	mlds_output_func_decl(Indent, Name, Context, Signature),
+	io__write_string("{\n"),
+	mlds_indent(Context, Indent),
+	(
+		{ IsFunc = yes },
+		mlds_output_pragma_export_func_defn_body(ModuleName, MLDS_Name,
+				MLDS_Signature)
+	;
+		{ IsFunc = no },
+		mlds_output_pragma_export_defn_body(ModuleName, MLDS_Name,
+				Signature)
+	),
+	io__write_string("}\n").
+
+	%
+	% Output the definition body for a pragma export when it is
+	% *NOT* a det forward mode function.
+	%
+:- pred mlds_output_pragma_export_defn_body(mlds_module_name, mlds__entity_name,
+		func_params, io__state, io__state).
+:- mode mlds_output_pragma_export_defn_body(in, in, in, di, uo) is det.
+
+mlds_output_pragma_export_defn_body(ModuleName, FuncName, Signature) -->
+	{ Signature = mlds__func_params(_Parameters, RetTypes) },
+	{ QualNames = argument_names(ModuleName, Signature) },
+
+	( { RetTypes = [] } ->
+		io__write_string("\t")
+	; { RetTypes = [_] } ->
+		io__write_string("\treturn ")
+	;
+		{ error("mlds_output_pragma_export: multiple return types") }
+	),
+
+	mlds_output_fully_qualified_name(qual(ModuleName, FuncName)),
+	io__write_string("("),
+	io__write_list(QualNames, ",", mlds_output_fully_qualified_name),
+	io__write_string(");\n").
+
+	%
+	% Output the definition body for a pragma export when it is
+	% det forward mode function.
+	%
+:- pred mlds_output_pragma_export_func_defn_body(mlds_module_name,
+		mlds__entity_name, func_params, io__state, io__state).
+:- mode mlds_output_pragma_export_func_defn_body(in, in, in, di, uo) is det.
+
+mlds_output_pragma_export_func_defn_body(ModuleName, FuncName, Signature) -->
+	{ ExportedSignature = det_func_signature(Signature) },
+	{ ExportedSignature = mlds__func_params(_Parameters, RetTypes) },
+	{ QualNames = argument_names(ModuleName, Signature) },
+
+	( { RetTypes = [RetType0] } ->
+		{ RetType = RetType0 }
+	;
+		{ error("mlds_output_pragma_export_func_defn_body") }
+	),
+
+		% Define a variable to hold the function result.
+	io__write_string("\t"),
+	mlds_output_type_prefix(RetType),
+	io__write_string(" arg"),
+	mlds_output_type_suffix(RetType),
+	io__write_string(";\n"),
+
+		% Call the MLDS function.
+	io__write_string("\t"),
+	mlds_output_fully_qualified_name(qual(ModuleName, FuncName)),
+	io__write_string("("),
+	write_func_args(QualNames),
+	io__write_string(");\n"),
+
+		% return the function result.
+	io__write_string("\t"),
+	io__write_string("return arg;\n").
+
+	%
+	% Write out the arguments to the MLDS function.  Note the last
+	% in the list of the arguments in the return value, so it must
+	% be "&arg"
+	%
+:- pred write_func_args(list(mlds__qualified_entity_name)::in,
+		io__state::di, io__state::uo) is det.
+
+write_func_args([]) -->
+	{ error("write_func_args: empty list") }.
+write_func_args([_Arg]) -->
+	io__write_string("&arg").
+write_func_args([Arg | Args]) -->
+	{ Args = [_|_] },
+	mlds_output_fully_qualified_name(Arg),
+	io__write_string(", "),
+	write_func_args(Args).
+
+	%
+	% Generate a list of entity_names corresponding to each function
+	% parameter.
+	%
+:- func argument_names(mlds_module_name, mlds__func_params)
+		= list(mlds__qualified_entity_name).
+
+argument_names(ModuleName, mlds__func_params(Parameters, _RetTypes))
+		= QualNames :-
+	list__map(fst, Parameters, Names),
+	list__map((pred(Name::in, QualName::out) is det :-
+			QualName = qual(ModuleName, Name)),
+			Names, QualNames).
+
+	%
+	% Generates the signature for det functions in the forward mode.
+	%
+:- func det_func_signature(mlds__func_params) = mlds__func_params.
+
+det_func_signature(mlds__func_params(Args, _RetTypes)) = Params :-
+	list__length(Args, NumArgs),
+	NumFuncArgs is NumArgs - 1,
+	( list__split_list(NumFuncArgs, Args, InputArgs0, [ReturnArg0]) ->
+		InputArgs = InputArgs0,
+		ReturnArg = ReturnArg0
+	;
+		error("det_func_signature: function missing return value?")
+	),
+	(
+		ReturnArg = _ReturnArgName - mlds__ptr_type(ReturnArgType0)
+	->
+		ReturnArgType = ReturnArgType0
+	;
+		error("det_func_signature: function return type!")
+	),
+	Params = mlds__func_params(InputArgs, [ReturnArgType]).
+	
 %-----------------------------------------------------------------------------%
 %
 % Code to output declarations and definitions
@@ -900,7 +1075,7 @@
 		func_params, io__state, io__state).
 :- mode mlds_output_func_decl(in, in, in, in, di, uo) is det.
 
-mlds_output_func_decl(Indent, Name, Context, Signature) -->
+mlds_output_func_decl(Indent, QualifiedName, Context, Signature) -->
 	{ Signature = mlds__func_params(Parameters, RetTypes) },
 	( { RetTypes = [] } ->
 		io__write_string("void")
@@ -910,35 +1085,35 @@
 		{ error("mlds_output_func: multiple return types") }
 	),
 	io__write_char(' '),
-	mlds_output_fully_qualified_name(Name),
-	mlds_output_params(Indent, Name, Context, Parameters),
+	mlds_output_fully_qualified_name(QualifiedName),
+	{ QualifiedName = qual(ModuleName, _) },
+	mlds_output_params(Indent, ModuleName, Context, Parameters),
 	( { RetTypes = [RetType2] } ->
 		mlds_output_type_suffix(RetType2)
 	;
 		[]
 	).
 
-:- pred mlds_output_params(indent, qualified_entity_name, mlds__context,
+:- pred mlds_output_params(indent, mlds_module_name, mlds__context,
 		mlds__arguments, io__state, io__state).
 :- mode mlds_output_params(in, in, in, in, di, uo) is det.
 
-mlds_output_params(Indent, FuncName, Context, Parameters) -->
+mlds_output_params(Indent, ModuleName, Context, Parameters) -->
 	io__write_char('('),
 	( { Parameters = [] } ->
 		io__write_string("void")
 	;
 		io__nl,
 		io__write_list(Parameters, ",\n",
-			mlds_output_param(Indent + 1, FuncName, Context))
+			mlds_output_param(Indent + 1, ModuleName, Context))
 	),
 	io__write_char(')').
 
-:- pred mlds_output_param(indent, qualified_entity_name, mlds__context,
+:- pred mlds_output_param(indent, mlds_module_name, mlds__context,
 		pair(mlds__entity_name, mlds__type), io__state, io__state).
 :- mode mlds_output_param(in, in, in, in, di, uo) is det.
 
-mlds_output_param(Indent, qual(ModuleName, _FuncName), Context,
-		Name - Type) -->
+mlds_output_param(Indent, ModuleName, Context, Name - Type) -->
 	mlds_indent(Context, Indent),
 	mlds_output_data_decl(qual(ModuleName, Name), Type).
 
@@ -1015,6 +1190,9 @@
 			% module
 			%
 			{ Name = data(base_typeclass_info(_, _)) }
+		;
+			% We don't module qualify pragma export names.
+			{ Name = export(_) }
 		)
 	->
 		mlds_output_name(Name)
@@ -1080,6 +1258,8 @@
 	;
 		[]
 	).
+mlds_output_name(export(Name)) -->
+	io__write_string(Name).
 
 :- pred mlds_output_pred_label(mlds__pred_label, io__state, io__state).
 :- mode mlds_output_pred_label(in, di, uo) is det.
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.198
diff -u -r1.198 io.m
--- library/io.m	2000/06/08 07:59:01	1.198
+++ library/io.m	2000/07/17 12:59:01
@@ -1809,6 +1809,27 @@
 
 :- pragma export(io__print(in, in, di, uo), "ML_io_print_to_stream").
 
+:- pragma c_code("
+/*
+** XXX this is a hack to work-around the current lack of
+** support for `pragma export'.
+*/
+#ifndef MR_BOOTSTRAPPED_PRAGMA_EXPORT
+  extern void mercury__io__print_3_p_0(MR_Word ti, MR_Box x);
+  extern void mercury__io__print_4_p_0(MR_Word ti, MR_Word stream, MR_Box x);
+
+  void
+  ML_io_print_to_cur_stream(MR_Word ti, MR_Word x) {
+	mercury__io__print_3_p_0(ti, (MR_Box) x);
+  }
+
+  void
+  ML_io_print_to_stream(MR_Word ti, MR_Word stream, MR_Word x) {
+	mercury__io__print_4_p_0(ti, stream, (MR_Box) x);
+  }
+#endif
+").
+
 io__print(Stream, Term) -->
 	io__set_output_stream(Stream, OrigStream),
 	io__print(Term),
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.7
diff -u -r1.7 mercury.c
--- runtime/mercury.c	2000/05/31 12:58:24	1.7
+++ runtime/mercury.c	2000/07/17 12:59:03
@@ -842,24 +842,4 @@
 
 /*---------------------------------------------------------------------------*/
 
-/*
-** XXX this is a hack to work-around the current lack of
-** support for `pragma export'.
-*/
-
-extern void mercury__io__print_3_p_0(MR_Word ti, MR_Box x);
-extern void mercury__io__print_4_p_0(MR_Word ti, MR_Word stream, MR_Box x);
-
-void
-ML_io_print_to_cur_stream(MR_Word ti, MR_Word x) {
-	mercury__io__print_3_p_0(ti, (MR_Box) x);
-}
-
-void
-ML_io_print_to_stream(MR_Word ti, MR_Word stream, MR_Word x) {
-	mercury__io__print_4_p_0(ti, stream, (MR_Box) x);
-}
-
-/*---------------------------------------------------------------------------*/
-
 #endif /* MR_HIGHLEVEL_CODE */
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.13
diff -u -r1.13 mercury.h
--- runtime/mercury.h	2000/06/05 02:42:47	1.13
+++ runtime/mercury.h	2000/07/17 12:59:04
@@ -43,15 +43,17 @@
 ** XXX this is a hack to work-around the current lack of
 ** support for `pragma export'.
 */
-#ifndef MR_HIGHLEVEL_DATA
-#define ML_report_uncaught_exception \
-		mercury__exception__report_uncaught_exception_3_p_0
-#define ML_throw_io_error		mercury__io__throw_io_error_1_p_0
-#define ML_io_finalize_state		mercury__io__finalize_state_2_p_0
-#define ML_io_init_state		mercury__io__init_state_2_p_0
-#define ML_io_stderr_stream		mercury__io__stderr_stream_3_p_0
-#define ML_io_stdin_stream		mercury__io__stdin_stream_3_p_0
-#define ML_io_stdout_stream		mercury__io__stdout_stream_3_p_0
+#ifndef MR_BOOTSTRAPPED_PRAGMA_EXPORT
+  #ifndef MR_HIGHLEVEL_DATA
+  #define ML_report_uncaught_exception \
+			 mercury__exception__report_uncaught_exception_3_p_0
+  #define ML_throw_io_error		mercury__io__throw_io_error_1_p_0
+  #define ML_io_finalize_state		mercury__io__finalize_state_2_p_0
+  #define ML_io_init_state		mercury__io__init_state_2_p_0
+  #define ML_io_stderr_stream		mercury__io__stderr_stream_3_p_0
+  #define ML_io_stdin_stream		mercury__io__stdin_stream_3_p_0
+  #define ML_io_stdout_stream		mercury__io__stdout_stream_3_p_0
+  #endif
 #endif
 
 /*---------------------------------------------------------------------------*/
@@ -423,10 +425,12 @@
 ** XXX this is a hack to work-around the current lack of
 ** support for `pragma export'.
 */
+#ifndef MR_BOOTSTRAPPED_PRAGMA_EXPORT
 void ML_io_print_to_cur_stream(MR_Word ti, MR_Word x);
 void ML_io_print_to_stream(MR_Word ti, MR_Word stream, MR_Word x);
 void ML_report_uncaught_exception(MR_Word ti);
 void ML_throw_io_error(MR_String);
+#endif
 
 /*---------------------------------------------------------------------------*/
 
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.21
diff -u -r1.21 mercury_init.h
--- runtime/mercury_init.h	2000/05/08 16:11:06	1.21
+++ runtime/mercury_init.h	2000/07/17 12:59:06
@@ -115,9 +115,20 @@
 extern	void	ML_io_stderr_stream(Word *);
 extern	void	ML_io_stdout_stream(Word *);
 extern	void	ML_io_stdin_stream(Word *);
-extern	void	ML_io_print_to_cur_stream(Word, Word);
-extern	void	ML_io_print_to_stream(Word, Word, Word);
 
+#ifndef MR_HIGHLEVEL_CODE
+  extern void	ML_io_print_to_stream(Word, Word, Word);
+  extern void	ML_io_print_to_cur_stream(Word, Word);
+#else
+  #ifdef MR_BOOTSTRAPPED_PRAGMA_EXPORT
+    extern void	ML_io_print_to_stream(MR_Word, MR_Word, MR_Box);
+    extern void	ML_io_print_to_cur_stream(MR_Word, MR_Box);
+  #else
+    extern void	ML_io_print_to_stream(Word, Word, Word);
+    extern void	ML_io_print_to_cur_stream(Word, Word);
+  #endif
+#endif
+
 /* in trace/mercury_trace_internal.h */
 extern	char	*MR_trace_getline(const char *, FILE *mdb_in, FILE *mdb_out);
 
@@ -138,11 +149,20 @@
 extern	bool	ML_DI_found_match(Integer, Integer, Integer, Word, String,
 		String, Integer, Integer, Integer, Word, String, Word);
 		/* found_match/12 */
-extern	Integer	ML_DI_get_var_number(Word);
 extern	void	ML_DI_read_request_from_socket(Word, Word *, Integer *);
 
+#ifndef MR_HIGHLEVEL_CODE
+  extern Integer	ML_DI_get_var_number(Word);
+#else
+  extern MR_Integer	ML_DI_get_var_number(MR_Word);
+#endif
+
 /* in library/std_util.m  */
-extern	String	ML_type_name(Word);
+#ifndef MR_HIGHLEVEL_CODE
+  extern String		ML_type_name(Word);
+#else
+  extern MR_String	ML_type_name(MR_Word);
+#endif
 
 /* in runtime/mercury_trace_base.c */
 extern	Code	*MR_trace_fake(const MR_Stack_Layout_Label *);
@@ -153,9 +173,6 @@
 
 /* in trace/mercury_trace_tables.c */
 extern	void	MR_register_module_layout_real(const MR_Module_Layout *);
-
-/* in library/std_util.h  */
-extern	String	ML_type_name(Word);
 
 /*---------------------------------------------------------------------------*/
 

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