diff: `pragma export' and `io__state'

[Fergus Henderson]

Hi,

DJ, can you please review this change?

compiler/export.m:
	When exporting procedures to C, don't include procedure arguments
	with type `io__state' or `store__store' or with mode `unused'
	in the arguments of the C function.

doc/reference_manual.texi:
	Document the above change.

runtime/init.h:
runtime/wrapper.h:
runtime/wrapper.mod:
	Modify the interface to ML_io_init_state() and ML_io_finalize_state()
	to reflect the above change.

cvs diff compiler/export.m doc/reference_manual.texi runtime/init.h runtime/wrapper.h runtime/wrapper.mod
Index: compiler/export.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/export.m,v
retrieving revision 1.13
diff -u -r1.13 export.m
--- 1.13	1997/07/27 15:00:16
+++ export.m	1997/09/27 16:20:58
@@ -5,7 +5,7 @@
 %-----------------------------------------------------------------------------%
 
 % This module defines predicates to produce the functions which are
-% exported to C via a pragma(export, ...) declaration.
+% exported to C via a `pragma export' declaration.
 
 % Main authors: dgj.
 
@@ -193,7 +193,8 @@
 			PredOrFunc = function,
 			pred_args_to_func_args(ArgInfoTypes0, ArgInfoTypes1,
 				arg_info(RetArgLoc, RetArgMode) - RetType),
-			RetArgMode = top_out
+			RetArgMode = top_out,
+			\+ export__exclude_argument_type(RetType)
 		->
 			export__term_to_type_string(RetType, C_RetType),
 			argloc_to_string(RetArgLoc, RetArgString0),
@@ -206,13 +207,13 @@
 						";\n"], MaybeFail),
 			string__append_list(["\treturn return_value;\n"],
 				MaybeSucceed),
-			ArgInfoTypes = ArgInfoTypes1
+			ArgInfoTypes2 = ArgInfoTypes1
 		;
 			C_RetType = "void",
 			MaybeDeclareRetval = "",
 			MaybeFail = "",
 			MaybeSucceed = "",
-			ArgInfoTypes = ArgInfoTypes0
+			ArgInfoTypes2 = ArgInfoTypes0
 		)
 	; CodeModel = model_semi,
 		% we treat semidet functions the same as semidet predicates,
@@ -228,7 +229,7 @@
 			"\t}\n"
 				], MaybeFail),
 		MaybeSucceed = "\treturn TRUE;\n",
-		ArgInfoTypes = ArgInfoTypes0
+		ArgInfoTypes2 = ArgInfoTypes0
 	; CodeModel = model_non,
 		% we should probably check this earlier, e.g. in make_hlds.m,
 		% but better we catch this error late than never...
@@ -236,8 +237,18 @@
 		MaybeDeclareRetval = "",
 		MaybeFail = "",
 		MaybeSucceed = "",
-		ArgInfoTypes = ArgInfoTypes0
-	).
+		ArgInfoTypes2 = ArgInfoTypes0
+	),
+	list__filter(export__include_arg, ArgInfoTypes2, ArgInfoTypes).
+
+	% export__include_arg(ArgInfoType):
+	%	Succeeds iff the specified argument should be included in
+	%	the arguments of the exported C function.
+	%
+:- pred export__include_arg(pair(arg_info, type)::in) is semidet.
+export__include_arg(arg_info(_Loc, Mode) - Type) :-
+	Mode \= top_unused,
+	\+ export__exclude_argument_type(Type).
 
 	% get_argument_declarations(Args, NameThem, DeclString):
 	% build a string to declare the argument types (and if
@@ -257,8 +268,24 @@
 get_argument_declarations_2([], _, _, "").
 get_argument_declarations_2([AT|ATs], Num0, NameThem, Result) :-
 	AT = ArgInfo - Type,
-	ArgInfo = arg_info(_Loc, Mode),
 	Num is Num0 + 1,
+	get_argument_declaration(ArgInfo, Type, Num, NameThem,
+			TypeString, ArgName),
+	(
+		ATs = []
+	->
+		string__append(TypeString, ArgName, Result)
+	;
+		get_argument_declarations_2(ATs, Num, NameThem, TheRest),
+		string__append_list([TypeString, ArgName, ", ", TheRest],
+			Result)
+	).
+	
+:- pred get_argument_declaration(arg_info, type, int, bool, string, string).
+:- mode get_argument_declaration(in, in, in, in, out, out) is det.
+
+get_argument_declaration(ArgInfo, Type, Num, NameThem, TypeString, ArgName) :-
+	ArgInfo = arg_info(_Loc, Mode),
 	( NameThem = yes ->
 		string__int_to_string(Num, NumString),
 		string__append(" Mercury__argument", NumString, ArgName)
@@ -273,15 +300,6 @@
 		string__append(TypeString0, " *", TypeString)
 	;
 		TypeString = TypeString0
-	),
-	(
-		ATs = []
-	->
-		string__append(TypeString, ArgName, Result)
-	;
-		get_argument_declarations_2(ATs, Num, NameThem, TheRest),
-		string__append_list([TypeString, ArgName, ", ", TheRest], 
-			Result)
 	).
 
 :- pred get_input_args(assoc_list(arg_info, type), int, string).
@@ -392,6 +410,25 @@
 		ConvertedRval = Rval
 	).
 
+% Certain types, namely io__state and store__store(S),
+% are just dummy types used to ensure logical semantics;
+% there is no need to actually pass them, and so when
+% exporting procedures to C, we don't include arguments with
+% these types.
+
+:- pred export__exclude_argument_type((type)::in) is semidet.
+export__exclude_argument_type(Type) :-
+	Type = term__functor(term__atom(":"), [
+			term__functor(term__atom(ModuleName), [], _),
+			term__functor(term__atom(TypeName), TypeArgs, _)
+		], _),
+	list__length(TypeArgs, TypeArity),
+	export__exclude_argument_type_2(ModuleName, TypeName, TypeArity).
+
+:- pred export__exclude_argument_type_2(string::in, string::in, arity::in)
+	is semidet.
+export__exclude_argument_type_2("io", "state", 0).	% io:state/0
+export__exclude_argument_type_2("store", "store", 1).	% store:store/1.
 
 export__produce_header_file(Module, ModuleName) -->
 	{ module_info_get_pragma_exported_procs(Module, ExportedProcs) },
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/reference_manual.texi,v
retrieving revision 1.71
diff -u -r1.71 reference_manual.texi
--- 1.71	1997/09/23 16:47:22
+++ reference_manual.texi	1997/09/27 16:19:01
@@ -2879,6 +2879,10 @@
 the function result has an output mode, then the C interface
 function will return the Mercury function result value.
 Otherwise the function result is appended as an extra argument.
+Arguments of type @samp{io__state} or @samp{store__store(_)}
+are not passed at all; that's because these types represent mutable state,
+and in C modifications to mutable state are done via side effects,
+rather than argument passing.
 
 Calling polymorphically typed Mercury procedures from C is a little bit
 more difficult than calling ordinary (monomorphically typed) Mercury procedures.
Index: runtime/init.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/init.h,v
retrieving revision 1.19
diff -u -r1.19 init.h
--- 1.19	1997/09/05 23:19:59
+++ init.h	1997/09/27 16:43:20
@@ -91,10 +91,19 @@
 ** mercury_main() takes the address of the following predicates/functions,
 ** which are defined elsewhere.
 */
-Declare_entry(mercury__main_2_0);		    /* in the user's program */
-extern	void	mercury_init_io(void);		    /* in the Mercury library */
-extern	void	ML_io_init_state(Word, Word *);	    /* in the Mercury library */
-extern	void	ML_io_finalize_state(Word, Word *); /* in the Mercury library */
+Declare_entry(mercury__main_2_0);		/* in the user's program */
+extern	void	mercury_init_io(void);		/* in the Mercury library */
+/*
+** XXX the following #ifndef suppresses the declarations of
+** ML_io_init_state() and ML_io_finalize_state() if
+** they have already been declared in library/io.h;
+** this is a temporary hack to avoid errors about
+** conflicting declarations when boostrapping.
+*/
+#ifndef IO_H
+extern	void	ML_io_init_state(void);		/* in the Mercury library */
+extern	void	ML_io_finalize_state(void);	/* in the Mercury library */
+#endif
 
 #endif /* not INIT_H */
 
Index: runtime/wrapper.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/wrapper.h,v
retrieving revision 1.20
diff -u -r1.20 wrapper.h
--- 1.20	1997/09/05 23:20:05
+++ wrapper.h	1997/09/27 16:27:00
@@ -42,8 +42,8 @@
 */
 extern	Code *		program_entry_point; /* normally mercury__main_2_0; */
 
-extern	void		(*MR_library_initializer)(Word, Word *);
-extern	void		(*MR_library_finalizer)(Word, Word *);
+extern	void		(*MR_library_initializer)(void);
+extern	void		(*MR_library_finalizer)(void);
 
 extern	void		(*address_of_mercury_init_io)(void);
 extern	void		(*address_of_init_modules)(void);
Index: runtime/wrapper.mod
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/wrapper.mod,v
retrieving revision 1.80
diff -u -r1.80 wrapper.mod
--- 1.80	1997/09/06 12:56:45
+++ wrapper.mod	1997/09/27 16:30:27
@@ -80,8 +80,6 @@
 char **		mercury_argv;
 int		mercury_exit_status = 0;
 
-static Word	MR_io_state;
-
 /*
 ** EXTERNAL DEPENDENCIES
 **
@@ -115,9 +113,9 @@
 
 Code	*program_entry_point;
 		/* normally mercury__main_2_0 (main/2) */
-void	(*MR_library_initializer)(Word, Word *);
+void	(*MR_library_initializer)(void);
 		/* normally ML_io_init_state (io__init_state/2)*/
-void	(*MR_library_finalizer)(Word, Word *);
+void	(*MR_library_finalizer)(void);
 		/* normally ML_io_finalize_state (io__finalize_state/2) */
 
 
@@ -226,7 +224,7 @@
 	save_registers();
 
 	/* initialize the Mercury library */
-	(*MR_library_initializer)(MR_io_state, &MR_io_state);
+	(*MR_library_initializer)();
 
 	/*
 	** Restore the callee-save registers before returning,
@@ -916,7 +914,7 @@
 	*/
 	save_regs_to_mem(c_regs);
 
-	(*MR_library_finalizer)(MR_io_state, &MR_io_state);
+	(*MR_library_finalizer)();
 
 	terminate_engine();
 

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