[m-dev.] diff: MLDS back-end: fix `pragma export' bug

[Fergus Henderson]

On 22-Aug-2000, Peter Ross <peter.ross at miscrit.be> wrote:
> The exception.m changes are needed because exporting a predicate from a
> different module then it is defined in is broken under the mlds (the wrong
> module name is used).

The following diff fixes that.

----------

Estimated hours taken: 1

Fix a bug in the MLDS back-end: handle `pragma export' of procedures
defined in modules other than the current module.

compiler/mlds.m:
	Change the entity_name in the pragma_export type to a
	qualified_entity_name.

compiler/ml_code_util.m:
	Change ml_gen_proc_label so that it returns the module name too,
	not just the entity_name.

compiler/ml_code_gen.m:
compiler/mlds_to_c.m:
	Modify to reflect the changes described above.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.57
diff -u -d -r1.57 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/08/09 07:47:13	1.57
+++ compiler/ml_code_gen.m	2000/08/24 06:38:27
@@ -734,7 +734,8 @@
 		pragma_exported_proc(PredId, ProcId, C_Name, ProgContext),
 		ML_Defn) :-
 
-	MLDS_Name = ml_gen_proc_label(ModuleInfo, PredId, ProcId),
+	ml_gen_proc_label(ModuleInfo, PredId, ProcId,
+		MLDS_Name, MLDS_ModuleName),
 	MLDS_FuncParams = ml_gen_proc_params(ModuleInfo, PredId, ProcId),
 	MLDS_Context = mlds__make_context(ProgContext),
 
@@ -746,8 +747,8 @@
 		IsOutDetFunc = no
 	),
 
-	ML_Defn = ml_pragma_export(C_Name, MLDS_Name, MLDS_FuncParams,
-			MLDS_Context, IsOutDetFunc).
+	ML_Defn = ml_pragma_export(C_Name, qual(MLDS_ModuleName, MLDS_Name),
+			MLDS_FuncParams, MLDS_Context, IsOutDetFunc).
 
 
 	%
@@ -857,7 +858,7 @@
 ml_gen_proc(ModuleInfo, PredId, ProcId, _PredInfo, ProcInfo, Defns0, Defns) :-
 	proc_info_context(ProcInfo, Context),
 
-	MLDS_Name = ml_gen_proc_label(ModuleInfo, PredId, ProcId),
+	ml_gen_proc_label(ModuleInfo, PredId, ProcId, MLDS_Name, _ModuleName),
 	MLDS_Context = mlds__make_context(Context),
 	MLDS_DeclFlags = ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId),
 	ml_gen_proc_defn(ModuleInfo, PredId, ProcId,
@@ -1947,8 +1948,9 @@
 ml_gen_hash_define_mr_proc_label(PredId, ProcId, HashDefine) -->
 	=(MLDSGenInfo),
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+	{ ml_gen_proc_label(ModuleInfo, PredId, ProcId, MLDS_Name, _Module) },
 	{ HashDefine = [raw_target_code("#define MR_PROC_LABEL "),
-			name(ml_gen_proc_label(ModuleInfo, PredId, ProcId)),
+			name(MLDS_Name),
 			raw_target_code("\n")] }.
 
 
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.18
diff -u -d -r1.18 ml_code_util.m
--- compiler/ml_code_util.m	2000/07/27 15:13:45	1.18
+++ compiler/ml_code_util.m	2000/08/24 06:56:05
@@ -125,10 +125,12 @@
 % Routines for generating labels and entity names.
 %
 
-	% Generate the mlds__entity_name for the entry point function
-	% corresponding to a given procedure.
+	% Generate the mlds__entity_name and module name for the entry point
+	% function corresponding to a given procedure.
 	%
-:- func ml_gen_proc_label(module_info, pred_id, proc_id) = mlds__entity_name.
+:- pred ml_gen_proc_label(module_info, pred_id, proc_id,
+		mlds__entity_name, mlds_module_name).
+:- mode ml_gen_proc_label(in, in, in, out, out) is det.
 
 	% Generate an mlds__entity_name for a continuation function
 	% with the given sequence number.  The pred_id and proc_id
@@ -874,24 +876,30 @@
 % Code for generating mlds__entity_names.
 %
 
-	% Generate the mlds__entity_name for the entry point function
-	% corresponding to a given procedure.
+	% Generate the mlds__entity_name and module name for the entry point
+	% function corresponding to a given procedure.
 	%
-ml_gen_proc_label(ModuleInfo, PredId, ProcId) = 
-	ml_gen_func_label(ModuleInfo, PredId, ProcId, no).
+ml_gen_proc_label(ModuleInfo, PredId, ProcId, MLDS_Name, MLDS_ModuleName) :-
+	ml_gen_func_label(ModuleInfo, PredId, ProcId, no,
+		MLDS_Name, MLDS_ModuleName).
 
 	% Generate an mlds__entity_name for a continuation function
 	% with the given sequence number.  The pred_id and proc_id
 	% specify the procedure that this continuation function
 	% is part of.
 	%
-ml_gen_nondet_label(ModuleInfo, PredId, ProcId, SeqNum) =
-	ml_gen_func_label(ModuleInfo, PredId, ProcId, yes(SeqNum)).
+ml_gen_nondet_label(ModuleInfo, PredId, ProcId, SeqNum) = MLDS_Name :-
+	ml_gen_func_label(ModuleInfo, PredId, ProcId, yes(SeqNum),
+		MLDS_Name, _MLDS_ModuleName).
 
-:- func ml_gen_func_label(module_info, pred_id, proc_id,
-		maybe(ml_label_func)) = mlds__entity_name.
-ml_gen_func_label(ModuleInfo, PredId, ProcId, MaybeSeqNum) = MLDS_Name :-
-	ml_gen_pred_label(ModuleInfo, PredId, ProcId, MLDS_PredLabel, _),
+:- pred ml_gen_func_label(module_info, pred_id, proc_id,
+		maybe(ml_label_func), mlds__entity_name, mlds_module_name).
+:- mode ml_gen_func_label(in, in, in, in, out, out) is det.
+
+ml_gen_func_label(ModuleInfo, PredId, ProcId, MaybeSeqNum,
+		MLDS_Name, MLDS_ModuleName) :-
+	ml_gen_pred_label(ModuleInfo, PredId, ProcId,
+		MLDS_PredLabel, MLDS_ModuleName),
 	MLDS_Name = function(MLDS_PredLabel, ProcId, MaybeSeqNum, PredId).
 
 	% Allocate a new function label and return an rval containing
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.31
diff -u -d -r1.31 mlds.m
--- compiler/mlds.m	2000/08/11 03:15:34	1.31
+++ compiler/mlds.m	2000/08/24 06:40:08
@@ -618,7 +618,7 @@
 :- type mlds__pragma_export
 	---> ml_pragma_export(
 		string,			% Exported name
-		mlds__entity_name,	% MLDS name for exported entity
+		mlds__qualified_entity_name, % MLDS name for exported entity
 		mlds__func_params,	% MLDS function parameters
 		mlds__context,
 		bool			% is a det function with the
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.51
diff -u -d -r1.51 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/08/11 03:15:35	1.51
+++ compiler/mlds_to_c.m	2000/08/24 06:42:21
@@ -551,8 +551,8 @@
 	% Output the definition body for a pragma export when it is
 	% *NOT* a det function whose last arg is top_out.
 	%
-:- pred mlds_output_pragma_export_defn_body(mlds_module_name, mlds__entity_name,
-		func_params, io__state, io__state).
+:- pred mlds_output_pragma_export_defn_body(mlds_module_name,
+		mlds__qualified_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) -->
@@ -569,7 +569,7 @@
 		{ error("mlds_output_pragma_export: multiple return types") }
 	),
 
-	mlds_output_fully_qualified_name(qual(ModuleName, FuncName)),
+	mlds_output_fully_qualified_name(FuncName),
 	io__write_string("("),
 	io__write_list(Parameters, ", ",
 			mlds_output_name_with_cast(ModuleName)),
@@ -581,7 +581,8 @@
 	% det function whose last arg is top_out.
 	%
 :- pred mlds_output_pragma_export_func_defn_body(mlds_module_name,
-		mlds__entity_name, func_params, io__state, io__state).
+		mlds__qualified_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) -->
@@ -604,7 +605,7 @@
 
 		% Call the MLDS function.
 	io__write_string("\t"),
-	mlds_output_fully_qualified_name(qual(ModuleName, FuncName)),
+	mlds_output_fully_qualified_name(FuncName),
 	io__write_string("("),
 	write_func_args(ModuleName, Parameters),
 	io__write_string(");\n"),

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