diff: bug fix

[Simon TAYLOR]

Hi DJ,

Could you please review this.

Simon

Estimated hours taken: 1

Fix bugs where undefined modes were causing map__lookup failures.

compiler/mode_util.m
	Add mode_get_insts_semidet, which fails instead of aborting
	if the mode is undefined.

compiler/make_hlds.m
	Use mode_get_insts_semidet instead of mode_get_insts when 
	matching pragma c_code modes.

compiler/mercury_compile.m
compiler/typecheck.m
	Pass through whether there were undefined modes into typecheck.m.
	Only attempt to propagate type information into modes if there
	were no undefined mode errors.

tests/invalid/Mmake
tests/invalid/undef_mode.m
tests/invalid/undef_mode.err_exp
	Add a test case.	

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.229
diff -u -r1.229 make_hlds.m
--- make_hlds.m	1997/05/05 11:17:15	1.229
+++ make_hlds.m	1997/05/23 01:10:17
@@ -1789,8 +1789,10 @@
 
 mode_list_matches([], [], _).
 mode_list_matches([Mode1 | Modes1], [Mode2 | Modes2], ModuleInfo) :-
-	mode_get_insts(ModuleInfo, Mode1, Inst1, Inst2),
-	mode_get_insts(ModuleInfo, Mode2, Inst1, Inst2),
+	% Use mode_get_insts_semidet instead of mode_get_insts to avoid
+	% aborting if there are undefined modes.
+	mode_get_insts_semidet(ModuleInfo, Mode1, Inst1, Inst2),
+	mode_get_insts_semidet(ModuleInfo, Mode2, Inst1, Inst2),
 	mode_list_matches(Modes1, Modes2, ModuleInfo).
 
 %-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.37
diff -u -r1.37 mercury_compile.m
--- mercury_compile.m	1997/05/21 02:13:33	1.37
+++ mercury_compile.m	1997/05/21 07:35:09
@@ -379,7 +379,7 @@
 	    %
 	    % Next typecheck the clauses.
 	    %
-	    typecheck(HLDS1, HLDS3, FoundTypeError), !,
+	    typecheck(FoundUndefModeError, HLDS1, HLDS3, FoundTypeError), !,
 	    ( { FoundTypeError = yes } ->
 		maybe_write_string(Verbose,
 			"% Program contains type error(s).\n"),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.86
diff -u -r1.86 mode_util.m
--- mode_util.m	1997/05/05 11:17:19	1.86
+++ mode_util.m	1997/05/16 05:25:37
@@ -19,11 +19,16 @@
 :- import_module bool, list.
 
 	% mode_get_insts returns the initial instantiatedness and
-	% the final instantiatedness for a given mode.
+	% the final instantiatedness for a given mode, aborting
+	% if the mode is undefined.
 	%
 :- pred mode_get_insts(module_info, mode, inst, inst).
 :- mode mode_get_insts(in, in, out, out) is det.
 
+	% a version of mode_get_insts which fails if the mode is undefined
+:- pred mode_get_insts_semidet(module_info, mode, inst, inst).
+:- mode mode_get_insts_semidet(in, in, out, out) is semidet.
+
 	% a mode is considered input if the initial inst is bound
 :- pred mode_is_input(module_info, mode).
 :- mode mode_is_input(in, in) is semidet.
@@ -1296,17 +1301,28 @@
 	% mode_get_insts returns the initial instantiatedness and
 	% the final instantiatedness for a given mode.
 
-mode_get_insts(_ModuleInfo, (InitialInst -> FinalInst), InitialInst, FinalInst).
-mode_get_insts(ModuleInfo, user_defined_mode(Name, Args), Initial, Final) :-
+mode_get_insts_semidet(_ModuleInfo, (InitialInst -> FinalInst), 
+		InitialInst, FinalInst).
+mode_get_insts_semidet(ModuleInfo, user_defined_mode(Name, Args), 
+		Initial, Final) :-
 	list__length(Args, Arity),
 	module_info_modes(ModuleInfo, Modes),
 	mode_table_get_mode_defns(Modes, ModeDefns),
-	map__lookup(ModeDefns, Name - Arity, HLDS_Mode),
+	map__search(ModeDefns, Name - Arity, HLDS_Mode),
 	HLDS_Mode = hlds_mode_defn(_VarSet, Params, ModeDefn, _Cond,
 						_Context, _Status),
 	ModeDefn = eqv_mode(Mode0),
 	mode_substitute_arg_list(Mode0, Params, Args, Mode),
 	mode_get_insts(ModuleInfo, Mode, Initial, Final).
+
+mode_get_insts(ModuleInfo, Mode, Inst1, Inst2) :-
+	( mode_get_insts_semidet(ModuleInfo, Mode, Inst1a, Inst2a) ->
+		Inst1 = Inst1a,
+		Inst2 = Inst2a
+	;
+		error("mode_get_insts_semidet failed")
+	).
+
 
 	% mode_substitute_arg_list(Mode0, Params, Args, Mode) is true
 	% iff Mode is the mode that results from substituting all
Index: compiler/typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.203
diff -u -r1.203 typecheck.m
--- typecheck.m	1997/05/07 07:52:19	1.203
+++ typecheck.m	1997/05/21 07:50:29
@@ -112,19 +112,20 @@
 :- import_module hlds_module, hlds_pred.
 :- import_module bool, io.
 
-:- pred typecheck(module_info, module_info, bool, io__state, io__state).
-:- mode typecheck(in, out, out, di, uo) is det.
+:- pred typecheck(bool, module_info, module_info, bool, io__state, io__state).
+:- mode typecheck(in, in, out, out, di, uo) is det.
 
 /*
-	Formally, typecheck(Module0, Module, FoundError, IO0, IO) is
+	Formally, typecheck(ModeError, Module0, Module, FoundError, IO0, IO) is
 	intended to be true iff Module is Module0 annotated with the
 	variable typings that result from the process of type-checking,
 	FoundError is `yes' if Module0 contains any type errors and `no'
 	otherwise, and IO is the io__state that results from IO0 after
 	printing out appropriate error messages for the type errors in
-	Module0, if any.
+	Module0, if any. ModeError should be true if any undefined modes	
+	were found by previous passes.
 
-	Informally, typecheck(Module0, Module, FoundError, IO0, IO) 
+	Informally, typecheck(PropModes, Module0, Module, FoundError, IO0, IO) 
 	type-checks Module0 and annotates it with variable typings
 	(returning the result in Module), prints out appropriate error
 	messages, and sets FoundError to `yes' if it finds any errors
@@ -135,6 +136,8 @@
 	and not at the start of modecheck because modecheck may be
 	reinvoked after HLDS transformations. Any transformation that
 	needs typechecking should work with the clause_info structure.
+	Type information is also propagated into the modes of procedures
+	by this pass if the ModeError parameter is no. 
 */
 
 
@@ -173,14 +176,14 @@
 
 	% XXX need to pass FoundError to all steps
 
-typecheck(Module0, Module, FoundError) -->
+typecheck(ModeError, Module0, Module, FoundError) -->
 	globals__io_lookup_bool_option(statistics, Statistics),
 	globals__io_lookup_bool_option(verbose, Verbose),
 	io__stderr_stream(StdErr),
 	io__set_output_stream(StdErr, OldStream),
 
 	maybe_write_string(Verbose, "% Type-checking clauses...\n"),
-	check_pred_types(Module0, Module, FoundError),
+	check_pred_types(ModeError, Module0, Module, FoundError),
 	maybe_report_stats(Statistics),
 
 	io__set_output_stream(OldStream, _).
@@ -189,24 +192,25 @@
 
 	% Type-check the code for all the predicates in a module.
 
-:- pred check_pred_types(module_info, module_info, bool, io__state, io__state).
-:- mode check_pred_types(in, out, out, di, uo) is det.
+:- pred check_pred_types(bool, module_info, module_info, bool,
+		io__state, io__state).
+:- mode check_pred_types(in, in, out, out, di, uo) is det.
 
-check_pred_types(Module0, Module, FoundError) -->
+check_pred_types(ModeError, Module0, Module, FoundError) -->
 	{ module_info_predids(Module0, PredIds) },
-	typecheck_to_fixpoint(PredIds, Module0, Module, FoundError),
+	typecheck_to_fixpoint(PredIds, ModeError, Module0, Module, FoundError),
 	write_inference_messages(PredIds, Module).
 
 	% Repeatedly typecheck the code for a group of predicates
 	% until a fixpoint is reached, or until some errors are detected.
 
-:- pred typecheck_to_fixpoint(list(pred_id), module_info, module_info, bool,
-			io__state, io__state).
-:- mode typecheck_to_fixpoint(in, in, out, out, di, uo) is det.
-
-typecheck_to_fixpoint(PredIds, Module0, Module, FoundError) -->
-	typecheck_pred_types_2(PredIds, Module0, Module1, no, FoundError1, no,
-		Changed),
+:- pred typecheck_to_fixpoint(list(pred_id), bool, module_info, 
+		module_info, bool, io__state, io__state).
+:- mode typecheck_to_fixpoint(in, in, in, out, out, di, uo) is det.
+
+typecheck_to_fixpoint(PredIds, ModeError, Module0, Module, FoundError) -->
+	typecheck_pred_types_2(PredIds, ModeError, 
+		Module0, Module1, no, FoundError1, no, Changed),
 	( { Changed = no ; FoundError1 = yes } ->
 		{ Module = Module1 },
 		{ FoundError = FoundError1 }
@@ -217,20 +221,22 @@
 		;
 			[]
 		),
-		typecheck_to_fixpoint(PredIds, Module1, Module, FoundError)
+		typecheck_to_fixpoint(PredIds, ModeError,
+			Module1, Module, FoundError)
 	).
 
 %-----------------------------------------------------------------------------%
 
 	% Iterate over the list of pred_ids in a module.
 
-:- pred typecheck_pred_types_2(list(pred_id), module_info, module_info,
+:- pred typecheck_pred_types_2(list(pred_id), bool, module_info, module_info,
 	bool, bool, bool, bool, io__state, io__state).
-:- mode typecheck_pred_types_2(in, in, out, in, out, in, out, di, uo) is det.
+:- mode typecheck_pred_types_2(in, in, in, out,
+	in, out, in, out, di, uo) is det.
 
-typecheck_pred_types_2([], ModuleInfo, ModuleInfo, Error, Error,
-			Changed, Changed) --> [].
-typecheck_pred_types_2([PredId | PredIds],
+typecheck_pred_types_2([], _, ModuleInfo, ModuleInfo, 
+			Error, Error, Changed, Changed) --> [].
+typecheck_pred_types_2([PredId | PredIds], ModeError, 
 		ModuleInfo0, ModuleInfo, Error0, Error, Changed0, Changed) -->
 	{ module_info_preds(ModuleInfo0, Preds0) },
 	{ map__lookup(Preds0, PredId, PredInfo0) },
@@ -255,21 +261,11 @@
 		Changed2 = Changed0
 		}
 	;
-		typecheck_pred_type(PredId, PredInfo0, ModuleInfo0,
-			MaybePredInfo, Changed1),
+		typecheck_pred_type(PredId, PredInfo0, ModeError, 
+			ModuleInfo0, MaybePredInfo, Changed1),
 		{
-			MaybePredInfo = yes(PredInfo1),
+			MaybePredInfo = yes(PredInfo),
 			Error1 = Error0,
-
-			% 
-			% Ensure that all constructors occurring in predicate 
-			% mode declarations are module qualified.
-			% 
-			pred_info_arg_types(PredInfo1, _, ArgTypes),
-			pred_info_procedures(PredInfo1, Procs1),
-			typecheck_propagate_type_info_into_proc_modes(
-			    ModuleInfo0, ProcIds, ArgTypes, Procs1, Procs),
-			pred_info_set_procedures(PredInfo1, Procs, PredInfo),
 			map__det_update(Preds0, PredId, PredInfo, Preds),
 			module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1)
 		;
@@ -280,8 +276,43 @@
 		},
 		{ bool__or(Changed0, Changed1, Changed2) }
 	),
-	typecheck_pred_types_2(PredIds, ModuleInfo1, ModuleInfo, Error1, Error,
-		Changed2, Changed).
+	typecheck_pred_types_2(PredIds, ModeError, ModuleInfo1, 
+		ModuleInfo, Error1, Error, Changed2, Changed).
+
+:- pred typecheck_pred_type(pred_id, pred_info, bool, module_info,
+	maybe(pred_info), bool, io__state, io__state).
+:- mode typecheck_pred_type(in, in, in, in, out, out, di, uo) is det.
+
+typecheck_pred_type(PredId, PredInfo0, ModeError, ModuleInfo,
+		MaybePredInfo, Changed, IOState0, IOState) :-
+	typecheck_pred_type_2(PredId, PredInfo0, ModuleInfo, MaybePredInfo0,
+		Changed, IOState0, IOState),
+	(
+		MaybePredInfo0 = no,
+		MaybePredInfo = no
+	;
+		MaybePredInfo0 = yes(PredInfo1),
+
+		( ModeError = no ->
+			% 
+			% Copy clauses to procs, then ensure that all 
+			% constructors occurring in predicate mode 
+			% declarations are module qualified, unless undefined
+			% modes were found by an earlier pass.
+			% 
+			maybe_add_default_mode(PredInfo1, PredInfo2),
+			copy_clauses_to_procs(PredInfo2, PredInfo3),
+			pred_info_arg_types(PredInfo3, _, ArgTypes),
+			pred_info_procedures(PredInfo3, Procs1),
+			pred_info_procids(PredInfo3, ProcIds),
+			typecheck_propagate_type_info_into_proc_modes(
+				ModuleInfo, ProcIds, ArgTypes, Procs1, Procs),
+			pred_info_set_procedures(PredInfo3, Procs, PredInfo)
+		;
+			PredInfo = PredInfo1
+		),
+		MaybePredInfo = yes(PredInfo)
+	).
 
 :- pred typecheck_propagate_type_info_into_proc_modes(module_info,
 		list(proc_id), list(type), proc_table, proc_table).
@@ -299,24 +330,6 @@
 	map__det_update(Procs0, ProcId, ProcInfo, Procs1),
 	typecheck_propagate_type_info_into_proc_modes(ModuleInfo, ProcIds,
 		ArgTypes, Procs1, Procs).
-
-:- pred typecheck_pred_type(pred_id, pred_info, module_info,
-	maybe(pred_info), bool, io__state, io__state).
-:- mode typecheck_pred_type(in, in, in, out, out, di, uo) is det.
-
-typecheck_pred_type(PredId, PredInfo0, ModuleInfo, MaybePredInfo, Changed,
-		IOState0, IOState) :-
-	typecheck_pred_type_2(PredId, PredInfo0, ModuleInfo, MaybePredInfo0,
-		Changed, IOState0, IOState),
-	(
-		MaybePredInfo0 = no,
-		MaybePredInfo = no
-	;
-		MaybePredInfo0 = yes(PredInfo1),
-		maybe_add_default_mode(PredInfo1, PredInfo2),
-		copy_clauses_to_procs(PredInfo2, PredInfo),
-		MaybePredInfo = yes(PredInfo)
-	).
 
 :- pred typecheck_pred_type_2(pred_id, pred_info, module_info,
 	maybe(pred_info), bool, io__state, io__state).
Index: tests/invalid/Mmake
===================================================================
RCS file: /home/staff/zs/imp/tests/invalid/Mmake,v
retrieving revision 1.15
diff -u -r1.15 Mmake
--- Mmake	1997/04/27 05:28:46	1.15
+++ Mmake	1997/05/22 23:22:36
@@ -27,6 +27,7 @@
 	qual_basic_test2.m \
 	type_loop.m \
 	undef_lambda_mode.m \
+	undef_mode.m \
 	undef_type.m
 
 # we do not yet pass the following tests: