[m-rev.] for review: allow arbitrary module name to source file mappings

[Simon Taylor]

Estimated hours taken: 8
Branches: main

Allow arbitrary mappings from source file name to module name.
The mapping is created using the command `mmc -f *.m', which must
be run before `mmake depend'.

compiler/parse_tree.m:
compiler/source_file_map.m:
compiler/notes/compiler_design.html:
	Add a new module to read, write and search the mapping.

compiler/modules.m:
	Use the source file map when searching for source files.

	Export `make_directory' for use by source_file_map.m.

	Use the module name rather than the source file name to
	generate the executable name. This matches the documentation
	in the User's Guide, and it's needed to make the tests work.

compiler/prog_io.m:
	Separate out the code to read the first item in a module to
	find the module name into a new predicate, `find_module_name'.

compiler/handle_options.m:
	Don't complain about the module name not matching the file
	name when generating the Mercury.modules file -- the file
	only needs to be generated when the module name doesn't
	match the file name.

compiler/llds_out.m:
	Remove a duplicate copy of `make_directory'.	

compiler/options.m:
compiler/mercury_compile.m:
doc/user_guide.texi:
	Add the `--generate-source-file-mapping' (-f) option
	to generate the mapping.

NEWS:
	Document the change.

tests/hard_coded/Mmakefile:
tests/hard_coded/source_file_map.m:
tests/hard_coded/mapped_module.exp:
	Test case.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.254
diff -u -u -r1.254 NEWS
--- NEWS	15 Mar 2002 07:31:39 -0000	1.254
+++ NEWS	8 Apr 2002 06:23:51 -0000
@@ -15,6 +15,7 @@
 * A new `--smart-recompilation' option, for fine-grained dependency tracking.
 * A new optional warning: `--warn-non-tail-recursion'.
 * A new optimization: `--constraint-propagation'.
+* Support for arbitrary mappings from module name to source file name. 
 
 Major improvements to the Mercury debugger, including:
 * Support for source-linked debugging using vim (rather than emacs).
@@ -254,6 +255,13 @@
   interface of a module changes, only modules which use the changed
   declarations are recompiled. Smart recompilation does not yet work
   with `--intermodule-optimization'.
+
+* The Mercury compiler can now handle arbitrary mappings from source files
+  to module names.  If the program contains modules for which the source
+  file name does not match the module name, before generating the
+  dependencies the command `mmc -f SOURCES' must be run, where `SOURCES'
+  is a list of the names of all of the source files.  If the names of the
+  source files all match the contained module names, `mmc -f' need not be run.
 
 * We've added a new compiler option `--warn-non-tail-recursion', which
   causes the compiler to issue a warning about any directly recursive
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.49
diff -u -u -r1.49 globals.m
--- compiler/globals.m	20 Mar 2002 12:36:11 -0000	1.49
+++ compiler/globals.m	7 Apr 2002 12:06:07 -0000
@@ -17,7 +17,8 @@
 
 :- interface.
 :- import_module libs__options, libs__trace_params.
-:- import_module bool, getopt, list, io, std_util.
+:- import_module parse_tree, parse_tree__prog_data. % for module_name.
+:- import_module bool, getopt, list, map, io, std_util.
 
 :- type globals.
 
@@ -64,6 +65,9 @@
 	;	num_data_elems
 	;	size_data_elems.
 
+	% Map from module name to file name.
+:- type source_file_map == map(module_name, string).
+
 :- pred convert_target(string::in, compilation_target::out) is semidet.
 :- pred convert_foreign_language(string::in, foreign_language::out) is semidet.
 :- pred convert_gc_method(string::in, gc_method::out) is semidet.
@@ -89,6 +93,8 @@
 :- pred globals__get_trace_level(globals::in, trace_level::out) is det.
 :- pred globals__get_trace_suppress(globals::in, trace_suppress_items::out)
 	is det.
+:- pred globals__get_source_file_map(globals::in,
+		maybe(source_file_map)::out) is det.
 
 :- pred globals__set_options(globals::in, option_table::in, globals::out)
 	is det.
@@ -100,6 +106,10 @@
 	is det.
 :- pred globals__set_trace_level_none(globals::in, globals::out) is det.
 
+
+:- pred globals__set_source_file_map(globals::in, maybe(source_file_map)::in,
+		globals::out) is det.
+
 :- pred globals__lookup_option(globals::in, option::in, option_data::out)
 	is det.
 
@@ -254,13 +264,14 @@
 			tags_method 		:: tags_method,
 			termination_norm 	:: termination_norm,
 			trace_level 		:: trace_level,
-			trace_suppress_items	:: trace_suppress_items
+			trace_suppress_items	:: trace_suppress_items,
+			source_file_map		:: maybe(source_file_map)
 		).
 
 globals__init(Options, Target, GC_Method, TagsMethod,
 		TerminationNorm, TraceLevel, TraceSuppress,
 	globals(Options, Target, GC_Method, TagsMethod,
-		TerminationNorm, TraceLevel, TraceSuppress)).
+		TerminationNorm, TraceLevel, TraceSuppress, no)).
 
 globals__get_options(Globals, Globals ^ options).
 globals__get_target(Globals, Globals ^ target).
@@ -269,6 +280,7 @@
 globals__get_termination_norm(Globals, Globals ^ termination_norm).
 globals__get_trace_level(Globals, Globals ^ trace_level).
 globals__get_trace_suppress(Globals, Globals ^ trace_suppress_items).
+globals__get_source_file_map(Globals, Globals ^ source_file_map).
 
 globals__get_backend_foreign_languages(Globals, ForeignLangs) :-
 	globals__lookup_accumulating_option(Globals, backend_foreign_languages,
@@ -289,6 +301,9 @@
 	Globals ^ trace_level := TraceLevel).
 globals__set_trace_level_none(Globals,
 	Globals ^ trace_level := trace_level_none).
+
+globals__set_source_file_map(Globals, SourceFileMap,
+	Globals ^ source_file_map := SourceFileMap).
 
 globals__lookup_option(Globals, Option, OptionData) :-
 	globals__get_options(Globals, OptionTable),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.137
diff -u -u -r1.137 handle_options.m
--- compiler/handle_options.m	28 Mar 2002 03:42:56 -0000	1.137
+++ compiler/handle_options.m	7 Apr 2002 15:55:45 -0000
@@ -818,6 +818,11 @@
 	option_implies(generate_module_order, generate_dependencies,
 		bool(yes)),
 
+	% We only generate the source file mapping if the module name
+	% doesn't match the file name. 
+	option_implies(generate_source_file_mapping, warn_wrong_module_name,
+		bool(no)),
+
 	% --aditi-only implies --aditi.
 	option_implies(aditi_only, aditi, bool(yes)),
 
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.189
diff -u -u -r1.189 llds_out.m
--- compiler/llds_out.m	20 Mar 2002 12:36:33 -0000	1.189
+++ compiler/llds_out.m	7 Apr 2002 12:06:07 -0000
@@ -4523,13 +4523,3 @@
 	io__write_string(", ").
 
 %-----------------------------------------------------------------------------%
-
-:- pred make_directory(string::in, io__state::di, io__state::uo) is det.
-
-make_directory(DirName) -->
-	{ make_command_string(string__format(
-		"[ -d %s ] || mkdir -p %s", [s(DirName), s(DirName)]),
-		forward, Command) },
-	io__call_system(Command, _Result).
-
-%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.244
diff -u -u -r1.244 mercury_compile.m
--- compiler/mercury_compile.m	7 Apr 2002 10:22:39 -0000	1.244
+++ compiler/mercury_compile.m	7 Apr 2002 12:06:07 -0000
@@ -37,7 +37,7 @@
 	% semantic analysis
 :- import_module libs__handle_options, parse_tree__prog_io.
 :- import_module parse_tree__prog_out, parse_tree__modules.
-:- import_module parse_tree__module_qual.
+:- import_module parse_tree__source_file_map, parse_tree__module_qual.
 :- import_module parse_tree__equiv_type, hlds__make_hlds.
 :- import_module check_hlds__typecheck, check_hlds__purity.
 :- import_module check_hlds__polymorphism, check_hlds__modes.
@@ -171,6 +171,8 @@
 	usage_error(ErrorMessage).
 main_2(no, OptionArgs, Args, Link) -->
 	globals__io_lookup_bool_option(help, Help),
+	globals__io_lookup_bool_option(generate_source_file_mapping,
+		GenerateMapping),
 	globals__io_lookup_bool_option(output_grade_string, OutputGrade),
 	globals__io_lookup_bool_option(filenames_from_stdin,
 		FileNamesFromStdin),
@@ -186,6 +188,8 @@
 		io__stdout_stream(Stdout),
 		io__write_string(Stdout, Grade),
 		io__write_string(Stdout, "\n")
+	; { GenerateMapping = yes } ->
+		source_file_map__write_source_file_map(Args)
 	; { Make = yes } ->
 		make__process_args(OptionArgs, Args)
 	; { Args = [], FileNamesFromStdin = no } ->
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.227
diff -u -u -r1.227 modules.m
--- compiler/modules.m	7 Apr 2002 10:22:46 -0000	1.227
+++ compiler/modules.m	8 Apr 2002 06:30:22 -0000
@@ -646,6 +646,12 @@
 :- pred update_interface(string, io__state, io__state).
 :- mode update_interface(in, di, uo) is det.
 
+	% make_directory(Dir)
+	%
+	% Make the directory Dir and all its parents.
+:- pred make_directory(string, io__state, io__state).
+:- mode make_directory(in, di, uo) is det.
+
 %-----------------------------------------------------------------------------%
 
 	% Check whether a particular `pragma' declaration is allowed
@@ -669,6 +675,7 @@
 :- import_module ll_backend__llds_out, hlds__passes_aux, parse_tree__prog_out.
 :- import_module parse_tree__prog_util, parse_tree__mercury_to_mercury.
 :- import_module parse_tree__prog_io_util, libs__options.
+:- import_module parse_tree__source_file_map.
 :- import_module parse_tree__module_qual, backend_libs__foreign.
 :- import_module recompilation__version.
 :- import_module make. % XXX undesirable dependency
@@ -744,15 +751,17 @@
 mercury_std_library_module("type_desc").
 mercury_std_library_module("varset").
 
-	% It is not really clear what the naming convention
-	% should be.  Currently we assume that the module
-	% `foo:bar:baz' will be in files `foo.bar.baz.{m,int,etc.}'.
-	% It would be nice to allow a more flexible mapping.
-
 module_name_to_file_name(ModuleName, Ext, MkDir, FileName) -->
-	{ prog_out__sym_name_to_string(ModuleName, ".", BaseFileName) },
-	{ string__append_list([BaseFileName, Ext], BaseName) },
-	choose_file_name(ModuleName, BaseName, Ext, MkDir, FileName).
+	( { Ext = ".m" } ->
+		% Look up the module in the module->file mapping.
+		source_file_map__lookup_module_source_file(ModuleName,
+			FileName)
+	;
+		{ prog_out__sym_name_to_string(ModuleName,
+			".", BaseFileName) },
+		{ string__append_list([BaseFileName, Ext], BaseName) },
+		choose_file_name(ModuleName, BaseName, Ext, MkDir, FileName)
+	).
 
 module_name_to_lib_file_name(Prefix, ModuleName, Ext, MkDir, FileName) -->
 	{ prog_out__sym_name_to_string(ModuleName, ".", BaseFileName) },
@@ -789,9 +798,8 @@
 		% and phony Mmake targets names go in the current directory
 		%
 		{
-			( Ext = ".m"
 			% executable files
-			; Ext = ""
+			( Ext = ""
 			; Ext = ".split"
 			% library files
 			; Ext = ".a"
@@ -956,9 +964,6 @@
 module_name_to_make_var_name(ModuleName, MakeVarName) :-
 	prog_out__sym_name_to_string(ModuleName, ".", MakeVarName).
 
-:- pred make_directory(string, io__state, io__state).
-:- mode make_directory(in, di, uo) is det.
-
 make_directory(DirName) -->
 	( { dir__this_directory(DirName) } ->
 		[]
@@ -2366,9 +2371,7 @@
 			"\t@:\n"
 		]),
 
-		module_name_to_file_name(ModuleName, ".m", no,
-			ExpectedSourceFileName),
-		( { SourceFileName \= ExpectedSourceFileName } ->
+		( { SourceFileName \= default_source_file(ModuleName) } ->
 			%
 			% The pattern rules in Mmake.rules won't work,
 			% since the source file name doesn't match the
@@ -3720,18 +3723,6 @@
 :- mode generate_dep_file(in, in, in, in, di, uo) is det.
 
 generate_dep_file(SourceFileName, ModuleName, DepsMap, DepStream) -->
-	%
-	% Some of the targets are based on the source file name
-	% rather than on the module name.
-	%
-	{
-		string__remove_suffix(SourceFileName, ".m", SourceFileBase)
-	->
-		file_name_to_module_name(SourceFileBase, SourceModuleName)
-	;
-		error("modules.m: source file name doesn't end in `.m'")
-	},
-
 	io__write_string(DepStream,
 		"# Automatically generated dependencies for module `"),
 	{ prog_out__sym_name_to_string(ModuleName, ModuleNameString) },
@@ -3797,7 +3788,7 @@
 	% than the `.c' files.
 	%
 
-	module_name_to_file_name(SourceModuleName, "", no, ExeFileName),
+	module_name_to_file_name(ModuleName, "", no, ExeFileName),
 
 	{ If = ["ifeq ($(findstring il,$(GRADE)),il)\n"] },
 	{ ILMainRule = [ExeFileName, " : ", ExeFileName, ".exe\n",
@@ -3828,7 +3819,7 @@
 	},
 	io__write_strings(DepStream, Rules),
 
-	module_name_to_file_name(SourceModuleName, ".split", yes,
+	module_name_to_file_name(ModuleName, ".split", yes,
 				SplitExeFileName),
 	module_name_to_file_name(ModuleName, ".split.$A",
 			yes, SplitLibFileName),
@@ -4025,8 +4016,7 @@
 		])
 	),
 
-	module_name_to_file_name(SourceModuleName, ".check", no,
-				CheckTargetName),
+	module_name_to_file_name(ModuleName, ".check", no, CheckTargetName),
 	module_name_to_file_name(ModuleName, ".ints", no, IntsTargetName),
 	module_name_to_file_name(ModuleName, ".int3s", no, Int3sTargetName),
 	module_name_to_file_name(ModuleName, ".opts", no, OptsTargetName),
@@ -4090,8 +4080,7 @@
 	% will also require a fix in `mmake.in'.
 	%
 
-	module_name_to_file_name(SourceModuleName, ".clean", no,
-				CleanTargetName),
+	module_name_to_file_name(ModuleName, ".clean", no, CleanTargetName),
 	io__write_strings(DepStream, [
 		"clean_local : ", CleanTargetName, "\n"
 	]),
@@ -4126,7 +4115,7 @@
 
 	io__write_string(DepStream, "\n"),
 
-	module_name_to_file_name(SourceModuleName, ".realclean", no,
+	module_name_to_file_name(ModuleName, ".realclean", no,
 			RealCleanTargetName),
 	io__write_strings(DepStream, [
 		"realclean_local : ", RealCleanTargetName, "\n"
@@ -4771,30 +4760,30 @@
 
 read_mod(ModuleName, Extension, Descr, Search, ReturnTimestamp,
 		Items, Error, FileName, MaybeTimestamp) -->
-	read_mod_2(no, ModuleName, ModuleName, Extension, Descr, Search,
+	read_mod_2(no, ModuleName, Extension, Descr, Search,
 		no, ReturnTimestamp, Items, Error, FileName, MaybeTimestamp).
 
 read_mod_if_changed(ModuleName, Extension, Descr, Search, OldTimestamp,
 		Items, Error, FileName, MaybeTimestamp) -->
-	read_mod_2(no, ModuleName, ModuleName, Extension, Descr, Search,
+	read_mod_2(no, ModuleName, Extension, Descr, Search,
 		yes(OldTimestamp), yes, Items, Error,
 		FileName, MaybeTimestamp).
 
 read_mod_ignore_errors(ModuleName, Extension, Descr, Search, ReturnTimestamp,
 		Items, Error, FileName, MaybeTimestamp) -->
-	read_mod_2(yes, ModuleName, ModuleName, Extension, Descr, Search,
+	read_mod_2(yes, ModuleName, Extension, Descr, Search,
 		no, ReturnTimestamp, Items, Error, FileName, MaybeTimestamp).
 
-:- pred read_mod_2(bool, module_name, module_name, string, string,
+:- pred read_mod_2(bool, module_name, string, string,
 		bool, maybe(timestamp), bool, item_list, module_error,
 		file_name, maybe(timestamp), io__state, io__state).
-:- mode read_mod_2(in, in, in, in, in, in, in, in, out, out, out, out,
+:- mode read_mod_2(in, in, in, in, in, in, in, out, out, out, out,
 		di, uo) is det.
 
-read_mod_2(IgnoreErrors, ModuleName, PartialModuleName,
+read_mod_2(IgnoreErrors, ModuleName,
 		Extension, Descr, Search, MaybeOldTimestamp,
 		ReturnTimestamp, Items, Error, FileName, MaybeTimestamp) -->
-	module_name_to_file_name(PartialModuleName, Extension, no, FileName0),
+	module_name_to_file_name(ModuleName, Extension, no, FileName0),
 	globals__io_lookup_bool_option(very_verbose, VeryVerbose),
 	maybe_write_string(VeryVerbose, "% "),
 	maybe_write_string(VeryVerbose, Descr),
@@ -4832,8 +4821,7 @@
 		MaybeFileName = no,
 		FileName = FileName0
 	},
-	check_module_has_expected_name(FileName,
-		ModuleName, ActualModuleName),
+	check_module_has_expected_name(FileName, ModuleName, ActualModuleName),
 
 	check_timestamp(FileName0, MaybeTimestamp0, MaybeTimestamp),
 	( { IgnoreErrors = yes } ->
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.366
diff -u -u -r1.366 options.m
--- compiler/options.m	28 Mar 2002 03:43:28 -0000	1.366
+++ compiler/options.m	7 Apr 2002 15:52:00 -0000
@@ -100,6 +100,7 @@
 		;	make_private_interface
 		;	make_optimization_interface
 		;	make_transitive_opt_interface
+		;	generate_source_file_mapping
 		;	generate_dependencies
 		;	generate_module_order
 		;	convert_to_mercury
@@ -644,6 +645,7 @@
 ]).
 option_defaults_2(output_option, [
 		% Output Options (mutually exclusive)
+	generate_source_file_mapping -	bool(no),
 	generate_dependencies	-	bool(no),
 	generate_module_order 	-	bool(no),
 	make_short_interface	-	bool(no),
@@ -1092,6 +1094,7 @@
 short_option('D', 			dump_hlds_alias).
 short_option('e', 			errorcheck_only).
 short_option('E', 			verbose_errors).
+short_option('f',			generate_source_file_mapping).
 short_option('h', 			help).
 short_option('H', 			highlevel_code).
 short_option('i', 			make_interface).
@@ -1171,6 +1174,8 @@
 long_option("debug-make",		debug_make).
 
 % output options (mutually exclusive)
+long_option("generate-source-file-mapping",
+					generate_source_file_mapping).
 long_option("generate-dependencies",	generate_dependencies).
 long_option("generate-module-order",	generate_module_order).
 long_option("make-short-interface",	make_short_interface).
@@ -2169,6 +2174,14 @@
 		"Only the first one specified will apply.",
 		"If none of these options are specified, the default action",
 		"is to link the named modules to produce an executable.\n",
+		"-f, --generate-source-file-mapping",
+		"\tOutput the module name to file name mapping for the list",
+		"\tof source files given as non-option arguments to mmc",
+		"\tto `Mercury.modules'. This must be done before",
+		"\t`mmc --generate-dependencies' if there are any modules",
+		"\tfor which the file name does not match the module name.",
+		"\tIf there are no such modules the mapping need not be",
+		"\tgenerated.",
 		"-M, --generate-dependencies",
 		"\tOutput `Make'-style dependencies for the module",
 		"\tand all of its dependencies to `<module>.dep'.",
Index: compiler/parse_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/parse_tree.m,v
retrieving revision 1.1
diff -u -u -r1.1 parse_tree.m
--- compiler/parse_tree.m	20 Mar 2002 12:37:05 -0000	1.1
+++ compiler/parse_tree.m	7 Apr 2002 12:06:07 -0000
@@ -35,7 +35,7 @@
 % Transformations that act on the parse tree,
 % and stuff relating to the module system.
 :- include_module equiv_type.
-:- include_module modules, module_qual.
+:- include_module modules, module_qual, source_file_map.
 
 % (Note that intermod and trans_opt also contain routines that
 % act on the parse tree, but those modules are considered part
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.206
diff -u -u -r1.206 prog_io.m
--- compiler/prog_io.m	7 Apr 2002 10:22:49 -0000	1.206
+++ compiler/prog_io.m	7 Apr 2002 14:27:57 -0000
@@ -155,6 +155,10 @@
 		maybe_error(file_name), io__state, io__state).
 :- mode search_for_module_source(in, in, out, di, uo) is det.
 
+	% Read the first item from the given file to find the module name.
+:- pred find_module_name(file_name, maybe(module_name), io__state, io__state).
+:- mode find_module_name(in, out, di, uo) is det.
+
 	% parse_item(ModuleName, VarSet, Term, MaybeItem)
 	%
 	% parse Term. If successful, MaybeItem is bound to the parsed item,
@@ -249,7 +253,7 @@
 
 :- import_module parse_tree__prog_io_goal, parse_tree__prog_io_dcg.
 :- import_module parse_tree__prog_io_pragma, parse_tree__prog_io_util.
-:- import_module parse_tree__prog_io_typeclass.
+:- import_module parse_tree__prog_io_typeclass, parse_tree__modules.
 :- import_module hlds__hlds_data, hlds__hlds_pred, parse_tree__prog_util.
 :- import_module parse_tree__prog_out.
 :- import_module libs__globals, libs__options.
@@ -360,7 +364,7 @@
 		io__close_input(ModuleInputStream)
 	;
 		{ OpenResult = error(Message0) },
-		io__progname_base("prog_io.m", Progname),
+		io__progname_base("mercury_compile", Progname),
 		{
 		  Message = Progname ++ ": " ++ Message0,
 		  dummy_term(Term),
@@ -546,6 +550,36 @@
 
 %-----------------------------------------------------------------------------%
 
+find_module_name(FileName, MaybeModuleName) -->
+	io__open_input(FileName, OpenRes),
+	(
+		{ OpenRes = ok(InputStream) },
+		io__set_input_stream(InputStream, OldInputStream),
+		{ string__remove_suffix(FileName, ".m", PartialFileName0) ->
+			PartialFileName = PartialFileName0
+		;
+			PartialFileName = FileName
+		},
+		{ file_name_to_module_name(dir__basename(PartialFileName),
+			DefaultModuleName) },
+		read_first_item(DefaultModuleName, FileName,
+			ModuleName, RevMessages, _, _, _),
+		{ MaybeModuleName = yes(ModuleName) },
+		prog_out__write_messages(list__reverse(RevMessages)),
+		io__set_input_stream(OldInputStream, _),
+		io__close_input(InputStream)
+	;
+		{ OpenRes = error(Error) },
+		io__progname_base("mercury_compile", Progname),
+		io__write_string(Progname),
+		io__write_string(": error opening `"),
+		io__write_string(FileName),
+		io__write_string("': "),
+		io__write_string(io__error_message(Error)),
+		io__write_string(".\n"),
+		{ MaybeModuleName = no }
+	).	
+
  	% Read a source file from standard in, first reading in
 	% the input term by term and then parsing those terms and producing
 	% a high-level representation.
@@ -571,19 +605,33 @@
 	io__input_stream(Stream),
 	io__input_stream_name(Stream, SourceFileName),
 	read_first_item(DefaultModuleName, SourceFileName, ModuleName,
-		RevMessages, RevItems0, Error0),
+		RevMessages0, RevItems0, MaybeSecondTerm, Error0),
+	(
+		{ MaybeSecondTerm = yes(SecondTerm) },
+		{ process_read_term(ModuleName, SecondTerm,
+			MaybeSecondItem) },
+
+		read_items_loop_2(MaybeSecondItem, ModuleName, SourceFileName,
+			RevMessages0, RevItems0, Error0,
+			RevMessages1, RevItems1, Error1)
+	;
+		{ MaybeSecondTerm = no },
+		read_items_loop(ModuleName, SourceFileName,
+			RevMessages0, RevItems0, Error0,
+			RevMessages1, RevItems1, Error1)
+	),
 
 	%
 	% get the end_module declaration (if any),
 	% check that it matches the initial module declaration (if any),
 	% and remove both of them from the final item list.
 	%
-	{ get_end_module(RevItems0, ModuleName, RevItems, EndModule) },
-	{ list__reverse(RevMessages, Messages0) },
-	{ list__reverse(RevItems, Items0) },
+	{ get_end_module(RevItems1, ModuleName, RevItems, EndModule) },
 	check_end_module(EndModule,
-			Messages0, Items0, Error0,
-			Messages, Items, Error).
+			RevMessages1, Items0, Error1,
+			RevMessages, Items, Error),
+	{ list__reverse(RevMessages, Messages) },
+	{ list__reverse(RevItems, Items0) }.
 
 %
 % We need to jump through a few hoops when reading the first item,
@@ -599,11 +647,12 @@
 % we reparse it in the default module scope.  Blecchh.
 %
 :- pred read_first_item(module_name, file_name, module_name,
-		message_list, item_list, module_error, io__state, io__state).
-:- mode read_first_item(in, in, out, out, out, out, di, uo) is det.
+		message_list, item_list, maybe(read_term), module_error,
+		io__state, io__state).
+:- mode read_first_item(in, in, out, out, out, out, out, di, uo) is det.
 
 read_first_item(DefaultModuleName, SourceFileName, ModuleName,
-	Messages, Items, Error) -->
+	Messages, Items, MaybeSecondTerm, Error) -->
 
 	globals__io_lookup_bool_option(warn_missing_module_name, WarnMissing),
 	globals__io_lookup_bool_option(warn_wrong_module_name, WarnWrong),
@@ -627,7 +676,7 @@
 	    { FirstItem = pragma(source_file(NewSourceFileName)) }
 	->
 	    read_first_item(DefaultModuleName, NewSourceFileName,
-	    	ModuleName, Messages, Items, Error)
+	    	ModuleName, Messages, Items, MaybeSecondTerm, Error)
 	;
 	    %
 	    % check if the first term was a `:- module' decl
@@ -645,12 +694,12 @@
 		match_sym_name(StartModuleName, DefaultModuleName)
 	    ->
 		ModuleName = DefaultModuleName,
-		Messages0 = []
+		Messages = []
 	    ;
 		match_sym_name(DefaultModuleName, StartModuleName)
 	    ->
 		ModuleName = StartModuleName,
-		Messages0 = []
+		Messages = []
 	    ;
 	    	prog_out__sym_name_to_string(StartModuleName,
 			StartModuleNameString),
@@ -658,7 +707,7 @@
 			"' contains module named `", StartModuleNameString,
 			"'"], WrongModuleWarning),
 	        maybe_add_warning(WarnWrong, MaybeFirstTerm, FirstContext,
-			WrongModuleWarning, [], Messages0),
+			WrongModuleWarning, [], Messages),
 
 		% Which one should we use here?
 		% We used to use the default module name
@@ -667,11 +716,9 @@
 		ModuleName = StartModuleName
 	    },
 	    { make_module_decl(ModuleName, FirstContext, FixedFirstItem) },
-	    { Items0 = [FixedFirstItem] },
-	    { Error0 = no_module_errors },
-	    read_items_loop(ModuleName, SourceFileName,
-			Messages0, Items0, Error0,
-			Messages, Items, Error)
+	    { Items = [FixedFirstItem] },
+	    { Error = no_module_errors },
+	    { MaybeSecondTerm = no }
 	;
 	    %
 	    % if the first term was not a `:- module' decl,
@@ -687,9 +734,9 @@
 		dummy_term_with_context(FirstContext, FirstTerm),
 		add_warning(
 			"module should start with a `:- module' declaration",
-			FirstTerm, [], Messages0)
+			FirstTerm, [], Messages)
 	    ;
-		Messages0 = []
+		Messages = []
 	    },
 	    { ModuleName = DefaultModuleName },
 	    { make_module_decl(ModuleName, FirstContext, FixedFirstItem) },
@@ -699,15 +746,9 @@
 	    % occuring within the scope of the implicit
 	    % `:- module' decl rather than in the root module.
 	    % 
-	    { MaybeSecondTerm = MaybeFirstTerm },
-	    { process_read_term(ModuleName, MaybeSecondTerm,
-		MaybeSecondItem) },
-
-	    { Items0 = [FixedFirstItem] },
-	    { Error0 = no_module_errors },
-	    read_items_loop_2(MaybeSecondItem, ModuleName, SourceFileName,
-		Messages0, Items0, Error0,
-		Messages, Items, Error)
+	    { MaybeSecondTerm = yes(MaybeFirstTerm) },
+	    { Items = [FixedFirstItem] },
+	    { Error = no_module_errors }
 	).
 
 :- pred make_module_decl(module_name, term__context, item_and_context).
Index: compiler/source_file_map.m
===================================================================
RCS file: compiler/source_file_map.m
diff -N compiler/source_file_map.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ compiler/source_file_map.m	8 Apr 2002 08:19:01 -0000
@@ -0,0 +1,204 @@
+%-----------------------------------------------------------------------------%
+% 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: source_file_map.m
+% Author: stayl
+%
+% Maintain a mapping from module name to source file name.
+%-----------------------------------------------------------------------------%
+:- module parse_tree__source_file_map.
+
+:- interface.
+
+:- import_module parse_tree__prog_data, parse_tree__prog_io.
+:- import_module io, list.
+
+	% lookup_module_source_file(ModuleName, FileName, FileNameIsMapped).
+	%
+	% FileNameIsMapped is `yes' if ModuleName is in
+	% the Mercury.modules file.
+:- pred lookup_module_source_file(module_name::in, file_name::out, 
+		io__state::di, io__state::uo) is det.
+
+	% Return the default fully-qualified source file name.
+:- func default_source_file(module_name) = file_name.
+
+	% Given a list of file names, produce the Mercury.modules file.
+:- pred write_source_file_map(list(string)::in,
+		io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module parse_tree__prog_out, parse_tree__prog_util.
+:- import_module parse_tree__modules.
+:- import_module libs__globals, libs__options.
+:- import_module bool, char, dir, map, std_util, string.
+
+lookup_module_source_file(ModuleName, FileName) -->
+	get_source_file_map(SourceFileMap),
+	{ map__search(SourceFileMap, ModuleName, FileName0) ->
+		FileName = FileName0
+	;
+		FileName = default_source_file(ModuleName)
+	}.
+
+default_source_file(ModuleName) = BaseFileName ++ ".m" :-
+	prog_out__sym_name_to_string(ModuleName, ".", BaseFileName).
+
+	% Read the Mercury.modules file (if it exists) to find
+	% the mapping from module name to file name.
+:- pred get_source_file_map(source_file_map::out,
+		io__state::di, io__state::uo) is det.
+
+get_source_file_map(SourceFileMap) -->
+	globals__io_get_globals(Globals0),
+	{ globals__get_source_file_map(Globals0, MaybeSourceFileMap) },
+	( { MaybeSourceFileMap = yes(SourceFileMap0) } ->
+		{ SourceFileMap = SourceFileMap0 }
+	;
+		globals__io_lookup_bool_option(use_subdirs, UseSubdirs),
+		io__open_input(modules_file_name(UseSubdirs), OpenRes),
+		(
+			{ OpenRes = ok(Stream) },
+			io__set_input_stream(Stream, OldStream),
+			read_source_file_map([], map__init, SourceFileMap),
+			io__set_input_stream(OldStream, _),
+			io__close_input(Stream)
+		;
+			{ OpenRes = error(_) },
+			% If the file doesn't exist, then the mapping is empty.
+			{ SourceFileMap = map__init }
+		),
+		globals__io_get_globals(Globals1),
+		{ globals__set_source_file_map(Globals1,
+			MaybeSourceFileMap, Globals2) },
+		{ unsafe_promise_unique(Globals2, Globals) },
+		globals__io_set_globals(Globals)
+	).
+
+:- pred read_source_file_map(list(char)::in, source_file_map::in,
+		source_file_map::out, io__state::di, io__state::uo) is det.
+
+read_source_file_map(ModuleChars, Map0, Map) -->
+	read_until_char('\t', [], ModuleCharsResult),
+	(
+		{ ModuleCharsResult = ok(RevModuleChars) },
+		{ string__from_rev_char_list(RevModuleChars, ModuleStr) },
+		{ string_to_sym_name(ModuleStr, ":", ModuleName) },
+		read_until_char('\n', [], FileNameCharsResult),
+		(
+			{ FileNameCharsResult = ok(FileNameChars) },
+			{ string__from_rev_char_list(FileNameChars,
+				FileName) },
+			{ map__set(Map0, ModuleName, FileName, Map1) },
+			read_source_file_map(ModuleChars, Map1, Map)
+		;
+			{ FileNameCharsResult = eof },
+			{ Map = Map0 },
+			io__set_exit_status(1),
+			io__write_string(
+	"mercury_compile: unexpected end of file in Mercury.modules file: ")
+		;
+			{ FileNameCharsResult = error(Error) },
+			{ Map = Map0 },
+			io__set_exit_status(1),
+			io__write_string(
+	"mercury_compile: error in Mercury.modules file: "),
+			io__write_string(io__error_message(Error))
+		)
+	;
+		{ ModuleCharsResult = eof },
+		{ Map = Map0 }
+	;
+		{ ModuleCharsResult = error(Error) },
+		{ Map = Map0 },
+		io__set_exit_status(1),
+		io__write_string(
+			"mercury_compile: error in Mercury.modules file: "),
+		io__write_string(io__error_message(Error))
+	).
+
+:- pred read_until_char(char::in, list(char)::in, io__result(list(char))::out,
+		io__state::di, io__state::uo) is det.
+
+read_until_char(EndChar, Chars0, Result) -->
+	io__read_char(CharRes),
+	(
+		{ CharRes = ok(Char) },
+		( { Char = EndChar } ->
+			{ Result = ok(Chars0) }
+		;
+			read_until_char(EndChar, [Char | Chars0], Result)	
+		)
+	;
+		{ CharRes = eof },
+		{ Result = ( Chars0 = [] -> eof ; ok(Chars0) ) }
+	;
+		{ CharRes = error(Error) },
+		{ Result = error(Error) }
+	).
+
+write_source_file_map(FileNames) -->
+	globals__io_lookup_bool_option(use_subdirs, UseSubdirs),
+	( { UseSubdirs = yes } ->
+		make_directory("Mercury")
+	;
+		[]
+	),
+	{ ModulesFileName = modules_file_name(UseSubdirs) },
+	io__open_output(ModulesFileName, OpenRes),
+	(
+		{ OpenRes = ok(Stream) },
+		list__foldl(write_source_file_map_2(Stream), FileNames),
+		io__close_output(Stream)
+	;
+		{ OpenRes = error(Error) },
+		io__set_exit_status(1),
+		io__write_string("mercury_compile: error opening `"),
+		io__write_string(ModulesFileName),
+		io__write_string("' for output: "),
+		io__write_string(io__error_message(Error))
+	).
+
+:- pred write_source_file_map_2(io__output_stream::in, file_name::in,
+		io__state::di, io__state::uo) is det.
+
+write_source_file_map_2(MapStream, FileName) -->
+	find_module_name(FileName, MaybeModuleName),
+	(
+		{ MaybeModuleName = yes(ModuleName) },
+		{ string__remove_suffix(FileName, ".m", PartialFileName0) ->
+			PartialFileName = PartialFileName0
+		;
+			PartialFileName = FileName
+		},
+		{ file_name_to_module_name(dir__basename(PartialFileName),
+			DefaultModuleName) },
+		(
+			% Only include a module in the mapping if the
+			% name doesn't match the default.
+			{ dir__dirname(PartialFileName) =
+				dir__this_directory `with_type` string },
+			{ ModuleName = DefaultModuleName }
+		->
+			[]
+		;
+			io__set_output_stream(MapStream, OldStream),
+			prog_out__write_sym_name(ModuleName),
+			io__write_string("\t"),
+			io__write_string(FileName),
+			io__nl,
+			io__set_output_stream(OldStream, _)
+		)
+	;
+		{ MaybeModuleName = no }
+	).
+
+:- func modules_file_name(bool) = string.
+
+modules_file_name(yes) = "Mercury/Mercury.modules".
+modules_file_name(no) = "Mercury.modules".
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.77
diff -u -u -r1.77 compiler_design.html
--- compiler/notes/compiler_design.html	7 Apr 2002 10:23:05 -0000	1.77
+++ compiler/notes/compiler_design.html	8 Apr 2002 06:42:09 -0000
@@ -219,6 +219,11 @@
 
 	modules.m has the code to write out `.int', `.int2', `.int3',
 	`.d' and `.dep' files.
+	
+	<p>
+
+	source_file_map.m contains code to read, write and search
+	the mapping between module names and file names.
 
 <li> module qualification of types, insts and modes <br>
 
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.304
diff -u -u -r1.304 user_guide.texi
--- doc/user_guide.texi	28 Mar 2002 03:44:36 -0000	1.304
+++ doc/user_guide.texi	8 Apr 2002 08:09:54 -0000
@@ -261,6 +261,10 @@
 qualifiers (e.g. if it is @file{bar.baz.m} or @file{baz.m}
 rather than @file{foo.bar.baz.m}), then the module name in the
 @samp{:- module} declaration for that module must be fully qualified.
+To make the compiler look in another file for a module, use
+ at samp{mmc -f @var{sources-files}} to generate a mapping from module name
+to file name, where @var{sources-files} is the list of source files in
+the directory (@pxref{Output options}).
 
 To compile a program which consists of just a single source file,
 use the command
@@ -452,6 +456,7 @@
 consisting of a number of modules is as simple as
 
 @example
+mmc -f @var{source-files}
 mmake @var{main-module}.depend
 mmake @var{main-module}
 @end example
@@ -469,10 +474,18 @@
 and there is no danger of getting an inconsistent executable if you forget
 this step --- instead you will get a compile or link error.
 
+The @samp{mmc -f} step above is only required if there are any source
+files for which the file name does not match the module name.
+ at samp{mmc -f} generates a file @file{Mercury.modules} containing
+a mapping from module name to source file.  The @file{Mercury.modules}
+file must be updated when a source file for which the file name does
+not match the module name is added to or removed from the directory.
+
 @samp{mmake} allows you to build more than one program in the same directory.
 Each program must have its own @file{.dep} and @file{.dv} files,
 and therefore you must run @samp{mmake @var{program}.depend}
-for each program.
+for each program.  The @samp{Mercury.modules} file is used for
+all programs in the directory.
 
 If there is a file called @samp{Mmake} or @samp{Mmakefile} in the
 current directory,
@@ -3777,6 +3790,17 @@
 an executable.
 
 @table @code
+ at item -f
+ at itemx --generate-source-file-mapping
+ at findex --generate-source-file-mapping
+Output the module name to file name mapping for the list
+of source files given as non-option arguments to mmc
+to @file{Mercury.modules}. This must be done before
+ at samp{mmc --generate-dependencies} if there are any modules
+for which the file name does not match the module name.
+If there are no such modules the mapping need not be
+generated.
+
 @item -M
 @itemx --generate-dependencies
 @findex -M
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.145
diff -u -u -r1.145 Mmakefile
--- tests/hard_coded/Mmakefile	27 Mar 2002 05:18:55 -0000	1.145
+++ tests/hard_coded/Mmakefile	8 Apr 2002 06:20:37 -0000
@@ -80,6 +80,7 @@
 	intermod_multimode_main \
 	intermod_type_qual \
 	join_list \
+	mapped_module \
 	merge_and_remove_dups \
 	minint_bug \
 	mode_choice \
@@ -303,16 +304,22 @@
 RESS=	$(PROGS:%=%.res) $(SPLIT_PROGS:%=%.split.res)
 
 dep_local:	$(DEPS)
-depend_local:	$(DEPENDS)
+depend_local:	$(SUBDIR)/Mercury.modules $(DEPENDS)
 check_local:	$(OUTS) $(RESS)
 all_local:	$(PROGS) $(SPLIT_PROGS:%=%.split)
 
 clean_local:
 	rm -f target_mlobjs_c.o		
 
+realclean_local:
+	rm -f $(SUBDIR)/Mercury.modules
+
 #-----------------------------------------------------------------------------#
 
 SUBDIRS = typeclasses sub-modules exceptions purity
+
+$(SUBDIR)/Mercury.modules:
+	$(MC) -f source_file_map.m
 
 dep_subdirs:
 	+for dir in $(SUBDIRS); do \
Index: tests/hard_coded/mapped_module.exp
===================================================================
RCS file: tests/hard_coded/mapped_module.exp
diff -N tests/hard_coded/mapped_module.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/mapped_module.exp	7 Apr 2002 17:05:22 -0000
@@ -0,0 +1 @@
+OK
Index: tests/hard_coded/source_file_map.m
===================================================================
RCS file: tests/hard_coded/source_file_map.m
diff -N tests/hard_coded/source_file_map.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/source_file_map.m	7 Apr 2002 15:42:32 -0000
@@ -0,0 +1,12 @@
+:- module mapped_module.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+main -->
+	io__write_string("OK\n").
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------