[m-dev.] diff: MLDS backend: strip away io__state arguments

Fergus Henderson fjh at cs.mu.OZ.AU
Sat Sep 18 03:18:34 AEST 1999
Previous message: [m-dev.] diff: MLDS backend: support builtins
Next message: [m-dev.] diff: MLDS backend: implement negation; nondet code bug fix
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Estimated hours taken: 1

Strip away `io__state' (and `store__store') arguments
in the MLDS code generator.

compiler/export.m:
compiler/type_util.m:
compiler/make_hlds.m:
	Move export__exclude_argument_type to type_util.m
	and rename it as type_util__is_dummy_argument_type.

compiler/ml_code_gen.m:
	Omit arguments for which type_util__is_dummy_argument_type is true.

compiler/mlds_to_c.m:
	Output `Bar foo(void)' rather than `Bar foo()' for functions
	with no parameters.

Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.27
diff -u -r1.27 export.m
--- compiler/export.m	1999/09/16 09:24:30	1.27
+++ compiler/export.m	1999/09/17 17:12:17
@@ -58,22 +58,15 @@
 :- pred convert_type_from_mercury(string, type, string).
 :- mode convert_type_from_mercury(in, in, out) is det.
 
-	% 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
-	% importing or exporting procedures to/from C, we don't
-	% include arguments with these types.
-:- pred export__exclude_argument_type(type).
-:- mode export__exclude_argument_type(in) is semidet.
-
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
 :- import_module code_gen, code_util, hlds_pred, llds_out, modules.
-:- import_module term, varset.
+:- import_module type_util.
 
+:- import_module term, varset.
 :- import_module library, map, int, string, std_util, assoc_list, require.
 :- import_module list, bool.
 
@@ -245,7 +238,7 @@
 			pred_args_to_func_args(ArgInfoTypes0, ArgInfoTypes1,
 				arg_info(RetArgLoc, RetArgMode) - RetType),
 			RetArgMode = top_out,
-			\+ export__exclude_argument_type(RetType)
+			\+ type_util__is_dummy_argument_type(RetType)
 		->
 			export__type_to_type_string(RetType, C_RetType),
 			argloc_to_string(RetArgLoc, RetArgString0),
@@ -299,7 +292,7 @@
 :- 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).
+	\+ type_util__is_dummy_argument_type(Type).
 
 	% get_argument_declarations(Args, NameThem, DeclString):
 	% build a string to declare the argument types (and if
@@ -460,25 +453,6 @@
 	;
 		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
-% importing or exporting procedures to/from C, we don't
-% include arguments with these types.
-
-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.
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.304
diff -u -r1.304 make_hlds.m
--- compiler/make_hlds.m	1999/09/17 06:28:36	1.304
+++ compiler/make_hlds.m	1999/09/17 16:27:40
@@ -3285,7 +3285,7 @@
 			mode_to_arg_mode(ModuleInfo, RetMode, RetType,
 				RetArgMode),
 			RetArgMode = top_out,
-			\+ export__exclude_argument_type(RetType)
+			\+ type_util__is_dummy_argument_type(RetType)
 		->
 			string__append(RetArgName, " = ", C_Code0),
 			Args2 = Args1
@@ -3320,7 +3320,7 @@
 include_import_arg(ModuleInfo, pragma_var(_Var, _Name, Mode) - Type) :-
 	mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
 	ArgMode \= top_unused,
-	\+ export__exclude_argument_type(Type).
+	\+ type_util__is_dummy_argument_type(Type).
 
 %
 % create_pragma_vars(Vars, Modes, ArgNum0, PragmaVars):
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.4
diff -u -r1.4 ml_code_gen.m
--- compiler/ml_code_gen.m	1999/09/17 16:22:25	1.4
+++ compiler/ml_code_gen.m	1999/09/17 17:03:52
@@ -934,9 +934,10 @@
 	=(MLDSGenInfo),
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
 	{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
-		_PredInfo, ProcInfo) },
+		PredInfo, ProcInfo) },
+	{ pred_info_arg_types(PredInfo, ArgTypes) },
 	{ proc_info_argmodes(ProcInfo, ArgModes) },
-	ml_gen_arg_list(ArgVars, ArgModes, ArgRvals0, RetLvals0),
+	ml_gen_arg_list(ArgVars, ArgTypes, ArgModes, ArgRvals0, RetLvals0),
 
 	% append the extra argument or return val for this code_model
 	(
@@ -986,21 +987,32 @@
 %
 % Generate rvals and lvals for the arguments of a procedure call
 %
-:- pred ml_gen_arg_list(list(prog_var), list(mode),
+:- pred ml_gen_arg_list(list(prog_var), list(prog_data__type), list(mode),
 		list(mlds__rval), list(mlds__lval),
 		ml_gen_info, ml_gen_info).
-:- mode ml_gen_arg_list(in, in, out, out, in, out) is det.
+:- mode ml_gen_arg_list(in, in, in, out, out, in, out) is det.
 
-ml_gen_arg_list(Vars, Modes, InputRvals, OutputLvals) -->
-	( { Vars = [], Modes = [] } ->
+ml_gen_arg_list(Vars, Types, Modes, InputRvals, OutputLvals) -->
+	(
+		{ Vars = [], Types = [], Modes = [] }
+	->
 		{ InputRvals = [] },
 		{ OutputLvals = [] }
-	; { Vars = [Var|Vars1], Modes = [Mode|Modes1] } ->
+	;
+		{ Vars = [Var|Vars1] },
+		{ Types = [Type|Types1] },
+		{ Modes = [Mode|Modes1] }
+	->
 		ml_gen_var(Var, VarLval),
-		ml_gen_arg_list(Vars1, Modes1, InputRvals1, OutputLvals1),
+		ml_gen_arg_list(Vars1, Types1, Modes1,
+			InputRvals1, OutputLvals1),
 		=(MLDSGenInfo),
 		{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
-		( { mode_is_input(ModuleInfo, Mode) } ->
+		( { type_util__is_dummy_argument_type(Type) } ->
+			% exclude arguments of type io__state etc.
+			{ InputRvals = InputRvals1 },
+			{ OutputLvals = OutputLvals1 }
+		; { mode_is_input(ModuleInfo, Mode) } ->
 			{ InputRvals = [lval(VarLval) | InputRvals1] },
 			{ OutputLvals = OutputLvals1 }
 	/************
@@ -2715,11 +2727,16 @@
 		HeadTypes = [Type | Types],
 		HeadModes = [Mode | Modes]
 	->
-		ml_gen_arg_decl(ModuleInfo, Var, Type, Mode, VarSet,
-			FuncArg),
 		ml_gen_arg_decls(ModuleInfo, Vars, Types, Modes, VarSet,
-			FuncArgs1),
-		FuncArgs = [FuncArg | FuncArgs1]
+			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, VarSet,
+				FuncArg),
+			FuncArgs = [FuncArg | FuncArgs0]
+		)
 	;
 		error("ml_gen_arg_decls: length mismatch")
 	).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.5
diff -u -r1.5 mlds_to_c.m
--- compiler/mlds_to_c.m	1999/09/17 16:22:27	1.5
+++ compiler/mlds_to_c.m	1999/09/17 17:08:10
@@ -423,7 +423,12 @@
 
 mlds_output_params(Indent, FuncName, Parameters) -->
 	io__write_char('('),
-	io__write_list(Parameters, ", ", mlds_output_param(Indent, FuncName)),
+	( { Parameters = [] } ->
+		io__write_string("void")
+	;
+		io__write_list(Parameters, ", ",
+			mlds_output_param(Indent, FuncName))
+	),
 	io__write_char(')').
 
 :- pred mlds_output_param(int, qualified_entity_name,
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.71
diff -u -r1.71 type_util.m
--- compiler/type_util.m	1999/07/19 04:50:47	1.71
+++ compiler/type_util.m	1999/09/17 16:34:43
@@ -45,6 +45,14 @@
 :- pred type_id_is_higher_order(type_id, pred_or_func, lambda_eval_method).
 :- mode type_id_is_higher_order(in, out, out) is semidet.
 
+	% Certain types, e.g. 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
+	% importing or exporting procedures to/from C, we don't
+	% include arguments with these types.
+:- pred type_util__is_dummy_argument_type(type).
+:- mode type_util__is_dummy_argument_type(in) is semidet.
+
 :- pred type_is_aditi_state(type).
 :- mode type_is_aditi_state(in) is semidet.
 
@@ -437,6 +445,26 @@
 		PorFStr = "func",
 		PredOrFunc = function
 	).
+
+	% Certain types, e.g. 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
+	% importing or exporting procedures to/from C, we don't
+	% include arguments with these types.
+
+type_util__is_dummy_argument_type(Type) :-
+	Type = term__functor(term__atom(":"), [
+			term__functor(term__atom(ModuleName), [], _),
+			term__functor(term__atom(TypeName), TypeArgs, _)
+		], _),
+	list__length(TypeArgs, TypeArity),
+	type_util__is_dummy_argument_type_2(ModuleName, TypeName, TypeArity).
+
+:- pred type_util__is_dummy_argument_type_2(string::in, string::in, arity::in)
+	is semidet.
+% XXX should we include aditi:state/0 in this list?
+type_util__is_dummy_argument_type_2("io", "state", 0).	 % io:state/0
+type_util__is_dummy_argument_type_2("store", "store", 1). % store:store/1.
 
 type_is_aditi_state(Type) :-
         type_to_type_id(Type,

-- 
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
--------------------------------------------------------------------------
Previous message: [m-dev.] diff: MLDS backend: support builtins
Next message: [m-dev.] diff: MLDS backend: implement negation; nondet code bug fix
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the developers mailing list