[m-dev.] for review: another partial module qualifiers bug fix

Fergus Henderson fjh at cs.mu.OZ.AU
Wed Jul 14 19:13:03 AEST 1999


Estimated hours taken: 8

Fix the remaining bugs with the handling of partial qualifiers
for nested modules.

compiler/module_qual.m:
	Define a new abstract type partial_qualifier_info, and a predicate
	mq_info_get_partial_qualifier_info to get this type from the mq_info.
	Define a new predicate get_partial_qualifiers/3 in module_qual.m
	which is like the old get_partial_qualifiers/2 predicate from
	modules.m except that it takes a partial_qualifier_info and
	uses the information in this to return only the partial qualifiers
	for modules which are visible, rather than returning all partial
	qualifier regardless of whether the modules that they refer to
	are in scope or not.

compiler/prog_util.m:
	Export the `insert_module_qualifier' predicate, for use in the
	definition of get_partial_qualifiers/3.

compiler/hlds_module.m:
compiler/make_hlds.m:
	Change the code for make_hlds__ctors_add and
	hlds_module__pred_table_insert/5 so that they handles partial
	qualifiers properly, computing the partial qualifiers by
	calling get_partial_qualifiers/3 rather than by checking the
	NeedQual variable and calling get_partial_qualifiers/2.

compiler/modules.m:
	Delete the old get_partial_qualifiers/2 predicate.

compiler/hlds_module.m:
	Add a new field to the HLDS containing the partial_qualifier_info.
	Add a partial_qualifier_info parameter to pred_table_insert/5.

compiler/check_typeclass.m:
compiler/make_hlds.m:
	When calling pred_table_insert/5, get the partial_qualifier_info
	from the HLDS and pass it as an extra argument.

tests/hard_coded/sub-modules/nested.m:
tests/hard_coded/sub-modules/nested3.m:
tests/hard_coded/sub-modules/parent.m:
tests/hard_coded/sub-modules/nested.exp:
tests/hard_coded/sub-modules/nested3.exp:
tests/hard_coded/sub-modules/parent.exp:
	Uncomment parts of these test cases which were previously
	commented out because they were not yet supported.

doc/reference_manual.texi:
	Delete the description of this bug.

Workspace: /home/mercury0/fjh/mercury-other
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.25
diff -u -r1.25 check_typeclass.m
--- check_typeclass.m	1999/06/30 17:12:15	1.25
+++ check_typeclass.m	1999/07/14 07:24:15
@@ -578,8 +578,11 @@
 	pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo),
 
 	module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
+	module_info_get_partial_qualifier_info(ModuleInfo0, PQInfo),
+	% XXX why do we need to pass may_be_unqualified here,
+	%     rather than passing must_be_qualified or calling the /4 version?
 	predicate_table_insert(PredicateTable0, PredInfo,
-		may_be_unqualified, PredId, PredicateTable),
+		may_be_unqualified, PQInfo, PredId, PredicateTable),
 	module_info_set_predicate_table(ModuleInfo0, PredicateTable,
 		ModuleInfo),
 
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.46
diff -u -r1.46 hlds_module.m
--- hlds_module.m	1999/07/12 06:21:19	1.46
+++ hlds_module.m	1999/07/14 08:06:42
@@ -21,7 +21,8 @@
 
 :- interface.
 
-:- import_module hlds_pred, hlds_data, prog_data, unify_proc, special_pred.
+:- import_module prog_data, module_qual.
+:- import_module hlds_pred, hlds_data, unify_proc, special_pred.
 :- import_module globals, llds.
 :- import_module relation, map, std_util, list, set, multi_map.
 
@@ -125,8 +126,9 @@
 	% Create an empty module_info for a given module name (and the
 	% global options).
 
-:- pred module_info_init(module_name, globals, module_info).
-:- mode module_info_init(in, in, out) is det.
+:- pred module_info_init(module_name, globals, partial_qualifier_info,
+		module_info).
+:- mode module_info_init(in, in, in, out) is det.
 
 :- pred module_info_get_predicate_table(module_info, predicate_table).
 :- mode module_info_get_predicate_table(in, out) is det.
@@ -147,14 +149,14 @@
 	module_info).
 :- mode module_info_set_special_pred_map(in, in, out) is det.
 
-% This junk field is unused... feel free to replace it.
+:- pred module_info_get_partial_qualifier_info(module_info,
+	partial_qualifier_info).
+:- mode module_info_get_partial_qualifier_info(in, out) is det.
+
+:- pred module_info_set_partial_qualifier_info(module_info,
+	partial_qualifier_info, module_info).
+:- mode module_info_set_partial_qualifier_info(in, in, out) is det.
 
-:- pred module_info_get_junk(module_info, unit).
-:- mode module_info_get_junk(in, out) is det.
-
-:- pred module_info_set_junk(module_info, unit, module_info).
-:- mode module_info_set_junk(in, in, out) is det.
-
 :- pred module_info_types(module_info, type_table).
 :- mode module_info_types(in, out) is det.
 
@@ -554,7 +556,7 @@
 			predicate_table,
 			proc_requests,
 			special_pred_map,
-			unit,		% junk (unused)
+			partial_qualifier_info,
 			type_table,
 			inst_table,
 			mode_table,
@@ -607,14 +609,13 @@
 
 	% A predicate which creates an empty module
 
-module_info_init(Name, Globals, ModuleInfo) :-
+module_info_init(Name, Globals, QualifierInfo, ModuleInfo) :-
 	predicate_table_init(PredicateTable),
 	unify_proc__init_requests(Requests),
 	map__init(UnifyPredMap),
 	map__init(Types),
 	inst_table_init(Insts),
 	mode_table_init(Modes),
-	Junk = unit,
 	map__init(Ctors),
 	set__init(StratPreds),
 	map__init(UnusedArgInfo),
@@ -637,7 +638,7 @@
 		[], [], StratPreds, UnusedArgInfo, 0, ModuleNames,
 		no_aditi_compilation, TypeSpecInfo),
 	ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
-		UnifyPredMap, Junk, Types, Insts, Modes, Ctors,
+		UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
 		ClassTable, SuperClassTable, InstanceTable, AssertionTable, 0).
 
 %-----------------------------------------------------------------------------%
@@ -801,7 +802,7 @@
 % B			predicate_table,
 % C			proc_requests,
 % D			special_pred_map,
-% E			unit,		% junk (unused)
+% E			partial_qualifier_info,
 % F			type_table,
 % G			inst_table,
 % H			mode_table,
@@ -832,7 +833,7 @@
 module_info_get_special_pred_map(MI0, D) :-
 	MI0 = module(_, _, _, D, _, _, _, _, _, _, _, _, _, _).
 
-module_info_get_junk(MI0, E) :-
+module_info_get_partial_qualifier_info(MI0, E) :-
 	MI0 = module(_, _, _, _, E, _, _, _, _, _, _, _, _, _).
 
 module_info_types(MI0, F) :-
@@ -882,7 +883,7 @@
 	MI0 = module(A, B, C, _, E, F, G, H, I, J, K, L, M, N),
 	MI  = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
 
-module_info_set_junk(MI0, E, MI) :-
+module_info_set_partial_qualifier_info(MI0, E, MI) :-
 	MI0 = module(A, B, C, D, _, F, G, H, I, J, K, L, M, N),
 	MI  = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
 
@@ -1499,18 +1500,21 @@
 				sym_name, arity, list(pred_id)) is semidet.
 :- mode predicate_table_search_pf_sym_arity(in, in, in, in, out) is semidet.
 
-	% predicate_table_insert(PredTable0, PredInfo, NeedQual, PredId,
-	% 		PredTable).
+	% predicate_table_insert(PredTable0, PredInfo,
+	%		NeedQual, PartialQualInfo, PredId, PredTable).
 	% 
 	% Insert PredInfo into PredTable0 and assign it a new pred_id.
 	% You should check beforehand that the pred doesn't already 
 	% occur in the table. 
-:- pred predicate_table_insert(predicate_table, pred_info, need_qualifier, 
-				pred_id, predicate_table).
-:- mode predicate_table_insert(in, in, in, out, out) is det.
-
-	% Equivalent to predicate_table_insert(PredTable0, PredInfo, 
-	%	yes, PredId, PredTable). 
+:- pred predicate_table_insert(predicate_table, pred_info, need_qualifier,
+		partial_qualifier_info, pred_id, predicate_table).
+:- mode predicate_table_insert(in, in, in, in, out, out) is det.
+
+	% Equivalent to predicate_table_insert/6, except that only the
+	% fully-qualified version of the predicate will be inserted into
+	% the predicate symbol table.  This is useful for creating
+	% compiler-generated predicates which will only ever be accessed
+	% via fully-qualified names.
 :- pred predicate_table_insert(predicate_table, pred_info, pred_id,
 				predicate_table).
 :- mode predicate_table_insert(in, in, out, out) is det.
@@ -1936,11 +1940,22 @@
 %-----------------------------------------------------------------------------%
 
 predicate_table_insert(PredicateTable0, PredInfo, PredId, PredicateTable) :-
-	predicate_table_insert(PredicateTable0, PredInfo, must_be_qualified,
-		PredId, PredicateTable).
+	predicate_table_insert_2(PredicateTable0, PredInfo,
+			must_be_qualified, no, PredId, PredicateTable).
 
-predicate_table_insert(PredicateTable0, PredInfo, NeedQual,
+predicate_table_insert(PredicateTable0, PredInfo, NeedQual, QualInfo,
 		PredId, PredicateTable) :-
+	predicate_table_insert_2(PredicateTable0, PredInfo,
+			NeedQual, yes(QualInfo),
+			PredId, PredicateTable).
+
+:- pred predicate_table_insert_2(predicate_table, pred_info, need_qualifier,
+		maybe(partial_qualifier_info), pred_id, predicate_table).
+:- mode predicate_table_insert_2(in, in, in, in, out, out) is det.
+
+predicate_table_insert_2(PredicateTable0, PredInfo, NeedQual, MaybeQualInfo,
+		PredId, PredicateTable) :-
+
 	PredicateTable0 = predicate_table(Preds0, NextPredId0, PredIds0,
 				Pred_N_Index0, Pred_NA_Index0, Pred_MNA_Index0,
 				Func_N_Index0, Func_NA_Index0, Func_MNA_Index0),
@@ -1957,8 +1972,9 @@
 	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
 	( 
 		PredOrFunc = predicate,
-		predicate_table_do_insert(Module, Name, Arity, NeedQual,
-			PredId, Pred_N_Index0, Pred_N_Index, 
+		predicate_table_do_insert(Module, Name, Arity,
+			NeedQual, MaybeQualInfo, PredId,
+			Pred_N_Index0, Pred_N_Index, 
 			Pred_NA_Index0, Pred_NA_Index,
 			Pred_MNA_Index0, Pred_MNA_Index),
 
@@ -1970,8 +1986,9 @@
 
 		FuncArity is Arity - 1,
 
-		predicate_table_do_insert(Module, Name, FuncArity, NeedQual,
-			PredId, Func_N_Index0, Func_N_Index, 
+		predicate_table_do_insert(Module, Name, FuncArity,
+			NeedQual, MaybeQualInfo, PredId,
+			Func_N_Index0, Func_N_Index, 
 			Func_NA_Index0, Func_NA_Index,
 			Func_MNA_Index0, Func_MNA_Index),
 
@@ -1990,20 +2007,16 @@
 				Pred_N_Index, Pred_NA_Index, Pred_MNA_Index,
 				Func_N_Index, Func_NA_Index, Func_MNA_Index).
 
-:- pred predicate_table_do_insert(module_name, string, arity, need_qualifier,
-	pred_id, name_index, name_index, name_arity_index, name_arity_index,
-	module_name_arity_index, module_name_arity_index).
-:- mode predicate_table_do_insert(in, in, in, in, in, 
+:- pred predicate_table_do_insert(module_name, string, arity,
+	need_qualifier, maybe(partial_qualifier_info),
+	pred_id, name_index, name_index, name_arity_index,
+	name_arity_index, module_name_arity_index, module_name_arity_index).
+:- mode predicate_table_do_insert(in, in, in, in, in, in,
 	in, out, in, out, in, out) is det.
 
-predicate_table_do_insert(Module, Name, Arity, NeedQual, PredId, 
-		N_Index0, N_Index, NA_Index0, NA_Index, 
+predicate_table_do_insert(Module, Name, Arity, NeedQual, MaybeQualInfo,
+		PredId, N_Index0, N_Index, NA_Index0, NA_Index, 
 		MNA_Index0, MNA_Index) :-
-
-	% XXX the code below doesn't handle mixing of
-	% `import_module' and `use_module' for
-	% parent & child modules properly.
-
 	( NeedQual = may_be_unqualified ->
 			% insert the unqualified name into the name index
 		multi_map__set(N_Index0, Name, PredId, N_Index),
@@ -2011,21 +2024,25 @@
 			% insert the unqualified name/arity into the
 			% name/arity index
 		NA = Name / Arity,
-		multi_map__set(NA_Index0, NA, PredId, NA_Index),
+		multi_map__set(NA_Index0, NA, PredId, NA_Index)
+	;
+		N_Index = N_Index0,
+		NA_Index = NA_Index0
+	),
 
+	( MaybeQualInfo = yes(QualInfo) ->
 			% insert partially module-qualified versions
 			% of the name into the module:name/arity index
-		get_partial_qualifiers(Module, PartialQuals),
+		get_partial_qualifiers(Module, QualInfo, PartialQuals),
 		list__map_foldl(lambda([AncModule::in, AncModule::out,
 				MNAs0::in, MNAs::out] is det,
 			insert_into_mna_index(AncModule, Name, Arity, PredId,
 					MNAs0, MNAs)),
 			PartialQuals, _, MNA_Index0, MNA_Index1)
 	;
-		N_Index = N_Index0,
-		NA_Index = NA_Index0,
 		MNA_Index1 = MNA_Index0
 	),
+
 		% insert the fully-qualified name into the
 		% module:name/arity index
 	insert_into_mna_index(Module, Name, Arity, PredId,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.298
diff -u -r1.298 make_hlds.m
--- make_hlds.m	1999/07/09 01:15:30	1.298
+++ make_hlds.m	1999/07/14 08:47:51
@@ -70,7 +70,8 @@
 parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module, 
 		UndefTypes, UndefModes) -->
 	globals__io_get_globals(Globals),
-	{ module_info_init(Name, Globals, Module0) },
+	{ mq_info_get_partial_qualifier_info(MQInfo0, PQInfo) },
+	{ module_info_init(Name, Globals, PQInfo, Module0) },
 	add_item_list_decls_pass_1(Items,
 		item_status(local, may_be_unqualified), Module0, Module1),
 	globals__io_lookup_bool_option(statistics, Statistics),
@@ -929,7 +930,7 @@
 			Procs, NewPredInfo),
 		module_info_get_predicate_table(ModuleInfo2, PredTable0),
 		predicate_table_insert(PredTable0, NewPredInfo,
-			must_be_qualified, NewPredId, PredTable),
+			NewPredId, PredTable),
 		module_info_set_predicate_table(ModuleInfo2,
 			PredTable, ModuleInfo3),
 
@@ -1710,8 +1711,10 @@
 			{ Body = du_type(ConsList, _, _, _) }
 		->
 			{ module_info_ctors(Module0, Ctors0) },
-			ctors_add(ConsList, TypeId, NeedQual, 
-				Context, Ctors0, Ctors),
+			{ module_info_get_partial_qualifier_info(Module0,
+				PQInfo) },
+			ctors_add(ConsList, TypeId, NeedQual, PQInfo, Context,
+				Ctors0, Ctors),
 			{ module_info_set_ctors(Module0, Ctors, Module1) }
 		;
 			{ Module1 = Module0 }
@@ -1889,17 +1892,24 @@
 convert_type_defn(eqv_type(Name, Args, Body), _, Name, Args, eqv_type(Body)).
 convert_type_defn(abstract_type(Name, Args), _, Name, Args, abstract_type).
 
-:- pred ctors_add(list(constructor), type_id, need_qualifier, prog_context, 
-			cons_table, cons_table, io__state, io__state).
-:- mode ctors_add(in, in, in, in, in, out, di, uo) is det.
+:- pred ctors_add(list(constructor), type_id, need_qualifier,
+		partial_qualifier_info, prog_context, cons_table, cons_table,
+		io__state, io__state).
+:- mode ctors_add(in, in, in, in, in, in, out, di, uo) is det.
 
-ctors_add([], _TypeId, _NeedQual, _Context, Ctors, Ctors) --> [].
-ctors_add([Ctor | Rest], TypeId, NeedQual, Context, Ctors0, Ctors) -->
+ctors_add([], _, _, _, _, Ctors, Ctors) --> [].
+ctors_add([Ctor | Rest], TypeId, NeedQual, PQInfo, Context, Ctors0, Ctors) -->
 	{ Ctor = ctor(ExistQVars, Constraints, Name, Args) },
 	{ make_cons_id(Name, Args, TypeId, QualifiedConsId) },
 	{ assoc_list__values(Args, Types) },
 	{ ConsDefn = hlds_cons_defn(ExistQVars, Constraints, Types, TypeId,
 				Context) },
+	%
+	% Insert the fully-qualified version of this cons_id into the
+	% cons_table.
+	% Also check that there is at most one definition of a given
+	% cons_id in each type.
+	%
 	(
 		{ map__search(Ctors0, QualifiedConsId, QualifiedConsDefns0) }
 	->
@@ -1928,29 +1938,29 @@
 	),
 	{ map__set(Ctors0, QualifiedConsId, QualifiedConsDefns, Ctors1) },
 
-	% XXX the code below does the wrong thing if you mix
-	% `import_module' and `use_module' declarations for
-	% parent and child modules.
-	% It assumes that all parents of an imported module were imported,
-	% and that all parents of a used module were used.
-
-	{
-		QualifiedConsId = cons(qualified(Module, ConsName), Arity),
-		NeedQual = may_be_unqualified
-	->
-		% Add unqualified version of the cons_id to the cons_table.
-		UnqualifiedConsId = cons(unqualified(ConsName), Arity),
-		multi_map__set(Ctors1, UnqualifiedConsId, ConsDefn, Ctors2),
+	{ QualifiedConsId = cons(qualified(Module, ConsName), Arity) ->
+		% Add unqualified version of the cons_id to the
+		% cons_table, if appropriate.
+		(
+			NeedQual = may_be_unqualified
+		->
+			UnqualifiedConsId = cons(unqualified(ConsName), Arity),
+			multi_map__set(Ctors1, UnqualifiedConsId, ConsDefn,
+				Ctors2)
+		;
+			Ctors2 = Ctors1
+		),
 
 		% Add partially qualified versions of the cons_id
-		get_partial_qualifiers(Module, PartialQuals),
+		get_partial_qualifiers(Module, PQInfo, PartialQuals),
 		list__map_foldl(add_ctor(ConsName, Arity, ConsDefn),
 			PartialQuals, _PartiallyQualifiedConsIds,
 			Ctors2, Ctors3)
 	;
-		Ctors3 = Ctors1
+		error("ctors_add: cons_id not qualified")
 	},
-	ctors_add(Rest, TypeId, NeedQual, Context, Ctors3, Ctors).
+
+	ctors_add(Rest, TypeId, NeedQual, PQInfo, Context, Ctors3, Ctors).
 
 :- pred add_ctor(string::in, int::in, hlds_cons_defn::in, module_name::in,
 		cons_id::out, cons_table::in, cons_table::out) is det.
@@ -2371,8 +2381,10 @@
 				{ Module = Module0 }
 			)
 		;
+			{ module_info_get_partial_qualifier_info(Module1,
+				PQInfo) },
 			{ predicate_table_insert(PredicateTable0, PredInfo0, 
-				NeedQual, PredId, PredicateTable1) },
+				NeedQual, PQInfo, PredId, PredicateTable1) },
 			( 
 				{ code_util__predinfo_is_builtin(PredInfo0) }
 			->
@@ -2543,7 +2555,7 @@
 		_),
 
 	module_info_get_predicate_table(Module0, PredicateTable0),
-	predicate_table_insert(PredicateTable0, PredInfo, may_be_unqualified, 
+	predicate_table_insert(PredicateTable0, PredInfo,
 		PredId, PredicateTable),
 	module_info_set_predicate_table(Module0, PredicateTable,
 		Module1),
@@ -2706,8 +2718,10 @@
 		\+ predicate_table_search_pf_sym_arity(PredicateTable0,
 			PredOrFunc, PredName, Arity, _)
 	->
+		module_info_get_partial_qualifier_info(ModuleInfo,
+			MQInfo),
 		predicate_table_insert(PredicateTable0, PredInfo, 
-			may_be_unqualified, PredId, PredicateTable)
+			may_be_unqualified, MQInfo, PredId, PredicateTable)
 	;	
 		error("preds_add_implicit")
 	).
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.47
diff -u -r1.47 module_qual.m
--- module_qual.m	1999/07/12 15:14:25	1.47
+++ module_qual.m	1999/07/14 08:41:43
@@ -51,6 +51,8 @@
 :- mode module_qual__qualify_type_qualification(in, out, in, in,
 		out, di, uo) is det.
 
+	% The type mq_info holds information needed for doing module
+	% qualification.
 :- type mq_info.
 
 :- pred mq_info_get_num_errors(mq_info::in, int::out) is det.
@@ -59,7 +61,41 @@
 :- pred mq_info_set_need_qual_flag(mq_info::in, 
 		need_qualifier::in, mq_info::out) is det.
 :- pred mq_info_get_need_qual_flag(mq_info::in, need_qualifier::out) is det.
+:- pred mq_info_get_partial_qualifier_info(mq_info::in,
+		partial_qualifier_info::out) is det.
 
+	% The type partial_qualifier_info holds info need for computing which
+	% partial quantifiers are visible -- see get_partial_qualifiers/3.
+:- type partial_qualifier_info.
+
+% Suppose we are processing a definition which defines the symbol
+% foo:bar:baz:quux/1.  Then we insert the following symbols
+% into the symbol table:
+%	- if the current value of the NeedQual flag at this point
+%		is `may_be_unqualified',
+%		i.e. module `foo:bar:baz' was imported
+%		then we insert the fully unqualified symbol quux/1;
+%	- if module `foo:bar:baz' occurs in the "imported" section,
+%		i.e. if module `foo:bar' was imported,
+%		then we insert the partially qualified symbol baz:quux/1;
+%	- if module `foo:bar' occurs in the "imported" section,
+%		i.e. if module `foo' was imported,
+%		then we insert the partially qualified symbol bar:baz:quux/1;
+%	- we always insert the fully qualified symbol foo:bar:baz:quux/1.
+%
+% The predicate `get_partial_qualifiers' returns all of the
+% partial qualifiers for which we need to insert definitions,
+% i.e. all the ones which are visible.  For example,
+% given as input `foo:bar:baz', it returns a list containing
+%	(1) `baz', iff `foo:bar' is imported
+% and 	(2) `bar:baz', iff `foo' is imported.
+% Note that the caller will still need to handle the fully-qualified
+% and fully-unqualified versions separately.
+
+:- pred get_partial_qualifiers(module_name, partial_qualifier_info,
+		list(module_name)).
+:- mode get_partial_qualifiers(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 :- implementation.
 
@@ -119,13 +155,20 @@
 				% explicitly module qualified.
 	).
 
+:- type partial_qualifier_info --->
+	partial_qualifier_info(module_id_set).
+
+mq_info_get_partial_qualifier_info(MQInfo, QualifierInfo) :-
+	mq_info_get_modules(MQInfo, ModuleIdSet),
+	QualifierInfo = partial_qualifier_info(ModuleIdSet).
+
 	% We only need to keep track of what is exported and what isn't,
 	% so we use a simpler data type here than hlds_pred__import_status.
 :- type import_status
 	--->	exported
 	;	not_exported.
 		
-	% The `module_eqv_map' field is unused junk -- feel free to replace it.
+	% The `junk' field is unused junk -- feel free to replace it.
 :- type junk == unit.
 
 	% Pass over the item list collecting all defined module, type, mode and
@@ -1451,5 +1494,78 @@
 	;
 		MatchingModules = []
 	).
+
+%-----------------------------------------------------------------------------%
+
+get_partial_qualifiers(ModuleName, PartialQualInfo, PartialQualifiers) :-
+	PartialQualInfo = partial_qualifier_info(ModuleIdSet),
+	(
+		ModuleName = unqualified(_),
+		PartialQualifiers = []
+	;
+		ModuleName = qualified(Parent, Child),
+		get_partial_qualifiers_2(Parent, unqualified(Child),
+			ModuleIdSet, [], PartialQualifiers)
+	).
+
+:- pred get_partial_qualifiers_2(module_name, module_name, module_id_set,
+		list(module_name), list(module_name)).
+:- mode get_partial_qualifiers_2(in, in, in, in, out) is det.
+
+get_partial_qualifiers_2(ImplicitPart, ExplicitPart, ModuleIdSet,
+		Qualifiers0, Qualifiers) :-
+	%
+	% if the ImplicitPart module was imported, rather than just being
+	% used, then insert the ExplicitPart module into the list of
+	% valid partial qualifiers.
+	%
+	( parent_module_is_imported(ImplicitPart, ExplicitPart, ModuleIdSet) ->
+		Qualifiers1 = [ExplicitPart | Qualifiers0]
+	;
+		Qualifiers1 = Qualifiers0
+	),
+	%
+	% recursively try to add the other possible partial qualifiers
+	%
+	( ImplicitPart = qualified(Parent, Child) ->
+		NextImplicitPart = Parent,
+		insert_module_qualifier(Child, ExplicitPart, NextExplicitPart),
+		get_partial_qualifiers_2(NextImplicitPart, NextExplicitPart,
+			ModuleIdSet, Qualifiers1, Qualifiers)
+	;
+		Qualifiers = Qualifiers1
+	).
+
+	% Check whether the parent module was imported, given the name of a
+	% child (or grandchild, etc.) module occurring in that parent module.
+	%
+:- pred parent_module_is_imported(module_name, module_name, module_id_set).
+:- mode parent_module_is_imported(in, in, in) is semidet.
+
+parent_module_is_imported(ParentModule, ChildModule, ModuleIdSet) :-
+	% Find the module name at the start of the ChildModule;
+	% this sub-module will be a direct sub-module of ParentModule
+	get_first_module_name(ChildModule, DirectSubModuleName),
+
+	% Check that the ParentModule was imported.
+	% We do this by looking up the definitions for the direct sub-module
+	% and checking that the one in ParentModule came from an
+	% imported module.
+	Arity = 0,
+	map__lookup(ModuleIdSet, DirectSubModuleName - Arity,
+			ImportModules - _UseModules),
+	set__member(ParentModule, ImportModules).
+
+	% Given a module name, possibly module-qualified,
+	% return the name of the first module in the qualifier list.
+	% e.g. given `foo:bar:baz', this returns `foo',
+	% and given just `baz', it returns `baz'.
+	%
+:- pred get_first_module_name(module_name, string).
+:- mode get_first_module_name(in, out) is det.
+
+get_first_module_name(unqualified(ModuleName), ModuleName).
+get_first_module_name(qualified(Parent, _), ModuleName) :-
+	get_first_module_name(Parent, ModuleName).
 
 %----------------------------------------------------------------------------%
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.100
diff -u -r1.100 modules.m
--- modules.m	1999/07/12 14:09:12	1.100
+++ modules.m	1999/07/14 08:02:06
@@ -432,14 +432,6 @@
 :- pred get_ancestors(module_name, list(module_name)).
 :- mode get_ancestors(in, out) is det.
 
-	% get_partial_qualifiers(ModuleName, PartialQualifiers):
-	%	PartialQualifiers is the list of partial module
-	%	qualifiers for ModuleName; e.g. if the ModuleName is 
-	%	`foo:bar:baz', then ParentDeps would be [`bar:baz', `baz']).
-	%
-:- pred get_partial_qualifiers(module_name, list(module_name)).
-:- mode get_partial_qualifiers(in, out) is det.
-
 %-----------------------------------------------------------------------------%
 
 	% touch_interface_datestamp(ModuleName, Ext).
@@ -3372,12 +3364,6 @@
 
 %-----------------------------------------------------------------------------%
 
-get_partial_qualifiers(unqualified(_), []).
-get_partial_qualifiers(qualified(ParentQual, ChildName),
-			[PartialQual | PartialQuals]) :-
-	drop_one_qualifier(ParentQual, ChildName, PartialQual),
-	get_partial_qualifiers(PartialQual, PartialQuals).
-	
 :- pred drop_one_qualifier(module_name, string, module_name).
 :- mode drop_one_qualifier(in, in, out) is det.
 
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.46
diff -u -r1.46 prog_util.m
--- prog_util.m	1999/07/08 05:08:56	1.46
+++ prog_util.m	1999/07/14 07:32:23
@@ -61,6 +61,12 @@
 :- pred match_sym_name(sym_name, sym_name).
 :- mode match_sym_name(in, in) is semidet.
 
+	% insert_module_qualifier(ModuleName, SymName0, SymName):
+	%	prepend the specified ModuleName onto the module
+	%	qualifiers in SymName0, giving SymName.
+:- pred insert_module_qualifier(string, sym_name, sym_name).
+:- mode insert_module_qualifier(in, in, out) is det.
+
         % Given a possible module qualified sym_name and a list of
 	% argument types and a context, construct a term. This is
 	% used to construct types. 
@@ -295,9 +301,6 @@
     ;
     	Result = unqualified(String)
     ).
-
-:- pred insert_module_qualifier(string, sym_name, sym_name).
-:- mode insert_module_qualifier(in, in, out) is det.
 
 insert_module_qualifier(ModuleName, unqualified(PlainName),
 		qualified(unqualified(ModuleName), PlainName)).
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.140
diff -u -r1.140 reference_manual.texi
--- reference_manual.texi	1999/06/30 17:13:18	1.140
+++ reference_manual.texi	1999/07/14 09:01:07
@@ -2849,10 +2849,6 @@
 
 @itemize @bullet
 @item
-If you mix an @samp{import_module} declaration for a parent module
-with a @samp{use_module} declaration for the child, or vice versa,
-then the compiler may report some spurious errors.
- at item
 The compiler sometimes reports spurious errors if you
 define an equivalence type in a sub-module and export it
 as abstract type.
Index: tests/hard_coded/sub-modules/nested.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/nested.exp,v
retrieving revision 1.1
diff -u -r1.1 nested.exp
--- nested.exp	1998/11/09 03:52:54	1.1
+++ nested.exp	1999/07/14 08:58:48
@@ -2,6 +2,7 @@
 nested:child:hello
 nested:child:hello
 nested:child2:hello
+nested:child2:hello
 t1 = nested:child:foo
 t2 = nested:child:foo
 t3 = nested:child:foo
Index: tests/hard_coded/sub-modules/nested.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/nested.m,v
retrieving revision 1.2
diff -u -r1.2 nested.m
--- nested.m	1999/07/12 15:14:30	1.2
+++ nested.m	1999/07/14 08:55:48
@@ -59,8 +59,7 @@
 	child:hello,
 	hello,
 	nested:child2:hello,
-	% child2:hello,		% XXX mixing of use_module and import_module
-				% is not yet supported.
+	child2:hello,
 
 	print("t1 = "), print(type_of(has_type_t1)), nl,
 	print("t2 = "), print(type_of(has_type_t2)), nl,
@@ -86,8 +85,6 @@
 has_type_t2 = child:bar.
 has_type_t3 = bar.
 has_type_t4 = nested:child2:bar.
-% has_type_t5 = child2:bar.  % XXX mixing of use_module and import_module
-			     % is not yet supported.
-has_type_t5 = nested:child2:bar.
+has_type_t5 = child2:bar.
 
 :- end_module nested.
Index: tests/hard_coded/sub-modules/nested3.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/nested3.exp,v
retrieving revision 1.1
diff -u -r1.1 nested3.exp
--- nested3.exp	1998/11/09 03:52:57	1.1
+++ nested3.exp	1999/07/14 08:58:50
@@ -2,6 +2,7 @@
 nested3:child:hello
 nested3:child:hello
 nested3:child2:hello
+nested3:child2:hello
 t1 = nested3:child:foo
 t2 = nested3:child:foo
 t3 = nested3:child:foo
Index: tests/hard_coded/sub-modules/nested3.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/nested3.m,v
retrieving revision 1.2
diff -u -r1.2 nested3.m
--- nested3.m	1999/07/12 15:14:30	1.2
+++ nested3.m	1999/07/14 08:54:49
@@ -64,8 +64,7 @@
 	child:hello,
 	hello,
 	nested3:child2:hello,
-	% child2:hello,		% XXX mixing of use_module and import_module
-				% is not yet supported.
+	child2:hello,
 
 	print("t1 = "), print(type_of(has_type_t1)), nl,
 	print("t2 = "), print(type_of(has_type_t2)), nl,
@@ -91,8 +90,6 @@
 has_type_t2 = child:bar.
 has_type_t3 = bar.
 has_type_t4 = nested3:child2:bar.
-% has_type_t5 = child2:bar.  % XXX mixing of use_module and import_module
-			     % is not yet supported.
-has_type_t5 = nested3:child2:bar.
+has_type_t5 = child2:bar.
 
 :- end_module nested3.
Index: tests/hard_coded/sub-modules/parent.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/parent.exp,v
retrieving revision 1.1
diff -u -r1.1 parent.exp
--- parent.exp	1998/11/09 03:53:04	1.1
+++ parent.exp	1999/07/14 08:58:19
@@ -2,6 +2,7 @@
 parent:child:hello
 parent:child:hello
 parent:child2:hello
+parent:child2:hello
 t1 = parent:child:foo
 t2 = parent:child:foo
 t3 = parent:child:foo
Index: tests/hard_coded/sub-modules/parent.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/parent.m,v
retrieving revision 1.2
diff -u -r1.2 parent.m
--- parent.m	1999/07/12 15:14:31	1.2
+++ parent.m	1999/07/14 08:54:26
@@ -25,8 +25,7 @@
 	child:hello,
 	hello,
 	parent:child2:hello,
-	% child2:hello,		% XXX mixing of use_module and import_module
-				% is not yet supported.
+	child2:hello,
 
 	print("t1 = "), print(type_of(has_type_t1)), nl,
 	print("t2 = "), print(type_of(has_type_t2)), nl,
@@ -52,7 +51,5 @@
 has_type_t2 = child:bar.
 has_type_t3 = bar.
 has_type_t4 = parent:child2:bar.
-% has_type_t5 = child2:bar.  % XXX mixing of use_module and import_module
-			     % is not yet supported.
-has_type_t5 = parent:child2:bar.
+has_type_t5 = child2:bar.

-- 
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.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list