[m-rev.] diff: minor cleanups in export.m and tupling.m

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Mar 21 13:40:37 AEDT 2005


compiler/export.m:
compiler/tupling.m:
	Convert a bunch of mode declarations into predmode declarations.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/export.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.82
diff -u -b -r1.82 export.m
--- compiler/export.m	19 Jan 2005 03:10:32 -0000	1.82
+++ compiler/export.m	19 Mar 2005 00:59:37 -0000
@@ -30,18 +30,20 @@
 	% of a foreign function named in a `pragma export' declaration,
 	% which is used to allow a call to be made to a Mercury
 	% procedure from the foreign language.
+	%
 :- pred export__get_foreign_export_decls(module_info::in,
 	foreign_export_decls::out) is det.
 
 	% From the module_info, get a list of foreign_export_defns,
 	% each of which is a string containing the foreign code
 	% for defining a foreign function named in a `pragma export' decl.
+	%
 :- pred export__get_foreign_export_defns(module_info::in,
 	foreign_export_defns::out) is det.
 
 	% Produce an interface file containing declarations for the
-	% exported foreign functions (if required in this foreign
-	% language).
+	% exported foreign functions (if required in this foreign language).
+	%
 :- pred export__produce_header_file(foreign_export_decls::in, module_name::in,
 	io::di, io::uo) is det.
 
@@ -53,15 +55,18 @@
 	% Generate C code to convert an rval (represented as a string), from
 	% a C type to a mercury C type (ie. convert strings and floats to
 	% words) and return the resulting C code as a string.
+	%
 :- pred convert_type_to_mercury(string::in, (type)::in, string::out) is det.
 
 	% Generate C code to convert an rval (represented as a string), from
 	% a mercury C type to a C type. (ie. convert words to strings and
 	% floats if required) and return the resulting C code as a string.
+	%
 :- pred convert_type_from_mercury(string::in, (type)::in, string::out) is det.
 
 	% Succeeds iff the given C type is known by the compiler to be
 	% an integer or pointer type the same size as MR_Word.
+	%
 :- pred c_type_is_word_sized_int_or_ptr(string::in) is semidet.
 
 %-----------------------------------------------------------------------------%
@@ -226,7 +231,7 @@
 	module_info::in, list(string)::out) is det.
 
 export__to_c(_Preds, [], _Module, []).
-export__to_c(Preds, [E|ExportedProcs], Module, ExportedProcsCode) :-
+export__to_c(Preds, [E | ExportedProcs], Module, ExportedProcsCode) :-
 	E = pragma_exported_proc(PredId, ProcId, C_Function, _Ctxt),
 	module_info_globals(Module, Globals),
 	get_export_info(Preds, PredId, ProcId, Globals, Module, DeclareString,
@@ -292,7 +297,7 @@
 				Code),
 
 	export__to_c(Preds, ExportedProcs, Module, TheRest),
-	ExportedProcsCode = [Code|TheRest].
+	ExportedProcsCode = [Code | TheRest].
 
 	% get_export_info(Preds, PredId, ProcId, Globals, DeclareString,
 	%		C_RetType, MaybeDeclareRetval, MaybeFail, MaybeSuccess,
@@ -309,9 +314,9 @@
 	module_info::in, string::out, string::out, string::out, string::out,
 	string::out, assoc_list(arg_info, type)::out) is det.
 
-get_export_info(Preds, PredId, ProcId, Globals, Module,
-		HowToDeclareLabel, C_RetType, MaybeDeclareRetval,
-		MaybeFail, MaybeSucceed, ArgInfoTypes) :-
+get_export_info(Preds, PredId, ProcId, Globals, Module, HowToDeclareLabel,
+		C_RetType, MaybeDeclareRetval, MaybeFail, MaybeSucceed,
+		ArgInfoTypes) :-
 	map__lookup(Preds, PredId, PredInfo),
 	pred_info_import_status(PredInfo, Status),
 	(
@@ -331,9 +336,11 @@
 	map__lookup(ProcTable, ProcId, ProcInfo),
 	proc_info_maybe_arg_info(ProcInfo, MaybeArgInfos),
 	pred_info_arg_types(PredInfo, ArgTypes),
-	( MaybeArgInfos = yes(ArgInfos0) ->
+	(
+		MaybeArgInfos = yes(ArgInfos0),
 		ArgInfos = ArgInfos0
 	;
+		MaybeArgInfos = no,
 		generate_proc_arg_info(ArgTypes, Module,
 			ProcInfo, NewProcInfo),
 		proc_info_arg_info(NewProcInfo, ArgInfos)
@@ -344,7 +351,8 @@
 
 	% figure out what the C return type should be,
 	% and build the `return' instructions (if any)
-	( CodeModel = model_det,
+	(
+		CodeModel = model_det,
 		(
 			PredOrFunc = function,
 			pred_args_to_func_args(ArgInfoTypes0, ArgInfoTypes1,
@@ -359,8 +367,7 @@
 			convert_type_from_mercury(RetArgString0, RetType,
 				RetArgString),
 			string__append_list(["\t", C_RetType,
-					" return_value;\n"],
-						MaybeDeclareRetval),
+				" return_value;\n"], MaybeDeclareRetval),
 			% We need to unbox non-word-sized foreign types
 			% before returning them to C code
 			( foreign__is_foreign_type(Export_RetType) = yes(_) ->
@@ -383,7 +390,8 @@
 			MaybeSucceed = "",
 			ArgInfoTypes2 = ArgInfoTypes0
 		)
-	; CodeModel = model_semi,
+	;
+		CodeModel = model_semi,
 		% we treat semidet functions the same as semidet predicates,
 		% which means that for Mercury functions the Mercury return
 		% value becomes the last argument, and the C return value
@@ -394,11 +402,11 @@
 			"\tif (!MR_r1) {\n",
 			"\t\tMR_restore_regs_from_mem(c_regs);\n",
 			"\treturn MR_FALSE;\n",
-			"\t}\n"
-				], MaybeFail),
+			"\t}\n"], MaybeFail),
 		MaybeSucceed = "\treturn MR_TRUE;\n",
 		ArgInfoTypes2 = ArgInfoTypes0
-	; CodeModel = model_non,
+	;
+		CodeModel = model_non,
 		unexpected(this_file, "Attempt to export model_non procedure.")
 	),
 	list__filter(export__include_arg, ArgInfoTypes2, ArgInfoTypes).
@@ -421,23 +429,23 @@
 	module_info::in, string::out) is det.
 
 get_argument_declarations([], _, _, "void").
-get_argument_declarations([X|Xs], NameThem, Module, Result) :-
-	get_argument_declarations_2([X|Xs], 0, NameThem, Module, Result).
+get_argument_declarations([X | Xs], NameThem, Module, Result) :-
+	get_argument_declarations_2([X | Xs], 0, NameThem, Module, Result).
 
 :- pred get_argument_declarations_2(assoc_list(arg_info, type)::in, int::in,
 	bool::in, module_info::in, string::out) is det.
 
 get_argument_declarations_2([], _, _, _, "").
-get_argument_declarations_2([AT|ATs], Num0, NameThem, Module, Result) :-
+get_argument_declarations_2([AT | ATs], Num0, NameThem, Module, Result) :-
 	AT = ArgInfo - Type,
 	Num = Num0 + 1,
 	get_argument_declaration(ArgInfo, Type, Num, NameThem, Module,
 			TypeString, ArgName),
 	(
-		ATs = []
-	->
+		ATs = [],
 		string__append(TypeString, ArgName, Result)
 	;
+		ATs = [_ | _],
 		get_argument_declarations_2(ATs, Num, NameThem, Module,
 			TheRest),
 		string__append_list([TypeString, ArgName, ", ", TheRest],
@@ -450,33 +458,32 @@
 get_argument_declaration(ArgInfo, Type, Num, NameThem, Module,
 		TypeString, ArgName) :-
 	ArgInfo = arg_info(_Loc, Mode),
-	( NameThem = yes ->
+	(
+		NameThem = yes,
 		string__int_to_string(Num, NumString),
 		string__append(" Mercury__argument", NumString, ArgName)
 	;
+		NameThem = no,
 		ArgName = ""
 	),
 	TypeString0 = foreign__to_type_string(c, Module, Type),
-	(
-		Mode = top_out
-	->
+	( Mode = top_out ->
 			% output variables are passed as pointers
 		string__append(TypeString0, " *", TypeString)
 	;
 		TypeString = TypeString0
 	).
 
-:- pred get_input_args(assoc_list(arg_info, type), int, module_info, string).
-:- mode get_input_args(in, in, in, out) is det.
+:- pred get_input_args(assoc_list(arg_info, type)::in, int::in,
+	module_info::in, string::out) is det.
 
 get_input_args([], _, _, "").
-get_input_args([AT|ATs], Num0, ModuleInfo, Result) :-
+get_input_args([AT | ATs], Num0, ModuleInfo, Result) :-
 	AT = ArgInfo - Type,
 	ArgInfo = arg_info(ArgLoc, Mode),
 	Num = Num0 + 1,
 	(
 		Mode = top_in,
-
 		string__int_to_string(Num, NumString),
 		string__append("Mercury__argument", NumString, ArgName0),
 		convert_type_to_mercury(ArgName0, Type, ArgName),
@@ -509,7 +516,7 @@
 	module_info::in, string::out) is det.
 
 copy_output_args([], _, _, "").
-copy_output_args([AT|ATs], Num0, ModuleInfo, Result) :-
+copy_output_args([AT | ATs], Num0, ModuleInfo, Result) :-
 	AT = ArgInfo - Type,
 	ArgInfo = arg_info(ArgLoc, Mode),
 	Num = Num0 + 1,
@@ -679,24 +686,24 @@
 :- pred export__produce_header_file_2(list(foreign_export_decl)::in,
 	io::di, io::uo) is det.
 
-export__produce_header_file_2([]) --> [].
-export__produce_header_file_2([E|ExportedProcs]) -->
-	{ E = foreign_export_decl(Lang, C_RetType, C_Function, ArgDecls) },
+export__produce_header_file_2([], !IO).
+export__produce_header_file_2([E | ExportedProcs], !IO) :-
+	E = foreign_export_decl(Lang, C_RetType, C_Function, ArgDecls),
 	(
-		{ Lang = c }
+		Lang = c
 	->
 			% output the function header
-		io__write_string(C_RetType),
-		io__write_string(" "),
-		io__write_string(C_Function),
-		io__write_string("("),
-		io__write_string(ArgDecls),
-		io__write_string(");\n")
+		io__write_string(C_RetType, !IO),
+		io__write_string(" ", !IO),
+		io__write_string(C_Function, !IO),
+		io__write_string("(", !IO),
+		io__write_string(ArgDecls, !IO),
+		io__write_string(");\n", !IO)
 	;
-		{ sorry(this_file,
-			"foreign languages other than C unimplemented") }
+		sorry(this_file,
+			"foreign languages other than C unimplemented")
 	),
-	export__produce_header_file_2(ExportedProcs).
+	export__produce_header_file_2(ExportedProcs, !IO).
 
 :- pred output_foreign_decl(maybe(foreign_decl_is_local)::in,
 	foreign_decl_code::in, io::di, io::uo) is det.
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.2
diff -u -b -r1.2 tupling.m
--- compiler/tupling.m	9 Mar 2005 23:34:07 -0000	1.2
+++ compiler/tupling.m	19 Mar 2005 00:51:24 -0000
@@ -575,16 +575,17 @@
 	% greater or equal to MinRunLength, threading an accumulator through
 	% it.
 	%
-:- pred fold_over_list_runs(pred(list(L), A, A), list(L), int, A, A).
-:- mode fold_over_list_runs(pred(in, in, out) is det, in, in, in, out) is det.
+:- pred fold_over_list_runs(pred(list(L), A, A)::in(pred(in, in, out) is det),
+	list(L)::in, int::in, A::in, A::out) is det.
 
 fold_over_list_runs(_, [], _, !Acc).
 fold_over_list_runs(Pred, List @ [_ | Tail], MinLength, !Acc) :-
 	fold_over_list_runs_2(Pred, List, MinLength, !Acc),
 	fold_over_list_runs(Pred, Tail, MinLength, !Acc).
 
-:- pred fold_over_list_runs_2(pred(list(L), A, A), list(L), int, A, A).
-:- mode fold_over_list_runs_2(pred(in, in, out) is det, in, in, in, out) is det.
+:- pred fold_over_list_runs_2(
+	pred(list(L), A, A)::in(pred(in, in, out) is det),
+	list(L)::in, int::in, A::in, A::out) is det.
 
 fold_over_list_runs_2(Pred, List, Length, !Acc) :-
 	( list__take(Length, List, Front) ->
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list