for review: add nested modules [2/5]

Fergus Henderson fjh at cs.mu.OZ.AU
Thu Feb 26 16:32:02 AEDT 1998


 		io__write_string("/* "),
@@ -476,7 +485,7 @@
 	io__write_string("\n"),
 	output_reset_line_num.
 
-output_c_module(c_export(PragmaExports), DeclSet, DeclSet, _BaseName) -->
+output_c_module(c_export(PragmaExports), DeclSet, DeclSet) -->
 	output_exported_c_functions(PragmaExports).
 
 	% output_c_header_include_lines reverses the list of c header lines
@@ -956,8 +965,10 @@
 output_instruction_and_comment(Instr, Comment, PrintComments) -->
 	{ set__init(ContLabelSet) },
 	{ hlds_pred__initial_proc_id(ProcId) },
-	{ ProfInfo = local(proc("DEBUG", predicate, "DEBUG", "DEBUG", 0,
-			ProcId)) - ContLabelSet },
+	{ DummyModule = unqualified("DEBUG") },
+	{ DummyPredName = "DEBUG" },
+	{ ProfInfo = local(proc(DummyModule, predicate, DummyModule,
+			DummyPredName, 0, ProcId)) - ContLabelSet },
 	output_instruction_and_comment(Instr, Comment, PrintComments, ProfInfo).
 
 	% output_instruction/3 is only for debugging.
@@ -966,8 +977,10 @@
 output_instruction(Instr) -->
 	{ set__init(ContLabelSet) },
 	{ hlds_pred__initial_proc_id(ProcId) },
-	{ ProfInfo = local(proc("DEBUG", predicate, "DEBUG", "DEBUG", 0,
-			ProcId)) - ContLabelSet },
+	{ DummyModule = unqualified("DEBUG") },
+	{ DummyPredName = "DEBUG" },
+	{ ProfInfo = local(proc(DummyModule, predicate, DummyModule,
+			DummyPredName, 0, ProcId)) - ContLabelSet },
 	output_instruction(Instr, ProfInfo).
 
 :- pred output_instruction(instr, pair(label, set(label)),
@@ -2235,11 +2248,11 @@
 
 	% Output a data address. 
 
-:- pred output_data_addr(string, data_name, io__state, io__state).
+:- pred output_data_addr(module_name, data_name, io__state, io__state).
 :- mode output_data_addr(in, in, di, uo) is det.
 
 output_data_addr(BaseName0, VarName) -->
-	{ llds_out__name_mangle(BaseName0, BaseName) },
+	{ llds_out__sym_name_mangle(BaseName0, BaseName) },
 	io__write_string("mercury_data_"),
 	(
 		{ VarName = common(N) },
@@ -2398,8 +2411,8 @@
 		TypeName, TypeArity, ModeNum0), AddPrefix, ProcLabelString) :-
 	% figure out the LabelName
 	DummyArity = -1,	% not used by get_label_name.
-	get_label_name("", predicate, "", PredName, DummyArity, AddPrefix,
-		LabelName),
+	get_label_name(unqualified(""), predicate, unqualified(""),
+		PredName, DummyArity, AddPrefix, LabelName),
 
 	% figure out the ModeNumString
 	string__int_to_string(TypeArity, TypeArityString),
@@ -2407,8 +2420,8 @@
 	string__int_to_string(ModeInt, ModeNumString),
 
 	% mangle all the relevent names
-	llds_out__name_mangle(Module, MangledModule),
-	llds_out__name_mangle(TypeModule, MangledTypeModule),
+	llds_out__sym_name_mangle(Module, MangledModule),
+	llds_out__sym_name_mangle(TypeModule, MangledTypeModule),
 	llds_out__name_mangle(TypeName, MangledTypeName),
 
 	% Module-qualify the type name.
@@ -2430,14 +2443,19 @@
 	%  function indicator, declaring module, predicate name, arity,
 	%  and whether or not to add a prefix.
 
-:- pred get_label_name(string, pred_or_func, string, string, int, bool, string).
+:- pred get_label_name(module_name, pred_or_func, module_name, string, arity,
+			bool, string).
 :- mode get_label_name(in, in, in, in, in, in, out) is det.
 
 get_label_name(DefiningModule, PredOrFunc, DeclaringModule,
 		Name0, Arity, AddPrefix, LabelName) :-
+	llds_out__sym_name_mangle(DeclaringModule, DeclaringModuleName),
+	llds_out__sym_name_mangle(DefiningModule, DefiningModuleName),
 	(
 		( 
-			DeclaringModule = "mercury_builtin"
+			mercury_private_builtin_module(DeclaringModule)
+		;
+			mercury_public_builtin_module(DeclaringModule)
 		;
 			Name0 = "main",
 			Arity = 2
@@ -2451,7 +2469,7 @@
 	->
 		LabelName0 = Name0
 	;
-		llds_out__qualify_name(DeclaringModule, Name0,
+		llds_out__qualify_name(DeclaringModuleName, Name0,
 			LabelName0)
 	),
 	(
@@ -2460,7 +2478,7 @@
 		% module prefixes
 		DefiningModule \= DeclaringModule
 	->
-		string__append_list([DefiningModule, "__", LabelName0],
+		string__append_list([DefiningModuleName, "__", LabelName0],
 			LabelName1)
 	;
 		LabelName1 = LabelName0
@@ -3063,6 +3081,14 @@
 
 %-----------------------------------------------------------------------------%
 
+llds_out__sym_name_mangle(unqualified(Name), MangledName) :-
+	llds_out__name_mangle(Name, MangledName).
+llds_out__sym_name_mangle(qualified(ModuleName, PlainName), MangledName) :-
+	llds_out__sym_name_mangle(ModuleName, MangledModuleName),
+	llds_out__name_mangle(PlainName, MangledPlainName),
+	llds_out__qualify_name(MangledModuleName, MangledPlainName,
+			MangledName).
+	
 	% Convert a Mercury predicate name into something that can form
 	% part of a C identifier.  This predicate is necessary because
 	% quoted names such as 'name with embedded spaces' are valid
@@ -3195,10 +3221,10 @@
 		ClassSym = unqualified(_),
 		error("llds_out__make_base_typeclass_info_name: unqualified name")
 	;
-		ClassSym = qualified(ModuleName, ClassName0),
-			% Mangle the class name in case it is an operator
+		ClassSym = qualified(ModuleName0, ClassName0),
+		llds_out__sym_name_mangle(ModuleName0, ModuleName),
 		llds_out__name_mangle(ClassName0, ClassName),
-		string__append_list([ModuleName, "__", ClassName], ClassString)
+		llds_out__qualify_name(ModuleName, ClassName, ClassString)
 	),
 	string__int_to_string(ClassArity, A_str),
 	llds_out__name_mangle(TypeNames0, TypeNames),
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.29
diff -u -u -r1.29 lookup_switch.m
--- lookup_switch.m	1998/01/23 12:56:42	1.29
+++ lookup_switch.m	1998/02/19 08:25:20
@@ -42,7 +42,7 @@
 :- interface.
 
 :- import_module hlds_goal, hlds_data, llds, switch_gen, code_info.
-:- import_module list, term.
+:- import_module std_util, map, set, list, term.
 
 :- type case_consts == list(pair(int, list(rval))).
 
@@ -67,8 +67,9 @@
 
 :- implementation.
 
-:- import_module set, code_gen, type_util, map, tree, int, std_util, require.
-:- import_module dense_switch, bool, assoc_list, globals, options, mode_util.
+:- import_module int, require, bool, assoc_list.
+:- import_module code_gen, type_util, tree.
+:- import_module dense_switch, globals, options, mode_util.
 :- import_module exprn_aux, getopt, prog_data, instmap.
 
 	% Most of this predicate is taken from dense_switch.m
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.261
diff -u -u -r1.261 make_hlds.m
--- make_hlds.m	1998/02/12 01:17:26	1.261
+++ make_hlds.m	1998/02/25 03:59:23
@@ -23,9 +23,9 @@
 :- interface.
 
 :- import_module prog_data, hlds_module, hlds_pred, hlds_goal, hlds_data.
-:- import_module equiv_type, module_qual.
+:- import_module equiv_type, module_qual, globals.
 
-:- import_module io, std_util.
+:- import_module io, std_util, list, bool, term.
 
 % parse_tree_to_hlds(ParseTree, MQInfo, EqvMap, HLDS, UndefTypes, UndefModes):
 %	Given MQInfo (returned by module_qual.m) and EqvMap (returned by
@@ -33,8 +33,8 @@
 %	Any errors found are recorded in the HLDS num_errors field.
 %	Returns UndefTypes = yes if undefined types found.
 %	Returns UndefModes = yes if undefined modes found.
-:- pred parse_tree_to_hlds(program, mq_info, eqv_map, module_info, bool, bool,
-			io__state, io__state).
+:- pred parse_tree_to_hlds(compilation_unit, mq_info, eqv_map, module_info,
+			bool, bool, io__state, io__state).
 :- mode parse_tree_to_hlds(in, in, in, out, out, out, di, uo) is det.
 
 :- pred create_atomic_unification(var, unify_rhs, term__context,
@@ -57,14 +57,14 @@
 :- implementation.
 
 :- import_module prog_io, prog_io_goal, prog_io_dcg, prog_io_util, prog_out.
-:- import_module modules, module_qual, prog_util, globals, options, hlds_out.
+:- import_module modules, module_qual, prog_util, options, hlds_out.
 :- import_module make_tags, quantification, (inst).
 :- import_module code_util, unify_proc, special_pred, type_util, mode_util.
 :- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
 :- import_module fact_table, purity, goal_util, term_util, export, llds.
 
-:- import_module string, char, int, set, bintree, list, map, require.
-:- import_module bool, getopt, assoc_list, term, term_io, varset.
+:- import_module string, char, int, set, bintree, map, require.
+:- import_module getopt, assoc_list, term_io, varset.
 
 parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module, 
 		UndefTypes, UndefModes) -->
@@ -228,6 +228,9 @@
 	; { ModuleDefn = use(module(_)) } ->
 		{ Status = Status0 },
 		{ Module = Module0 }
+	; { ModuleDefn = include_module(_) } ->
+		{ Status = Status0 },
+		{ Module = Module0 }
 	; { ModuleDefn = external(External) } ->
 		( { External = name_arity(Name, Arity) } ->
 			{ Status = Status0 },
@@ -1388,14 +1391,21 @@
 	(
 		M = func(_, FuncName, TypesAndModes, _, _, _, _, _)
 	->
-		module_info_name(Module0, ModuleName0),
-		sym_name_get_module_name(FuncName, ModuleName0, ModuleName),
-		unqualify_name(FuncName, Func),
+		( FuncName = qualified(ModuleName0, Func0) ->
+			ModuleName = ModuleName0,
+			Func = Func0
+		;
+			% The class interface should be fully module qualified
+			% by prog_io.m at the time it is read in.
+			error(
+		       "add_default_class_method_func_modes: unqualified func")
+		),
+
 		list__length(TypesAndModes, FuncArity),
 		module_info_get_predicate_table(Module0, PredTable),
 		(
-			predicate_table_search_func_m_n_a(PredTable, ModuleName,
-				Func, FuncArity, [PredId])
+			predicate_table_search_func_m_n_a(PredTable,
+				ModuleName, Func, FuncArity, [PredId])
 		->
 			module_info_pred_info(Module0, PredId, PredInfo0),
 			maybe_add_default_mode(Module0, PredInfo0, 
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.26
diff -u -u -r1.26 make_tags.m
--- make_tags.m	1998/01/23 12:56:44	1.26
+++ make_tags.m	1998/02/19 08:26:11
@@ -39,7 +39,7 @@
 :- interface.
 
 :- import_module prog_data, hlds_data, globals.
-:- import_module bool.
+:- import_module bool, list.
 
 % assign_constructor_tags(Constructors, Globals, TagValues, IsEnum):
 %	Assign a constructor tag to each constructor for a discriminated
@@ -57,7 +57,7 @@
 :- implementation.
 
 :- import_module prog_util, type_util, globals, options.
-:- import_module int, map, list, std_util, require.
+:- import_module int, map, std_util, require.
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.75
diff -u -u -r1.75 mercury_compile.m
--- mercury_compile.m	1998/02/12 01:17:28	1.75
+++ mercury_compile.m	1998/02/25 21:04:27
@@ -29,8 +29,8 @@
 :- import_module library, getopt, term, varset.
 
 	% the main compiler passes (in order of execution)
-:- import_module handle_options, prog_io, modules, module_qual, equiv_type.
-:- import_module make_hlds, typecheck, purity, modes.
+:- import_module handle_options, prog_io, prog_out, modules, module_qual.
+:- import_module equiv_type, make_hlds, typecheck, purity, modes.
 :- import_module switch_detection, cse_detection, det_analysis, unique_modes.
 :- import_module check_typeclass, simplify, intermod, trans_opt.
 :- import_module bytecode_gen, bytecode.
@@ -128,25 +128,42 @@
 :- pred process_module(string, io__state, io__state).
 :- mode process_module(in, di, uo) is det.
 
-process_module(Module) -->
+process_module(PathName) -->
 	 	% All messages go to stderr
 	io__stderr_stream(StdErr),
 	io__set_output_stream(StdErr, _),
 
-	globals__io_lookup_bool_option(generate_dependencies, GenerateDeps),
-	( { GenerateDeps = yes } ->
-		generate_dependencies(Module)
+	{ dir__split_name(PathName, DirName, BaseFileName) },
+	( { dir__this_directory(DirName) } ->
+		{ file_name_to_module_name(BaseFileName, ModuleName) },
+
+		globals__io_lookup_bool_option(generate_dependencies,
+			GenerateDeps),
+		( { GenerateDeps = yes } ->
+			generate_dependencies(ModuleName)
+		;
+			process_module_2(ModuleName)
+		)
 	;
-		process_module_2(Module)
+		% Currently we don't allow directory names in the
+		% command-line arguments, because it would confuse
+		% the mapping between module names and file names.
+		io__progname("mercury_compile", ProgName),
+		io__write_string(ProgName),
+		io__write_string(": Error in command-line argument `"),
+		io__write_string(PathName),
+		io__write_string("':\n"),
+		io__write_string("arguments may not contain directory names.\n")
 	).
 
-:- pred process_module_2(string, io__state, io__state).
+:- pred process_module_2(module_name, io__state, io__state).
 :- mode process_module_2(in, di, uo) is det.
 
 process_module_2(ModuleName) -->
 	globals__io_lookup_bool_option(verbose, Verbose),
 	maybe_write_string(Verbose, "% Parsing `"),
-	maybe_write_string(Verbose, ModuleName),
+	{ module_name_to_file_name(ModuleName, BaseFileName) },
+	maybe_write_string(Verbose, BaseFileName),
 	maybe_write_string(Verbose, ".m' and imported interfaces...\n"),
 	read_mod(ModuleName, ".m", "Reading module", yes, Items0, Error), !,
 	globals__io_lookup_bool_option(statistics, Stats),
@@ -156,6 +173,8 @@
 	globals__io_lookup_bool_option(make_interface, MakeInterface),
 	globals__io_lookup_bool_option(make_short_interface,
 						MakeShortInterface),
+	globals__io_lookup_bool_option(make_private_interface,
+						MakePrivateInterface),
 	globals__io_lookup_bool_option(convert_to_mercury, ConvertToMercury),
 	globals__io_lookup_bool_option(convert_to_goedel, ConvertToGoedel),
 	( { Error = fatal } ->
@@ -166,16 +185,17 @@
 		make_interface(ModuleName, Items0)
 	; { MakeShortInterface = yes } ->
 		make_short_interface(ModuleName, Items0)
+	; { MakePrivateInterface = yes } ->
+		make_private_interface(ModuleName, Items0)
 	; { ConvertToMercury = yes } ->
-		{ string__append(ModuleName, ".ugly", OutputFileName) },
+		{ string__append(BaseFileName, ".ugly", OutputFileName) },
 		convert_to_mercury(ModuleName, OutputFileName, Items0)
 	; { ConvertToGoedel = yes } ->
 		convert_to_goedel(ModuleName, Items0)
 	;
-		grab_imported_modules(ModuleName, Items0, Module, FactDeps,
-			Error2),
+		grab_imported_modules(ModuleName, Items0, Module, Error2),
 		( { Error2 \= fatal } ->
-			mercury_compile(Module, FactDeps)
+			mercury_compile(Module)
 		;
 			[]
 		)
@@ -196,16 +216,16 @@
 	% The initial arrangement has the stage numbers increasing by three
 	% so that new stages can be slotted in without too much trouble.
 
-:- pred mercury_compile(module_imports, list(string), io__state, io__state).
-:- mode mercury_compile(in, in, di, uo) is det.
+:- pred mercury_compile(module_imports, io__state, io__state).
+:- mode mercury_compile(in, di, uo) is det.
 
-mercury_compile(Module, FactDeps) -->
+mercury_compile(Module) -->
 	globals__io_lookup_bool_option(typecheck_only, TypeCheckOnly),
 	globals__io_lookup_bool_option(errorcheck_only, ErrorCheckOnly),
 	{ bool__or(TypeCheckOnly, ErrorCheckOnly, DontWriteDFile) },
 	% If we are only typechecking or error checking, then we should not
 	% modify any files, this includes writing to .d files.
-	mercury_compile__pre_hlds_pass(Module, FactDeps, DontWriteDFile,
+	mercury_compile__pre_hlds_pass(Module, DontWriteDFile,
 		HLDS1, UndefTypes, UndefModes, Errors1), !,
 	mercury_compile__frontend_pass(HLDS1, HLDS20, UndefTypes,
 		UndefModes, Errors2), !,
@@ -231,18 +251,19 @@
 	    ; { MakeTransOptInt = yes } ->
 	    	mercury_compile__output_trans_opt_file(HLDS21)
 	    ;
-		{ Module = module_imports(ModuleName, _, _, _, _) },
+		{ module_imports_get_module_name(Module, ModuleName) },
 		mercury_compile__maybe_output_prof_call_graph(HLDS21,
 			Verbose, Stats, HLDS25),
 		mercury_compile__middle_pass(ModuleName, HLDS25, HLDS50), !,
 		globals__io_lookup_bool_option(highlevel_c, HighLevelC),
 		( { HighLevelC = yes } ->
-			{ string__append(ModuleName, ".c", C_File) },
+			{ module_name_to_file_name(ModuleName, BaseFileName) },
+			{ string__append(BaseFileName, ".c", C_File) },
 			mercury_compile__gen_hlds(C_File, HLDS50),
 			globals__io_lookup_bool_option(compile_to_c,
 				CompileToC),
 			( { CompileToC = no } ->
-				mercury_compile__single_c_to_obj(ModuleName,
+				mercury_compile__single_c_to_obj(BaseFileName,
 					_CompileOK)
 			;
 				[]
@@ -260,18 +281,17 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- pred mercury_compile__pre_hlds_pass(module_imports, list(string),
-		bool, module_info, bool, bool, bool, io__state, io__state).
-:- mode mercury_compile__pre_hlds_pass(in, in, in, out, out, out, out,
+:- pred mercury_compile__pre_hlds_pass(module_imports, bool,
+		module_info, bool, bool, bool, io__state, io__state).
+:- mode mercury_compile__pre_hlds_pass(in, in, out, out, out, out,
 		di, uo) is det.
 
-mercury_compile__pre_hlds_pass(ModuleImports0, FactDeps, DontWriteDFile,
+mercury_compile__pre_hlds_pass(ModuleImports0, DontWriteDFile,
 		HLDS1, UndefTypes, UndefModes, FoundError) -->
 	globals__io_lookup_bool_option(statistics, Stats),
 	globals__io_lookup_bool_option(verbose, Verbose),
 
-	{ ModuleImports0 = module_imports(Module, LongDeps, ShortDeps, _, _) },
-	
+	{ module_imports_get_module_name(ModuleImports0, Module) },
 
 	( { DontWriteDFile = yes } ->
 		% The only time the TransOptDeps are required is when
@@ -281,15 +301,14 @@
 		{ MaybeTransOptDeps = no }
 	;
 		maybe_read_dependency_file(Module, MaybeTransOptDeps), !,
-		write_dependency_file(Module, LongDeps, ShortDeps, FactDeps, 
-			MaybeTransOptDeps), !
+		write_dependency_file(ModuleImports0, MaybeTransOptDeps), !
 	),
 
 	% Errors in .opt and .trans_opt files result in software errors.
 	mercury_compile__maybe_grab_optfiles(ModuleImports0, Verbose,
 		MaybeTransOptDeps, ModuleImports1, IntermodError), !,
 
-	{ ModuleImports1 = module_imports(_, _, _, Items1, _) },
+	{ module_imports_get_items(ModuleImports1, Items1) },
 	mercury_compile__module_qualify_items(Items1, Items2, Module, Verbose,
 				Stats, MQInfo, _, UndefTypes0, UndefModes0), !,
 
@@ -322,10 +341,11 @@
 		)
 	).
 
-:- pred mercury_compile__module_qualify_items(item_list, item_list, string,
-		bool, bool, mq_info, int, bool, bool, io__state, io__state).
+:- pred mercury_compile__module_qualify_items(item_list, item_list,
+		module_name, bool, bool, mq_info, int, bool, bool,
+		io__state, io__state).
 :- mode mercury_compile__module_qualify_items(in, out, in, in, in, out, out,
-			out, out, di, uo) is det. 
+		out, out, di, uo) is det. 
 
 mercury_compile__module_qualify_items(Items0, Items, ModuleName, Verbose, 
 			Stats, MQInfo, NumErrors, UndefTypes, UndefModes) -->
@@ -337,7 +357,7 @@
 	maybe_report_stats(Stats).
 
 :- pred mercury_compile__maybe_grab_optfiles(module_imports, bool,
-	 maybe(list(string)), module_imports, bool, io__state, io__state).
+	 maybe(list(module_name)), module_imports, bool, io__state, io__state).
 :- mode mercury_compile__maybe_grab_optfiles(in, in, in, out, out, 
 	di, uo) is det.
 
@@ -367,16 +387,22 @@
 		;
 			{ Imports = Imports1 },
 			{ Error2 = no },
-			{ Imports = module_imports(ModuleName, _, _, _, _) },
+			{ module_imports_get_module_name(Imports,
+				ModuleName) },
 			globals__io_lookup_bool_option(
 				warn_missing_trans_opt_deps,
 				WarnNoTransOptDeps),
 			( { WarnNoTransOptDeps = yes } ->
+				{ prog_out__sym_name_to_string(ModuleName,
+					ModuleString) },
+				{ module_name_to_file_name(ModuleName,
+					BaseFileName) },
 				io__write_strings([
-				    "Warning: Cannot read dependencies for `",
-				    ModuleName, ".trans_opt'.\n",
-				    "  run `mmake main_module.depend' ",
-				    "to remake the dependencies\n"])
+				    "Warning: cannot read trans-opt ",
+				    "dependencies for module `",
+				    ModuleString, "'.\n",
+				    "  Run `mmake ", BaseFileName, ".depend' ",
+				    "to remake the dependencies.\n"])
 			;
 				[]
 			)
@@ -386,10 +412,14 @@
 			% If transitive optimization is enabled, but we are
 			% not creating the trans opt file, then import the
 			% trans_opt files for all the modules that are
-			% imported (or used).
-			{ Imports0 = module_imports(_Module, DirectImports, 
-				_IndirectImports, _Items, _) },
-			trans_opt__grab_optfiles(Imports1, DirectImports,
+			% imported (or used), and for all ancestor modules.
+			{ Imports0 = module_imports(_Module, Ancestors,
+				InterfaceImports, ImplementationImports,
+				_IndirectImports, _PublicChildren, _FactDeps,
+				_Items, _Error) },
+			{ list__condense([Ancestors, InterfaceImports,
+				ImplementationImports], TransOptFiles) },
+			trans_opt__grab_optfiles(Imports1, TransOptFiles,
 				Imports, Error2)
 		;
 			{ Imports = Imports1 },
@@ -559,7 +589,8 @@
 			{ HLDS = HLDS1 }
 		),
 		{ module_info_name(HLDS, ModuleName) },
-		{ string__append(ModuleName, ".opt", OptName) },
+		{ module_name_to_file_name(ModuleName, BaseFileName) },
+		{ string__append(BaseFileName, ".opt", OptName) },
 		update_interface(OptName),
 		touch_interface_datestamp(ModuleName, ".optdate")
 	;
@@ -700,7 +731,7 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- pred mercury_compile__middle_pass(string, module_info, module_info,
+:- pred mercury_compile__middle_pass(module_name, module_info, module_info,
 					io__state, io__state).
 % :- mode mercury_compile__middle_pass(in, di, uo, di, uo) is det.
 :- mode mercury_compile__middle_pass(in, in, out, di, uo) is det.
@@ -1179,9 +1210,10 @@
 	globals__io_lookup_bool_option(show_dependency_graph, ShowDepGraph),
 	( { ShowDepGraph = yes } ->
 		maybe_write_string(Verbose, "% Writing dependency graph..."),
-		{ module_info_name(ModuleInfo0, Name) },
-		{ string__append(Name, ".dependency_graph", WholeName) },
-		io__tell(WholeName, Res),
+		{ module_info_name(ModuleInfo0, ModuleName) },
+		{ module_name_to_file_name(ModuleName, BaseFileName) },
+		{ string__append(BaseFileName, ".dependency_graph", FileName) },
+		io__tell(FileName, Res),
 		( { Res = ok } ->
 			dependency_graph__write_dependency_graph(ModuleInfo0,
 							ModuleInfo),
@@ -1213,9 +1245,10 @@
 	->
 		maybe_write_string(Verbose, "% Outputing profiling call graph..."),
 		maybe_flush_output(Verbose),
-		{ module_info_name(ModuleInfo0, Name) },
-		{ string__append(Name, ".prof", WholeName) },
-		io__tell(WholeName, Res),
+		{ module_info_name(ModuleInfo0, ModuleName) },
+		{ module_name_to_file_name(ModuleName, BaseFileName) },
+		{ string__append(BaseFileName, ".prof", WholeFileName) },
+		io__tell(WholeFileName, Res),
 		(
 			{ Res = ok }
 		->
@@ -1286,7 +1319,7 @@
 		{ HLDS = HLDS0 }
 	).
 
-:- pred mercury_compile__maybe_bytecodes(module_info, string, bool, bool,
+:- pred mercury_compile__maybe_bytecodes(module_info, module_name, bool, bool,
 	io__state, io__state).
 :- mode mercury_compile__maybe_bytecodes(in, in, in, in, di, uo) is det.
 
@@ -1302,7 +1335,8 @@
 		bytecode_gen__module(HLDS1, Bytecode),
 		maybe_write_string(Verbose, "% done.\n"),
 		maybe_report_stats(Stats),
-		{ string__append(ModuleName, ".bytedebug", BytedebugFile) },
+		{ module_name_to_file_name(ModuleName, BaseFileName) },
+		{ string__append(BaseFileName, ".bytedebug", BytedebugFile) },
 		maybe_write_string(Verbose,
 			"% Writing bytecodes to `"),
 		maybe_write_string(Verbose, BytedebugFile),
@@ -1310,7 +1344,7 @@
 		maybe_flush_output(Verbose),
 		debug_bytecode_file(BytedebugFile, Bytecode),
 		maybe_write_string(Verbose, " done.\n"),
-		{ string__append(ModuleName, ".mbc", BytecodeFile) },
+		{ string__append(BaseFileName, ".mbc", BytecodeFile) },
 		maybe_write_string(Verbose,
 			"% Writing bytecodes to `"),
 		maybe_write_string(Verbose, BytecodeFile),
@@ -1611,8 +1645,8 @@
 
 % The LLDS output pass
 
-:- pred mercury_compile__output_pass(module_info, list(c_procedure), string,
-	bool, io__state, io__state).
+:- pred mercury_compile__output_pass(module_info, list(c_procedure),
+		module_name, bool, io__state, io__state).
 :- mode mercury_compile__output_pass(in, in, in, out, di, uo) is det.
 
 mercury_compile__output_pass(HLDS0, LLDS0, ModuleName, CompileErrors) -->
@@ -1656,9 +1690,10 @@
 :- mode mercury_compile__chunk_llds(in, in, in, in, out, out, di, uo) is det.
 
 mercury_compile__chunk_llds(HLDS, Procedures, BaseTypeData, CommonDataModules,
-		c_file(Name, C_HeaderCode, ModuleList), NumChunks) -->
-	{ module_info_name(HLDS, Name) },
-	{ string__append(Name, "_module", ModName) },
+		c_file(ModuleName, C_HeaderCode, ModuleList), NumChunks) -->
+	{ module_info_name(HLDS, ModuleName) },
+	{ llds_out__sym_name_mangle(ModuleName, MangledModName) },
+	{ string__append(MangledModName, "_module", ModName) },
 	globals__io_lookup_int_option(procs_per_c_function, ProcsPerFunc),
 	{ module_info_get_c_header(HLDS, C_HeaderCode0) },
 	{ module_info_get_c_body_code(HLDS, C_BodyCode0) },
@@ -1673,7 +1708,7 @@
 			ProcModules) }
 	),
 	{ export__get_pragma_exported_procs(HLDS, PragmaExports) },
-	maybe_add_header_file_include(PragmaExports, Name, C_HeaderCode0,
+	maybe_add_header_file_include(PragmaExports, ModuleName, C_HeaderCode0,
 		C_HeaderCode1),
 	globals__io_lookup_bool_option(generate_trace, Trace),
 	( { Trace = yes } ->
@@ -1687,12 +1722,13 @@
 		ProcModules, [c_export(PragmaExports)]], ModuleList) },
 	{ list__length(ModuleList, NumChunks) }.
 
-:- pred maybe_add_header_file_include(list(c_export), string,
+:- pred maybe_add_header_file_include(list(c_export), module_name,
 	c_header_info, c_header_info, io__state, io__state).
 :- mode maybe_add_header_file_include(in, in, in, out, di, uo) is det.
 
-maybe_add_header_file_include(PragmaExports, BaseName, 
+maybe_add_header_file_include(PragmaExports, ModuleName, 
 		C_HeaderCode0, C_HeaderCode) -->
+	{ module_name_to_file_name(ModuleName, BaseName) },
 	(
 		{ PragmaExports = [] },
 		{ C_HeaderCode = C_HeaderCode0 }
@@ -1701,6 +1737,7 @@
                 globals__io_lookup_bool_option(split_c_files, SplitFiles),
                 { 
 			SplitFiles = yes,
+			
                         string__append_list(
                                 ["#include ""../", BaseName, ".h""\n"],
 				Include0)
@@ -1729,14 +1766,14 @@
 	get_c_body_code(CodesAndContexts, C_Modules).
 
 :- pred mercury_compile__combine_chunks(list(list(c_procedure)), string,
-	list(c_module)).
+		list(c_module)).
 :- mode mercury_compile__combine_chunks(in, in, out) is det.
 
 mercury_compile__combine_chunks(ChunkList, ModName, Modules) :-
 	mercury_compile__combine_chunks_2(ChunkList, ModName, 0, Modules).
 
-:- pred mercury_compile__combine_chunks_2(list(list(c_procedure)), string, int,
-	list(c_module)).
+:- pred mercury_compile__combine_chunks_2(list(list(c_procedure)),
+		string, int, list(c_module)).
 :- mode mercury_compile__combine_chunks_2(in, in, in, out) is det.
 
 mercury_compile__combine_chunks_2([], _ModName, _N, []).
@@ -1755,7 +1792,8 @@
 mercury_compile__output_llds(ModuleName, LLDS, Verbose, Stats) -->
 	maybe_write_string(Verbose,
 		"% Writing output to `"),
-	maybe_write_string(Verbose, ModuleName),
+	{ module_name_to_file_name(ModuleName, FileName) },
+	maybe_write_string(Verbose, FileName),
 	maybe_write_string(Verbose, ".c'..."),
 	maybe_flush_output(Verbose),
 	output_c_file(LLDS),
@@ -1796,16 +1834,17 @@
 
 :- type compiler_type ---> gcc ; lcc ; unknown.
 
-:- pred mercury_compile__c_to_obj(string, int, bool, io__state, io__state).
+:- pred mercury_compile__c_to_obj(module_name, int, bool, io__state, io__state).
 :- mode mercury_compile__c_to_obj(in, in, out, di, uo) is det.
 
 mercury_compile__c_to_obj(ModuleName, NumChunks, Succeeded) -->
+	{ module_name_to_file_name(ModuleName, BaseFileName) },
 	globals__io_lookup_bool_option(split_c_files, SplitFiles),
 	( { SplitFiles = yes } ->
-		mercury_compile__c_to_obj_list(ModuleName, 0, NumChunks,
+		mercury_compile__c_to_obj_list(BaseFileName, 0, NumChunks,
 			Succeeded)
 	;
-		mercury_compile__single_c_to_obj(ModuleName, Succeeded)
+		mercury_compile__single_c_to_obj(BaseFileName, Succeeded)
 	).
 
 :- pred mercury_compile__c_to_obj_list(string, int, int, bool,
@@ -1814,11 +1853,11 @@
 
 	% compile each of the C files in `<module>.dir'
 
-mercury_compile__c_to_obj_list(ModuleName, Chunk, NumChunks, Succeeded) -->
+mercury_compile__c_to_obj_list(BaseFileName, Chunk, NumChunks, Succeeded) -->
 	( { Chunk > NumChunks } ->
 		{ Succeeded = yes }
 	;
-		{ dir__basename(ModuleName, BaseName) },
+		{ dir__basename(BaseFileName, BaseName) },
 		{ string__format("%s.dir/%s_%03d",
 			[s(BaseName), s(BaseName), i(Chunk)], NewName) },
 		mercury_compile__single_c_to_obj(NewName, Succeeded0),
@@ -1826,7 +1865,7 @@
 			{ Succeeded = no }
 		;
 			{ Chunk1 is Chunk + 1 },
-			mercury_compile__c_to_obj_list(ModuleName,
+			mercury_compile__c_to_obj_list(BaseFileName,
 				Chunk1, NumChunks, Succeeded)
 		)
 	).
@@ -1834,9 +1873,9 @@
 :- pred mercury_compile__single_c_to_obj(string, bool, io__state, io__state).
 :- mode mercury_compile__single_c_to_obj(in, out, di, uo) is det.
 
-mercury_compile__single_c_to_obj(ModuleName, Succeeded) -->
-	{ string__append(ModuleName, ".c", C_File) },
-	{ string__append(ModuleName, ".o", O_File) },
+mercury_compile__single_c_to_obj(BaseFileName, Succeeded) -->
+	{ string__append(BaseFileName, ".c", C_File) },
+	{ string__append(BaseFileName, ".o", O_File) },
 	globals__io_lookup_bool_option(verbose, Verbose),
 	maybe_write_string(Verbose, "% Compiling `"),
 	maybe_write_string(Verbose, C_File),
@@ -2155,9 +2194,9 @@
 		}
 	->
 		{ module_info_name(HLDS, ModuleName) },
-		{ string__append_list(
-			[ModuleName, ".hlds_dump.", StageNum, "-", StageName],
-			DumpFile) },
+		{ module_name_to_file_name(ModuleName, BaseFileName) },
+		{ string__append_list( [BaseFileName, ".hlds_dump.",
+				StageNum, "-", StageName], DumpFile) },
 		mercury_compile__dump_hlds(DumpFile, HLDS)
 	;
 		[]
Index: compiler/mercury_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_c.m,v
retrieving revision 1.33
diff -u -u -r1.33 mercury_to_c.m
--- mercury_to_c.m	1998/01/24 05:44:20	1.33
+++ mercury_to_c.m	1998/02/16 06:48:13
@@ -111,7 +111,7 @@
 	{ module_info_name(Module, Name) },
 	c_gen_indent(Indent),
 	io__write_string("/* :- module "),
-	io__write_string(Name),
+	prog_out__write_sym_name(Name),
 	io__write_string(". */\n\n"),
 	c_gen_indent(Indent),
 	io__write_string("#include ""mercury_imp.h""\n\n").
@@ -123,7 +123,7 @@
 	{ module_info_name(Module, Name) },
 	c_gen_indent(Indent),
 	io__write_string("/* :- end_module "),
-	io__write_string(Name),
+	prog_out__write_sym_name(Name),
 	io__write_string(". */\n").
 
 :- pred c_gen_preds(int, module_info, pred_table,
@@ -389,10 +389,11 @@
 	{ predicate_module(ModuleInfo, PredId, ModuleName) },
 	{ predicate_name(ModuleInfo, PredId, PredName) },
 	{ predicate_arity(ModuleInfo, PredId, Arity) },
+	{ llds_out__sym_name_mangle(ModuleName, MangledModuleName) },
 	{ llds_out__name_mangle(PredName, MangledPredName) },
 	io__write_string("MP_"),
 	io__write_string("_"),
-	io__write_string(ModuleName),
+	io__write_string(MangledModuleName),
 	io__write_string("__"),
 	io__write_string(MangledPredName),
 	io__write_string("_"),
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.62
diff -u -u -r1.62 mercury_to_goedel.m
--- mercury_to_goedel.m	1997/12/19 03:07:29	1.62
+++ mercury_to_goedel.m	1998/02/16 06:48:13
@@ -33,7 +33,8 @@
 :- import_module list, io.
 :- import_module prog_data.
 
-:- pred convert_to_goedel(string, list(item_and_context), io__state, io__state).
+:- pred convert_to_goedel(module_name, list(item_and_context),
+			io__state, io__state).
 :- mode convert_to_goedel(in, in, di, uo) is det.
 
 %-----------------------------------------------------------------------------%
@@ -60,7 +61,7 @@
 
 %-----------------------------------------------------------------------------%
 
-convert_to_goedel(ProgName, Items0) -->
+convert_to_goedel(ModuleNameSym, Items0) -->
 	io__stderr_stream(StdErr),
 	io__write_string(StdErr, "% Expanding equivalence types..."),
 	io__flush_output(StdErr),
@@ -69,7 +70,9 @@
 					Items, Error,  _),
 	io__write_string(StdErr, " done\n"),
 	( { Error = no } ->
-		{ convert_functor_name(ProgName, GoedelName) },
+		{ prog_out__sym_name_to_string(ModuleNameSym, "__",
+				ModuleName) },
+		{ convert_functor_name(ModuleName, GoedelName) },
 		{ string__append(GoedelName, ".loc", OutputFileName) },
 		io__tell(OutputFileName, Res),
 		( { Res = ok } ->
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.131
diff -u -u -r1.131 mercury_to_mercury.m
--- mercury_to_mercury.m	1998/02/16 17:23:03	1.131
+++ mercury_to_mercury.m	1998/02/26 03:56:04
@@ -15,10 +15,10 @@
 :- interface.
 
 :- import_module hlds_goal, hlds_data, hlds_pred, prog_data, (inst), purity.
-:- import_module list, io, varset, term.
+:- import_module bool, std_util, list, io, varset, term.
 
-%	convert_to_mercury(ProgName, OutputFileName, Items)
-:- pred convert_to_mercury(string, string, list(item_and_context),
+%	convert_to_mercury(ModuleName, OutputFileName, Items)
+:- pred convert_to_mercury(module_name, string, list(item_and_context),
 				io__state, io__state).
 :- mode convert_to_mercury(in, in, in, di, uo) is det.
 
@@ -170,12 +170,12 @@
 
 :- import_module prog_out, prog_util, hlds_pred, hlds_out, instmap.
 :- import_module globals, options, termination.
-:- import_module bool, int, string, set, term_io, lexer, std_util, require.
+:- import_module int, string, set, term_io, lexer, require.
 :- import_module char.
 
 %-----------------------------------------------------------------------------%
 
-convert_to_mercury(ProgName, OutputFileName, Items) -->
+convert_to_mercury(ModuleName, OutputFileName, Items) -->
 	io__stderr_stream(StdErr),
 	io__tell(OutputFileName, Res),
 	( { Res = ok } ->
@@ -189,7 +189,7 @@
 			[]
 		),
 		io__write_string(":- module "),
-		mercury_output_bracketed_constant(term__atom(ProgName)),
+		mercury_output_bracketed_sym_name(ModuleName),
 		io__write_string(".\n"),
 		mercury_output_item_list(Items),
 		( { Verbose = yes } ->
@@ -516,19 +516,23 @@
 			io__state, io__state).
 :- mode mercury_output_module_defn(in, in, in, di, uo) is det.
 
-mercury_output_module_defn(_VarSet, Module, _Context) -->
-	( { Module = import(module(ImportedModules)) } ->
+mercury_output_module_defn(_VarSet, ModuleDefn, _Context) -->
+	( { ModuleDefn = import(module(ImportedModules)) } ->
 		io__write_string(":- import_module "),
 		mercury_write_module_spec_list(ImportedModules),
 		io__write_string(".\n")
-	; { Module = use(module(UsedModules)) } ->
+	; { ModuleDefn = use(module(UsedModules)) } ->
 		io__write_string(":- use_module "),
 		mercury_write_module_spec_list(UsedModules),
 		io__write_string(".\n")
-	; { Module = interface } ->
+	; { ModuleDefn = interface } ->
 		io__write_string(":- interface.\n")
-	; { Module = implementation } ->
+	; { ModuleDefn = implementation } ->
 		io__write_string(":- implementation.\n")
+	; { ModuleDefn = include_module(IncludedModules) } ->
+		io__write_string(":- include_module "),
+		mercury_write_module_spec_list(IncludedModules),
+		io__write_string(".\n")
 	;
 		% XXX unimplemented
 		io__write_string("% unimplemented module declaration\n")
@@ -540,7 +544,7 @@
 
 mercury_write_module_spec_list([]) --> [].
 mercury_write_module_spec_list([ModuleName | ModuleNames]) -->
-	mercury_output_bracketed_constant(term__atom(ModuleName)),
+	mercury_output_bracketed_sym_name(ModuleName),
 	( { ModuleNames = [] } ->
 		[]
 	;
@@ -1032,14 +1036,16 @@
 	io__write_int(ProcInt),
 	io__write_string(")>").
 mercury_output_cons_id(base_type_info_const(Module, Type, Arity), _) -->
+	{ prog_out__sym_name_to_string(Module, ModuleString) },
 	{ string__int_to_string(Arity, ArityString) },
-	io__write_strings(["<base_type_info for ", Module, ":", Type, "/",
-		ArityString, ">"]).
+	io__write_strings(["<base_type_info for ",
+		ModuleString, ":", Type, "/", ArityString, ">"]).
 mercury_output_cons_id(base_typeclass_info_const(Module, Class, InstanceString),
 		_) -->
+	{ prog_out__sym_name_to_string(Module, ModuleString) },
 	io__write_string("<base_typeclass_info for "),
 	io__write(Class),
-	io__write_strings([" from module ", Module, ", instance number",
+	io__write_strings([" from module ", ModuleString, ", instance number",
 		InstanceString]).
 
 mercury_output_mode_defn(VarSet, eqv_mode(Name, Args, Mode), Context) -->
@@ -1509,7 +1515,7 @@
 
 mercury_output_bracketed_sym_name(Name) -->
 	(	{ Name = qualified(ModuleName, Name2) },
-		mercury_output_bracketed_constant(term__atom(ModuleName)),
+		mercury_output_bracketed_sym_name(ModuleName),
 		io__write_char(':')
 	;
 		{ Name = unqualified(Name2) }
@@ -1521,7 +1527,7 @@
 
 mercury_output_sym_name(Name) -->
 	(	{ Name = qualified(ModuleName, PredName) },
-		mercury_output_bracketed_constant(term__atom(ModuleName)),
+		mercury_output_bracketed_sym_name(ModuleName),
 		io__write_char(':'),
 		mercury_quote_qualified_atom(PredName)
 	;
@@ -1733,7 +1739,7 @@
 mercury_output_call(Name, Term, VarSet, _Indent) -->
 	(	
 		{ Name = qualified(ModuleName, PredName) },
-		io__write_string(ModuleName),
+		mercury_output_bracketed_sym_name(ModuleName),
 		io__write_string(":")
 	;
 		{ Name = unqualified(PredName) }
@@ -2388,6 +2394,7 @@
 mercury_unary_prefix_op("func").
 mercury_unary_prefix_op("if").
 mercury_unary_prefix_op("import_module").
+mercury_unary_prefix_op("include_module").
 mercury_unary_prefix_op("impure").
 mercury_unary_prefix_op("insert").
 mercury_unary_prefix_op("inst").
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.69
diff -u -u -r1.69 middle_rec.m
--- middle_rec.m	1998/01/13 10:12:54	1.69
+++ middle_rec.m	1998/02/16 06:48:14
@@ -25,8 +25,9 @@
 
 :- implementation.
 
-:- import_module hlds_module, hlds_data.
+:- import_module hlds_module, hlds_data, prog_out.
 :- import_module code_gen, unify_gen, code_util, code_aux, opt_util.
+
 :- import_module bool, set, int, std_util, tree, list, assoc_list, require.
 :- import_module string, term.
 
@@ -183,8 +184,10 @@
 				- "test on upward loop"]
 	;
 		predicate_module(ModuleInfo, PredId, ModuleName),
+		prog_out__sym_name_to_string(ModuleName, ModuleNameString),
 		predicate_name(ModuleInfo, PredId, PredName),
-		string__append_list([ModuleName, ":", PredName], PushMsg),
+		string__append_list([ModuleNameString, ":", PredName],
+			PushMsg),
 		MaybeIncrSp = [incr_sp(FrameSize, PushMsg) - ""],
 		MaybeDecrSp = [decr_sp(FrameSize) - ""],
 		InitAuxReg =  [assign(AuxReg, lval(sp))
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.56
diff -u -u -r1.56 mode_errors.m
--- mode_errors.m	1998/02/18 22:23:24	1.56
+++ mode_errors.m	1998/02/26 03:56:05
@@ -17,8 +17,9 @@
 
 :- interface.
 
-:- import_module hlds_data, prog_data, mode_info, (inst).
-:- import_module set, assoc_list.
+:- import_module hlds_data, hlds_pred, hlds_module, hlds_goal.
+:- import_module prog_data, mode_info, (inst).
+:- import_module bool, set, assoc_list, term, list.
 
 %-----------------------------------------------------------------------------%
 
@@ -163,10 +164,10 @@
 
 :- implementation.
 
-:- import_module hlds_module, hlds_pred, hlds_goal, hlds_out.
+:- import_module hlds_out.
 :- import_module mode_info, mode_util, prog_out, mercury_to_mercury.
 :- import_module options, globals.
-:- import_module bool, int, list, map, io, term, term_io, varset.
+:- import_module int, map, io, term_io, varset.
 :- import_module std_util, require.
 
 	% just dispatch on the diffferent sorts of mode errors
Index: compiler/mode_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.44
diff -u -u -r1.44 mode_info.m
--- mode_info.m	1998/01/30 06:12:51	1.44
+++ mode_info.m	1998/02/19 08:28:45
@@ -17,7 +17,7 @@
 :- interface.
 
 :- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, instmap.
-:- import_module mode_errors, delay_info, (inst).
+:- import_module prog_data, mode_errors, delay_info, (inst).
 :- import_module map, list, varset, set, bool, term, assoc_list.
 
 :- interface.
@@ -275,7 +275,7 @@
 
 :- implementation.
 
-:- import_module delay_info, mode_errors, prog_data, mode_util.
+:- import_module delay_info, mode_errors, mode_util.
 :- import_module require, std_util, queue.
 
 :- type mode_info 
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.106
diff -u -u -r1.106 mode_util.m
--- mode_util.m	1998/02/14 14:39:01	1.106
+++ mode_util.m	1998/02/25 04:07:50
@@ -16,7 +16,7 @@
 
 :- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, prog_data.
 :- import_module (inst), instmap.
-:- import_module bool, list.
+:- import_module bool, list, term.
 
 	% mode_get_insts returns the initial instantiatedness and
 	% the final instantiatedness for a given mode, aborting
@@ -164,10 +164,18 @@
 :- mode normalise_inst(in, in, out) is det.
 
 %-----------------------------------------------------------------------------%
+
+	% Construct a mode corresponding to the standard `in',
+	% `out', or `uo' mode.
+:- pred in_mode((mode)::out) is det.
+:- pred out_mode((mode)::out) is det.
+:- pred uo_mode((mode)::out) is det.
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module require, int, map, set, term, std_util, assoc_list.
+:- import_module require, int, map, set, std_util, assoc_list.
 :- import_module prog_util, type_util.
 :- import_module inst_match, inst_util.
 
@@ -202,36 +210,29 @@
 	% more readable.
 	%
 	( Initial = free, Final = ground(shared, no) ->
-		Mode = user_defined_mode(
-				qualified("mercury_builtin", "out"), [])
+		make_std_mode("out", [], Mode)
 	; Initial = free, Final = ground(unique, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "uo"), [])
+		make_std_mode("uo", [], Mode)
 	; Initial = free, Final = ground(mostly_unique, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "muo"),
-								[])
+		make_std_mode("muo", [], Mode)
 	; Initial = ground(shared, no), Final = ground(shared, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "in"), [])
+		make_std_mode("in", [], Mode)
 	; Initial = ground(unique, no), Final = ground(clobbered, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "di"), [])
+		make_std_mode("di", [], Mode)
 	; Initial = ground(mostly_unique, no),
 	  Final = ground(mostly_clobbered, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "mdi"),
-								[])
+		make_std_mode("mdi", [], Mode)
 	; Initial = ground(unique, no), Final = ground(unique, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "ui"), [])
+		make_std_mode("ui", [], Mode)
 	; Initial = ground(mostly_unique, no),
 	  Final = ground(mostly_unique, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "mui"),
-								[])
+		make_std_mode("mdi", [], Mode)
 	; Initial = free ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "out"),
-								[Final])
+		make_std_mode("out", [Final], Mode)
 	; Final = ground(clobbered, no) ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "di"),
-								[Initial])
+		make_std_mode("di", [Initial], Mode)
 	; Initial = Final ->
-		Mode = user_defined_mode(qualified("mercury_builtin", "in"),
-								[Initial])
+		make_std_mode("in", [Initial], Mode)
 	;
 		Mode = (Initial -> Final)
 	).
@@ -802,7 +803,7 @@
 		BoundInsts = BoundInsts0
 	).
 
-:- pred propagate_ctor_info_3(list(bound_inst), string, list(constructor),
+:- pred propagate_ctor_info_3(list(bound_inst), module_name, list(constructor),
 		tsubst, module_info, list(bound_inst)).
 :- mode propagate_ctor_info_3(in, in, in, in, in, out) is det.
 
@@ -1363,7 +1364,12 @@
 						sym_name::out) is det.
 
 strip_builtin_qualifier_from_sym_name(SymName0, SymName) :-
-	( SymName0 = qualified("mercury_builtin", Name) ->
+	(
+		SymName0 = qualified(Module, Name),
+		( mercury_public_builtin_module(Module)
+		; mercury_private_builtin_module(Module)
+		)
+	->
 		SymName = unqualified(Name)
 	;
 		SymName = SymName0
@@ -1486,6 +1492,22 @@
 		goal_info_set_instmap_delta(GoalInfo0, InstMapDelta, GoalInfo)
 	),
 	Goal = GoalExpr - GoalInfo.
+
+%-----------------------------------------------------------------------------%
+
+in_mode(Mode) :- make_std_mode("in", [], Mode).
+
+out_mode(Mode) :- make_std_mode("out", [], Mode).
+
+uo_mode(Mode) :- make_std_mode("uo", [], Mode).
+
+:- pred make_std_mode(string, list(inst), mode).
+:- mode make_std_mode(in, in, out) is det.
+
+make_std_mode(Name, Args, Mode) :-
+	mercury_public_builtin_module(MercuryBuiltin),
+	QualifiedName = qualified(MercuryBuiltin, Name),
+	Mode = user_defined_mode(QualifiedName, Args).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.23
diff -u -u -r1.23 modecheck_call.m
--- modecheck_call.m	1998/02/12 01:17:32	1.23
+++ modecheck_call.m	1998/02/25 04:27:30
@@ -21,8 +21,9 @@
 :- module modecheck_call.
 :- interface.
 
-:- import_module hlds_goal, mode_info.
-:- import_module term.
+:- import_module hlds_goal, hlds_pred, hlds_module, hlds_data.
+:- import_module prog_data, modes, mode_info.
+:- import_module term, list, std_util.
 
 :- pred modecheck_call_pred(pred_id, list(var), maybe(determinism),
 				proc_id, list(var), extra_goals,
@@ -59,11 +60,11 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module prog_data, hlds_pred, hlds_data, hlds_module, instmap, (inst).
+:- import_module prog_data, instmap, (inst).
 :- import_module mode_info, mode_debug, modes, mode_util, mode_errors.
 :- import_module clause_to_proc, inst_match, make_hlds.
 :- import_module det_report, unify_proc.
-:- import_module map, list, bool, std_util, set, require.
+:- import_module map, bool, set, require.
 
 modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0, Goal)
 		-->
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.32
diff -u -u -r1.32 modecheck_unify.m
--- modecheck_unify.m	1998/02/19 03:17:08	1.32
+++ modecheck_unify.m	1998/02/26 04:02:24
@@ -20,8 +20,8 @@
 :- module modecheck_unify.
 :- interface.
 
-:- import_module hlds_goal, mode_info, modes.
-:- import_module term.
+:- import_module hlds_goal, hlds_data, prog_data, mode_info, modes.
+:- import_module map, term, list.
 
 	% Modecheck a unification
 :- pred modecheck_unification( var, unify_rhs, unification, unify_context,
@@ -49,12 +49,14 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module llds, prog_data, prog_util, type_util, module_qual, instmap.
-:- import_module hlds_module, hlds_goal, hlds_pred, hlds_data, hlds_out.
+
+:- import_module llds, prog_util, type_util, module_qual, instmap.
+:- import_module hlds_module, hlds_goal, hlds_pred, hlds_out.
 :- import_module mode_debug, mode_util, mode_info, modes, mode_errors.
 :- import_module inst_match, inst_util, unify_proc, code_util, unique_modes.
 :- import_module typecheck, modecheck_call, (inst), quantification.
-:- import_module bool, list, std_util, int, map, set, require, varset.
+
+:- import_module bool, std_util, int, set, require, varset.
 :- import_module string, assoc_list.
 
 %-----------------------------------------------------------------------------%
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.220
diff -u -u -r1.220 modes.m
--- modes.m	1998/02/15 06:49:17	1.220
+++ modes.m	1998/02/19 09:04:16
@@ -131,8 +131,8 @@
 
 :- interface.
 
-:- import_module hlds_module, hlds_pred, (inst), instmap.
-:- import_module bool, io.
+:- import_module prog_data, hlds_goal, hlds_module, hlds_pred, (inst), instmap.
+:- import_module bool, list, term, io.
 
 	% modecheck(HLDS0, HLDS, UnsafeToContinue):
 	% Perform mode inference and checking for a whole module.
@@ -301,13 +301,15 @@
 
 :- implementation.
 
-:- import_module make_hlds, hlds_goal, hlds_data, unique_modes, mode_debug.
+:- import_module make_hlds, hlds_data, unique_modes, mode_debug.
 :- import_module mode_info, delay_info, mode_errors, inst_match, instmap.
-:- import_module type_util, mode_util, code_util, prog_data, unify_proc.
+:- import_module type_util, mode_util, code_util, unify_proc.
 :- import_module globals, options, mercury_to_mercury, hlds_out, int, set.
 :- import_module passes_aux, typecheck, module_qual, clause_to_proc.
 :- import_module modecheck_unify, modecheck_call, inst_util, purity.
-:- import_module list, map, varset, term, prog_out, string, require, std_util.
+:- import_module prog_out.
+
+:- import_module list, map, varset, string, require, std_util.
 :- import_module assoc_list.
 
 %-----------------------------------------------------------------------------%
@@ -1769,7 +1771,7 @@
 		)
 	).
 
-:- pred modes__build_call(string, string, list(var),
+:- pred modes__build_call(module_name, string, list(var),
 			term__context, maybe(call_unify_context), module_info,
 			hlds_goal).
 :- mode modes__build_call(in, in, in, in, in, in, out) is semidet.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.30
diff -u -u -r1.30 module_qual.m
--- module_qual.m	1998/01/25 06:05:29	1.30
+++ module_qual.m	1998/02/25 13:05:17
@@ -5,9 +5,8 @@
 %-----------------------------------------------------------------------------%
 %
 :- module module_qual.
-%	Main author: stayl
+%	Main authors: stayl, fjh.
 %
-%	Based on undef_types and undef_modes by fjh.
 %	Module qualifies types, insts and modes within declaration items.
 %	The head of all declarations should be module qualified in prog_io.m.
 %	This module qualifies the bodies of the declarations.
@@ -21,10 +20,10 @@
 :- interface.
 
 :- import_module prog_data.
-:- import_module bool, io.
+:- import_module bool, list, io.
 
-	% module_qualify_items(Items0, Items, ReportUndefErrors,
-	%				NumErrors, UndefTypes, UndefModes).
+	% module_qualify_items(Items0, Items, ModuleName, ReportUndefErrors,
+	%			MQ_Info, NumErrors, UndefTypes, UndefModes):
 	%
 	% Items is Items0 with all items module qualified as much
 	% as possible. If ReportUndefErrors is yes, then
@@ -32,7 +31,8 @@
 	% ReportUndefErrors should be no when module qualifying the
 	% short interface.
 :- pred module_qual__module_qualify_items(item_list, item_list,
-		string, bool, mq_info, int, bool, bool, io__state, io__state).
+		module_name, bool, mq_info, int, bool, bool,
+		io__state, io__state).
 :- mode module_qual__module_qualify_items(in, out, in, in,
 		out, out, out, out, di, uo) is det.
 
@@ -64,9 +64,9 @@
 :- implementation.
 
 :- import_module hlds_data, hlds_module, hlds_pred, type_util, prog_out.
-:- import_module prog_util, mercury_to_mercury, globals, options.
+:- import_module prog_util, mercury_to_mercury, modules, globals, options.
 :- import_module (inst), instmap.
-:- import_module int, list, map, require, set, std_util, string, term, varset.
+:- import_module int, map, require, set, std_util, string, term, varset.
 
 module_qual__module_qualify_items(Items0, Items, ModuleName, ReportErrors,
 			Info, NumErrors, UndefTypes, UndefModes) -->
@@ -196,6 +196,7 @@
 :- pred process_module_defn(module_defn::in, mq_info::in, mq_info::out) is det.
 
 process_module_defn(module(_), Info, Info).
+process_module_defn(include_module(_), Info, Info).
 process_module_defn(interface, Info0, Info) :-
 	mq_info_set_import_status(Info0, exported, Info).
 process_module_defn(implementation, Info0, Info) :-
@@ -338,7 +339,7 @@
 	{ list__length(Types0, Arity) },
 	{ Id = Name0 - Arity },
 	{ mq_info_set_error_context(Info0, instance(Id) - Context, Info1) },
-		% We don't qualify the interface yet, since that requires
+		% We don't qualify the implementation yet, since that requires
 		% us to resolve overloading.
 	qualify_class_constraints(Constraints0, Constraints, Info1, Info2),
 	qualify_class_name(Id, Name - _, Info2, Info3),
@@ -361,6 +362,12 @@
 update_import_status(export(_), Info, Info, yes).
 update_import_status(import(_), Info, Info, yes).
 update_import_status(use(_), Info, Info, yes).
+update_import_status(include_module(_), Info0, Info, yes) :-
+	% The sub-module might make use of *any* of the imported modules.
+	% There's no way for us to tell which ones.
+	% So we conservatively assume that it uses all of them.
+	set__init(UnusedInterfaceModules),
+	mq_info_set_interface_modules(Info0, UnusedInterfaceModules, Info).
 
 	% Qualify the constructors or other types in a type definition.	
 :- pred qualify_type_defn(type_defn::in, type_defn::out, mq_info::in,
@@ -622,7 +629,10 @@
 		; Typename = "float"
 		)
 	->
-		mq_info_set_module_used(Info2, Typename, Info)
+		% -- not yet:
+		% StdLibraryModule = qualified(unqualified("std"), Typename),
+		StdLibraryModule = unqualified(Typename),
+		mq_info_set_module_used(Info2, StdLibraryModule, Info)
 	;
 		Info = Info2
 	}.
@@ -757,27 +767,46 @@
 	instance_interface::out) is det. 
 
 qualify_instance_interface(ClassName, M0s, Ms) :-
-	(
-		ClassName = qualified(Module, _)
+	( ClassName = unqualified(_) ->
+		Ms = M0s
 	;
-		ClassName = unqualified( _),
-		Module = ""
-	),
-	Qualify = lambda([M0::in, M::out] is det,
-		(
-			M0 = pred_instance(unqualified(Method), A, B),
-			M = pred_instance(qualified(Module, Method), A, B)
-		;
-			M0 = pred_instance(qualified(_, _), _A, _B),
-			M = M0
-		;
-			M0 = func_instance(unqualified(Method), A, B),
-			M = func_instance(qualified(Module, Method), A, B)
-		;
-			M0 = func_instance(qualified(_, _), _A, _B),
-			M = M0
-		)),
-	list__map(Qualify, M0s, Ms).
+		sym_name_get_module_name(ClassName, unqualified(""), Module),
+		Qualify = lambda([M0::in, M::out] is det,
+			(
+				M0 = pred_instance(Method0, A, B),
+				add_module_qualifier(Module, Method0, Method),
+				M = pred_instance(Method, A, B)
+			;
+				M0 = func_instance(Method0, A, B),
+				add_module_qualifier(Module, Method0, Method),
+				M = func_instance(Method, A, B)
+			)),
+		list__map(Qualify, M0s, Ms)
+	).
+
+:- pred add_module_qualifier(sym_name::in, sym_name::in, sym_name::out) is det.
+
+add_module_qualifier(Module, unqualified(SymName), qualified(Module, SymName)).
+add_module_qualifier(DefaultModule, qualified(SymModule, SymName),
+			qualified(Module, SymName)) :-
+	( match_sym_name(SymModule, DefaultModule) ->
+		Module = DefaultModule
+	;
+		% This case is an error.  The user must have written something
+		% like
+		%	:- instance foo:bar(some_type) where [
+		%		pred(baz:p/1) is q
+		%	].
+		% where the module qualifier on the pred or func in the
+		% instance (`baz:') does not match the qualifier for the 
+		% class name (`foo:').
+		%
+		% We don't report the error here, we just leave the original
+		% module qualifier intact so that the error can be reported
+		% later on.
+
+		Module = SymModule
+	).
 
 	% Find the unique match in the current name space for a given id
 	% from a list of ids. If none exists, either because no match was
@@ -992,10 +1021,15 @@
 	->
 		[]
 	;
-		{ string__append(ModuleName, ".m", FileName) },
+		{ module_name_to_file_name(ModuleName, BaseFileName) },
+		{ string__append(BaseFileName, ".m", FileName) },
 		{ term__context_init(FileName, 1, Context) },
 		prog_out__write_context(Context),
-		io__write_string("Warning: "),
+		io__write_string("In module `"),
+		prog_out__write_sym_name(ModuleName),
+		io__write_string("':\n"),
+		prog_out__write_context(Context),
+		io__write_string("  warning: "),
 		( { UnusedImports = [_] } ->
 			io__write_string("module ")
 		;
@@ -1161,7 +1195,9 @@
 	mq_info_set_type_error_flag(Info0, Info).
 
 	% If the current item is in the interface, remove its module 
-	% name from the list of modules not used in the interface.
+	% name from the list of modules not used in the interface
+	% (and if the module name is itself module-qualified,
+	% recursively mark its parent module as used).
 :- pred mq_info_set_module_used(mq_info::in, module_name::in,
 						mq_info::out) is det.
 
@@ -1169,7 +1205,14 @@
 	( mq_info_get_import_status(Info0, exported) ->
 		mq_info_get_interface_modules(Info0, Modules0),
 		set__delete(Modules0, Module, Modules),
-		mq_info_set_interface_modules(Info0, Modules, Info)
+		mq_info_set_interface_modules(Info0, Modules, Info1),
+		(
+			Module = qualified(ParentModule, _),
+			mq_info_set_module_used(Info1, ParentModule, Info)
+		;
+			Module = unqualified(_),
+			Info = Info1
+		)
 	;
 		Info = Info0
 	).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.56
diff -u -u -r1.56 modules.m
--- modules.m	1998/02/07 09:55:32	1.56
+++ modules.m	1998/02/25 21:09:32
@@ -28,6 +28,11 @@
 % on the .date file gives the last time the .int and .int2 files
 % were checked.
 %
+% 3. The .int0 file is similar to the .int file except that it also
+% includes declarations (but not clauses) from the implementation section.
+% It is used when compiling sub-modules.  The datestamp on the .date0
+% file gives the last time the .int0 file was checked.
+%
 %-----------------------------------------------------------------------------%
 
 :- module modules.
@@ -35,7 +40,26 @@
 :- interface.
 
 :- import_module prog_data, prog_io.
-:- import_module list, io.
+:- import_module std_util, bool, list, io.
+
+%-----------------------------------------------------------------------------%
+
+	% Convert a module name to the corresponding file name
+	% (excluding the trailing `.m').
+	%
+	% Currently we use the convention that the module
+	% `foo:bar:baz' should be named `foo.bar.baz.m'.
+	%
+:- pred module_name_to_file_name(module_name, file_name).
+:- mode module_name_to_file_name(in, out) is det.
+
+	% convert a file name (excluding the trailing `.m')
+	% to the corresponding module name
+	% 
+:- pred file_name_to_module_name(file_name, module_name).
+:- mode file_name_to_module_name(in, out) is det.
+
+%-----------------------------------------------------------------------------%
 
 	% read_mod(ModuleName, Extension, Descr, Search, Items, Error):
 	%	Given a module name and a file extension (e.g. `.m',
@@ -43,81 +67,204 @@
 	%	If Search is yes, search all directories given by the option
 	%	search_directories for the module.
 	%
-:- pred read_mod(string, string, string, bool, item_list, module_error,
+:- pred read_mod(module_name, string, string, bool, item_list, module_error,
 		io__state, io__state).
 :- mode read_mod(in, in, in, in, out, out, di, uo) is det.
 
 	% Same as above, but doesn't return error messages.
-:- pred read_mod_ignore_errors(string, string, string, bool, item_list, 
+:- pred read_mod_ignore_errors(module_name, string, string, bool, item_list, 
 		module_error, io__state, io__state).
 :- mode read_mod_ignore_errors(in, in, in, in, out, out, di, uo) is det.
 
+%-----------------------------------------------------------------------------%
+
+	% make_private_interface(ModuleName, Items):
+	%	Given a module name and the list of items in that module,
+	%	output the private (`.int0') interface file for the module.
+	%	(The private interface contains all the declarations in
+	%	the module, including those in the `implementation'
+	%	section; it is used when compiling sub-modules.)
+	%
+:- pred make_private_interface(module_name, item_list, io__state, io__state).
+:- mode make_private_interface(in, in, di, uo) is det.
+
 	% make_interface(ModuleName, Items):
 	%	Given a module name and the list of items in that module,
 	%	output the long (`.int') and short (`.int2') interface files
 	%	for the module.
 	%
-:- pred make_interface(string, item_list, io__state, io__state).
+:- pred make_interface(module_name, item_list, io__state, io__state).
 :- mode make_interface(in, in, di, uo) is det.
 
 	% 	Output the unqualified short interface file to <module>.int3.
 	%
-:- pred make_short_interface(string, item_list, io__state, io__state).
+:- pred make_short_interface(module_name, item_list, io__state, io__state).
 :- mode make_short_interface(in, in, di, uo) is det.
 
-	% grab_imported_modules(ModuleName, Items, Module, FactDeps, Error)
-	%	Given a module name and the list of items in that module,
-	%	read in the full interface files for all the imported modules,
-	%	and the short interface files for all the indirectly imported
-	%	modules, and return a `module_imports' structure containing the
-	%	relevant information.
-	%	Also returns FactDeps list of filenames for fact tables in this
-	%	module.
-	%
+%-----------------------------------------------------------------------------%
+
+% The `module_imports' structure holds information about
+% a module and the modules that it imports.
+
 :- type module_imports --->
 	module_imports(
-		string,		% The primary module name
-		list(string),	% The list of modules it directly imports
-		list(string),	% The list of modules it indirectly imports
+		module_name,	    % The primary module name
+		list(module_name),  % The list of ancestor modules it inherits
+		list(module_name),  % The list of modules it directly imports
+				    % in the interface
+				    % (imports via ancestors count as direct)
+		list(module_name),  % The list of modules it directly imports
+				    % in the implementation.
+		list(module_name),  % The list of modules it indirectly imports
+		list(module_name),  % The list of its public children,
+				    % i.e. child modules that it includes
+				    % in the interface section.
+		list(string),  	    % The list of filenames for fact tables
+				    % in this module.
 		item_list,	% The contents of the module and its imports
 		module_error	% Whether an error has been encountered
+				% when reading in this module.
 	).
 
-:- pred grab_imported_modules(string, item_list, module_imports, list(string), 
+% Some access predicates for the module_imports structure
+
+:- pred module_imports_get_module_name(module_imports, module_name).
+:- mode module_imports_get_module_name(in, out) is det.
+
+:- pred module_imports_get_items(module_imports, item_list).
+:- mode module_imports_get_items(in, out) is det.
+
+:- pred module_imports_set_items(module_imports, item_list, module_imports).
+:- mode module_imports_set_items(in, in, out) is det.
+
+:- pred module_imports_get_error(module_imports, module_error).
+:- mode module_imports_get_error(in, out) is det.
+
+:- pred module_imports_set_error(module_imports, module_error, module_imports).
+:- mode module_imports_set_error(in, in, out) is det.
+
+:- pred module_imports_set_indirect_deps(module_imports, list(module_name),
+				module_imports).
+:- mode module_imports_set_indirect_deps(in, in, out) is det.
+
+	% append_pseudo_decl(Module0, PseudoDecl, Module):
+	%	append the specified module declaration to the list
+	%	of items in Module0 to give Module.
+	%
+:- pred append_pseudo_decl(module_imports, module_defn, module_imports).
+:- mode append_pseudo_decl(in, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+
+	% grab_imported_modules(ModuleName, Items, Module, Error)
+	%	Given a module name and the list of items in that module,
+	%	read in the private interface files for all the parent modules,
+	%	the long interface files for all the imported modules,
+	%	and the short interface files for all the indirectly imported
+	%	modules, and return a `module_imports' structure containing the
+	%	relevant information.
+	%
+:- pred grab_imported_modules(module_name, item_list, module_imports,
 			module_error, io__state, io__state).
-:- mode grab_imported_modules(in, in, out, out, out, di, uo) is det.
+:- mode grab_imported_modules(in, in, out, out, di, uo) is det.
+
+	% grab_unqual_imported_modules(ModuleName, Items, Module, Error):
+	%	Similar to grab_imported_modules, but only reads in
+	%	the unqualified short interfaces (.int3s),
+	%	and the .int0 files for parent modules,
+	%	instead of reading the long interfaces and
+	%	qualified short interfaces (.int and int2s).
+	%	Does not set the `PublicChildren' or `FactDeps'
+	%	fields of the module_imports structure.
+
+:- pred grab_unqual_imported_modules(module_name, item_list, module_imports,
+			module_error, io__state, io__state).
+:- mode grab_unqual_imported_modules(in, in, out, out, di, uo) is det.
+
+	% process_module_long_interfaces(Imports, Ext, IndirectImports0,
+	%			IndirectImports, Module0, Module):
+	%  	Read the long interfaces for modules in Imports
+	%	(unless they've already been read in)
+	%	from files with filename extension Ext,
+	%	and append any imports/uses in those modules to the
+	%	IndirectImports list.
+	%
+:- pred process_module_long_interfaces(list(module_name), string,
+		list(module_name), list(module_name),
+		module_imports, module_imports,
+		io__state, io__state).
+:- mode process_module_long_interfaces(in, in, in, out, in, out, di, uo) is det.
+
+	% process_module_indirect_imports(IndirectImports, Ext,
+	%			Module0, Module):
+	%  	Read the short interfaces for modules in IndirectImports
+	%	(unless they've already been read in) and any
+	%	modules that those modules import (transitively),
+	%	from files with filename extension Ext.
+	%	Put them all in a `:- used.' section.
+	%
+:- pred process_module_indirect_imports(list(module_name), string,
+		module_imports, module_imports, io__state, io__state).
+:- mode process_module_indirect_imports(in, in, in, out, di, uo)
+		is det.
+
+	% process_module_short_interfaces_transitively(IndirectImports, Ext,
+	%			Module0, Module):
+	%  	Read the short interfaces for modules in IndirectImports
+	%	(unless they've already been read in) and any
+	%	modules that those modules import (transitively).
+	%
+:- pred process_module_short_interfaces_transitively(list(module_name),
+		string, module_imports, module_imports, io__state, io__state).
+:- mode process_module_short_interfaces_transitively(in, in, in, out, di, uo)
+		is det.
+
+	% process_module_short_interfaces(Modules, Ext,
+	%		IndirectImports0, IndirectImports, Module0, Module):
+	%  	Read the short interfaces for modules in Modules
+	%	(unless they've already been read in).
+	%	Append the modules imported by Modules to
+	%	IndirectImports0 to give IndirectImports.
+	%
+:- pred process_module_short_interfaces(list(module_name), string,
+		list(module_name), list(module_name),
+		module_imports, module_imports, io__state, io__state).
+:- mode process_module_short_interfaces(in, in, in, out, in, out, di, uo)
+		is det.
+
+%-----------------------------------------------------------------------------%
 
-	% write_dependency_file(ModuleName, LongDeps, ShortDeps, FactDeps
-	% 		MaybeTransOptDeps):
+	% write_dependency_file(Module, MaybeTransOptDeps):
 	%	Write out the per-module makefile dependencies (`.d') file
-	%	for a module `ModuleName' which depends directly on the
-	% 	modules `LongDeps' and indirectly on the modules `ShortDeps'.
-	%	FactDeps is the list of filenames of fact tables in the module.
-	%	MaybeTransOptDeps is a list of filenames which the
-	%	.trans_opt file may depend on.  This is set to no if the
+	%	for the specified module.
+	%	MaybeTransOptDeps is a list of module names which the
+	%	`.trans_opt' file may depend on.  This is set to `no' if the
 	%	dependency list is not available.
 	%
-:- pred write_dependency_file(string, list(string), list(string), list(string),
-				maybe(list(string)), io__state, io__state).
-:- mode write_dependency_file(in, in, in, in, in, di, uo) is det.
+:- pred write_dependency_file(module_imports, maybe(list(module_name)),
+				io__state, io__state).
+:- mode write_dependency_file(in, in, di, uo) is det.
 
 	%	maybe_read_dependency_file(ModuleName, MaybeTransOptDeps).
 	%	If transitive intermodule optimization has been enabled,
 	%	then read <ModuleName>.d to find the modules which
 	%	<ModuleName>.trans_opt may depend on.  Otherwise return
 	%	`no'.
-:- pred maybe_read_dependency_file(string, maybe(list(string)), io__state,
-	io__state).
+:- pred maybe_read_dependency_file(module_name, maybe(list(module_name)),
+		io__state, io__state).
 :- mode maybe_read_dependency_file(in, out, di, uo) is det.
 
+%-----------------------------------------------------------------------------%
+
 	% generate_dependencies(ModuleName):
 	%	Generate the per-program makefile dependencies (`.dep') file
 	%	for a program whose top-level module is `ModuleName'.
 	%	This involves first transitively reading in all imported
-	%	modules.  While we're at it, we also save the per-module
-	%	makefile dependency (`.d') files for all those modules.
+	%	or ancestor modules.  While we're at it, we also save the
+	%	per-module makefile dependency (`.d') files for all those
+	%	modules.
 	%
-:- pred generate_dependencies(string, io__state, io__state).
+:- pred generate_dependencies(module_name, io__state, io__state).
 :- mode generate_dependencies(in, di, uo) is det.
 
 	% get_dependencies(Items, ImportDeps, UseDeps).
@@ -125,22 +272,22 @@
 	%	ImportDeps is the list of modules imported using
 	% 	`:- import_module', UseDeps is the list of modules imported
 	%	using `:- use_module'.
+	%	N.B. Typically you also need to consider the module's
+	%	parent modules (see get_ancestors/2) and possibly
+	%	also the module's child modules (see get_children/2).
 	%
-:- pred get_dependencies(item_list, list(string), list(string)).
+:- pred get_dependencies(item_list, list(module_name), list(module_name)).
 :- mode get_dependencies(in, out, out) is det.
 
+	% get_ancestors(ModuleName, ParentDeps):
+	%	ParentDeps is the list of ancestor modules for this
+	%	module, oldest first (e.g. if the ModuleName is 
+	%	`foo:bar:baz', then ParentDeps would be [`foo', `foo:bar']).
+	%
+:- pred get_ancestors(module_name, list(module_name)).
+:- mode get_ancestors(in, out) is det.
 
-	% process_module_interfaces(DirectImports, IndirectImports, 
-	% 			Module0, Module)
-	%  	Read the long interfaces for the modules in DirectImports
-	%	then read the short interfaces for modules in IndirectImports
-	% 	and modules indirectly imported from DirectImports, taking
-	%	care not to read both the long and short interfaces for 
-	%	a module.
-:- pred process_module_interfaces(list(string), list(string),
-				module_imports, module_imports,
-				io__state, io__state).
-:- mode process_module_interfaces(in, in, in, out, di, uo) is det.
+%-----------------------------------------------------------------------------%
 
 	% touch_interface_datestamp(ModuleName, Ext).
 	%
@@ -148,7 +295,7 @@
 	% are used to record when each of the interface files was last
 	% updated.
 
-:- pred touch_interface_datestamp(string, string, io__state, io__state).
+:- pred touch_interface_datestamp(module_name, string, io__state, io__state).
 :- mode touch_interface_datestamp(in, in, di, uo) is det.
 
 	% update_interface(FileName)
@@ -159,6 +306,8 @@
 :- pred update_interface(string, io__state, io__state).
 :- mode update_interface(in, di, uo) is det.
 
+%-----------------------------------------------------------------------------%
+
 	% Check whether a particular `pragma' declaration is allowed
 	% in the interface section of a module.
 
@@ -169,55 +318,101 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module passes_aux, prog_out, mercury_to_mercury.
+:- import_module passes_aux, prog_out, prog_util, mercury_to_mercury.
 :- import_module prog_io_util, globals, options, intermod, module_qual.
-:- import_module bool, string, set, map, term, varset, dir, std_util, library.
+
+:- import_module string, set, map, term, varset, dir, library.
 :- import_module assoc_list, relation, char, require.
 
+%-----------------------------------------------------------------------------%
+
+	% 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, BaseFileName) :-
+	prog_out__sym_name_to_string(ModuleName, ".", BaseFileName).
+
+file_name_to_module_name(FileName, ModuleName) :-
+	string_to_sym_name(FileName, ".", ModuleName).
+
+%-----------------------------------------------------------------------------%
+
+	% Read in the .int3 files that the current module depends on,
+	% and use these to qualify all the declarations
+	% as much as possible. Then write out the .int0 file.
+make_private_interface(ModuleName, Items0) -->
+	grab_unqual_imported_modules(ModuleName, Items0, Module, Error),
+		%
+		% Check whether we succeeded
+		%
+	{ module_name_to_file_name(ModuleName, BaseFileName) },
+	( { Error = yes } ->
+		io__write_strings(["Error reading interface files.\n",
+				"`", BaseFileName, ".int0' not written.\n"])
+	;
+			%
+			% Module-qualify all items.
+			%
+		{ module_imports_get_items(Module, Items1) },
+		module_qual__module_qualify_items(Items1,
+				Items2, ModuleName, yes, _, _, _, _),
+		io__get_exit_status(Status),
+		( { Status \= 0 } ->
+			io__write_strings(["`", BaseFileName, ".int0' ",
+				"not written.\n"])
+		;
+				%
+				% Write out the `.int0' file.
+				%
+			{ strip_imported_items(Items2, [], Items3) },
+			{ strip_clauses_from_interface(Items3, Items) },
+			write_interface_file(ModuleName, ".int0", Items),
+			touch_interface_datestamp(ModuleName, ".date0")
+		)
+	).
+
 	% Read in the .int3 files that the current module depends on,
 	% and use these to qualify all items in the interface as much as
 	% possible. Then write out the .int and .int2 files.
 make_interface(ModuleName, Items0) -->
-		% Get interface, including imports.
-	{ get_interface(Items0, yes, InterfaceItems0) },
-	{ term__context_init(Context) },
-	{ varset__init(Varset) },
-	{ get_dependencies(InterfaceItems0, 
-		InterfaceImportDeps, InterfaceUseDeps) },
-	{ list__append(InterfaceItems0,
-			[module_defn(Varset, imported) - Context],
-			InterfaceItems1) },
-	{ Module1 = module_imports(ModuleName, [], [], InterfaceItems1, no) },
-		% Get the .int3s that the current .int depends on.
-	process_module_short_interfaces(
-			["mercury_builtin" | InterfaceImportDeps],
-			".int3", Module1, Module2),
-	{ Module2 = module_imports(_, Direct2, Indirect2,
-			InterfaceItems2, Error2) },
-	{ list__append(InterfaceItems2,
-			[module_defn(Varset, used) - Context],
-			InterfaceItems3) },
-	{ Module3 = module_imports(ModuleName, Direct2, Indirect2,
-			InterfaceItems3, Error2) },
-	process_module_short_interfaces(InterfaceUseDeps,
-			".int3", Module3, Module4),
-
-	{ Module4 = module_imports(_, _, _, InterfaceItems4, Error) },
+	{ get_interface(Items0, no, InterfaceItems0) },
+		% 
+		% Get the .int3 files for imported modules
+		%
+	grab_unqual_imported_modules(ModuleName, InterfaceItems0,
+		Module0, Error),
+
+		%
+		% Check whether we succeeded
+		%
+	{ module_name_to_file_name(ModuleName, BaseFileName) },
+	{ module_imports_get_items(Module0, InterfaceItems1) },
 	( { Error = yes } ->
 		io__write_strings(["Error reading short interface files.\n",
-				ModuleName, ".int and ",
-				ModuleName, ".int2 not written.\n"])
+				"`", BaseFileName, ".int' and ",
+				"`", BaseFileName, ".int2' not written.\n"])
 	;
-			% Qualify all items.
-		module_qual__module_qualify_items(InterfaceItems4,
-				InterfaceItems5, ModuleName, yes, _, _, _, _),
+			%
+			% Module-qualify all items.
+			%
+		module_qual__module_qualify_items(InterfaceItems1,
+				InterfaceItems2, ModuleName, yes, _, _, _, _),
 		io__get_exit_status(Status),
 		( { Status \= 0 } ->
-			io__write_strings([ModuleName, ".int not written.\n"])
+			io__write_strings(["`", BaseFileName, ".int' ",
+				"not written.\n"])
 		;
-			{ strip_imported_items(InterfaceItems5, [],
-							InterfaceItems6) },
-			check_for_clauses_in_interface(InterfaceItems6,
+			%
+			% Strip out the imported interfaces,
+			% check for some warnings, and then 
+			% write out the `.int' and `int2' files
+			% and touch the `.date' file.
+			%
+			{ strip_imported_items(InterfaceItems2, [],
+							InterfaceItems3) },
+			check_for_clauses_in_interface(InterfaceItems3,
 							InterfaceItems),
 			check_for_no_exports(InterfaceItems, ModuleName),
 			write_interface_file(ModuleName, ".int",
@@ -241,6 +436,7 @@
 	write_interface_file(ModuleName, ".int3", ShortInterfaceItems),
 	touch_interface_datestamp(ModuleName, ".date3").
 
+%-----------------------------------------------------------------------------%
 
 :- pred strip_imported_items(item_list::in, item_list::in,
 						item_list::out) is det.
@@ -255,7 +451,6 @@
 	;
 		strip_imported_items(Rest, [Item - Context | Items0], Items)
 	).
-%-----------------------------------------------------------------------------%
 
 :- pred check_for_clauses_in_interface(item_list, item_list,
 					io__state, io__state).
@@ -284,6 +479,47 @@
 		check_for_clauses_in_interface(Items0, Items1)
 	).
 
+% strip_clauses_from_interface is the same as check_for_clauses_in_interface
+% except that it doesn't issue any warnings, and that it also strips out
+% the `:- interface' and `:- implementation' declarations.
+%
+% This is used when creating the private interface (`.int0') files
+% for packages with sub-modules.
+
+:- pred strip_clauses_from_interface(item_list, item_list).
+:- mode strip_clauses_from_interface(in, out) is det.
+
+strip_clauses_from_interface(Items0, Items) :-
+	split_clauses_and_decls(Items0, _Clauses, Items).
+
+
+:- pred split_clauses_and_decls(item_list, item_list, item_list).
+:- mode split_clauses_and_decls(in, out, out) is det.
+
+split_clauses_and_decls([], [], []).
+split_clauses_and_decls([ItemAndContext0 | Items0],
+		ClauseItems, InterfaceItems) :-
+	ItemAndContext0 = Item0 - _Context,
+	(
+		( Item0 = module_defn(_, interface)
+		; Item0 = module_defn(_, implementation)
+		)
+	->
+		split_clauses_and_decls(Items0, ClauseItems, InterfaceItems)
+	;
+		( Item0 = pred_clause(_,_,_,_)
+		; Item0 = func_clause(_,_,_,_,_)
+		; Item0 = pragma(Pragma),
+		  pragma_allowed_in_interface(Pragma, no)
+		)
+	->
+		split_clauses_and_decls(Items0, ClauseItems1, InterfaceItems),
+		ClauseItems = [ItemAndContext0 | ClauseItems1]
+	;
+		split_clauses_and_decls(Items0, ClauseItems, InterfaceItems1),
+		InterfaceItems = [ItemAndContext0 | InterfaceItems1]
+	).
+
 % pragma `obsolete', `terminates', `does_not_terminate' 
 % `termination_info' and `check_termination' declarations
 % are supposed to go in the interface,
@@ -313,7 +549,7 @@
 pragma_allowed_in_interface(does_not_terminate(_, _), yes).
 pragma_allowed_in_interface(check_termination(_, _), yes).
 
-:- pred check_for_no_exports(item_list, string, io__state, io__state).
+:- pred check_for_no_exports(item_list, module_name, io__state, io__state).
 :- mode check_for_no_exports(in, in, di, uo) is det.
 
 check_for_no_exports([], ModuleName) -->
@@ -331,7 +567,7 @@
 		[]
 	).
 
-:- pred warn_no_exports(string, io__state, io__state).
+:- pred warn_no_exports(module_name, io__state, io__state).
 :- mode warn_no_exports(in, di, uo) is det.
 
 warn_no_exports(ModuleName) -->
@@ -339,8 +575,13 @@
 	( 	
 		{ ExportWarning = yes }
 	->
-		report_warning(ModuleName, 1,
-			"interface does not export anything."),
+		{ module_name_to_file_name(ModuleName, BaseFileName) },
+		{ string__append(BaseFileName, ".m", FileName) },
+		{ sym_name_to_string(ModuleName, ModuleNameString) },
+		{ string__append_list(["interface for module `",
+			ModuleNameString, "' does not export anything."],
+			Message) },
+		report_warning(FileName, 1, Message),
 		globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
 		(
 			{ VerboseErrors = yes }
@@ -362,25 +603,25 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred write_interface_file(string, string, item_list, io__state, io__state).
+:- pred write_interface_file(module_name, string, item_list, io__state, io__state).
 :- mode write_interface_file(in, in, in, di, uo) is det.
 
 write_interface_file(ModuleName, Suffix, InterfaceItems) -->
 
-		% create <Module>.int.tmp
+		% create (e.g.) `foo.int.tmp'
 
-	{ string__append(ModuleName, Suffix, OutputFileName) },
+	{ module_name_to_file_name(ModuleName, BaseFileName) },
+	{ string__append(BaseFileName, Suffix, OutputFileName) },
 	{ string__append(OutputFileName, ".tmp", TmpOutputFileName) },
-	{ dir__basename(ModuleName, BaseModuleName) },
 
 		% we need to add a `:- interface' declaration at the start
 		% of the item list
 	{ varset__init(VarSet) },
-	{ term__context_init(ModuleName, 0, Context) },
+	{ term__context_init(BaseFileName, 0, Context) },
 	{ InterfaceDeclaration = module_defn(VarSet, interface) - Context },
 	{ InterfaceItems1 = [InterfaceDeclaration | InterfaceItems] },
 
-	convert_to_mercury(BaseModuleName, TmpOutputFileName, InterfaceItems1),
+	convert_to_mercury(ModuleName, TmpOutputFileName, InterfaceItems1),
 	update_interface(OutputFileName).
 
 		% invoke the shell script `mercury_update_interface'
@@ -406,7 +647,8 @@
 %-----------------------------------------------------------------------------%
 
 touch_interface_datestamp(ModuleName, Ext) -->
-	{ string__append(ModuleName, Ext, OutputFileName) },
+	{ module_name_to_file_name(ModuleName, BaseFileName) },
+	{ string__append(BaseFileName, Ext, OutputFileName) },
 
 	globals__io_lookup_bool_option(verbose, Verbose),
 	maybe_write_string(Verbose, "% Touching `"),
@@ -427,94 +669,318 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-grab_imported_modules(ModuleName, Items0, Module, FactDeps, Error) -->
-	{ get_dependencies(Items0, ImportedModules, UsedModules0) },
-
-	{ set__list_to_set(ImportedModules, ImportedSet) },
-	{ set__list_to_set(UsedModules0, UsedSet) },
-
-	{ set__intersect(ImportedSet, UsedSet, BothSet) },
-
-	% Report errors for modules imported using both :- use_module
-	% and :- import_module. Remove the import_module declaration.
-	{ string__append(ModuleName, ".m", FileName) },
-	{ term__context_init(FileName, 0, Context) },
-	( { set__empty(BothSet) } ->
-		{ UsedModules = UsedModules0 }
-	;
-		prog_out__write_context(Context),
-		io__write_string("Warning:"),
-		{ set__to_sorted_list(BothSet, BothList) },
-		( { BothList = [_] } ->
-			io__write_string(" module "),
-			prog_out__write_module_list(BothList),
-			io__write_string(" is ")
-		;
-			io__write_string(" modules "),
-			prog_out__write_module_list(BothList),
-			io__write_string(" are ")
-		),
-		io__write_string("imported using both\n"),
-		prog_out__write_context(Context),
-		io__write_string("  `:- import_module' and `:- use_module' declarations.\n"),
-
-		% Treat the modules with both types of import as if they 
-		% were imported using :- import_module.
-		{ list__delete_elems(UsedModules0, BothList,
-			UsedModules) },
-		globals__io_lookup_bool_option(halt_at_warn, Halt),
-		( { Halt = yes } ->
-			io__set_exit_status(1)
-		;
-			[]
-		)
-	),
+grab_imported_modules(ModuleName, Items0, Module, Error) -->
+		%
+		% Find out which modules this one depends on
+		%
+	{ get_ancestors(ModuleName, AncestorModules) },
+	{ get_dependencies(Items0, ImportedModules0, UsedModules0) },
+
+	warn_if_import_self_or_ancestor(ModuleName, AncestorModules,
+		ImportedModules0, UsedModules0),
+
+	warn_if_duplicate_use_import_decls(ModuleName,
+		ImportedModules0, ImportedModules1,
+		UsedModules0, UsedModules1),
 
 	{ get_fact_table_dependencies(Items0, FactDeps) },
+	{ get_interface(Items0, no, InterfaceItems) },
+	{ get_children(InterfaceItems, PublicChildren) },
+	{ init_module_imports(ModuleName, Items0, PublicChildren, FactDeps,
+		Module0) },
+
+		% If this module has any seperately-compiled sub-modules,
+		% then we need to make everything in this module exported.
+	{ get_children(Items0, Children) },
+	{ Children = [] ->
+		Module1 = Module0
+	;
+		split_clauses_and_decls(Items0, Clauses, Decls),
+		make_pseudo_decl(interface, InterfaceDecl),
+		make_pseudo_decl(implementation, ImplementationDecl),
+		list__append([InterfaceDecl | Decls],
+			[ImplementationDecl | Clauses], Items1),
+		module_imports_set_items(Module0, Items1, Module1)
+	},
 
 		% We add a pseudo-declarations `:- imported' at the end
 		% of the item list. Uses of the items with declarations 
 		% following this do not need module qualifiers.
-	{ varset__init(VarSet) },
-	{ list__append(Items0,
-		[module_defn(VarSet, imported) - Context], Items1) },
-	{ dir__basename(ModuleName, BaseModuleName) },
-	{ Module1 = module_imports(BaseModuleName, [], [], Items1, no) },
+	{ append_pseudo_decl(Module1, imported, Module2) },
 
-		% Process the modules imported using `import_module'.
-	process_module_interfaces_2(["mercury_builtin" | ImportedModules], 
-		[], IndirectImports, Module1, Module2),
-	{ Module2 = module_imports(_, Direct2, Indirect2, Items2, Error2) },
+		% Add `mercury_builtin' to the list of imported modules
+	{ add_implicit_imports(ImportedModules1, UsedModules1,
+			ImportedModules2, UsedModules2) },
+
+		% Process the ancestor modules
+	process_module_private_interfaces(AncestorModules,
+		ImportedModules2, ImportedModules, UsedModules2, UsedModules,
+		Module2, Module3),
 
-		% We add a pseudo-declarations `:- used' at the end
-		% of the item list. Uses of the items with declarations 
-		% following this must be module qualified.
-	{ list__append(Items2,
-		[module_defn(VarSet, used) - Context], Items3) },
-	{ Module3 = module_imports(BaseModuleName, Direct2, Indirect2, 
-		Items3, Error2) },
+		% Process the modules imported using `import_module'.
+	{ IndirectImports0 = [] },
+	process_module_long_interfaces(ImportedModules, ".int",
+		IndirectImports0, IndirectImports1, Module3, Module4),
 
 		% Process the modules imported using `use_module' 
 		% and the short interfaces for indirectly imported
 		% modules. The short interfaces are treated as if
 		% they are imported using `use_module'.
-	process_module_interfaces(UsedModules, IndirectImports,
-		Module3, Module),
+	{ append_pseudo_decl(Module4, used, Module5) },
+	process_module_long_interfaces(UsedModules, ".int",
+		IndirectImports1, IndirectImports, Module5, Module6),
+	process_module_short_interfaces_transitively(IndirectImports, ".int2",
+		Module6, Module),
+
+	{ module_imports_get_error(Module, Error) }.
+
+% grab_unqual_imported_modules:
+%	like grab_imported_modules, but gets the `.int3' files
+%	instead of the `.int' and `.int2' files.
+
+grab_unqual_imported_modules(ModuleName, Items0, Module, Error) -->
+		%
+		% Find out which modules this one depends on
+		%
+	{ get_ancestors(ModuleName, ParentDeps) },
+	{ get_dependencies(Items0, ImportDeps0, UseDeps0) },
+
+		%
+		% Construct the initial module import structure,
+		% and append a `:- imported' decl to the items.
+		%
+	{ init_module_imports(ModuleName, Items0, [], [], Module0) },
+	{ append_pseudo_decl(Module0, imported, Module1) },
+
+		% Add `mercury_builtin' to the imported modules.
+	{ add_implicit_imports(ImportDeps0, UseDeps0, ImportDeps1, UseDeps1) },
+
+		%
+		% Get the .int3s and .int0s that the current module depends on.
+		%
+
+		% first the .int0s for parent modules
+	process_module_private_interfaces(ParentDeps,
+			ImportDeps1, ImportDeps, UseDeps1, UseDeps,
+			Module1, Module2),
+
+		% then the .int3s for `:- import'-ed modules
+	process_module_long_interfaces(ImportDeps, ".int3",
+			[], IndirectImportDeps0, Module2, Module3),
+
+		% then (after a `:- used' decl)
+		% the .int3s for `:- use'-ed modules
+		% and indirectly imported modules
+	{ append_pseudo_decl(Module3, used, Module4) },
+	process_module_long_interfaces(UseDeps, ".int3",
+			IndirectImportDeps0, IndirectImportDeps,
+			Module4, Module5),
+	process_module_short_interfaces_transitively(
+			IndirectImportDeps, ".int3", Module5, Module),
+
+	{ module_imports_get_error(Module, Error) }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred init_module_imports(module_name, item_list, list(module_name),
+				list(string), module_imports).
+:- mode init_module_imports(in, in, in, in, out) is det.
+
+init_module_imports(ModuleName, Items, PublicChildren, FactDeps, Module) :-
+	Module = module_imports(ModuleName, [], [], [], [],
+			PublicChildren, FactDeps, Items, no).
+
+module_imports_get_module_name(Module, ModuleName) :-
+	Module = module_imports(ModuleName, _, _, _, _, _, _, _, _).
+
+module_imports_get_items(Module, Items) :-
+	Module = module_imports(_, _, _, _, _, _, _, Items, _).
+
+module_imports_set_items(Module0, Items, Module) :-
+	Module0 = module_imports(A, B, C, D, E, F, G, _, I),
+	Module = module_imports(A, B, C, D, E, F, G, Items, I).
+
+module_imports_get_error(Module, Error) :-
+	Module = module_imports(_, _, _, _, _, _, _, _, Error).
+
+module_imports_set_error(Module0, Error, Module) :-
+	Module0 = module_imports(A, B, C, D, E, F, G, H, _),
+	Module = module_imports(A, B, C, D, E, F, G, H, Error).
+
+module_imports_set_indirect_deps(Module0, IndirectDeps, Module) :-
+	Module0 = module_imports(A, B, C, D, _, F, G, H, I),
+	Module = module_imports(A, B, C, D, IndirectDeps, F, G, H, I).
+
+append_pseudo_decl(Module0, PseudoDecl, Module) :-
+	Module0 = module_imports(ModuleName, Ancestors, IntDeps, ImplDeps,
+				IndirectDeps, PublicChildren, FactDeps,
+				Items0, Error),
+	make_pseudo_decl(PseudoDecl, Item),
+	list__append(Items0, [Item], Items),
+	Module = module_imports(ModuleName, Ancestors, IntDeps, ImplDeps,
+				IndirectDeps, PublicChildren, FactDeps,
+				Items, Error).
+
+:- pred make_pseudo_decl(module_defn, item_and_context).
+:- mode make_pseudo_decl(in, out) is det.
+make_pseudo_decl(PseudoDecl, Item) :-
+	term__context_init(Context),
+	varset__init(Varset),
+	Item = module_defn(Varset, PseudoDecl) - Context.
+
+%-----------------------------------------------------------------------------%
+
+:- pred add_implicit_imports(list(module_name), list(module_name),
+			list(module_name), list(module_name)).
+:- mode add_implicit_imports(in, in, out, out) is det.
+
+add_implicit_imports(ImportDeps0, UseDeps0, ImportDeps, UseDeps) :-
+	mercury_public_builtin_module(MercuryPublicBuiltin),
+	mercury_private_builtin_module(MercuryPrivateBuiltin),
+	ImportDeps = [MercuryPublicBuiltin | ImportDeps0],
+	( MercuryPrivateBuiltin = MercuryPublicBuiltin ->
+		UseDeps = UseDeps0
+	;
+		UseDeps = [MercuryPrivateBuiltin | UseDeps0]
+	).
+
+:- pred warn_if_import_self_or_ancestor(module_name, list(module_name),
+		list(module_name), list(module_name), 
+		io__state, io__state).
+:- mode warn_if_import_self_or_ancestor(in, in, in, in, di, uo) is det.
 
-	{ Module = module_imports(_, _, _, _, Error) }.
+% Warn if a module imports itself, or an ancestor.
+
+warn_if_import_self_or_ancestor(ModuleName, AncestorModules,
+		ImportedModules, UsedModules) -->
+	globals__io_lookup_bool_option(warn_simple_code, Warn),
+	( { Warn = yes } ->
+		(
+			{ list__member(ModuleName, ImportedModules)
+			; list__member(ModuleName, UsedModules)
+			}
+		->
+			{ module_name_to_file_name(ModuleName,
+				BaseFileName) },
+			{ string__append(BaseFileName, ".m",
+				FileName) },
+			{ term__context_init(FileName, 1, Context) },
+			prog_out__write_context(Context),
+			report_warning("Warning: module `"),
+			prog_out__write_sym_name(ModuleName),
+			io__write_string("' imports itself!\n")
+		;
+			[]
+		),
+		{ IsImportedAncestor = lambda([Import::out] is nondet, (
+			list__member(Import, AncestorModules),
+			( list__member(Import, ImportedModules)
+			; list__member(Import, UsedModules)
+			))) },
+		aggregate(IsImportedAncestor,
+			warn_imported_ancestor(ModuleName))
+	;
+		[]
+	).
+
+:- pred warn_imported_ancestor(module_name, module_name, io__state, io__state).
+:- mode warn_imported_ancestor(in, in, di, uo) is det.
+
+warn_imported_ancestor(ModuleName, AncestorName) -->
+	{ module_name_to_file_name(ModuleName, BaseFileName) },
+	{ string__append(BaseFileName, ".m", FileName) },
+	{ term__context_init(FileName, 1, Context) },
+	prog_out__write_context(Context),
+	report_warning("module `"),
+	prog_out__write_sym_name(ModuleName),
+	io__write_string("' imports its own ancestor,\n"),
+	prog_out__write_context(Context),
+	io__write_string("  module `"),
+	prog_out__write_sym_name(AncestorName),
+	io__write_string("'.\n"),
+	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+	( { VerboseErrors = yes } ->
+		io__write_strings([
+		"\tEvery sub-module implicitly imports its ancestors.\n",
+		"\tThere is no need to explicitly import them.\n"
+		])
+	;
+		[]
+	).
+
+:- pred warn_if_duplicate_use_import_decls(module_name, list(module_name),
+		list(module_name), list(module_name), list(module_name), 
+		io__state, io__state).
+:- mode warn_if_duplicate_use_import_decls(in, in, out, in, out, di, uo) is det.
+
+% Report warnings for modules imported using both `:- use_module'
+% and `:- import_module'.  Remove the unnecessary `:- use_module'
+% declarations.
+
+warn_if_duplicate_use_import_decls(ModuleName,
+		ImportedModules0, ImportedModules,
+		UsedModules0, UsedModules) -->
+	{ set__list_to_set(ImportedModules0, ImportedSet) },
+	{ set__list_to_set(UsedModules0, UsedSet) },
+	{ set__intersect(ImportedSet, UsedSet, BothSet) },
+	( { set__empty(BothSet) } ->
+		{ ImportedModules = ImportedModules0 },
+		{ UsedModules = UsedModules0 }
+	;
+		{ set__to_sorted_list(BothSet, BothList) },
+		globals__io_lookup_bool_option(warn_simple_code, WarnSimple),
+		( { WarnSimple = yes } ->
+			{ module_name_to_file_name(ModuleName, BaseFileName) },
+			{ string__append(BaseFileName, ".m", FileName) },
+			{ term__context_init(FileName, 1, Context) },
+			prog_out__write_context(Context),
+			io__write_string("Warning:"),
+			( { BothList = [_] } ->
+				io__write_string(" module "),
+				prog_out__write_module_list(BothList),
+				io__write_string(" is ")
+			;
+				io__write_string(" modules "),
+				prog_out__write_module_list(BothList),
+				io__write_string(" are ")
+			),
+			io__write_string("imported using both\n"),
+			prog_out__write_context(Context),
+			io__write_string("  `:- import_module' and "),
+			io__write_string("`:- use_module' declarations.\n"),
+
+			globals__io_lookup_bool_option(halt_at_warn, Halt),
+			( { Halt = yes } ->
+				io__set_exit_status(1)
+			;
+				[]
+			)
+		;
+			[]
+		),
+
+		% Treat the modules with both types of import as if they 
+		% were imported using `:- import_module.'
+		{ ImportedModules = ImportedModules0 },
+		{ list__delete_elems(UsedModules0, BothList, UsedModules) }
+	).
 
 %-----------------------------------------------------------------------------%
 
-write_dependency_file(ModuleName, LongDeps0, ShortDeps0, FactDeps0,
-		MaybeTransOptDeps) -->

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.



More information about the developers mailing list