[m-rev.] diff: bug fix for mode-specific clauses with inter-module optimization

[Simon Taylor]

Estimated hours taken: 0.5
Branches: main

compiler/make_hlds.m:
	Don't attempt to module qualify the mode annotations on clauses
	read from `.opt' files. They are already fully module qualified.

tests/hard_coded/Mmakefile:
tests/hard_coded/intermod_multimode.m:
tests/hard_coded/intermod_multimode_main.exp:
	Test case.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.381
diff -u -u -r1.381 make_hlds.m
--- compiler/make_hlds.m	2001/08/20 15:15:21	1.381
+++ compiler/make_hlds.m	2001/08/28 09:21:22
@@ -3669,7 +3669,7 @@
 		{ pred_info_clauses_info(PredInfo1, Clauses0) },
 		{ pred_info_typevarset(PredInfo1, TVarSet0) },
 		{ maybe_add_default_func_mode(PredInfo1, PredInfo2, _) },
-		select_applicable_modes(Args, ClauseVarSet, Context,
+		select_applicable_modes(Args, ClauseVarSet, Status, Context,
 			PredId, PredInfo2, ModuleInfo1, Info0,
 			ArgTerms, ProcIdsForThisClause, ModuleInfo2, Info1),
 		clauses_info_add_clause(Clauses0, ProcIdsForThisClause,
@@ -3726,26 +3726,33 @@
 	% and determine which mode(s) this clause should apply to.
 
 :- pred select_applicable_modes(list(prog_term)::in, prog_varset::in,
-		prog_context::in, pred_id::in, pred_info::in,
-		module_info::in, qual_info::in,
+		import_status::in, prog_context::in, pred_id::in,
+		pred_info::in, module_info::in, qual_info::in,
 		list(prog_term)::out, list(proc_id)::out,
 		module_info::out, qual_info::out,
 		io__state::di, io__state::uo) is det.
 
-select_applicable_modes(Args0, VarSet, Context, PredId, PredInfo, ModuleInfo0,
-		Info0, Args, ProcIds, ModuleInfo, Info) -->
+select_applicable_modes(Args0, VarSet, Status, Context, PredId, PredInfo,
+		ModuleInfo0, Info0, Args, ProcIds, ModuleInfo, Info) -->
 	{ get_mode_annotations(Args0, Args, empty, ModeAnnotations) },
 	(
 		{ ModeAnnotations = modes(ModeList0) },
 
 		%
 		% The user specified some mode annotations on this clause.
-		% First module-qualify the mode annotations.
+		% First module-qualify the mode annotations. The annotations
+		% on clauses from `.opt' files will already be fully module
+		% qualified.
 		%
-		{ qual_info_get_mq_info(Info0, MQInfo0) },
-		module_qual__qualify_clause_mode_list(ModeList0, ModeList,
-			Context, MQInfo0, MQInfo),
-		{ qual_info_set_mq_info(Info0, MQInfo, Info) },
+		( { Status = opt_imported } ->
+			{ ModeList = ModeList0 },
+			{ Info = Info0 }
+		;
+			{ qual_info_get_mq_info(Info0, MQInfo0) },
+			module_qual__qualify_clause_mode_list(ModeList0,
+				ModeList, Context, MQInfo0, MQInfo),
+			{ qual_info_set_mq_info(Info0, MQInfo, Info) }
+		),
 
 		%
 		% Now find the procedure which matches these mode annotations.
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.128
diff -u -u -r1.128 Mmakefile
--- tests/hard_coded/Mmakefile	2001/08/25 07:54:58	1.128
+++ tests/hard_coded/Mmakefile	2001/08/27 15:56:16
@@ -226,6 +226,8 @@
 MCFLAGS-no_fully_strict	=	--no-fully-strict
 MCFLAGS-intermod_c_code =	--intermodule-optimization
 MCFLAGS-intermod_c_code2 =	--intermodule-optimization
+MCFLAGS-intermod_multimode =	--intermodule-optimization
+MCFLAGS-intermod_multimode_main = --intermodule-optimization
 MCFLAGS-nondet_copy_out =	--no-inlining --nondet-copy-out
 MCFLAGS-redoip_clobber	=	--no-inlining
 MCFLAGS-rnd		=	-O6
Index: tests/hard_coded/intermod_multimode.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/intermod_multimode.m,v
retrieving revision 1.2
diff -u -u -r1.2 intermod_multimode.m
--- tests/hard_coded/intermod_multimode.m	2001/08/18 11:33:54	1.2
+++ tests/hard_coded/intermod_multimode.m	2001/08/27 16:01:49
@@ -56,6 +56,7 @@
 func1(0::out) = ("func1(out) = out"::out).
 
 :- pragma promise_pure(func2/2). % XXX technically this is a lie
+:- pragma inline(func2/2).
 func2(_::in, _::in) = (R::out) :-
 	R = "func2(in, in) = out".
 func2(_::in, 0::out) = (R::out) :-
@@ -73,6 +74,7 @@
 test1(0::out) :-
 	impure puts("test1(out)").
 
+:- pragma inline(test2/2).
 test2(_::in, _::in) :-
 	impure puts("test2(in, in)").
 test2(_::in, 0::out) :-
@@ -85,10 +87,25 @@
 :- pragma c_code(puts(S::in), [will_not_call_mercury], "puts(S)").
 
 :- pragma promise_pure(get_determinism/2).
-get_determinism(_Pred::(pred(out) is det), det::out(bound(det))).
-get_determinism(_Pred::(pred(out) is semidet), semidet::out(bound(semidet))).
+:- pragma inline(get_determinism/2).
+get_determinism(Pred::(pred(out) is det), Det::out(bound(det))) :-
+	get_determinism_2(Pred, Det).
+get_determinism(Pred::(pred(out) is semidet), Det::out(bound(semidet))) :-
+	get_determinism_2(Pred, Det).
 get_determinism(_Pred::(pred(out) is cc_multi), cc_multi::out(bound(cc_multi))).
 get_determinism(_Pred::(pred(out) is cc_nondet), cc_nondet::out(bound(cc_nondet))).
 get_determinism(_Pred::(pred(out) is multi), multi::out(bound(multi))).
 get_determinism(_Pred::(pred(out) is nondet), nondet::out(bound(nondet))).
 
+:- inst bound_to_det == bound(det).
+:- inst bound_to_semidet == bound(semidet).
+
+:- pred get_determinism_2(pred(T), determinism).
+:- mode get_determinism_2(pred(out) is det,     out(bound_to_det))     is det.
+:- mode get_determinism_2(pred(out) is semidet, out(bound_to_semidet)) is det.
+:- pragma promise_pure(get_determinism_2/2).
+:- pragma inline(get_determinism_2/2).
+
+get_determinism_2(_Pred::(pred(out) is det), det::out(bound_to_det)).
+get_determinism_2(_Pred::(pred(out) is semidet),
+		semidet::out(bound_to_semidet)).
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------