[m-rev.] for review: implement pragma export on the .NET backend.

[Tyson Dowd]

Hi,


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


Estimated hours taken: 8
Branches: main

Implement pragma export on the .NET backend.

We just generate a forwarding call from the "exported" name (which
occurs in the same class and module) to the specified predicate.

compiler/ml_code_gen.m:
	Generate exports for IL as well as C.

compiler/mlds_to_il.m:
	Generate a forwarding function for each exported predicate.
	Put the forwarding function inside the wrapper class.
	Generate a more specific error message if an return statement
	has an empty list of return values.


Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.98
diff -u -r1.98 ml_code_gen.m
--- compiler/ml_code_gen.m	7 Aug 2001 13:53:33 -0000	1.98
+++ compiler/ml_code_gen.m	22 Aug 2001 12:02:37 -0000
@@ -819,8 +819,8 @@
 			MLDSWantedForeignBodys = list__map(ConvBody, 
 				WantedForeignBodys),
 			 	% XXX exports are only implemented for
-				% C at the moment
-			( Lang = c ->
+				% C and IL at the moment
+			( ( Lang = c ; Lang = il ) ->
 				ml_gen_pragma_export(ModuleInfo,
 					MLDS_PragmaExports)
 			;
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.76
diff -u -r1.76 mlds_to_il.m
--- compiler/mlds_to_il.m	16 Aug 2001 15:04:03 -0000	1.76
+++ compiler/mlds_to_il.m	22 Aug 2001 12:02:40 -0000
@@ -45,7 +45,6 @@
 % [ ] Computed gotos need testing.
 % [ ] :- extern doesn't work -- it needs to be treated like pragma c code.
 % [ ] nested modules need testing
-% [ ] Implement pragma export.
 % [ ] Fix issues with abstract types so that we can implement C
 %     pointers as MR_Box rather than MR_Word.
 % [ ] When generating target_code, sometimes we output more calls than
@@ -194,7 +193,9 @@
 %-----------------------------------------------------------------------------%
 
 generate_il(MLDS, ILAsm, ForeignLangs, IO0, IO) :-
-	mlds(MercuryModuleName, _, Imports, Defns) = transform_mlds(MLDS),
+
+	mlds(MercuryModuleName, _ForeignCode, Imports, Defns) =
+		transform_mlds(MLDS),
 
 	ModuleName = mercury_module_name_to_mlds(MercuryModuleName),
 	prog_out__sym_name_to_string(mlds_module_name_to_sym_name(ModuleName),
@@ -213,6 +214,7 @@
 	IlInfo0 = il_info_init(ModuleName, AssemblyName, Imports,
 			ILDataRep, DebugIlAsm, VerifiableCode, ByRefTailCalls),
 
+		% Generate code for all the methods.
 	list__map_foldl(mlds_defn_to_ilasm_decl, Defns, ILDecls,
 			IlInfo0, IlInfo),
 
@@ -276,11 +278,21 @@
 :- func transform_mlds(mlds) = mlds.
 
 transform_mlds(MLDS0) = MLDS :-
+	AllExports = list__condense(
+		list__map(
+			(func(mlds__foreign_code(_, _, Exports)) = Exports),
+			map__values(MLDS0 ^ foreign_code))
+		),
+
+		% Generate the exports for this file, they will be placed
+		% into global methods.
+	list__map(mlds_export_to_mlds_defn, AllExports, ExportDefns),
+
 	list__filter((pred(D::in) is semidet :-
 			( D = mlds__defn(_, _, _, mlds__function(_, _, _))
 			; D = mlds__defn(_, _, _, mlds__data(_, _))
 			)
-		), MLDS0 ^ defns, MercuryCodeMembers, Others),
+		), MLDS0 ^ defns ++ ExportDefns, MercuryCodeMembers, Others),
 	WrapperClass = wrapper_class(list__map(rename_defn, MercuryCodeMembers)),
 		% Note that ILASM requires that the type definitions in Others
 		% must precede the references to those types in WrapperClass.
@@ -1082,6 +1094,83 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
+	% MLDS exports are converted into forwarding functions, which are
+	% marked as public, are given the specified name, and simply call to
+	% the "exported" function.
+	%
+	% They will be placed inside the "mercury_code" wrapper class with
+	% all the other procedures.
+	%
+	% XXX much of this code should be generalized and turned into a
+	% more general routine for generating MLDS forwarding functions.
+	% We could use almost the same approach for outline_foreign_code
+	% to generate the forwarding function.
+
+:- pred mlds_export_to_mlds_defn(mlds__pragma_export::in, mlds__defn::out)
+	is det.
+
+mlds_export_to_mlds_defn(
+	ml_pragma_export(ExportName, EntityName, Params, Context), Defn) :- 
+	EntityName = qual(ModuleName, UnqualName),
+
+	Params = mlds__func_params(Inputs, RetTypes),
+	list__map_foldl((pred(RT::in, RV - Lval::out,
+			N0::in, N0 + 1::out) is det :-
+		VN = var_name("returnval" ++ int_to_string(N0), no),
+		RV = ml_gen_mlds_var_decl(var(VN), RT, no_initializer, Context),
+		Lval = var(qual(ModuleName, VN), RT)),
+			RetTypes, ReturnVars, 0, _),
+
+	EntNameToVarName = (func(EntName) = VarName :-
+		( EntName = data(var(VarName0)) ->
+			VarName = qual(ModuleName, VarName0)
+		;
+			error("exported method has argument without var name")
+		)
+	),
+	ArgTypes = assoc_list__values(Inputs),
+	ArgRvals = list__map(
+		(func(EntName - Type) = lval(var(VarName, Type)) :-
+			VarName = EntNameToVarName(EntName)
+		), Inputs),
+	ReturnVarDecls = assoc_list__keys(ReturnVars),
+	ReturnLvals = assoc_list__values(ReturnVars),
+	ReturnRvals = list__map((func(X) = lval(X)), ReturnLvals),
+
+	Signature = func_signature(ArgTypes, RetTypes),
+	( 
+		UnqualName = function(PredLabel, ProcId, _MaybeSeq, _PredId)
+	->
+		CodeRval = const(code_addr_const(proc(
+			qual(ModuleName, PredLabel - ProcId),
+			Signature)))
+	;
+		error("exported entity is not a function")
+	),
+
+		% XXX should we look for tail calls?
+	CallStatement = statement(
+		call(Signature, CodeRval, no, ArgRvals, ReturnLvals,
+			call), Context),
+	ReturnStatement = statement(return(ReturnRvals), Context),
+
+	Statement = statement(mlds__block(ReturnVarDecls,
+		( ReturnRvals = [] ->
+			[CallStatement]
+		;
+			[CallStatement, ReturnStatement]
+		)
+		), Context),
+		
+	DefnEntity = function(no, Params, defined_here(Statement)),
+
+	Flags = init_decl_flags(public, one_copy, non_virtual, overridable,
+		const, concrete),
+	Defn = defn(export(ExportName), Context, Flags, DefnEntity).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 	%
 	% Code for generating initializers.
 	%
@@ -1399,6 +1488,8 @@
 			context_node(Context),
 			LoadInstrs,
 			instr_node(ret)]) }
+	; { Rvals = [] } ->
+		{ unexpected(this_file, "empty list of return values") }
 	;
 		% MS IL doesn't support multiple return values
 		{ sorry(this_file, "multiple return values") }
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------