diff: compiler support for nested modules

Fergus Henderson fjh at cs.mu.OZ.AU
Wed May 27 04:11:54 AEST 1998


Implement compiler support for nested sub-modules.
(Mmake support is still missing, so you have to compile by hand.
Also you must use `ml' to link rather `mmc', because
`mmc' doesn't link all the object files that it generates.)

compiler/prog_io.m:
	Fix a couple of bugs in the parsing of `module' and `end_module'
	declarations.

compiler/mercury_to_mercury.m:
	Handle output of `:- module' and `:- end_module' declarations.

compiler/modules.m:
	Add predicate split_into_submodules, which takes the item_list
	for a module and splits it into a list of item_lists for each
	submodule.

compiler/mercury_compile.m:
	Change the code for creating interface files and generating
	LLDS fragments so that it calls split_into_submodules and then
	iterates over each submodule.

That means that we now generate a seperate HLDS for each submodule, and
compile that to a seperate LLDS and a seperate C file.  It would be
more efficient to combine the LLDS fragments for each submodule after
code generation, generate a single C file, and thus only invoke the C
compiler once.  In view of this goal, I have done some cleaning up of
the HLDS/LLDS distinction, so that we don't need to pass the HLDS to
the various LLDS output routines.  (However, I haven't actually gotten
as far as combining the LLDS code fragments.)

compiler/llds.m:
	Add type `c_interface_info' which contains information from the
	HLDS that is used during the LLDS output pass.

compiler/mercury_compile.m:
	Add a predicate `get_c_interface_info' which gets the relevant
	info from the HLDS that is needed for LLDS output.

compiler/export.m:
	Add `export__get_c_export_decls', and rename
	`export__get_pragma_exported_procs' as `export__get_c_export_defns'.
	Change export__produce_header_file so that it takes a `c_export_decls'
	(part of the `c_interface_info') instead of an HLDS.

cvs diff  compiler/export.m compiler/llds.m compiler/mercury_compile.m compiler/mercury_to_mercury.m compiler/modules.m compiler/prog_io.m
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.21
diff -u -r1.21 export.m
--- export.m	1998/03/18 08:07:32	1.21
+++ export.m	1998/05/26 16:49:57
@@ -18,17 +18,26 @@
 
 :- interface.
 
-:- import_module hlds_module, prog_data.
+:- import_module hlds_module, prog_data, llds.
 :- import_module io, list, term.
 
-	% From the module_info, get a list of functions, each of which allows
-	% a call to be made to a Mercury procedure from C
-:- pred export__get_pragma_exported_procs(module_info, list(string)).
-:- mode export__get_pragma_exported_procs(in, out) is det.
+	% From the module_info, get a list of c_export_decls,
+	% each of which holds information about the declaration
+	% of a C function named in a `pragma export' declaration,
+	% which is used to allow a call to be made to a Mercury
+	% procedure from C.
+:- pred export__get_c_export_decls(module_info, c_export_decls).
+:- mode export__get_c_export_decls(in, out) is det.
+
+	% From the module_info, get a list of c_export_defns,
+	% each of which is a string containing the C code
+	% for defining a C function named in a `pragma export' decl.
+:- pred export__get_c_export_defns(module_info, c_export_defns).
+:- mode export__get_c_export_defns(in, out) is det.
 
 	% Produce a header file containing prototypes for the exported C
 	% functions
-:- pred export__produce_header_file(module_info, module_name,
+:- pred export__produce_header_file(c_export_decls, module_name,
 					io__state, io__state).
 :- mode export__produce_header_file(in, in, di, uo) is det.
 
@@ -57,14 +66,42 @@
 :- pred export__exclude_argument_type(type).
 :- mode export__exclude_argument_type(in) is semidet.
 
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- implementation.
 
-:- import_module code_gen, code_util, hlds_pred, llds, llds_out, modules.
+:- import_module code_gen, code_util, hlds_pred, llds_out, modules.
 
 :- import_module library, map, int, string, std_util, assoc_list, require.
 :- import_module bool.
 
-export__get_pragma_exported_procs(Module, ExportedProcsCode) :-
+%-----------------------------------------------------------------------------%
+
+export__get_c_export_decls(HLDS, C_ExportDecls) :-
+	module_info_get_predicate_table(HLDS, PredicateTable),
+	predicate_table_get_preds(PredicateTable, Preds),
+	module_info_get_pragma_exported_procs(HLDS, ExportedProcs),
+	export__get_c_export_decls_2(Preds, ExportedProcs, C_ExportDecls).
+
+:- pred export__get_c_export_decls_2(pred_table, list(pragma_exported_proc),
+	list(c_export_decl)).
+:- mode export__get_c_export_decls_2(in, in, out) is det.
+
+export__get_c_export_decls_2(_Preds, [], []).
+export__get_c_export_decls_2(Preds, [E|ExportedProcs], C_ExportDecls) :-
+	E = pragma_exported_proc(PredId, ProcId, C_Function),
+	get_export_info(Preds, PredId, ProcId, C_RetType,
+		_DeclareReturnVal, _FailureAction, _SuccessAction,
+		HeadArgInfoTypes),
+	get_argument_declarations(HeadArgInfoTypes, no, ArgDecls),
+	C_ExportDecl = c_export_decl(C_RetType, C_Function, ArgDecls),
+	export__get_c_export_decls_2(Preds, ExportedProcs, C_ExportDecls0),
+	C_ExportDecls = [C_ExportDecl | C_ExportDecls0].
+
+%-----------------------------------------------------------------------------%
+
+export__get_c_export_defns(Module, ExportedProcsCode) :-
 	module_info_get_pragma_exported_procs(Module, ExportedProcs),
 	module_info_get_predicate_table(Module, PredicateTable),
 	predicate_table_get_preds(PredicateTable, Preds),
@@ -442,13 +479,14 @@
 export__exclude_argument_type_2("io", "state", 0).	% io:state/0
 export__exclude_argument_type_2("store", "store", 1).	% store:store/1.
 
-export__produce_header_file(Module, ModuleName) -->
-	{ module_info_get_pragma_exported_procs(Module, ExportedProcs) },
+%-----------------------------------------------------------------------------%
+
+% Should this predicate go in llds_out.m?
+
+export__produce_header_file(C_ExportDecls, ModuleName) -->
 	(
-		{ ExportedProcs = [_|_] }
+		{ C_ExportDecls = [_|_] }
 	->
-		{ module_info_get_predicate_table(Module, PredicateTable) },
-		{ predicate_table_get_preds(PredicateTable, Preds) },
 		module_name_to_file_name(ModuleName, ".h", yes, FileName),
 		io__tell(FileName, Result),
 		(
@@ -479,7 +517,7 @@
 					"\n",
 					"#include ""mercury_imp.h""\n",
 					"\n"]),
-			export__produce_header_file_2(Preds, ExportedProcs),
+			export__produce_header_file_2(C_ExportDecls),
 			io__write_strings([
 					"\n",
 					"#ifdef __cplusplus\n",
@@ -501,16 +539,11 @@
 		[]
 	).
 
-:- pred export__produce_header_file_2(pred_table, list(pragma_exported_proc),
-	io__state, io__state).
-:- mode export__produce_header_file_2(in, in, di, uo) is det.
-export__produce_header_file_2(_Preds, []) --> [].
-export__produce_header_file_2(Preds, [E|ExportedProcs]) -->
-	{ E = pragma_exported_proc(PredId, ProcId, C_Function) },
-	{ get_export_info(Preds, PredId, ProcId, C_RetType,
-		_DeclareReturnVal, _FailureAction, _SuccessAction,
-		HeadArgInfoTypes) },
-	{ get_argument_declarations(HeadArgInfoTypes, no, ArgDecls) },
+:- pred export__produce_header_file_2(c_export_decls, io__state, io__state).
+:- mode export__produce_header_file_2(in, di, uo) is det.
+export__produce_header_file_2([]) --> [].
+export__produce_header_file_2([E|ExportedProcs]) -->
+	{ E = c_export_decl(C_RetType, C_Function, ArgDecls) },
 
 		% output the function header
 	io__write_string(C_RetType),
@@ -520,7 +553,7 @@
 	io__write_string(ArgDecls),
 	io__write_string(");\n"),
 
-	export__produce_header_file_2(Preds, ExportedProcs).
+	export__produce_header_file_2(ExportedProcs).
 
 	% Convert a term representation of a variable type to a string which
 	% represents the C type of the variable
@@ -538,3 +571,4 @@
 		Result = "Word"
 	).
 
+%-----------------------------------------------------------------------------%
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.223
diff -u -r1.223 llds.m
--- llds.m	1998/05/16 07:30:15	1.223
+++ llds.m	1998/05/26 15:40:12
@@ -26,12 +26,18 @@
 	;	model_semi		% just functional
 	;	model_non.		% not functional
 
-:- type c_file	
-	--->	c_file(
-			module_name,
-			c_header_info,
-			list(c_module)
-		).
+% c_interface_info holds information used when generating
+% code that uses the C interface.
+:- type c_interface_info
+	---> c_interface_info(
+		module_name,
+		% info about stuff imported from C:
+		c_header_info,
+		c_body_info,
+		% info about stuff exported to C:
+		c_export_decls,
+		c_export_defns
+	).
 
 :- type c_header_info 	==	list(c_header_code).	% in reverse order
 :- type c_body_info 	==	list(c_body_code).	% in reverse order
@@ -39,6 +45,30 @@
 :- type c_header_code	==	pair(string, term__context).
 :- type c_body_code	==	pair(string, term__context).
 
+:- type c_export_defns == list(c_export).
+:- type c_export_decls == list(c_export_decl).
+
+:- type c_export_decl
+	---> c_export_decl(
+		string,		% return type
+		string,		% function name
+		string		% argument declarations
+	).
+
+	% the code for `pragma export' is generated directly as strings
+	% by export.m.
+:- type c_export	==	string.
+
+%
+% The type `c_file' is the actual LLDS.
+%
+:- type c_file	
+	--->	c_file(
+			module_name,
+			c_header_info,
+			list(c_module)
+		).
+
 :- type c_module
 		% a bunch of low-level C code
 	--->	c_module(
@@ -79,10 +109,6 @@
 		).
 
 :- type llds_proc_id	==	int.
-
-	% the code for `pragma export' is generated directly as strings
-	% by export.m.
-:- type c_export	==	string.
 
 	% we build up instructions as trees and then flatten
 	% the tree to get a list.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.89
diff -u -r1.89 mercury_compile.m
--- mercury_compile.m	1998/05/20 17:57:55	1.89
+++ mercury_compile.m	1998/05/26 18:07:23
@@ -183,11 +183,14 @@
 	; { Error = yes, HaltSyntax = yes } ->
 		[]
 	; { MakeInterface = yes } ->
-		make_interface(ModuleName, Items0)
+		{ split_into_submodules(ModuleName, Items0, SubModuleList) },
+		list__foldl(make_interface, SubModuleList)
 	; { MakeShortInterface = yes } ->
-		make_short_interface(ModuleName, Items0)
+		{ split_into_submodules(ModuleName, Items0, SubModuleList) },
+		list__foldl(make_short_interface, SubModuleList)
 	; { MakePrivateInterface = yes } ->
-		make_private_interface(ModuleName, Items0)
+		{ split_into_submodules(ModuleName, Items0, SubModuleList) },
+		list__foldl(make_private_interface, SubModuleList)
 	; { ConvertToMercury = yes } ->
 		module_name_to_file_name(ModuleName, ".ugly", yes,
 					OutputFileName),
@@ -195,14 +198,39 @@
 	; { ConvertToGoedel = yes } ->
 		convert_to_goedel(ModuleName, Items0)
 	;
-		grab_imported_modules(ModuleName, Items0, Module, Error2),
-		( { Error2 \= fatal } ->
-			mercury_compile(Module)
-		;
-			[]
-		)
+		{ split_into_submodules(ModuleName, Items0, SubModuleList) },
+		list__foldl(compile, SubModuleList)
+
+		% XXX it would be better to do something like
+		%
+		%	list__map_foldl(compile_to_llds, SubModuleList,
+		%		LLDS_FragmentList),
+		%	merge_llds_fragments(LLDS_FragmentList, LLDS),
+		%	output_pass(LLDS_FragmentList)
+		%
+		% i.e. compile nested modules to a single C file.
 	).
 
+:- pred make_interface(pair(module_name, item_list), io__state, io__state).
+:- mode make_interface(in, di, uo) is det.
+
+make_interface(Module - Items) -->
+	make_interface(Module, Items).
+
+:- pred make_short_interface(pair(module_name, item_list),
+				io__state, io__state).
+:- mode make_short_interface(in, di, uo) is det.
+
+make_short_interface(Module - Items) -->
+	make_short_interface(Module, Items).
+
+:- pred make_private_interface(pair(module_name, item_list),
+				io__state, io__state).
+:- mode make_private_interface(in, di, uo) is det.
+
+make_private_interface(Module - Items) -->
+	make_private_interface(Module, Items).
+
 %-----------------------------------------------------------------------------%
 
 	% Given a fully expanded module (i.e. a module name and a list
@@ -218,6 +246,17 @@
 	% The initial arrangement has the stage numbers increasing by three
 	% so that new stages can be slotted in without too much trouble.
 
+:- pred compile(pair(module_name, item_list), io__state, io__state).
+:- mode compile(in, di, uo) is det.
+
+compile(ModuleName - Items0) -->
+	grab_imported_modules(ModuleName, Items0, Module, Error2),
+	( { Error2 \= fatal } ->
+		mercury_compile(Module)
+	;
+		[]
+	).
+
 :- pred mercury_compile(module_imports, io__state, io__state).
 :- mode mercury_compile(in, di, uo) is det.
 
@@ -1700,6 +1739,30 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
+%
+% Gather together the information from the HLDS that is
+% used for the C interface.  This stuff mostly just gets
+% passed directly to the LLDS unchanged, but we do do
+% a bit of code generation -- for example, we call
+% export__get_pragma_exported_procs here, which does the
+% generation of C code for `pragma export' declarations.
+%
+
+:- pred get_c_interface_info(module_info, c_interface_info).
+:- mode get_c_interface_info(in, out) is det.
+
+get_c_interface_info(HLDS, C_InterfaceInfo) :-
+	module_info_name(HLDS, ModuleName),
+	module_info_get_c_header(HLDS, C_HeaderCode),
+	module_info_get_c_body_code(HLDS, C_BodyCode),
+	export__get_c_export_decls(HLDS, C_ExportDecls),
+	export__get_c_export_defns(HLDS, C_ExportDefns),
+	C_InterfaceInfo = c_interface_info(ModuleName,
+		C_HeaderCode, C_BodyCode, C_ExportDecls, C_ExportDefns).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 % The LLDS output pass
 
 :- pred mercury_compile__output_pass(module_info, list(c_procedure),
@@ -1722,17 +1785,20 @@
 		set_bbbtree__init(StackLayoutLabelMap),
 		StaticData0 = BaseTypeLayouts
 	},
+	{ get_c_interface_info(HLDS, C_InterfaceInfo) },
 
 	{ llds_common(LLDS0, StaticData0, ModuleName, LLDS1, 
 		StaticData, CommonData) },
 
 	{ list__append(BaseTypeInfos, StaticData, AllData) },
-	mercury_compile__chunk_llds(HLDS, LLDS1, AllData, CommonData,
-		LLDS2, NumChunks),
+	mercury_compile__chunk_llds(C_InterfaceInfo, LLDS1, AllData,
+		CommonData, LLDS2, NumChunks),
 	mercury_compile__output_llds(ModuleName, LLDS2, StackLayoutLabelMap,
 		Verbose, Stats),
 
-	export__produce_header_file(HLDS, ModuleName),
+	{ C_InterfaceInfo = c_interface_info(_ModuleName,
+		_C_headerCode, _C_BodyCode, C_ExportDecls, _C_ExportDefns) },
+	export__produce_header_file(C_ExportDecls, ModuleName),
 
 	globals__io_lookup_bool_option(compile_to_c, CompileToC),
 	( { CompileToC = no } ->
@@ -1744,19 +1810,19 @@
 
 	% Split the code up into bite-size chunks for the C compiler.
 
-:- pred mercury_compile__chunk_llds(module_info, list(c_procedure),
+:- pred mercury_compile__chunk_llds(c_interface_info, list(c_procedure),
 	list(c_module), list(c_module), c_file, int, io__state, io__state).
 % :- mode mercury_compile__chunk_llds(in, di, di, uo, out, di, uo) is det.
 :- mode mercury_compile__chunk_llds(in, in, in, in, out, out, di, uo) is det.
 
-mercury_compile__chunk_llds(HLDS, Procedures, BaseTypeData, CommonDataModules,
+mercury_compile__chunk_llds(C_InterfaceInfo, Procedures, BaseTypeData,
+		CommonDataModules,
 		c_file(ModuleName, C_HeaderCode, ModuleList), NumChunks) -->
-	{ module_info_name(HLDS, ModuleName) },
+	{ C_InterfaceInfo = c_interface_info(ModuleName,
+		C_HeaderCode0, C_BodyCode0, C_ExportDecls, C_ExportDefns) },
 	{ 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) },
 	{ get_c_body_code(C_BodyCode0, C_BodyCode) },
 	( { ProcsPerFunc = 0 } ->
 		% ProcsPerFunc = 0 really means infinity -
@@ -1767,8 +1833,7 @@
 		{ mercury_compile__combine_chunks(ChunkList, ModName,
 			ProcModules) }
 	),
-	{ export__get_pragma_exported_procs(HLDS, PragmaExports) },
-	maybe_add_header_file_include(PragmaExports, ModuleName, C_HeaderCode0,
+	maybe_add_header_file_include(C_ExportDecls, ModuleName, C_HeaderCode0,
 		C_HeaderCode1),
 	globals__io_get_trace_level(TraceLevel),
 	( { TraceLevel = interface ; TraceLevel = full } ->
@@ -1779,20 +1844,20 @@
 		{ C_HeaderCode = C_HeaderCode1 }
 	),
 	{ list__condense([C_BodyCode, BaseTypeData, CommonDataModules,
-		ProcModules, [c_export(PragmaExports)]], ModuleList) },
+		ProcModules, [c_export(C_ExportDefns)]], ModuleList) },
 	{ list__length(ModuleList, NumChunks) }.
 
-:- pred maybe_add_header_file_include(list(c_export), module_name,
+:- pred maybe_add_header_file_include(c_export_decls, 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, ModuleName, 
+maybe_add_header_file_include(C_ExportDecls, ModuleName, 
 		C_HeaderCode0, C_HeaderCode) -->
 	(
-		{ PragmaExports = [] },
+		{ C_ExportDecls = [] },
 		{ C_HeaderCode = C_HeaderCode0 }
 	;
-		{ PragmaExports = [_|_] },
+		{ C_ExportDecls = [_|_] },
 		module_name_to_file_name(ModuleName, ".h", no, HeaderFileName),
                 globals__io_lookup_bool_option(split_c_files, SplitFiles),
                 { 
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.135
diff -u -r1.135 mercury_to_mercury.m
--- mercury_to_mercury.m	1998/05/20 13:10:02	1.135
+++ mercury_to_mercury.m	1998/05/26 17:28:47
@@ -540,6 +540,14 @@
 		io__write_string(":- include_module "),
 		mercury_write_module_spec_list(IncludedModules),
 		io__write_string(".\n")
+	; { ModuleDefn = module(Module) } ->
+		io__write_string(":- module "),
+		mercury_output_bracketed_sym_name(Module),
+		io__write_string(".\n")
+	; { ModuleDefn = end_module(Module) } ->
+		io__write_string(":- end_module "),
+		mercury_output_bracketed_sym_name(Module),
+		io__write_string(".\n")
 	;
 		% XXX unimplemented
 		io__write_string("% unimplemented module declaration\n")
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.71
diff -u -r1.71 modules.m
--- modules.m	1998/05/25 21:48:52	1.71
+++ modules.m	1998/05/26 17:22:10
@@ -210,6 +210,15 @@
 
 %-----------------------------------------------------------------------------%
 
+	% Given a module (well, a list of items), split it into
+	% its constituent sub-modules, in top-down order.
+
+:- pred split_into_submodules(module_name, item_list,
+				list(pair(module_name, item_list))).
+:- mode split_into_submodules(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,
@@ -2833,6 +2842,79 @@
 
 %-----------------------------------------------------------------------------%
 
+	% Given a module (well, a list of items), split it into
+	% its constituent sub-modules, in top-down order.
+
+split_into_submodules(ModuleName, Items0, ModuleList) :-
+	split_into_submodules_2(ModuleName, Items0, Items, ModuleList),
+	require(unify(Items, []), "modules.m: items after end_module").
+
+:- pred split_into_submodules_2(module_name, item_list, item_list,
+				list(pair(module_name, item_list))).
+:- mode split_into_submodules_2(in, in, out, out) is det.
+
+split_into_submodules_2(ModuleName, Items0, Items, ModuleList) :-
+	split_into_submodules_3(ModuleName, Items0, ThisModuleItems,
+		Items, SubModuleList),
+	ModuleList = [ModuleName - ThisModuleItems | SubModuleList].
+
+:- pred split_into_submodules_3(module_name, item_list, item_list, item_list,
+				list(pair(module_name, item_list))).
+:- mode split_into_submodules_3(in, in, out, out, out) is det.
+
+split_into_submodules_3(_ModuleName, [], [], [], []).
+split_into_submodules_3(ModuleName, [Item | Items1],
+		ThisModuleItems, OtherItems, SubModules) :-
+	(
+		%
+		% check for a `module' declaration, which signals
+		% the start of a nested module
+		%
+		Item = module_defn(VarSet, module(SubModuleName)) - Context
+	->
+		%
+		% parse in the items for the nested submodule
+		%
+		split_into_submodules_2(SubModuleName, Items1,
+			Items2, SubModules0),
+		%
+		% parse in the remaining items for this module
+		%
+		split_into_submodules_3(ModuleName, Items2,
+			ThisModuleItems0, Items3, SubModules1),
+		%
+		% replace the nested submodule with an `include_module'
+		% declaration
+		%
+		IncludeSubMod = module_defn(VarSet,
+			include_module([SubModuleName])) - Context,
+		ThisModuleItems = [IncludeSubMod | ThisModuleItems0],
+		OtherItems = Items3,
+		list__append(SubModules0, SubModules1, SubModules)
+	;
+		%
+		% check for a matching `end_module' declaration
+		%
+		Item = module_defn(_VarSet, end_module(ModuleName)) - _Context
+	->
+		%
+		% if so, thats the end of this module
+		%
+		ThisModuleItems = [],
+		OtherItems = Items1,
+		SubModules = []
+	;
+		%
+		% otherwise just parse the remaining items for this
+		% module and then put the current item back onto the
+		% front of the item list for this module
+		%
+		split_into_submodules_3(ModuleName, Items1,
+			ThisModuleItems0, Items2, SubModules),
+		ThisModuleItems = [Item | ThisModuleItems0],
+		OtherItems = Items2
+	).
+			
 	% Given a module (well, a list of items), extract the interface
 	% part of that module, i.e. all the items between `:- interface'
 	% and `:- implementation'. If IncludeImported is yes, also
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.170
diff -u -r1.170 prog_io.m
--- prog_io.m	1998/03/03 17:35:43	1.170
+++ prog_io.m	1998/05/26 17:42:49
@@ -588,14 +588,14 @@
 	; Item = module_defn(_VarSet, module(NestedModuleName)) ->
 		ModuleName = NestedModuleName,
 		SourceFileName = SourceFileName0,
-		Items1 = Items0
+		Items1 = [Item - Context | Items0]
 	; Item = module_defn(_VarSet, end_module(NestedModuleName)) ->
 		root_module_name(RootModuleName),
 		sym_name_get_module_name(NestedModuleName, RootModuleName,
 			ParentModuleName),
 		ModuleName = ParentModuleName,
 		SourceFileName = SourceFileName0,
-		Items1 = Items0
+		Items1 = [Item - Context | Items0]
 	;
 		SourceFileName = SourceFileName0,
 		ModuleName = ModuleName0,
@@ -894,7 +894,15 @@
 	).
 
 process_decl(DefaultModuleName, VarSet, "end_module", [ModuleName], Result) :-
-	parse_module_name(DefaultModuleName, ModuleName, R),
+	%
+	% The name in an `end_module' declaration not inside the
+	% scope of the module being ended, so the default module name
+	% here is the parent of the previous default module name.
+	%
+	root_module_name(RootModuleName),
+	sym_name_get_module_name(DefaultModuleName, RootModuleName,
+		ParentOfDefaultModuleName),
+	parse_module_name(ParentOfDefaultModuleName, ModuleName, R),
 	(	
 		R = ok(ModuleNameSym), 
 		Result = ok(module_defn(VarSet, end_module(ModuleNameSym)))
-- 
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