[m-rev.] diff: handle `mmc --make lib<module>'

Simon Taylor stayl at cs.mu.OZ.AU
Mon May 13 16:13:30 AEST 2002


Estimated hours taken: 3

Handle `mmc --make lib<module>' target, which builds all the files
required to use a library in the current grade.

compiler/make.m:
	Check for `lib<module>' when attempting to classify a target.

compiler/make.program_target.m:
compiler/compile_target_code.m:
	Make `.init' files when building the `.a' file.

	Invoke the command given by `--pre-link-command' before linking.

compiler/make.module_target.m:
compiler/make.util.m:
	Move find_oldest_timestamp into make.util.m for
	use by make.program_target.m.

compiler/options.m:
doc/user_guide.texi:
	Add an option `--make-init-file-command', to specify an
	alternative command to make the `.init' file. This is needed
	for the standard library.

	Add an option `--pre-link-command', which specifies a
	command to be run before linking. This is useful if there
	are foreign files which depend on headers produced by
	the Mercury compiler.

Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.8
diff -u -u -r1.8 compile_target_code.m
--- compiler/compile_target_code.m	6 May 2002 14:19:38 -0000	1.8
+++ compiler/compile_target_code.m	9 May 2002 07:54:17 -0000
@@ -4,7 +4,7 @@
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
 % File: compile_target_code.m
-% Main authors: stayl
+% Main authors: fjh, stayl
 %
 % Code to compile the generated `.c', `.s', `.o', etc, files.
 %
@@ -69,6 +69,13 @@
 		bool, io__state, io__state).
 :- mode compile_csharp_file(in, in, in, out, di, uo) is det.
 
+	% make_init_file(ErrorStream, MainModuleName, ModuleNames, Succeeded).
+	%
+	% Make the `.init' file for a library containing the given modules.
+:- pred make_init_file(io__output_stream, module_name,
+		list(module_name), bool, io__state, io__state).
+:- mode make_init_file(in, in, in, out, di, uo) is det.
+
 	% make_init_obj_file(ErrorStream, MainModuleName,
 	%		AllModuleNames, MaybeInitObjFileName).
 :- pred make_init_obj_file(io__output_stream, module_name, list(module_name),
@@ -122,10 +129,26 @@
 :- mode remove_split_c_output_files(in, in, di, uo) is det.
 
 %-----------------------------------------------------------------------------%
+
+	% substitute_user_command(Command0, ModuleName,
+	%		AllModuleNames) = Command
+	%
+	% Replace all occurrences of `@' in Command with ModuleName,
+	% and replace occurrences of `%' in Command with AllModuleNames.
+	% This is used to implement the `--pre-link-command' and
+	% `--make-init-file-command' options.
+:- func substitute_user_command(string, module_name,
+		list(module_name)) = string.
+
+%-----------------------------------------------------------------------------%
 :- implementation.
 
 :- import_module libs__globals, libs__options, libs__handle_options.
 :- import_module hlds__passes_aux, libs__trace_params.
+:- import_module parse_tree__prog_out.
+
+:- import_module ll_backend__llds_out.	% for llds_out__make_init_name and
+					% llds_out__make_rl_data_name
 
 :- import_module dir, int, require, string.
 
@@ -615,6 +638,63 @@
 
 %-----------------------------------------------------------------------------%
 
+make_init_file(ErrorStream, MainModuleName, AllModules, Succeeded) -->
+    globals__io_lookup_maybe_string_option(make_init_file_command,
+		MaybeInitFileCommand),
+    (
+	{ MaybeInitFileCommand = yes(InitFileCommand0) },
+	{ InitFileCommand = substitute_user_command(InitFileCommand0,
+		MainModuleName, AllModules) },
+	invoke_shell_command(ErrorStream, verbose_commands,
+		InitFileCommand, Succeeded)
+    ;
+	{ MaybeInitFileCommand = no },
+	module_name_to_file_name(MainModuleName, ".init.tmp",
+		yes, TmpInitFileName),
+	io__open_output(TmpInitFileName, InitFileRes),
+	(
+		{ InitFileRes = ok(InitFileStream) },
+		globals__io_lookup_bool_option(aditi, Aditi),
+		list__foldl(
+		    (pred(ModuleName::in, di, uo) is det -->
+			{ llds_out__make_init_name(ModuleName,
+				InitFuncName0) },
+			{ InitFuncName = InitFuncName0 ++ "init" },
+			io__write_string(InitFileStream, "INIT "),
+			io__write_string(InitFileStream, InitFuncName),
+			io__nl(InitFileStream),
+			( { Aditi = yes } ->
+				{ llds_out__make_rl_data_name(ModuleName,
+					RLName) },
+				io__write_string(InitFileStream,
+					"ADITI_DATA "),
+				io__write_string(InitFileStream, RLName),
+				io__nl(InitFileStream)
+			;
+				[]
+			)
+		    ), AllModules),
+		io__close_output(InitFileStream),
+		module_name_to_file_name(MainModuleName, ".init",
+			yes, InitFileName),
+		update_interface(InitFileName, Succeeded)
+	;
+		{ InitFileRes = error(Error) },
+		io__progname_base("mercury_compile", ProgName),
+		io__write_string(ErrorStream, ProgName),
+		io__write_string(ErrorStream, ": can't open `"),
+		io__write_string(ErrorStream, TmpInitFileName),
+		io__write_string(ErrorStream, "' for output:\n"),
+		io__nl(ErrorStream),
+		io__write_string(ErrorStream, io__error_message(Error)),
+		io__nl(ErrorStream),
+		io__set_exit_status(1),
+		{ Succeeded = no }
+	)
+    ).
+
+%-----------------------------------------------------------------------------%
+
 link_module_list(Modules, Succeeded) -->
 	globals__io_lookup_string_option(output_file_name, OutputFileName0),
 	( { OutputFileName0 = "" } ->
@@ -959,7 +1039,6 @@
 	;
 		{ Succeeded = no },
 		io__progname_base("mercury_compile", ProgName),
-		io__write_string("\n"),
 		io__write_string(ProgName),
 		io__write_string(": can't open `"),
 		io__write_string(NumChunksFileName),
@@ -1026,6 +1105,27 @@
 		remove_split_c_output_files(ModuleName, ThisChunk, NumChunks)
 	;
 		[]	
+	).
+
+%-----------------------------------------------------------------------------%
+
+substitute_user_command(Command0, MainModule, AllModules) = Command :-
+	( string__contains_char(Command0, '@') ->
+		prog_out__sym_name_to_string(MainModule, ".", MainModuleStr),
+		Command1 = string__replace_all(Command0, "@", MainModuleStr)
+	;
+		Command1 = Command0
+	),
+	( string__contains_char(Command0, '%') ->
+		AllModulesStrings = list__map(
+		    (func(Module) = ModuleStr :-
+			prog_out__sym_name_to_string(Module, ".", ModuleStr)
+		    ), AllModules),
+		join_string_list(AllModulesStrings,
+			"", "", " ", AllModulesStr),
+		Command = string__replace_all(Command1, "%", AllModulesStr)
+	;
+		Command = Command1
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/make.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.m,v
retrieving revision 1.5
diff -u -u -r1.5 make.m
--- compiler/make.m	6 May 2002 11:43:56 -0000	1.5
+++ compiler/make.m	6 May 2002 15:24:52 -0000
@@ -155,6 +155,7 @@
 	--->	clean
 	;	realclean
 	;	check
+	;	build_library
 	;	install_library
 	.
 
@@ -365,9 +366,17 @@
     ->
 	TargetFile = ModuleName - TargetType
     ;
-	globals__lookup_string_option(Globals, executable_file_extension, ""),
+	string__append("lib", ModuleNameStr, FileName)
+    ->
+	TargetType = misc_target(build_library),
+	file_name_to_module_name(ModuleNameStr, ModuleName)
+    ;
+	globals__lookup_string_option(Globals, executable_file_extension, "")
+    ->
 	TargetType = linked_target(executable),
 	file_name_to_module_name(FileName, ModuleName)
+    ;
+    	fail
     ).
 
 :- pred search_backwards_for_dot(string::in, int::in, int::out) is semidet.
Index: compiler/make.module_target.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.module_target.m,v
retrieving revision 1.5
diff -u -u -r1.5 make.module_target.m
--- compiler/make.module_target.m	6 May 2002 11:43:56 -0000	1.5
+++ compiler/make.module_target.m	8 May 2002 08:37:13 -0000
@@ -173,14 +173,6 @@
 	{ Info = Info1 }
     ).
 
-:- func find_oldest_timestamp(maybe_error(timestamp),
-		maybe_error(timestamp)) = maybe_error(timestamp).
-
-find_oldest_timestamp(error(_) @ Timestamp, _) = Timestamp.
-find_oldest_timestamp(ok(_), error(_) @ Timestamp) = Timestamp.
-find_oldest_timestamp(ok(Timestamp1), ok(Timestamp2)) =
-    ok( ( compare((<), Timestamp1, Timestamp2) -> Timestamp1 ; Timestamp2 ) ).
-
 %-----------------------------------------------------------------------------%
 
 :- pred build_target(compilation_task_result::in, target_file::in,
Index: compiler/make.program_target.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.program_target.m,v
retrieving revision 1.3
diff -u -u -r1.3 make.program_target.m
--- compiler/make.program_target.m	24 Apr 2002 08:42:34 -0000	1.3
+++ compiler/make.program_target.m	10 May 2002 07:38:30 -0000
@@ -18,6 +18,8 @@
 %-----------------------------------------------------------------------------%
 :- implementation.
 
+:- import_module hlds__passes_aux.
+
 make_linked_target(MainModuleName - FileType, Succeeded, Info0, Info) -->
     find_reachable_local_modules(MainModuleName, DepsSuccess,
 		AllModules, Info0, Info1),
@@ -54,7 +56,7 @@
 	linked_target_file_name(MainModuleName, FileType, 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 ->
@@ -129,7 +131,38 @@
 		AllModules, ObjModules, CompilationTarget, ObjExtToUse,
 		DepsSuccess, BuildDepsResult, _, ErrorStream, Succeeded,
 		Info0, Info) -->
+	globals__io_lookup_maybe_string_option(pre_link_command,
+		MaybePreLinkCommand),
+	( { MaybePreLinkCommand = yes(PreLinkCommand0) } ->
+		{ PreLinkCommand = substitute_user_command(PreLinkCommand0,
+			MainModuleName, set__to_sorted_list(AllModules)) },
+		invoke_shell_command(ErrorStream, verbose, PreLinkCommand,
+			PreLinkSucceeded)
+	;
+		{ PreLinkSucceeded = yes }
+	),	
+
+	( { PreLinkSucceeded = yes } ->
+		build_linked_target_2(MainModuleName, FileType, OutputFileName,
+			MaybeTimestamp, AllModules, ObjModules,
+			CompilationTarget, ObjExtToUse, DepsSuccess,
+			BuildDepsResult, ErrorStream, Succeeded,
+			Info0, Info)
+	;
+		{ Succeeded = no },
+		{ Info = Info0 }
+	).
 
+:- pred build_linked_target_2(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, io__output_stream::in, bool::out,
+	make_info::in, make_info::out, io__state::di, io__state::uo) is det.
+
+build_linked_target_2(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.
@@ -264,7 +297,8 @@
 			file_error(OutputFileName),
 			{ Info = Info3 }
 		)
-	).
+	),
+	globals__io_set_option(link_objects, accumulating(ExtraObjects0)).
 
 :- pred linked_target_cleanup(module_name::in, linked_target_type::in,
 	file_name::in, compilation_target::in, make_info::in, make_info::out,
@@ -331,6 +365,50 @@
 				make_dependency_list(AllModules, errors),
 				Succeeded1, Info3, Info),
 			{ Succeeded = Succeeded0 `and` Succeeded1 }
+		)
+	;
+		{ TargetType = build_library },
+		{ ShortInts = make_dependency_list(AllModules,
+				unqualified_short_interface) },
+		{ LongInts = make_dependency_list(AllModules,
+				long_interface) },
+		globals__io_lookup_bool_option(intermodule_optimization,
+			Intermod),
+		{ Intermod = yes ->
+			OptFiles = make_dependency_list(AllModules,
+					long_interface)
+		;
+			OptFiles = []
+		},
+		globals__io_lookup_bool_option(keep_going, KeepGoing),
+		foldl2_maybe_stop_at_error(KeepGoing,
+			foldl2_maybe_stop_at_error(KeepGoing,
+				make_module_target),
+			[ShortInts, LongInts, OptFiles],
+			IntSucceeded, Info3, Info4),
+		( { IntSucceeded = yes } ->
+		    % Errors while making the `.init' file should be very rare.
+		    io__output_stream(ErrorStream),
+		    compile_target_code__make_init_file(ErrorStream,
+				MainModuleName, AllModules, InitSucceeded),
+		    ( { InitSucceeded = yes } ->
+			make_linked_target(MainModuleName - static_library,
+				StaticSucceeded, Info4, Info5),
+			( { StaticSucceeded = yes } ->
+				make_linked_target(
+					MainModuleName - shared_library,
+					Succeeded, Info5, Info)
+			;
+				{ Succeeded = no },
+				{ Info = Info5 }
+			)
+		    ;
+			{ Succeeded = no },
+		    	{ Info = Info4 }
+		    )
+		;
+			{ Succeeded = no },
+			{ Info = Info4 }
 		)
 	;
 		{ TargetType = install_library },
Index: compiler/make.util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.util.m,v
retrieving revision 1.5
diff -u -u -r1.5 make.util.m
--- compiler/make.util.m	3 May 2002 06:52:22 -0000	1.5
+++ compiler/make.util.m	8 May 2002 08:38:58 -0000
@@ -106,6 +106,11 @@
 	maybe_error(timestamp)::out, make_info::in, make_info::out,
 	io__state::di, io__state::uo) is det.
 
+	% Return the oldest of the timestamps if both are of the form
+	% `ok(Timestamp)', returning `error(Error)' otherwise.
+:- func find_oldest_timestamp(maybe_error(timestamp),
+		maybe_error(timestamp)) = maybe_error(timestamp).
+
 %-----------------------------------------------------------------------------%
 	% Remove file a file, deleting the cached timestamp.
 
@@ -515,6 +520,11 @@
 	;
 		{ SearchDirs = [dir__this_directory] }
 	).
+
+find_oldest_timestamp(error(_) @ Timestamp, _) = Timestamp.
+find_oldest_timestamp(ok(_), error(_) @ Timestamp) = Timestamp.
+find_oldest_timestamp(ok(Timestamp1), ok(Timestamp2)) =
+    ok( ( compare((<), Timestamp1, Timestamp2) -> Timestamp1 ; Timestamp2 ) ).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.371
diff -u -u -r1.371 options.m
--- compiler/options.m	9 May 2002 16:31:06 -0000	1.371
+++ compiler/options.m	12 May 2002 05:12:00 -0000
@@ -540,6 +540,8 @@
 		;	keep_going
 		;	rebuild
 		;	invoked_by_mmc_make
+		;	make_init_file_command
+		;	pre_link_command
 		;	install_prefix
 		;	install_command
 		;	libgrades
@@ -1071,6 +1073,8 @@
 	keep_going		-	bool(no),
 	rebuild			-	bool(no),
 	invoked_by_mmc_make	-	bool(no),
+	pre_link_command	-	maybe_string(no),
+	make_init_file_command	-	maybe_string(no),
 	install_prefix		-	string("/usr/local/"),
 	install_command		-	string("cp"),
 	libgrades		-	accumulating([]),
@@ -1641,6 +1645,8 @@
 long_option("keep-going",		keep_going).
 long_option("rebuild",			rebuild).
 long_option("invoked-by-mmc-make",	invoked_by_mmc_make).
+long_option("pre-link-command",		pre_link_command).
+long_option("make-init-file-command",	make_init_file_command).
 long_option("install-prefix",		install_prefix).
 long_option("install-command",		install_command).
 long_option("library-grade",		libgrades).
@@ -3379,6 +3385,19 @@
 		"-k, --keep-going",
 		"\tWith `--make', keep going as far as",
 		"\tpossible even if an error is detected.",
+		"--pre-link-command <command>",
+		"\tSpecify a command to run before linking with `mmc --make'.",
+		"\tThis can be used to compile C source files which rely on",
+		"\theader files generated by the Mercury compiler.",
+		"\tOccurrences of `@' in the command will be replaced with",
+		"\tthe name of the main module with `.' as the module",
+		"\tqualifier. Occurrences of `%' in the command will be",
+		"\treplaced by the list of modules making up the library.",
+		"--make-init-file-command <command>",
+		"\tSpecify an alternative command to produce the `.init' file",
+		"\tfor a library. Occurrences of `@' and `%' in the command",
+		"\tare substituted as for the `--pre-link-command' option.",
+		"\tBy default, `mmc --make' creates the `.init' file itself.",
 		"--install-prefix <dir>",
 		"\tThe directory under which to install Mercury libraries.",
 		"--install-command <command>",
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.310
diff -u -u -r1.310 user_guide.texi
--- doc/user_guide.texi	9 May 2002 16:31:09 -0000	1.310
+++ doc/user_guide.texi	12 May 2002 05:12:11 -0000
@@ -5619,6 +5619,23 @@
 Same as @samp{--make}, but always rebuild the target files
 even if they are up to date.
 
+ at item --pre-link-command @var{command}
+ at findex --pre-link-command
+Specify a command to run before linking with @samp{mmc --make}.
+This can be used to compile C source files which rely on
+header files generated by the Mercury compiler.
+Occurrences of @samp{@@} in the command will be replaced with
+the name of the main module with @samp{.} as the module
+qualifier. Occurrences of @samp{%} in the command will be
+replaced by the list of modules making up the library.
+
+ at item --make-init-file-command @var{command}
+ at findex --make-init-file-command
+Specify an alternative command to produce the @file{.init} file
+for a library. Occurrences of @samp{@@} and @samp{%} in the command
+are substituted as for the @samp{--pre-link-command} option.
+By default, @samp{mmc --make} creates the @samp{.init} file itself.
+
 @item -k
 @itemx --keep-going
 @findex -k
--------------------------------------------------------------------------
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