[m-rev.] for review: mmc --make [4]

Simon Taylor stayl at cs.mu.OZ.AU
Wed Feb 6 02:21:10 AEDT 2002


Index: compiler/make.program_target.m
===================================================================
RCS file: compiler/make.program_target.m
diff -N compiler/make.program_target.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ compiler/make.program_target.m	4 Feb 2002 02:03:11 -0000
@@ -0,0 +1,398 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2002 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+:- module make__program_target.
+
+:- interface.
+
+:- pred make_linked_target(linked_target_file::in, bool::out,
+		make_info::in, make_info::out,
+		io__state::di, io__state::uo) is det.
+
+:- pred make_misc_target(pair(module_name, misc_target_type)::in,
+		bool::out, make_info::in, make_info::out,
+		io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+make_linked_target(MainModuleName - FileType, Succeeded, Info0, Info) -->
+    find_reachable_local_modules(MainModuleName, DepsSuccess,
+		AllModules, Info0, Info1),
+    globals__io_lookup_bool_option(keep_going, KeepGoing),
+    ( { DepsSuccess = no, KeepGoing = no } ->
+	{ Succeeded = no },
+	{ Info = Info1 }
+    ;
+	globals__io_get_target(CompilationTarget),
+	( { CompilationTarget = asm } ->
+	    % An assembler file is only produced for the top-level
+	    % module in each source file.
+	    list__foldl3(
+		(pred(ModuleName::in, ObjModules0::in, ObjModules1::out,
+				MInfo0::in, MInfo::out, di, uo) is det -->
+			get_module_dependencies(ModuleName, MaybeImports,
+				MInfo0, MInfo),
+			{
+				MaybeImports = yes(Imports),
+				ModuleName = Imports ^ source_file_module_name
+			->
+				ObjModules1 = [ModuleName | ObjModules0]
+			;	
+				ObjModules1 = ObjModules0
+			}
+		),
+		set__to_sorted_list(AllModules), [],
+		ObjModules, Info1, Info4)
+	;
+		{ Info4 = Info1 },
+		{ ObjModules = set__to_sorted_list(AllModules) }
+	),
+
+	globals__io_get_globals(Globals),
+	module_name_to_file_name(MainModuleName,
+		linked_target_extension(Globals, FileType),
+		no, OutputFileName),
+	get_file_timestamp([dir__this_directory], OutputFileName,
+		MaybeTimestamp, Info4, Info5),
+	
+	globals__io_lookup_string_option(pic_object_file_extension, PicObjExt),
+	globals__io_lookup_string_option(object_file_extension, ObjExt),
+	{ FileType = shared_library, PicObjExt \= ObjExt ->
+		ObjectCodeType = pic,
+		ObjExtToUse = PicObjExt
+	;
+		ObjectCodeType = non_pic,
+		ObjExtToUse = ObjExt
+	},
+
+	%
+	% Build the `.c' files first so that errors are
+	% reported as soon as possible.
+	%
+	{
+		CompilationTarget = c,
+		IntermediateTargetType = c_code,
+		ObjectTargetType = object_code(ObjectCodeType)
+	;
+		CompilationTarget = asm,
+		IntermediateTargetType = asm_code(ObjectCodeType),
+		ObjectTargetType = object_code(ObjectCodeType)
+	;
+		CompilationTarget = il,
+		IntermediateTargetType = il_code,
+		ObjectTargetType = il_asm
+	;
+		CompilationTarget = java,
+		IntermediateTargetType = java_code,
+		% XXX Whoever finishes the Java backend can fill this in.
+		ObjectTargetType = object_code(non_pic)
+	},
+
+	{ IntermediateTargets = make_dependency_list(ObjModules,
+					IntermediateTargetType) },
+	{ ObjTargets = make_dependency_list(ObjModules, ObjectTargetType) },
+
+	foldl2_maybe_stop_at_error(KeepGoing,
+		foldl2_maybe_stop_at_error(KeepGoing, make_module_target),
+		[IntermediateTargets, ObjTargets], _, Info5, Info6),
+	check_dependencies(OutputFileName, MaybeTimestamp,
+		ObjTargets, BuildDepsResult, Info6, Info7),
+
+	(
+	    { DepsSuccess = yes },
+	    { BuildDepsResult \= error }
+	->
+	    build_with_check_for_interrupt(
+		build_with_module_options_and_output_redirect(
+			MainModuleName, [],
+			build_linked_target(MainModuleName, FileType,
+				OutputFileName, MaybeTimestamp, AllModules,
+				ObjModules, CompilationTarget, ObjExtToUse,
+				DepsSuccess, BuildDepsResult)),
+		linked_target_cleanup(MainModuleName, FileType, OutputFileName,
+			CompilationTarget),
+		Succeeded, Info7, Info)
+    	;
+    	    { Succeeded = no },
+	    { Info = Info7 }
+	)
+    ).
+
+:- pred build_linked_target(module_name::in, linked_target_type::in,
+	file_name::in, maybe_error(timestamp)::in, set(module_name)::in,
+	list(module_name)::in, compilation_target::in, string::in, bool::in,
+	dependencies_result::in, list(string)::in, io__output_stream::in,
+	bool::out, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+build_linked_target(MainModuleName, FileType, OutputFileName, MaybeTimestamp,
+		AllModules, ObjModules, CompilationTarget, ObjExtToUse,
+		DepsSuccess, BuildDepsResult, _, ErrorStream, Succeeded,
+		Info0, Info) -->
+
+	globals__io_lookup_accumulating_option(link_objects, ExtraObjects0),
+
+	% Clear the option -- we'll pass the list of files directly.
+	globals__io_set_option(link_objects, accumulating([])),
+
+	%
+	% Remake the `_init.o' file.
+	% XXX We should probably make a `_init.o' file for shared
+	% libraries linked using dlopen().
+	%
+	{ AllModulesList = set__to_sorted_list(AllModules) },
+	(
+		{ FileType = executable },
+		{ CompilationTarget = c ; CompilationTarget = asm }
+	->
+		mercury_compile__make_init_obj_file(ErrorStream,
+			MainModuleName, AllModulesList, InitObjectResult),
+		(
+			{ InitObjectResult = yes(InitObject) },
+			
+			% We may need to update the timestamp
+			% of the `_init.o' file.
+			{ Info1 = Info0 ^ file_timestamps :=
+				map__delete(Info0 ^ file_timestamps,
+				InitObject) },
+			{ ExtraObjects = [InitObject | ExtraObjects0] },
+			{ DepsResult2 = BuildDepsResult }
+		;
+			{ InitObjectResult = no },
+			{ Info1 = Info0 },
+			{ DepsResult2 = error },
+			{ ExtraObjects = ExtraObjects0 }
+		)
+	;
+		{ DepsResult2 = BuildDepsResult },
+		{ Info1 = Info0 },
+		{ ExtraObjects = ExtraObjects0 }
+	),
+
+	list__map_foldl2(get_file_timestamp([dir__this_directory]),
+		ExtraObjects, ExtraObjectTimestamps, Info1, Info2),
+	check_dependency_timestamps(OutputFileName, MaybeTimestamp,
+		ExtraObjects, io__write, ExtraObjectTimestamps,
+		ExtraObjectDepsResult),
+
+	{ DepsResult3 = ( DepsSuccess = yes -> DepsResult2 ; error ) },
+	{ DepsResult3 = error, DepsResult = DepsResult3
+	; DepsResult3 = out_of_date, DepsResult = DepsResult3
+	; DepsResult3 = up_to_date, DepsResult = ExtraObjectDepsResult
+	},
+	(
+		{ DepsResult = error },
+		file_error(OutputFileName),
+		{ Succeeded = no },
+		{ Info = Info2 }
+	;
+		{ DepsResult = up_to_date },
+		{ Succeeded = yes },
+		{ Info = Info2 }
+	;
+		{ DepsResult = out_of_date },
+		maybe_make_linked_target_message(OutputFileName),
+
+		%
+		% Find the extra object files for externally compiled
+		% foreign procedures and fact tables. We don't need
+		% to include these in the timestamp checking above --
+		% they will have been checked when the module's object
+		% file was built.
+		%
+		list__map_foldl2(
+		    (pred(ModuleName::in, ForeignFiles::out,
+		    	    MakeInfo0::in, MakeInfo::out, di, uo) is det -->
+			get_module_dependencies(ModuleName, MaybeImports,
+				MakeInfo0, MakeInfo),
+			(
+			    { MaybeImports = yes(Imports) },
+			    external_foreign_code_files(Imports, ForeignFiles)
+			;
+			    { MaybeImports = no },
+			    % This error should have been detected earlier.
+			    { error(
+			    "build_linked_target: error in dependencies") }
+			)
+		    ), AllModulesList, ExtraForeignFiles, Info2, Info3),
+		{ ForeignObjects = list__map(
+			(func(foreign_code_file(_, _, ObjFile)) = ObjFile),
+			list__condense(ExtraForeignFiles)) },
+		{ AllExtraObjects = ExtraObjects ++ ForeignObjects },
+
+		list__map_foldl(
+		    (pred(ObjModule::in, ObjToLink::out, di, uo) is det -->
+			module_name_to_file_name(ObjModule,
+				ObjExtToUse, no, ObjToLink)
+		    ), ObjModules, ObjList),
+		{ AllObjects = AllExtraObjects ++ ObjList },
+
+		(
+			{ CompilationTarget = c },
+			% Run the link in a separate process so it can
+			% be killed if an interrupt is received.
+			call_in_forked_process(
+				mercury_compile__link(ErrorStream, FileType,
+					MainModuleName, AllObjects),
+				Succeeded)
+		;
+			{ CompilationTarget = asm },
+			% Run the link in a separate process so it can
+			% be killed if an interrupt is received.
+			call_in_forked_process(
+				mercury_compile__link(ErrorStream, FileType,
+					MainModuleName, AllObjects),
+				Succeeded)
+		;
+			%
+			% IL doesn't need any linking. XXX Is this right?
+			%
+			{ CompilationTarget = il },
+			{ Succeeded = yes }
+		;
+			{ CompilationTarget = java },
+			{ Succeeded = no },
+			io__write_string(
+			"Sorry, not implemented, linking for `--target java'")
+		),
+
+		( { Succeeded = yes } ->
+			{ Info = Info3 ^ file_timestamps :=
+				map__delete(Info3 ^ file_timestamps,
+					OutputFileName) }
+		;
+			file_error(OutputFileName),
+			{ Info = Info3 }
+		)
+	).
+
+:- pred linked_target_cleanup(module_name::in, linked_target_type::in,
+	file_name::in, compilation_target::in, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+linked_target_cleanup(MainModuleName, FileType, OutputFileName,
+		CompilationTarget, Info0, Info) -->
+	remove_file(OutputFileName, Info0, Info1),
+	(
+		{ FileType = executable },
+		{ CompilationTarget = c
+		; CompilationTarget = asm
+		}
+	->
+		globals__io_lookup_string_option(object_file_extension,
+			ObjExt),
+		remove_file(MainModuleName, "_init.c", Info1, Info2),
+		remove_file(MainModuleName, "_init" ++ ObjExt, Info2, Info)
+	;
+		{ Info = Info1 }
+	).
+
+%-----------------------------------------------------------------------------%
+
+make_misc_target(MainModuleName - TargetType, Succeeded, Info0, Info) -->
+	% Don't rebuild dependencies when cleaning up.
+	{ RebuildDeps = Info0 ^ rebuild_dependencies },
+	{ ( TargetType = clean ; TargetType = realclean ) ->
+		Info1 = Info0 ^ rebuild_dependencies := no
+	;
+		Info1 = Info0
+	},
+	find_reachable_local_modules(MainModuleName, Succeeded0,
+		AllModules0, Info1, Info2),
+	{ Info3 = Info2 ^ rebuild_dependencies := RebuildDeps },
+
+	{ AllModules = set__to_sorted_list(AllModules0) },
+	(
+		{ TargetType = clean },
+		{ Succeeded = yes },
+		list__foldl2(make_clean, AllModules, Info3, Info)
+	;
+		{ TargetType = realclean },	
+		{ Succeeded = yes },
+		list__foldl2(make_realclean, AllModules, Info3, Info4),
+		globals__io_lookup_string_option(executable_file_extension,
+			ExeExt),
+		globals__io_lookup_string_option(library_extension, LibExt),
+		globals__io_lookup_string_option(shared_library_extension,
+			SharedLibExt),
+
+		list__foldl2(remove_file(MainModuleName),
+			[ExeExt, LibExt, SharedLibExt, "_init.c", "_init.o"],
+			Info4, Info)
+	;
+		{ TargetType = check },
+		globals__io_lookup_bool_option(keep_going, KeepGoing),
+		( { Succeeded0 = no, KeepGoing = no } ->
+			{ Info = Info3 },
+			{ Succeeded = no }
+		;
+			foldl2_maybe_stop_at_error(KeepGoing,
+				make_module_target,
+				make_dependency_list(AllModules, errors),
+				Succeeded1, Info3, Info),
+			{ Succeeded = Succeeded0 `and` Succeeded1 }
+		)
+	;
+		{ TargetType = install_library },
+		{ Succeeded = no },
+		{ error("sorry, not implemented: mmc --make module.install") }
+	).
+
+:- pred make_clean(module_name::in, make_info::in, make_info::out,
+		io__state::di, io__state::uo) is det.
+
+make_clean(ModuleName, Info0, Info) -->
+	list__foldl2(remove_target_file(ModuleName),
+		[errors, c_code, c_header,
+		object_code(pic), object_code(non_pic),
+		asm_code(pic), asm_code(non_pic),
+		il_code, java_code
+		],
+		Info0, Info1),
+
+	globals__io_lookup_string_option(object_file_extension, ObjExt),
+	list__foldl2(remove_file(ModuleName),
+		["_init.c", "_init" ++ ObjExt, ".used", ".prof",
+		".derived_schema", ".base_schema"],
+		Info1, Info2),
+
+	get_module_dependencies(ModuleName, MaybeImports, Info2, Info3),
+	(
+		{ MaybeImports = yes(Imports) },
+		external_foreign_code_files(Imports, ForeignCodeFiles),
+		list__foldl2(
+		    (pred(ForeignCodeFile::in, MakeInfo0::in, MakeInfo::out,
+		    		di, uo) is det -->
+			{ ForeignCodeFile = foreign_code_file(_,
+				TargetFile, ObjectFile) },
+			remove_file(TargetFile, MakeInfo0, MakeInfo1),
+			remove_file(ObjectFile, MakeInfo1, MakeInfo)
+		    ), ForeignCodeFiles, Info3, Info)
+	;
+		{ MaybeImports = no },
+		{ Info = Info3 }
+	).
+
+:- pred make_realclean(module_name::in, make_info::in, make_info::out,
+		io__state::di, io__state::uo) is det.
+
+make_realclean(ModuleName, Info0, Info) -->
+	make_clean(ModuleName, Info0, Info1),
+	list__foldl2(remove_target_file(ModuleName),
+		[private_interface, long_interface, short_interface,
+		unqualified_short_interface, intermodule_interface,
+		aditi_code, c_header
+		],
+		Info1, Info2),
+	globals__io_lookup_string_option(executable_file_extension, ExeExt),
+	globals__io_lookup_string_option(library_extension, LibExt),
+	globals__io_lookup_string_option(shared_library_extension,
+		SharedLibExt),
+	list__foldl2(remove_file(ModuleName),
+		[module_dep_file_extension, ExeExt, LibExt, SharedLibExt],
+		Info2, Info).
+
+%-----------------------------------------------------------------------------%
Index: compiler/make.util.m
===================================================================
RCS file: compiler/make.util.m
diff -N compiler/make.util.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ compiler/make.util.m	4 Feb 2002 18:09:49 -0000
@@ -0,0 +1,1010 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2002 University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: make.util.m
+% Main author: stayl
+%
+% Assorted predicates used to implement `mmc --make'.
+%-----------------------------------------------------------------------------%
+:- module make__util.
+
+:- interface.
+
+	%
+	% Versions of foldl which stop if the supplied predicate returns `no'
+	% for any element of the list.
+	%
+
+	% foldl2_pred_with_status(T, Succeeded, Info0, Info).
+:- type foldl2_pred_with_status(T, Info, IO) ==
+				pred(T, bool, Info, Info, IO, IO).
+:- inst foldl2_pred_with_status == (pred(in, out, in, out, di, uo) is det).
+
+	% foldl2_maybe_stop_at_error(KeepGoing, P, List,
+	%	Succeeded, Info0, Info).
+:- pred foldl2_maybe_stop_at_error(bool::in,
+	foldl2_pred_with_status(T, Info, IO)::in(foldl2_pred_with_status),
+	list(T)::in, bool::out, Info::in, Info::out, IO::di, IO::uo) is det.
+
+	% foldl3_pred_with_status(T, Succeeded, Acc0, Acc, Info0, Info).
+:- type foldl3_pred_with_status(T, Acc, Info, IO) ==
+		pred(T, bool, Acc, Acc, Info, Info, IO, IO).
+:- inst foldl3_pred_with_status ==
+		(pred(in, out, in, out, in, out, di, uo) is det).
+
+	% foldl3_maybe_stop_at_error(KeepGoing, P, List,
+	%	Succeeded, Acc0, Acc, Info0, Info).
+:- pred foldl3_maybe_stop_at_error(bool::in,
+	foldl3_pred_with_status(T, Acc, Info, IO)::in(foldl3_pred_with_status),
+	list(T)::in, bool::out, Acc::in, Acc::out, Info::in, Info::out,
+	IO::di, IO::uo) is det.
+
+%-----------------------------------------------------------------------------%
+	% Code to handle cleaning up when a signal is received.
+
+:- type build0 == pred(bool, make_info, make_info, io__state, io__state).
+:- inst build0 == (pred(out, in, out, di, uo) is det).
+
+:- type post_signal_cleanup ==
+		pred(make_info, make_info, io__state, io__state).
+:- inst post_signal_cleanup == (pred(in, out, di, uo) is det).
+
+	% build_with_check_for_interrupt(Build, Cleanup,
+	%	Succeeded, Info0, Info)
+	%
+	% Apply `Build' with signal handlers installed to check for signals
+	% which would normally kill the process. If a signal occurs call
+	% `Cleanup', then restore signal handlers to their defaults and
+	% reraise the signal to kill the current process.
+	% An action being performed in a child process by
+	% call_in_forked_process will be killed if a fatal signal
+	% (SIGINT, SIGTERM, SIGHUP or SIGQUIT) is received by the
+	% current process.
+	% An action being performed within the current process or by
+	% system() will run to completion, with the interrupt being taken
+	% immediately afterwards.
+:- pred build_with_check_for_interrupt(build0::in(build0),
+	post_signal_cleanup::in(post_signal_cleanup),
+	bool::out, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- type build(T) == pred(T, bool, make_info, make_info, io__state, io__state).
+:- inst build == (pred(in, out, in, out, di, uo) is det).
+
+	% Perform the given closure after updating the option_table in
+	% the globals in the io__state to contain the module-specific
+	% options for the specified module.
+:- pred build_with_module_options(module_name::in,
+	list(string)::in, build(list(string))::in(build), bool::out,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+	% Perform the given closure with an output stream created
+	% to append to the error file for the given module.
+:- pred build_with_output_redirect(module_name::in,
+	build(io__output_stream)::in(build), bool::out,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+	% Produce an output stream which writes to the error file
+	% for the given module.
+:- pred redirect_output(module_name::in, maybe(io__output_stream)::out,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+	% Close the module error output stream.
+:- pred unredirect_output(module_name::in, io__output_stream::in,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- type build2(T, U) == pred(T, U, bool, make_info, make_info,
+				io__state, io__state).
+:- inst build2 == (pred(in, in, out, in, out, di, uo) is det).
+
+:- pred build_with_module_options_and_output_redirect(module_name::in,
+	list(string)::in, build2(list(string), io__output_stream)::in(build2),
+	bool::out, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- type io_pred == pred(bool, io__state, io__state).
+:- inst io_pred == (pred(out, di, uo) is det).
+
+	% call_in_forked_process(P, AltP, Succeeded)
+	%
+	% Execute `P' in a separate process.
+	%
+	% We prefer to use fork() rather than system() because
+	% that will avoid shell and Mercury runtime startup overhead.
+	% Interrupt handling will also work better (system() on Linux
+	% ignores SIGINT).
+	%
+	% If fork() is not supported on the current architecture,
+	% `AltP' will be called instead in the current process.
+:- pred call_in_forked_process(io_pred::in(io_pred), io_pred::in(io_pred),
+	bool::out, io__state::di, io__state::uo) is det.
+
+	% As above, but if fork() is not available, just call the
+	% predicate in the current process.
+:- pred call_in_forked_process(io_pred::in(io_pred),
+	bool::out, io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+	% Timestamp handling.
+
+	% Find the timestamp updated when a target is produced.
+:- pred get_timestamp_file_timestamp(target_file::in,
+	maybe_error(timestamp)::out, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+:- pred get_dependency_timestamp(dependency_file::in,
+	maybe_error(timestamp)::out, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+:- pred get_target_timestamp(target_file::in, maybe_error(timestamp)::out,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+:- pred get_file_name(target_file::in, file_name::out,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+:- pred get_file_timestamp(list(dir_name)::in, file_name::in,
+	maybe_error(timestamp)::out, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+	% Remove file a file, deleting the cached timestamp.
+
+:- pred remove_target_file(target_file::in, make_info::in, make_info::out,
+	io__state::di, io__state::uo) is det.
+
+:- pred remove_target_file(module_name::in, module_target_type::in,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+	% remove_file(ModuleName, Extension, Info0, Info).
+:- pred remove_file(module_name::in, string::in, make_info::in, make_info::out,
+		io__state::di, io__state::uo) is det.
+
+:- pred remove_file(file_name::in, make_info::in, make_info::out,
+		io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- func make_target_list(list(K), V) = assoc_list(K, V).
+
+:- func make_dependency_list(list(module_name), module_target_type) =
+		list(dependency_file).
+
+:- func target_extension(globals, module_target_type) = string.
+:- mode target_extension(in, in) = out is det.
+:- mode target_extension(in, out) = in is nondet.
+
+:- func linked_target_extension(globals, linked_target_type) = string.
+:- mode linked_target_extension(in, in) = out is det.
+:- mode linked_target_extension(in, out) = in is nondet.
+
+	% Find the extension for the timestamp file for the
+	% given target type, if one exists.
+:- func timestamp_extension(module_target_type) = string is semidet.
+
+%-----------------------------------------------------------------------------%
+	% Debugging, verbose and error messages.
+
+	% Apply the given predicate if `--debug-make' is set.
+:- pred debug_msg(pred(io__state, io__state)::(pred(di, uo) is det),
+		io__state::di, io__state::uo) is det.
+
+	% Apply the given predicate if `--verbose-make' is set.
+:- pred verbose_msg(pred(io__state, io__state)::(pred(di, uo) is det),
+		io__state::di, io__state::uo) is det.
+
+	% Write a debugging message relating to a given target file.
+:- pred debug_file_msg(target_file::in, string::in,
+		io__state::di, io__state::uo) is det.
+
+:- pred write_dependency_file(dependency_file::in,
+		io__state::di, io__state::uo) is det.
+
+:- pred write_target_file(target_file::in,
+		io__state::di, io__state::uo) is det.
+
+	% Write a message "Making <filename>" if `--verbose-make' is set.
+:- pred maybe_make_linked_target_message(file_name::in,
+		io__state::di, io__state::uo) is det.
+
+	% Write a message "Making <filename>" if `--verbose-make' is set.
+:- pred maybe_make_target_message(target_file::in,
+		io__state::di, io__state::uo) is det.
+
+:- pred maybe_make_target_message(io__output_stream::in, target_file::in,
+		io__state::di, io__state::uo) is det.
+
+	% Write a message "** Error making <filename>".
+:- pred target_file_error(target_file::in,
+		io__state::di, io__state::uo) is det.
+
+	% Write a message "** Error making <filename>".
+:- pred file_error(file_name::in, io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+foldl2_maybe_stop_at_error(KeepGoing, MakeTarget,
+		Targets, Success, Info0, Info) -->
+	foldl2_maybe_stop_at_error_2(KeepGoing, MakeTarget, Targets,
+		yes, Success, Info0, Info).
+
+:- pred foldl2_maybe_stop_at_error_2(bool::in,
+	foldl2_pred_with_status(T, Info, IO)::in(foldl2_pred_with_status),
+	list(T)::in, bool::in, bool::out, Info::in, Info::out,
+	IO::di, IO::uo) is det.
+
+foldl2_maybe_stop_at_error_2(_KeepGoing, _P, [],
+		Success, Success, Info, Info) --> [].
+foldl2_maybe_stop_at_error_2(KeepGoing, P, [T | Ts],
+		Success0, Success, Info0, Info) -->
+	P(T, Success1, Info0, Info1),
+	( { Success1 = yes ; KeepGoing = yes } ->
+		foldl2_maybe_stop_at_error_2(KeepGoing, P, Ts,
+			Success0 `and` Success1, Success, Info1, Info)
+	;
+		{ Success = no },
+		{ Info = Info0 }
+	).
+
+foldl3_maybe_stop_at_error(KeepGoing, P, Ts, Success,
+		Acc0, Acc, Info0, Info) -->
+	foldl3_maybe_stop_at_error_2(KeepGoing, P, Ts,
+		yes, Success, Acc0, Acc, Info0, Info).
+
+:- pred foldl3_maybe_stop_at_error_2(bool::in,
+	foldl3_pred_with_status(T, Acc, Info, IO)::in(foldl3_pred_with_status),
+	list(T)::in, bool::in, bool::out, Acc::in, Acc::out,
+	Info::in, Info::out, IO::di, IO::uo) is det.
+
+foldl3_maybe_stop_at_error_2(_KeepGoing, _P, [],
+		Success, Success, Acc, Acc, Info, Info) --> [].
+foldl3_maybe_stop_at_error_2(KeepGoing, P, [T | Ts],
+		Success0, Success, Acc0, Acc, Info0, Info) -->
+	P(T, Success1, Acc0, Acc1, Info0, Info1),
+	( { Success1 = yes ; KeepGoing = yes } ->
+		foldl3_maybe_stop_at_error_2(KeepGoing, P, Ts,
+			Success0 `and` Success1, Success, Acc1, Acc,
+			Info1, Info)
+	;
+		{ Success = no },
+		{ Acc = Acc0 },
+		{ Info = Info0 }
+	).
+
+%-----------------------------------------------------------------------------%
+
+build_with_check_for_interrupt(Build, Cleanup, Succeeded, Info0, Info) -->
+	setup_signal_handlers(SigIntHandler),
+	Build(Succeeded0, Info0, Info1),
+	restore_signal_handlers(SigIntHandler),
+	check_for_signal(Signalled, Signal),
+	( { Signalled = 1 } ->
+		{ Succeeded = no },
+		verbose_msg(
+			(pred(di, uo) is det -->
+				io__write_string("** Received signal "),
+				io__write_int(Signal),
+				io__write_string(", cleaning up.\n")
+			)),
+		Cleanup(Info1, Info),
+
+		% The signal handler has been restored to the default,
+		% so this should kill us.
+		raise_signal(Signal)
+	;
+		{ Succeeded = Succeeded0 },
+		{ Info = Info1 }
+	).	
+
+:- type signal_action ---> signal_action(c_pointer).
+
+:- pragma foreign_decl("C",
+"
+#ifdef HAVE_UNISTD_H
+  #include <unistd.h>
+#endif
+
+#ifdef HAVE_SYS_TYPES_H
+  #include <sys/types.h>
+#endif
+
+#ifdef HAVE_SYS_WAIT
+  #include <sys/wait.h>
+#endif
+
+#include <errno.h>
+
+#include ""mercury_signal.h""
+#include ""mercury_types.h""
+#include ""mercury_heap.h""
+#include ""mercury_misc.h""
+
+#if defined(HAVE_FORK) && defined(HAVE_WAIT) && defined(HAVE_KILL)
+  #define MC_CAN_FORK 1
+#endif
+
+#define MC_SETUP_SIGNAL_HANDLER(sig, handler) \
+		MR_setup_signal(sig, (MR_Code *) handler, FALSE,	\
+			""mercury_compile: cannot install signal handler"");
+
+	/* Have we received a signal. */
+volatile sig_atomic_t MC_signalled;
+
+	/* Which signal did we receive. */
+volatile sig_atomic_t MC_signal_received;
+
+void MC_mercury_compile_signal_handler(int sig);
+").
+
+:- pragma foreign_code("C",
+"
+volatile sig_atomic_t MC_signalled = FALSE;
+volatile sig_atomic_t MC_signal_received = 0;
+
+void
+MC_mercury_compile_signal_handler(int sig)
+{
+	MC_signalled = TRUE;
+	MC_signal_received = sig;
+}
+").
+
+:- pred setup_signal_handlers(signal_action::out,
+		io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+		setup_signal_handlers(SigintHandler::out, IO0::di, IO::uo),
+		[will_not_call_mercury, promise_pure],
+"{
+	IO = IO0;
+	MC_signalled = FALSE;
+
+	MR_incr_hp_msg(SigintHandler,
+		MR_bytes_to_words(sizeof(MR_signal_action)),
+		MR_PROC_LABEL, ""make.util.signal_action/0"");
+
+	/*
+	** mdb sets up a SIGINT handler, so we should restore
+	** it after we're done.
+	*/
+	MR_get_signal_action(SIGINT, (MR_signal_action *) SigintHandler,
+		""error getting SIGINT handler"");
+	MC_SETUP_SIGNAL_HANDLER(SIGINT, MC_mercury_compile_signal_handler);
+	MC_SETUP_SIGNAL_HANDLER(SIGTERM, MC_mercury_compile_signal_handler);
+#ifdef SIGHUP
+	MC_SETUP_SIGNAL_HANDLER(SIGHUP, MC_mercury_compile_signal_handler);
+#endif
+#ifdef SIGQUIT
+	MC_SETUP_SIGNAL_HANDLER(SIGQUIT, MC_mercury_compile_signal_handler);
+#endif
+}").
+
+:- pred restore_signal_handlers(signal_action::in,
+		io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+		restore_signal_handlers(SigintHandler::in, IO0::di, IO::uo),
+		[will_not_call_mercury, promise_pure],
+"{
+	IO = IO0;
+	MR_set_signal_action(SIGINT, (MR_signal_action *) SigintHandler,
+		""error resetting SIGINT handler"");
+	MC_SETUP_SIGNAL_HANDLER(SIGTERM, SIG_DFL);
+#ifdef SIGHUP
+	MC_SETUP_SIGNAL_HANDLER(SIGHUP, SIG_DFL);
+#endif
+#ifdef SIGQUIT
+	MC_SETUP_SIGNAL_HANDLER(SIGQUIT, SIG_DFL);
+#endif
+}").
+
+:- pred check_for_signal(int::out, int::out,
+		io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+		check_for_signal(Signalled::out, Signal::out, IO0::di, IO::uo),
+		[will_not_call_mercury, promise_pure],
+"
+	IO = IO0;
+	Signalled = (MC_signalled ? 1 : 0);
+	Signal = MC_signal_received;
+").
+
+:- pred raise_signal(int::in, io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+		raise_signal(Signal::in, IO0::di, IO::uo),
+		[will_not_call_mercury, promise_pure],
+"
+	IO = IO0;
+	raise(Signal);
+").
+
+%-----------------------------------------------------------------------------%
+
+call_in_forked_process(P, Success) -->
+	call_in_forked_process(P, P, Success).
+
+call_in_forked_process(P, AltP, Success) -->
+	( { can_fork } ->
+		debug_msg(io__write_string("call_in_forked_process\n")),
+		call_in_forked_process_2(P, ForkStatus, CallStatus),
+		{ ForkStatus = 1 ->
+			Success = no
+		;
+			Status = io__handle_system_command_exit_status(
+					CallStatus),
+			Success = (Status = ok(exited(0)) -> yes ; no)
+		},
+		debug_msg(io__write_string(
+				"finished call_in_forked_process\n"))
+	;
+		AltP(Success)
+	).
+
+:- pred can_fork is semidet.
+
+:- pragma foreign_proc("C", can_fork,
+		[will_not_call_mercury, thread_safe, promise_pure],
+"
+#ifdef MC_CAN_FORK
+	SUCCESS_INDICATOR = TRUE;
+#else
+	SUCCESS_INDICATOR = FALSE;
+#endif
+").
+
+:- pred call_in_forked_process_2(io_pred::in(io_pred), int::out, int::out,
+		io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+		call_in_forked_process_2(Pred::in(io_pred),
+			ForkStatus::out, Status::out, IO0::di, IO::uo),
+			[may_call_mercury, promise_pure],
+"{
+#ifdef MC_CAN_FORK
+	pid_t child_pid;
+
+	IO = IO0;
+	ForkStatus = 0;
+	Status = 0;
+
+	child_pid = fork();
+	if (child_pid == -1) {		/* error */
+		MR_perror(""error in fork()"");
+		ForkStatus = 1;
+	} else if (child_pid == 0) {	/* child */
+		MR_Integer exit_status;
+
+		call_io_pred(Pred, &exit_status);
+		exit(exit_status);
+	} else {			/* parent */
+		int child_status;
+		pid_t wait_status;
+
+		/*
+		** Make sure the wait() is interrupted by the signals
+		** which cause us to exit.
+		*/
+		MR_signal_should_restart(SIGINT, FALSE);
+		MR_signal_should_restart(SIGTERM, FALSE);
+#ifdef SIGHUP
+		MR_signal_should_restart(SIGHUP, FALSE);
+#endif
+#ifdef SIGQUIT
+		MR_signal_should_restart(SIGQUIT, FALSE);
+#endif
+
+		while (1) {
+		    wait_status = wait(&child_status);
+		    if (wait_status == child_pid) {
+			Status = child_status;
+			break;
+		    } else if (wait_status == -1) {
+			if (errno == EINTR) {
+			    if (MC_signalled) {
+				/*
+				** A normally fatal signal has been received,
+				** so kill the child immediately.
+				** Use SIGTERM, not MC_signal_received,
+				** because the child may be inside a call
+				** to system() which would cause SIGINT
+				** to be ignored on some systems (e.g. Linux).
+				*/
+				kill(child_pid, SIGTERM);
+			    }
+			} else {
+			    /*
+			    ** This should never happen.
+			    */
+			    MR_perror(""error in wait(): "");
+			    ForkStatus = 1;
+			    Status = 1;
+			    break;
+			}
+		    }
+		}
+
+		/*
+		** Restore the system call signal behaviour. 
+		*/
+		MR_signal_should_restart(SIGINT, TRUE);
+		MR_signal_should_restart(SIGTERM, TRUE);
+#ifdef SIGHUP
+		MR_signal_should_restart(SIGHUP, TRUE);
+#endif
+#ifdef SIGQUIT
+		MR_signal_should_restart(SIGQUIT, TRUE);
+#endif
+
+	}
+#else
+	IO = IO0;
+	ForkStatus = 1;
+	Status = 1;
+#endif
+}").
+
+	% call_io_pred(P, ExitStatus).
+:- pred call_io_pred(io_pred::in(io_pred), int::out,
+		io__state::di, io__state::uo) is det.
+:- pragma export(call_io_pred(in(io_pred), out, di, uo), "call_io_pred").
+
+call_io_pred(P, Status) -->
+	P(Success),
+	{ Status = ( Success = yes -> 0 ; 1 ) }.
+
+%-----------------------------------------------------------------------------%
+
+build_with_module_options_and_output_redirect(ModuleName,
+		ExtraOptions, Build, Succeeded, Info0, Info) -->	
+    build_with_module_options(ModuleName, ExtraOptions,
+	(pred(AllOptions::in, Succeeded1::out,
+			Info1::in, Info2::out, di, uo) is det -->
+	    build_with_output_redirect(ModuleName,
+		(pred(ErrorStream::in, Succeeded2::out,
+				Info3::in, Info4::out, di, uo) is det -->
+		    Build(AllOptions, ErrorStream, Succeeded2, Info3, Info4)
+		), Succeeded1, Info1, Info2)
+	), Succeeded, Info0, Info).
+
+build_with_output_redirect(ModuleName, Build, Succeeded, Info0, Info) -->
+	redirect_output(ModuleName, RedirectResult, Info0, Info1),
+	(
+		{ RedirectResult = no },
+		{ Succeeded = no },
+		{ Info = Info1 }
+	;
+		{ RedirectResult = yes(ErrorStream) },
+		Build(ErrorStream, Succeeded, Info1, Info2),
+		unredirect_output(ModuleName, ErrorStream, Info2, Info)
+	).
+
+build_with_module_options(ModuleName, ExtraOptions,
+		Build, Succeeded, Info0, Info) -->
+	lookup_mmc_module_options(Info0 ^ options_variables,
+		ModuleName, OptionsResult),
+	(
+		{ OptionsResult = no },
+		{ Info = Info0 },
+		{ Succeeded = no }
+	;
+		{ OptionsResult = yes(OptionArgs) }, 
+		globals__io_get_globals(Globals),
+
+		% --no-generate-mmake-module-dependencies disables
+		% generation of `.d' files.
+		{ AllOptionArgs = list__condense(
+		    [["--no-generate-mmake-module-dependencies" | OptionArgs],
+		    Info0 ^ option_args, ExtraOptions,
+		    ["--no-make", "--no-rebuild"]]) },
+	    	
+		handle_options(AllOptionArgs, OptionsError, _, _, _),
+		(
+			{ OptionsError = yes(OptionsMessage) },
+			{ Succeeded = no },
+			{ Info = Info0 },
+			usage_error(OptionsMessage)
+		;
+			{ OptionsError = no },
+			Build(AllOptionArgs, Succeeded, Info0, Info),
+			globals__io_set_globals(unsafe_promise_unique(Globals))
+		)
+	).
+
+redirect_output(_ModuleName, MaybeErrorStream, Info, Info) -->
+	%
+	% Write the output to a temporary file first, so it's
+	% easy to just print the part of the error file
+	% that relates to the current command. It will
+	% be appended to the error file later.
+	%
+	io__make_temp(ErrorFileName),
+	io__open_output(ErrorFileName, ErrorFileRes),
+	(
+		{ ErrorFileRes = ok(ErrorOutputStream) },
+		{ MaybeErrorStream = yes(ErrorOutputStream) }
+	;
+		{ ErrorFileRes = error(IOError) },
+		{ MaybeErrorStream = no },
+		io__write_string("** Error opening `"),
+		io__write_string(ErrorFileName),
+		io__write_string("' for output: "),
+		{ io__error_message(IOError, Msg) },
+		io__write_string(Msg),
+		io__nl
+	).
+
+unredirect_output(ModuleName, ErrorOutputStream, Info0, Info) -->
+   io__output_stream_name(ErrorOutputStream, TmpErrorFileName),
+   io__close_output(ErrorOutputStream),
+
+   io__open_input(TmpErrorFileName, TmpErrorInputRes),
+   (
+	{ TmpErrorInputRes = ok(TmpErrorInputStream) },
+	module_name_to_file_name(ModuleName, ".err", yes, ErrorFileName),
+	( { set__member(ModuleName, Info0 ^ error_file_modules) } -> 
+		io__open_append(ErrorFileName, ErrorFileRes)
+	;
+		io__open_output(ErrorFileName, ErrorFileRes)
+	),
+	( 
+	    { ErrorFileRes = ok(ErrorFileOutputStream) },
+	    globals__io_lookup_int_option(output_compile_error_lines,
+			LinesToWrite),
+	    io__output_stream(CurrentOutputStream),
+	    io__input_stream_foldl2_io(TmpErrorInputStream,
+	    		write_error_char(ErrorFileOutputStream,
+	    		CurrentOutputStream, LinesToWrite),
+			0, TmpFileInputRes),
+	    (
+	    	{ TmpFileInputRes = ok(_) }
+	    ;
+		{ TmpFileInputRes = error(_, TmpFileInputError) },
+		io__write_string("Error reading `"),
+		io__write_string(TmpErrorFileName),
+		io__write_string("': "),
+		io__write_string(io__error_message(TmpFileInputError)),
+		io__nl
+	    ),
+
+	    io__close_output(ErrorFileOutputStream),
+
+	    { Info = Info0 ^ error_file_modules :=
+			set__insert(Info0 ^ error_file_modules, ModuleName) }
+	;
+	    { ErrorFileRes = error(Error) },
+	    { Info = Info0 },
+	    io__write_string("Error opening `"),
+	    io__write_string(TmpErrorFileName),
+	    io__write_string("': "),
+	    io__write_string(io__error_message(Error)),
+	    io__nl
+	),
+	io__close_input(TmpErrorInputStream)
+    ;
+	{ TmpErrorInputRes = error(Error) },
+	{ Info = Info0 },
+	io__write_string("Error opening `"),
+	io__write_string(TmpErrorFileName),
+	io__write_string("': "),
+	io__write_string(io__error_message(Error)),
+	io__nl
+    ),
+    io__remove_file(TmpErrorFileName, _).
+
+:- pred write_error_char(io__output_stream::in, io__output_stream::in,
+		int::in, char::in, int::in, int::out,
+		io__state::di, io__state::uo) is det.
+
+write_error_char(FullOutputStream, PartialOutputStream, LineLimit,
+		Char, Lines0, Lines) -->
+	io__write_char(FullOutputStream, Char),
+	( { Lines0 < LineLimit } ->
+		io__write_char(PartialOutputStream, Char)
+	;
+		[]
+	),
+	{ Lines = ( Char = '\n' -> Lines0 + 1 ; Lines0 ) }.
+
+%-----------------------------------------------------------------------------%
+
+get_timestamp_file_timestamp(ModuleName - FileType,
+		MaybeTimestamp, Info0, Info) -->
+	globals__io_get_globals(Globals),
+	{ TimestampExt = timestamp_extension(FileType) ->
+		Ext = TimestampExt	
+	;
+		Ext = target_extension(Globals, FileType)
+	},
+	module_name_to_file_name(ModuleName, Ext, no, FileName),
+
+	% We should only ever look for timestamp files
+	% in the current directory. Timestamp files are
+	% only used when processing a module, and only
+	% modules in the current directory are processed.
+	{ SearchDirs = [dir__this_directory] },
+	get_file_timestamp(SearchDirs, FileName, MaybeTimestamp, Info0, Info).
+
+get_dependency_timestamp(file(FileName, MaybeOption), MaybeTimestamp,
+			Info0, Info) -->
+	(       
+		{ MaybeOption = yes(Option) },
+		globals__io_lookup_accumulating_option(Option, SearchDirs)
+	;       
+		{ MaybeOption = no },
+		{ SearchDirs = [dir__this_directory] }
+	),
+	get_file_timestamp(SearchDirs, FileName, MaybeTimestamp, Info0, Info).
+get_dependency_timestamp(target(Target), MaybeTimestamp, Info0, Info) -->
+	get_target_timestamp(Target, MaybeTimestamp, Info0, Info).
+
+get_target_timestamp(ModuleName - FileType, MaybeTimestamp, Info0, Info) -->
+	get_file_name(ModuleName - FileType, FileName, Info0, Info1),
+	get_search_directories(FileType, SearchDirs),
+	get_file_timestamp(SearchDirs, FileName, MaybeTimestamp0,
+		Info1, Info2),
+	(
+		{ MaybeTimestamp0 = error(_) },
+		{ FileType = intermodule_interface }
+	->
+		%
+		% If a `.opt' file in another directory doesn't exist,
+		% it just means that a library wasn't compiled with
+		% `--intermodule-optimization'.
+		%
+		get_module_dependencies(ModuleName, MaybeImports,	
+			Info2, Info3),
+		{
+			MaybeImports = yes(Imports),
+			Imports ^ module_dir \= dir__this_directory
+		->
+			MaybeTimestamp = ok(oldest_timestamp),
+			Info = Info3 ^ file_timestamps
+					^ elem(FileName) := MaybeTimestamp
+		;
+			MaybeTimestamp = MaybeTimestamp0,
+			Info = Info3
+		}
+	;
+		{ MaybeTimestamp = MaybeTimestamp0 },
+		{ Info = Info2 }
+	).
+
+get_file_name(ModuleName - FileType, FileName, Info0, Info) -->
+	( { FileType = source } -> 
+		%
+		% In some cases the module name won't match the file
+		% name (module mdb.parse might be in parse.m or mdb.m),
+		% so we need to look up the file name here.
+		% 
+		get_module_dependencies(ModuleName, MaybeImports, Info0, Info),
+		(
+			{ MaybeImports = yes(Imports) },
+			{ FileName = Imports ^ source_file_name }
+		;
+			{ MaybeImports = no },
+
+			% Something has gone wrong generating the dependencies,
+			% so just take a punt (which probably won't work).
+			module_name_to_file_name(ModuleName, ".m",
+				no, FileName)
+		)
+	;
+		{ Info = Info0 },
+		globals__io_get_globals(Globals),
+		module_name_to_file_name(ModuleName,
+			target_extension(Globals, FileType), no, FileName)
+	).
+
+get_file_timestamp(SearchDirs, FileName, MaybeTimestamp, Info0, Info) -->
+	( { MaybeTimestamp0 = Info0 ^ file_timestamps ^ elem(FileName) } -> 
+		{ Info = Info0 },
+		{ MaybeTimestamp = MaybeTimestamp0 }
+	;
+		io__input_stream(OldInputStream),
+		search_for_file(SearchDirs, FileName, SearchResult),
+		( { SearchResult = yes(_) } ->
+			io__input_stream_name(FullFileName),
+			io__set_input_stream(OldInputStream, FileStream),
+			io__close_input(FileStream),
+			io__file_modification_time(FullFileName, TimeTResult),
+			{
+				TimeTResult = ok(TimeT),
+				Timestamp = time_t_to_timestamp(TimeT),
+				MaybeTimestamp = ok(Timestamp)
+			;
+				TimeTResult = error(Error),
+				MaybeTimestamp = error(
+						io__error_message(Error))
+			},
+			{ Info = Info0 ^ file_timestamps
+					^ elem(FileName) := MaybeTimestamp }
+		;
+			{ MaybeTimestamp = error("file `" ++ FileName
+							++ "' not found") },
+			{ Info = Info0 }
+		)
+	).
+
+:- pred get_search_directories(module_target_type::in, list(dir_name)::out,
+		io__state::di, io__state::uo) is det.	
+
+get_search_directories(FileType, SearchDirs) -->
+	( { yes(SearchDirOpt) = search_for_file_type(FileType) } ->
+		globals__io_lookup_accumulating_option(SearchDirOpt,
+			SearchDirs)
+	;
+		{ SearchDirs = [dir__this_directory] }
+	).
+
+%-----------------------------------------------------------------------------%
+
+remove_target_file(ModuleName - FileType, Info0, Info) -->
+	remove_target_file(ModuleName, FileType, Info0, Info).
+
+remove_target_file(ModuleName, FileType, Info0, Info) -->
+	globals__io_get_globals(Globals),
+	remove_file(ModuleName, target_extension(Globals, FileType),
+		Info0, Info1),
+	( { TimestampExt = timestamp_extension(FileType) } ->
+		remove_file(ModuleName, TimestampExt, Info1, Info)
+	;
+		{ Info = Info1 }
+	).
+
+remove_file(ModuleName, Ext, Info0, Info) -->
+	module_name_to_file_name(ModuleName, Ext, no, FileName),
+	remove_file(FileName, Info0, Info).
+
+remove_file(FileName, Info0, Info) -->
+	io__remove_file(FileName, _),
+	{ Info = Info0 ^ file_timestamps :=
+			map__delete(Info0 ^ file_timestamps, FileName) }.
+
+%-----------------------------------------------------------------------------%
+
+make_target_list(Ks, V) = list__map((func(K) = K - V), Ks).
+
+make_dependency_list(ModuleNames, FileType) =
+	list__map((func(Module) = target(Module - FileType)), ModuleNames).
+
+target_extension(_, source) = ".m".
+target_extension(_, errors) = ".err".
+target_extension(_, private_interface) = ".int0".
+target_extension(_, long_interface) = ".int".
+target_extension(_, short_interface) = ".int2".
+target_extension(_, unqualified_short_interface) = ".int3".
+target_extension(_, intermodule_interface) = ".opt".
+target_extension(_, aditi_code) = ".rlo".
+target_extension(_, c_header) = ".h".
+target_extension(_, c_code) = ".c".
+target_extension(_, il_code) = ".il".
+target_extension(_, il_asm) = ".dll". % XXX ".exe" if the module contains main.
+target_extension(_, java_code) = ".java".
+target_extension(_, asm_code(non_pic)) = ".s".
+target_extension(_, asm_code(pic)) = ".pic_s".
+target_extension(Globals, object_code(non_pic)) = Ext :-
+	globals__lookup_string_option(Globals, object_file_extension, Ext).
+target_extension(Globals, object_code(pic)) = Ext :-
+	globals__lookup_string_option(Globals, pic_object_file_extension, Ext).
+
+linked_target_extension(Globals, executable) = Ext :-
+	globals__lookup_string_option(Globals, executable_file_extension, Ext).
+linked_target_extension(Globals, static_library) = Ext :-
+	globals__lookup_string_option(Globals, library_extension, Ext).
+linked_target_extension(Globals, shared_library) = Ext :-
+	globals__lookup_string_option(Globals, shared_library_extension, Ext).
+
+	% Note that we need a timestamp file for `.err' files because
+	% errors is written to the `.err'. The timestamp is only updated
+	% when compiling to target code.
+timestamp_extension(errors) = ".err_date".
+timestamp_extension(private_interface) = ".date0".
+timestamp_extension(long_interface) = ".date".
+timestamp_extension(short_interface) = ".date".
+timestamp_extension(unqualified_short_interface) = ".date3".
+timestamp_extension(intermodule_interface) = ".optdate".
+timestamp_extension(c_code) = ".c_date".
+timestamp_extension(il_code) = ".il_date".
+timestamp_extension(java_code) = ".java_date".
+timestamp_extension(asm_code(non_pic)) = ".s_date".
+timestamp_extension(asm_code(pic)) = ".pic_s_date".
+
+:- func search_for_file_type(module_target_type) = maybe(option).
+
+search_for_file_type(source) = no.
+search_for_file_type(errors) = no.
+	% XXX only for inter-module optimization.
+search_for_file_type(private_interface) = yes(search_directories).
+search_for_file_type(long_interface) = yes(search_directories).
+search_for_file_type(short_interface) = yes(search_directories).
+search_for_file_type(unqualified_short_interface) = yes(search_directories).
+search_for_file_type(intermodule_interface) = yes(intermod_directories).
+search_for_file_type(aditi_code) = no.
+search_for_file_type(c_header) = yes(c_include_directory).
+search_for_file_type(c_code) = no.
+search_for_file_type(il_code) = no.
+search_for_file_type(il_asm) = no.
+search_for_file_type(java_code) = no.
+search_for_file_type(asm_code(_)) = no.
+search_for_file_type(object_code(_)) = no.
+
+%-----------------------------------------------------------------------------%
+
+debug_msg(P) -->
+	globals__io_lookup_bool_option(debug_make, Debug),
+	( { Debug = yes } ->
+		P,
+		io__flush_output
+	;
+		[]
+	).
+
+verbose_msg(P) -->
+	globals__io_lookup_bool_option(verbose_make, Verbose),
+	( { Verbose = yes } ->
+		P,
+		io__flush_output
+	;
+		[]
+	).
+
+debug_file_msg(TargetFile, Msg) -->
+	debug_msg(
+		(pred(di, uo) is det -->
+			write_target_file(TargetFile),
+			io__write_string(": "),
+			io__write_string(Msg),
+			io__nl
+		)).
+
+write_dependency_file(target(TargetFile)) --> write_target_file(TargetFile).
+write_dependency_file(file(FileName, _)) --> io__write_string(FileName).
+
+write_target_file(ModuleName - FileType) -->
+	prog_out__write_sym_name(ModuleName),
+	globals__io_get_globals(Globals),
+	io__write_string(target_extension(Globals, FileType)).
+
+maybe_make_linked_target_message(TargetFile) -->
+	verbose_msg(
+		(pred(di, uo) is det -->
+			io__write_string("Making "),
+			io__write_string(TargetFile),
+			io__nl
+		)).
+
+maybe_make_target_message(TargetFile) -->
+	io__output_stream(OutputStream),
+	maybe_make_target_message(OutputStream, TargetFile).
+
+maybe_make_target_message(OutputStream, TargetFile) -->
+	verbose_msg(
+		(pred(di, uo) is det -->
+			io__set_output_stream(OutputStream, OldOutputStream),
+			io__write_string("Making "),
+			write_target_file(TargetFile),
+			io__nl,
+			io__set_output_stream(OldOutputStream, _)
+		)).
+
+target_file_error(TargetFile) -->
+	io__write_string("** Error making `"),
+	write_target_file(TargetFile),
+	io__write_string("'.\n").
+
+file_error(TargetFile) -->
+	io__write_string("** Error making `"),
+	io__write_string(TargetFile),
+	io__write_string("'.\n").
+
+%-----------------------------------------------------------------------------%
Index: compiler/options_file.m
===================================================================
RCS file: compiler/options_file.m
diff -N compiler/options_file.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ compiler/options_file.m	4 Feb 2002 02:36:59 -0000
@@ -0,0 +1,986 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2002 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: options_file.m
+% Main author: stayl
+%
+% Code to deal with options for `mmc --make', including code to parse
+% an Mmakefile equivalent.
+%-----------------------------------------------------------------------------%
+:- module options_file.
+
+:- interface.
+
+:- import_module list, io, prog_data, std_util.
+
+:- type options_variables.
+
+:- func options_variables_init = options_variables.
+
+:- pred read_options_files(maybe(options_variables)::out,
+		io__state::di, io__state::uo) is det.
+
+	% Look up the DEFAULT_MCFLAGS variable.
+:- pred lookup_default_options(options_variables::in, maybe(list(string))::out,
+	io__state::di, io__state::uo) is det.
+
+	% Look up all the non-module specific options.
+:- pred lookup_mmc_options(options_variables::in, maybe(list(string))::out,
+	io__state::di, io__state::uo) is det.
+
+	% Same as lookup_mmc_module_options, but also adds the
+	% module-specific (MCFLAGS-module) options.
+:- pred lookup_mmc_module_options(options_variables::in, module_name::in,
+	maybe(list(string))::out, io__state::di, io__state::uo) is det.
+
+	% Look up $(MAIN_TARGET).
+:- pred lookup_main_target(options_variables::in, maybe(list(string))::out,
+	io__state::di, io__state::uo) is det.
+
+	% Quote any strings containing whitespace.
+:- func quote_args(list(string)) = list(string).
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module error_util, globals, options, prog_io, prog_out.
+:- import_module assoc_list, bool, char, dir, exception, map.
+:- import_module require, string, term.
+
+:- type options_variable == string.
+
+:- type options_file_error
+	--->	options_file_error(string).
+
+:- type found_options_file_error
+	--->	found_options_file_error.
+
+:- type options_variables == map(options_variable, options_variable_value).
+
+:- type options_variable_value
+	---> 	options_variable_value(
+			list(char),
+			list(string),	% split into words.
+			variable_source
+		).
+		
+:- type variable_source
+	--->	options_file
+	;	command_line
+	;	environment
+	.
+
+options_variables_init = map__init.
+
+read_options_files(MaybeVariables) -->
+	promise_only_solution_io(
+	    (pred(R::out, di, uo) is cc_multi -->
+		try_io(
+	    	    (pred((Variables1)::out, di, uo) is det -->
+			globals__io_lookup_accumulating_option(options_files,
+				OptionsFiles),
+			{ Variables0 = options_variables_init },
+			(
+			        { OptionsFiles = [_|_] },
+				list__foldl2(
+					read_options_file(error, search, no),
+					OptionsFiles, Variables0, Variables1)
+			;
+				{ OptionsFiles = [] },
+			    	read_options_file(no_error, no_search,
+					yes(dir__this_directory),
+					"Mercury.options",
+					Variables0, Variables1)
+			)
+		    ), R)
+	    ), OptionsFileResult),
+	(
+		{ OptionsFileResult = succeeded(Variables) },
+		{ MaybeVariables = yes(Variables) }
+	;
+		{ OptionsFileResult = exception(Exception) },
+		{ Exception = univ(found_options_file_error) ->
+			MaybeVariables = no
+		;
+			rethrow(OptionsFileResult)
+		}
+	;
+		{ OptionsFileResult = failed },
+		{ error("read_options_files") }
+	).
+
+:- type error_if_not_exist
+	--->	error
+	;	no_error.
+
+:- type search
+	--->	search
+	;	no_search.
+
+	% read_options_file(ErrorIfNotExist, Search, MaybeDirName,
+	% 	FileName, Variables0, Variables).
+:- pred read_options_file(error_if_not_exist::in, search::in,
+		maybe(dir_name)::in, string::in, options_variables::in,
+		options_variables::out, io__state::di, io__state::uo) is det.
+
+read_options_file(ErrorIfNotExist, Search, MaybeDirName, OptionsFile0,
+		Variables0, Variables) -->
+	( { Search = search } ->
+		globals__io_lookup_accumulating_option(
+			options_search_directories, SearchDirs)
+	;
+		{ SearchDirs = [dir__this_directory] }
+	),
+
+	{ dir__split_name(OptionsFile0, OptionsDir, OptionsFile) },
+	(
+		% Is it an absolute pathname?
+		% XXX This won't work on Windows
+		% (but GNU Make does it this way too).
+		{ string__index(OptionsDir, 0, dir__directory_separator) }
+	->
+		{ FileToFind = OptionsFile },
+		{ Dirs = [OptionsDir] }
+	;
+		{ MaybeDirName = yes(DirName) }
+	->
+		{ FileToFind = OptionsFile },
+		{ Dirs = [dir__make_path_name(DirName, OptionsDir)
+				| SearchDirs] }
+	;
+		{ Dirs = SearchDirs },
+		{ FileToFind = OptionsFile0 }
+	),
+	io__input_stream(OldInputStream),
+	search_for_file(Dirs, FileToFind, MaybeDir),
+	(
+		{ MaybeDir = yes(FoundDir) },
+		read_options_lines(FoundDir, Variables0, Variables),
+		io__input_stream(OptionsStream),
+		io__set_input_stream(OldInputStream, _),
+		io__close_input(OptionsStream)
+	;
+		{ MaybeDir = no },
+		{ Variables = Variables0 },
+		( { ErrorIfNotExist = error } ->
+			{ Dirs = [SingleDir] ->
+				ErrorFile = maybe_add_path_name(SingleDir,
+						OptionsFile)	
+			;
+				ErrorFile = OptionsFile
+			},
+			io__write_string("Error reading options file `"),
+			io__write_string(ErrorFile),
+			io__write_string("'.\n"),
+			io__set_exit_status(1)
+		;
+			[]
+		)
+	).
+
+:- func maybe_add_path_name(dir_name, file_name) = file_name.
+
+maybe_add_path_name(Dir, File) =
+	( Dir = dir__this_directory -> File ; dir__make_path_name(Dir, File) ).
+
+:- pred read_options_lines(dir_name::in, options_variables::in,
+		options_variables::out, io__state::di, io__state::uo) is det.
+
+read_options_lines(Dir, Variables0, Variables) -->
+	io__get_line_number(LineNumber),
+	promise_only_solution_io(
+	    (pred(R::out, di, uo) is cc_multi -->
+		try_io(
+	    	    (pred((Variables1 - FoundEOF1)::out, di, uo) is det -->
+			read_options_line(FoundEOF1, [], Line0),
+			(
+			    { Line0 = [] },
+			    { Variables1 = Variables0 }	
+			;
+			    { Line0 = [_|_] },
+			    { parse_options_line(Line0, ParsedLine) },
+			    (
+				{ ParsedLine = define_variable(VarName,
+						AddToValue, Value) },
+				update_variable(VarName, AddToValue, Value,
+						Variables0, Variables1)
+			    ;
+				{ ParsedLine = include_options_files(
+						ErrorIfNotExist,
+						IncludedFilesChars0) },
+				expand_variables(Variables0,
+					IncludedFilesChars0,
+					IncludedFilesChars, UndefVars),
+				report_undefined_variables(UndefVars),
+				{ IncludedFileNames =
+					split_into_words(IncludedFilesChars) },
+				list__foldl2(
+					read_options_file(ErrorIfNotExist,
+						search, yes(Dir)),
+					IncludedFileNames,
+					Variables0, Variables1)
+			    )
+		        )
+		    ), R)
+	    ), LineResult),
+	(
+		{ LineResult = succeeded(Variables2 - FoundEOF) },
+		(
+			{ FoundEOF = yes },
+			{ Variables = Variables2 }
+		;
+			{ FoundEOF = no },
+			read_options_lines(Dir, Variables2, Variables)
+		)
+	;
+		{ LineResult = exception(Exception) },
+		( { Exception = univ(options_file_error(Error)) } ->
+			{ Variables = Variables0 },
+			io__input_stream_name(FileName),
+			prog_out__write_context(
+				term__context_init(FileName, LineNumber)),
+			io__write_string(Error),
+			io__nl,
+
+			% This will be caught by `read_options_files'.
+			% The open options files aren't closed on
+			% the way up, but we'll be exiting straight
+			% away so that doesn't matter.
+			{ throw(found_options_file_error) }
+		;
+			{ rethrow(LineResult) }
+		)
+	;
+		{ LineResult = failed },
+		{ error("read_options_lines") }
+	).
+
+:- pred read_options_line(bool::out, list(char)::in, list(char)::out,
+		io__state::di, io__state::uo) is det.
+
+read_options_line(FoundEOF, Chars0, list__reverse(RevChars)) -->
+	io__ignore_whitespace(SpaceResult),
+	{ SpaceResult = error(Error) ->
+		throw(options_file_error(io__error_message(Error)))
+	;
+		true
+	},
+	read_options_line_2(FoundEOF, Chars0, RevChars).
+
+:- pred read_options_line_2(bool::out, list(char)::in, list(char)::out,
+		io__state::di, io__state::uo) is det.
+
+read_options_line_2(FoundEOF, Chars0, Chars) -->
+    read_item_or_eof(io__read_char, MaybeChar),
+    (
+	{ MaybeChar = yes(Char) },
+	( { Char = '#' } ->
+		skip_comment_line(FoundEOF),
+		{ Chars = Chars0 }
+	; { Char = ('\\') } ->
+    	    read_item_or_eof(io__read_char, MaybeChar2),
+	    (
+		{ MaybeChar2 = yes(Char2) },
+		( { Char2 = '\n' } ->
+		    read_options_line_2(FoundEOF, ['\n' | Chars0], Chars)
+		;
+		    read_options_line_2(FoundEOF,
+		    		[Char2, Char | Chars0], Chars)
+		)
+	    ;
+		{ MaybeChar2 = no },
+		{ FoundEOF = yes },
+		{ Chars = [Char | Chars0] }
+	    )
+    	; { Char = '\n' } ->
+    	    { FoundEOF = no },
+	    { Chars = Chars0 }
+	;
+	    read_options_line_2(FoundEOF, [Char | Chars0], Chars)
+	)
+    ;
+	{ MaybeChar = no },
+	{ FoundEOF = yes },
+	{ Chars = Chars0 }
+    ).
+
+:- pred update_variable(options_variable::in, bool::in, list(char)::in,
+		options_variables::in, options_variables::out,
+		io__state::di, io__state::uo) is det.
+
+update_variable(VarName, AddToValue, NewValue0, Variables0, Variables) -->
+	expand_variables(Variables0, NewValue0, NewValue1, Undef),
+	report_undefined_variables(Undef),
+	{ Words1 = split_into_words(NewValue1) },
+	io__get_environment_var(VarName, MaybeEnvValue),
+	(
+		{ MaybeEnvValue = yes(EnvValue) }
+	->
+		{ Value = string__to_char_list(EnvValue) },
+		{ Words = split_into_words(Value) },
+		{ map__set(Variables0, VarName,
+			options_variable_value(string__to_char_list(EnvValue),
+				Words, environment),
+			Variables) }
+	;
+		{ map__search(Variables0, VarName,
+			options_variable_value(OldValue, OldWords, Source)) }
+	->
+		(
+			{ Source = environment },
+			{ Variables = Variables0 }
+		;
+			{ Source = command_line },
+			{ Variables = Variables0 }
+		;
+			{ Source = options_file },
+			{ AddToValue = yes ->
+				NewValue = OldValue ++ [' ' |  NewValue1],
+				Words = OldWords ++ Words1
+			;
+				NewValue = NewValue1,
+				Words = Words1
+			},
+			{ map__set(Variables0, VarName,
+				options_variable_value(NewValue,
+					Words, options_file),
+				Variables) }
+		)
+	;
+		{ map__set(Variables0, VarName,
+			options_variable_value(NewValue1,
+				Words1, options_file),
+			Variables) }
+	).
+
+:- pred expand_variables(options_variables::in, list(char)::in,
+	list(char)::out, list(string)::out,
+	io__state::di, io__state::uo) is det.
+
+expand_variables(Variables, Chars0, Chars, UndefVars) -->
+	expand_variables_2(Variables, Chars0, [], Chars, [], UndefVars).
+
+:- pred expand_variables_2(options_variables::in, list(char)::in,
+	list(char)::in, list(char)::out,
+	list(string)::in, list(string)::out,
+	io__state::di, io__state::uo) is det.
+
+expand_variables_2(_, [], RevChars, list__reverse(RevChars),
+		Undef, list__reverse(Undef)) --> [].
+expand_variables_2(Variables, [Char | Chars], RevChars0, RevChars,
+		Undef0, Undef) -->
+	( { Char = '$' } ->
+	    (
+		{ Chars = [] },
+		{ throw(
+		options_file_error("unterminated variable reference")) }
+	    ;
+		{ Chars = [Char2 | Chars1] },
+		( { Char2 = '$' } ->
+		    expand_variables_2(Variables, Chars1,
+			['$' | RevChars0], RevChars, Undef0, Undef)
+		;
+		    {
+			( Char2 = '(', EndChar = ')'
+			; Char2 = '{', EndChar = '}'
+			)
+		    ->
+		        parse_variable(VarName0, Chars1, Chars2),
+		    	( Chars2 = [EndChar | Chars3] ->
+				Chars4 = Chars3,
+				VarName = VarName0
+			;
+				throw(options_file_error(
+					"unterminated variable reference"))
+			)
+		    ;
+			Chars4 = Chars1,
+			VarName = string__char_to_string(Char2)
+		    },
+			
+		    lookup_variable_chars(Variables, VarName,
+				VarChars, Undef0, Undef1),
+		    expand_variables_2(Variables, Chars4,
+				reverse(VarChars) ++ RevChars0,
+				RevChars, Undef1, Undef)
+		)
+	    )
+	;
+	    expand_variables_2(Variables, Chars, [Char | RevChars0],
+		RevChars, Undef0, Undef)
+	).
+
+:- pred report_undefined_variables(list(string)::in,
+		io__state::di, io__state::uo) is det.
+
+report_undefined_variables([]) --> [].
+report_undefined_variables([_|Rest] @ UndefVars) -->
+	globals__io_lookup_bool_option(warn_undefined_options_variables, Warn),
+	( { Warn = yes } ->
+		io__input_stream_name(FileName),
+		io__get_line_number(LineNumber),
+		{ Context = term__context_init(FileName, LineNumber) },
+
+		{ error_util__list_to_pieces(
+			list__map((func(Var) = "`" ++ Var ++ "'"), UndefVars),
+			VarList) },
+		{ Rest = [], Word = "variable"
+		; Rest = [_|_], Word = "variables"
+		},
+		{ Pieces =
+			[words("Warning: "), words(Word) | VarList]
+			++ [words("are undefined.")] },
+		write_error_pieces(Context, 0, Pieces),
+
+		globals__io_lookup_bool_option(halt_at_warn, Halt),
+		( { Halt = yes } ->
+			{ throw(found_options_file_error) }
+		;
+			[]
+		)
+	;
+		[]
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- type options_file_line
+	--->	define_variable(
+			options_variable,
+			bool,		% Add to any existing value?
+			list(char)
+		)
+	;	include_options_files(
+			error_if_not_exist,
+			list(char)
+		).
+
+:- pred parse_options_line(list(char)::in, options_file_line::out) is det.
+
+parse_options_line(Line0, OptionsFileLine) :-
+	(	
+		( Line0 = [('-') | Line1] ->
+			ErrorIfNotExist = no_error,
+			Line2 = Line1
+		;
+			ErrorIfNotExist = error,
+			Line2 = Line0	
+		),
+		list__append(string__to_char_list("include"), Line3, Line2)
+	->
+		list__takewhile(char__is_whitespace, Line3, _, Line4),
+		OptionsFileLine = include_options_files(
+					ErrorIfNotExist, Line4)
+	;
+		parse_variable(VarName, Line0, Line1),
+		list__takewhile(char__is_whitespace, Line1, _, Line2),
+		( Line2 = [('=') | Line3] ->
+			Add = no,
+			Line4 = Line3
+		; Line2 = [('+'), ('=') | Line3] ->
+			Add = yes,
+			Line4 = Line3
+		; Line2 = [(':'), ('=') | Line3] ->
+			Add = no,
+			Line4 = Line3
+		;
+			throw(options_file_error(
+				"expected `=', `:=' or `+=' after `"
+				++ VarName ++ "'"))
+		),
+		list__takewhile(char__is_whitespace, Line4, _, VarValue),
+		OptionsFileLine = define_variable(VarName, Add, VarValue)
+	).
+
+:- pred parse_file_name(file_name::out,
+		list(char)::in, list(char)::out) is det.
+
+parse_file_name(FileName, Chars0, Chars) :-
+	( Chars0 = ['"' | Chars1] ->
+		parse_string(FileName, Chars1, Chars)
+	;
+		list__takewhile(isnt(char__is_whitespace), Chars0,
+			FileNameChars, Chars),
+		FileName = string__from_char_list(FileNameChars)
+	).
+
+:- pred parse_variable(options_variable::out,
+		list(char)::in, list(char)::out) is det.
+
+parse_variable(VarName, Chars0, Chars) :-
+	parse_variable_2(yes, [], VarList, Chars0, Chars),
+	string__from_rev_char_list(VarList, VarName),
+	( VarName = "" ->
+		list__takewhile(isnt(char__is_whitespace), Chars,
+			FirstWord, _),
+		throw(options_file_error(
+			string__append_list(["expected variable at `",
+				string__from_char_list(FirstWord), "'"])))
+	;
+		true
+	).
+
+:- pred parse_variable_2(bool::in, list(char)::in, list(char)::out,
+		list(char)::in, list(char)::out) is det.
+
+parse_variable_2(_, Var, Var, [], []).
+parse_variable_2(IsFirst, Var0, Var, [Char | Chars0], Chars) :-
+	(
+		\+ char__is_whitespace(Char),
+		( IsFirst = yes ->
+			char__is_alpha(Char) 
+		;
+			( char__is_alnum_or_underscore(Char)
+			; Char = ('-')
+			; Char = ('.')
+			)
+		)
+	->
+		parse_variable_2(no, [Char | Var0], Var, Chars0, Chars)
+	;
+		Var = Var0,
+		Chars = [Char | Chars0]
+	).
+
+:- pred parse_string(string::out, list(char)::in, list(char)::out) is det.
+
+parse_string(String, Chars0, Chars) :-
+	parse_string_chars([], StringChars, Chars0, Chars),
+	String = string__from_rev_char_list(StringChars).
+
+:- pred parse_string_chars(list(char)::in, list(char)::out,
+		list(char)::in, list(char)::out) is det.
+
+parse_string_chars(_, _, [], _) :-
+	throw(options_file_error("unterminated string")).
+parse_string_chars(String0, String, [Char | Chars0], Chars) :-
+	( Char = '"' ->
+		Chars = Chars0,
+		String = String0
+	; Char = ('\\') ->
+		(
+			Chars0 = [Char2 | Chars1],
+			( Char2 = '"' ->
+				String1 = [Char2 | String0]
+			;
+				String1 = [Char2, Char | String0]
+			),
+			parse_string_chars(String1, String, Chars1, Chars)
+		;
+			Chars0 = [],
+			throw(options_file_error("unterminated string"))
+		)
+	;
+		parse_string_chars([Char | String0], String, Chars0, Chars)
+	).
+
+:- pred skip_comment_line(bool::out, io__state::di, io__state::uo) is det.
+
+skip_comment_line(FoundEOF) -->
+	read_item_or_eof(io__read_char, MaybeChar),
+	(
+		{ MaybeChar = yes(Char) },
+		( { Char = '\n' } ->
+			{ FoundEOF = no }
+		;
+			skip_comment_line(FoundEOF)
+		)
+	;
+		{ MaybeChar = no },
+		{ FoundEOF = yes }
+	).
+
+:- pred read_item_or_eof(
+	pred(io__result(T), io__state, io__state)::(pred(out, di, uo) is det),
+	maybe(T)::out, io__state::di, io__state::uo) is det.
+
+read_item_or_eof(Pred, MaybeItem) -->
+	Pred(Result),
+	(
+		{ Result = ok(Item) },
+		{ MaybeItem = yes(Item) }
+	;
+		{ Result = eof },
+		{ MaybeItem = no }
+	;
+		{ Result = error(Error) },
+		{ throw(options_file_error(io__error_message(Error))) }
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- func checked_split_into_words(list(char)) = maybe_error(list(string)).
+
+checked_split_into_words(Chars) = Result :-
+	TryResult =
+	    promise_only_solution(
+		(pred(TResult::out) is cc_multi :-
+		    try(
+			(pred(Words0::out) is det :-
+			    Words0 = split_into_words(Chars)
+			), TResult)
+		)),
+	(
+		TryResult = succeeded(Words),
+		Result = ok(Words)
+	;
+		TryResult = failed,
+		error("split_into_words failed")
+	;
+		TryResult = exception(Exception),
+		( Exception = univ(options_file_error(Msg)) ->
+			Result = error(Msg)
+		;
+			rethrow(TryResult)
+		)
+	).
+
+:- func split_into_words(list(char)) = list(string).
+
+split_into_words(Chars) = list__reverse(split_into_words_2(Chars, [])).
+
+:- func split_into_words_2(list(char), list(string)) = list(string).
+
+split_into_words_2(Chars0, Words0) = Words :-
+	list__takewhile(char__is_whitespace, Chars0, _, Chars1),
+	(
+		Chars1 = [],
+		Words = Words0
+	;
+		Chars1 = [_|_],
+		get_word(Word, Chars1, Chars),
+		Words = split_into_words_2(Chars, [Word | Words0])
+	).
+
+:- pred get_word(string::out, list(char)::in, list(char)::out) is det.
+
+get_word(string__from_rev_char_list(RevWord), Chars0, Chars) :-
+	get_word_2([], RevWord, Chars0, Chars).	
+
+:- pred get_word_2(list(char)::in, list(char)::out,
+	list(char)::in, list(char)::out) is det.
+
+get_word_2(RevWord, RevWord, [], []).
+get_word_2(RevWord0, RevWord, [Char | Chars0], Chars) :-
+	( char__is_whitespace(Char) ->
+		Chars = Chars0,
+		RevWord = RevWord0			
+	; Char = '"' ->
+		parse_string_chars([], RevStringChars, Chars0, Chars1),
+		get_word_2(RevStringChars ++ RevWord0, RevWord,
+			Chars1, Chars)
+	; Char = ('\\') ->
+		(
+			Chars0 = [],
+			RevWord = [Char | RevWord0],
+			Chars = []
+		;
+			Chars0 = [Char2 | Chars1],
+			get_word_2([Char2 | RevWord0], RevWord,
+				Chars1, Chars)
+		)
+	;
+		get_word_2([Char | RevWord0], RevWord, Chars0, Chars)
+	).
+
+%-----------------------------------------------------------------------------%
+
+lookup_main_target(Vars, MaybeMainTarget) -->
+	lookup_variable_words_report_error(Vars,
+		"MAIN_TARGET", MaybeMainTarget).
+
+lookup_default_options(Vars, Result) -->
+	lookup_mmc_maybe_module_options(Vars, default, Result).
+
+lookup_mmc_options(Vars, Result) -->
+	lookup_mmc_maybe_module_options(Vars, non_module_specific, Result).
+
+lookup_mmc_module_options(Vars, ModuleName, Result) -->
+	lookup_mmc_maybe_module_options(Vars,
+		module_specific(ModuleName), Result).
+
+:- pred lookup_mmc_maybe_module_options(options_variables::in,
+	options_variable_class::in, maybe(list(string))::out,
+	io__state::di, io__state::uo) is det.
+
+lookup_mmc_maybe_module_options(Vars, MaybeModuleName, Result) -->
+	{ VariableTypes = options_variable_types },
+	list__map_foldl(lookup_options_variable(Vars, MaybeModuleName),
+		VariableTypes, Results),
+	{
+		list__map((pred(yes(Value)::in, Value::out) is semidet),
+			Results, Values)
+	->
+		assoc_list__from_corresponding_lists(VariableTypes,
+			Values, VariableValues),
+		Result = yes(list__condense(
+			list__map(convert_to_mmc_options, VariableValues)))
+	;
+		Result = no
+	}.
+
+:- type options_variable_class
+	--->	default
+	;	non_module_specific
+	;	module_specific(module_name)
+	.
+
+
+:- type options_variable_type
+	--->	grade_flags
+	;	mmc_flags
+	;	c_flags
+	;	java_flags
+	;	ilasm_flags
+	;	csharp_flags
+	;	mcpp_flags
+	;	ml_flags
+	;	ml_objs
+	;	ml_libs
+	;	c2init_args
+	;	libraries
+	;	lib_dirs
+	.
+
+:- func options_variable_types = list(options_variable_type).
+
+options_variable_types =
+	[grade_flags, mmc_flags, c_flags, java_flags,
+	ilasm_flags, csharp_flags, mcpp_flags, ml_flags, ml_objs,
+	ml_libs, c2init_args, libraries, lib_dirs].
+
+:- func options_variable_name(options_variable_type) = string.
+
+options_variable_name(grade_flags) = "GRADEFLAGS".
+options_variable_name(mmc_flags) = "MCFLAGS".
+options_variable_name(c_flags) = "CFLAGS".
+options_variable_name(java_flags) = "JAVAFLAGS".
+options_variable_name(ilasm_flags) = "MS_ILASM_FLAGS".
+options_variable_name(mcpp_flags) = "MS_CL_FLAGS".
+options_variable_name(csharp_flags) = "MS_CSC_FLAGS".
+options_variable_name(ml_flags) = "MLFLAGS".
+options_variable_name(ml_objs) = "MLOBJS".
+options_variable_name(ml_libs) = "MLLIBS".
+options_variable_name(c2init_args) = "C2INITARGS".
+options_variable_name(libraries) = "LIBRARIES".
+options_variable_name(lib_dirs) = "LIB_DIRS".
+
+:- func options_variable_type_is_target_specific(options_variable_type) = bool.
+
+options_variable_type_is_target_specific(grade_flags) = no.
+options_variable_type_is_target_specific(mmc_flags) = yes.
+options_variable_type_is_target_specific(c_flags) = yes.
+options_variable_type_is_target_specific(java_flags) = yes.
+options_variable_type_is_target_specific(ilasm_flags) = yes.
+options_variable_type_is_target_specific(mcpp_flags) = yes.
+options_variable_type_is_target_specific(csharp_flags) = yes.
+options_variable_type_is_target_specific(ml_flags) = yes.
+options_variable_type_is_target_specific(ml_objs) = yes.
+options_variable_type_is_target_specific(ml_libs) = yes.
+options_variable_type_is_target_specific(c2init_args) = yes.
+options_variable_type_is_target_specific(libraries) = yes.
+options_variable_type_is_target_specific(lib_dirs) = no.
+
+:- func convert_to_mmc_options(pair(options_variable_type, list(string)))
+			= list(string).
+
+convert_to_mmc_options(VariableType - VariableValue) = OptionsStrings :-
+	MMCOptionType = mmc_option_type(VariableType),
+	(
+		MMCOptionType = mmc_flags,
+		OptionsStrings = VariableValue
+	;
+		MMCOptionType = option(not_split, OptionName),
+		OptionsStrings = [OptionName,
+					string__join_list(" ", VariableValue)]
+	;
+		MMCOptionType = option(split, OptionName),
+		OptionsStrings = list__condense(
+				list__map((func(Word) = [OptionName, Word]),
+					VariableValue))
+	).
+
+:- type mmc_option_type
+	--->	mmc_flags	% The options can be passed directly to mmc.
+
+	;	option(split_into_words, option_name :: string)
+				% The options need to be passed as an
+				% argument of an option to mmc.
+	.
+
+	% The split_into_words type specifies whether there should be
+	% one mmc option per word in a variable's value, or just a single
+	% mmc option.
+	% The value of CFLAGS is converted into a single `--cflags' option.
+	% The value of MLOBJS is converted into as multiple
+	% `--link-object' options.
+:- type split_into_words
+	--->	split
+	;	not_split
+	.
+
+:- func mmc_option_type(options_variable_type) = mmc_option_type.
+
+mmc_option_type(grade_flags) = mmc_flags.
+mmc_option_type(mmc_flags) = mmc_flags.
+mmc_option_type(c_flags) = option(not_split, "--cflags").
+mmc_option_type(java_flags) = option(not_split, "--java-flags").
+mmc_option_type(ilasm_flags) = option(not_split, "--ilasm-flags").
+mmc_option_type(mcpp_flags) = option(not_split, "--mcpp-flags").
+mmc_option_type(csharp_flags) = option(not_split, "--csharp-flags").
+mmc_option_type(ml_flags) = option(not_split, "--link-flags").
+mmc_option_type(ml_objs) = option(split, "--link_object").
+mmc_option_type(ml_libs) = option(not_split, "--link-flags").
+mmc_option_type(c2init_args) = option(split, "--init-files").
+mmc_option_type(libraries) = option(split, "--mercury-library").
+mmc_option_type(lib_dirs) = option(split, "--mercury-library-directory").
+
+%-----------------------------------------------------------------------------%
+
+:- pred lookup_options_variable(options_variables::in,
+	options_variable_class::in, options_variable_type::in,
+	maybe(list(string))::out, io__state::di, io__state::uo) is det.
+
+lookup_options_variable(Vars, OptionsVariableClass, FlagsVar, Result) -->
+	{ VarName = options_variable_name(FlagsVar) },
+	lookup_variable_words_report_error(Vars, "DEFAULT_" ++ VarName,
+		DefaultFlagsResult),
+	(
+		{ OptionsVariableClass = default }
+	->
+		{ FlagsResult = yes([]) },
+		{ ExtraFlagsResult = yes([]) }
+	;
+		lookup_variable_words_report_error(Vars, VarName, FlagsResult),
+		lookup_variable_words_report_error(Vars, VarName,
+			ExtraFlagsResult)
+	),
+	(
+		{ OptionsVariableClass = module_specific(ModuleName) },
+		{ options_variable_type_is_target_specific(FlagsVar) = yes }
+	->
+		{ prog_out__sym_name_to_string(ModuleName,
+			".", ModuleFileNameBase) },
+		{ ModuleVarName = VarName ++ "-" ++ ModuleFileNameBase },
+		lookup_variable_words_report_error(Vars, ModuleVarName,
+			ModuleFlagsResult)
+	;
+		{ ModuleFlagsResult = yes([]) }
+	),
+
+	(
+		{ DefaultFlagsResult = yes(DefaultFlags) },
+		{ FlagsResult = yes(Flags) },
+		{ ExtraFlagsResult = yes(ExtraFlags) },
+		{ ModuleFlagsResult = yes(TargetFlags) }
+	->
+		{ Result = yes(list__condense([DefaultFlags,
+				Flags, ExtraFlags, TargetFlags])) }
+	;
+		{ Result = no }
+	).
+
+:- pred lookup_variable_words_report_error(options_variables::in,
+	options_variable::in, maybe(list(string))::out,
+	io__state::di, io__state::uo) is det.
+
+lookup_variable_words_report_error(Vars, VarName, Result) -->
+	lookup_variable_words(Vars, VarName, Result0),
+	(
+		{ Result0 = ok(Words) },
+		{ Result = yes(Words) }
+	;
+		{ Result0 = error(Error) },
+		{ Result = no },
+		io__write_string(Error),
+		io__nl
+	).
+
+:- pred lookup_variable_words(options_variables::in, options_variable::in,
+	maybe_error(list(string))::out,
+	io__state::di, io__state::uo) is det.
+
+lookup_variable_words(Vars, VarName, Result) -->
+	io__get_environment_var(VarName, MaybeEnvValue),
+	( { MaybeEnvValue = yes(EnvValue) } ->
+		{ SplitResult = checked_split_into_words(
+			string__to_char_list(EnvValue)) },
+		{
+			SplitResult = ok(EnvWords),
+			Result = ok(EnvWords)
+		;
+			SplitResult = error(Msg),
+			Result = error(string__append_list(
+					["Error: in environment variable `",
+					VarName, "': ", Msg]))
+		}
+	; { map__search(Vars, VarName, MapValue) } ->
+		{ MapValue = options_variable_value(_, Words, _) },
+		{ Result = ok(Words) }
+	;
+		{ Result = ok([]) }
+	).
+
+:- pred lookup_variable_chars(options_variables::in, string::in, list(char)::out,
+	list(string)::in, list(string)::out,
+	io__state::di, io__state::uo) is det.
+
+lookup_variable_chars(Variables, Var, Value, Undef0, Undef) -->
+	io__get_environment_var(Var, MaybeValue),
+	{
+		MaybeValue = yes(ValueString),
+		Value = string__to_char_list(ValueString),
+		Undef = Undef0
+	;
+		MaybeValue = no,
+		(
+			map__search(Variables, Var,
+				options_variable_value(Value0, _, _))
+		->
+			Value = Value0,
+			Undef = Undef0
+		;
+			Value = [],
+			Undef = [Var | Undef0]
+		)
+	}.
+
+%-----------------------------------------------------------------------------%
+
+quote_args(Args) = list__map(quote_arg, Args).
+
+:- func quote_arg(string) = string.
+
+quote_arg(Arg0) = Arg :-
+	ArgList = quote_arg_2(string__to_char_list(Arg0)),
+	(
+		list__member(Char, ArgList),
+		( char__is_whitespace(Char)
+		; Char = ('\\')
+		; Char = '"'
+		)
+	->
+		Arg = "'" ++ string__from_char_list(ArgList) ++ "'"
+	;
+		Arg = string__from_char_list(ArgList)
+	).
+
+:- func quote_arg_2(list(char)) = list(char).
+
+quote_arg_2([]) = [].
+quote_arg_2([Char | Chars0]) = Chars :-
+	Chars1 = quote_arg_2(Chars0),
+	( Char = ('\\') ->
+		Chars = [Char, Char | Chars1]
+	; Char = '\n' ->
+		Chars = [('\\'), 'n' | Chars1]
+	; Char = '"' ->
+		Chars = [('\\'), '"' | Chars1]
+	;
+		Chars = [Char | Chars1]	
+	).	
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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