[m-dev.] diff: fix context transformation

[Simon Taylor]

Estimated hours taken: 1

compiler/context.m:
compiler/magic_util.m:
	Fix some spurious errors and compiler aborts caused by the
	context transformation.

tests/valid/Mmakefile:
tests/valid/context_anc.m:
	Test case.


Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.4
diff -u -u -r1.4 magic_util.m
--- magic_util.m	1999/07/13 08:53:08	1.4
+++ magic_util.m	2000/02/21 00:04:01
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998-1999 University of Melbourne.
+% Copyright (C) 1998-2000 University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -379,10 +379,15 @@
 			{ proc_info_argmodes(ProcInfo, ArgModes) },
 			magic_util__create_input_test_unifications(Args,
 				InputArgs, ArgModes, NewArgs, [], Tests,
-				CallGoalInfo0, CallGoalInfo),
+				CallGoalInfo0, CallGoalInfo1),
+			{ goal_info_get_nonlocals(CallGoalInfo1,
+				CallNonLocals1) },
+			magic_util__restrict_nonlocals(CallNonLocals1,
+				CallNonLocals),
+			{ goal_info_set_nonlocals(CallGoalInfo1, CallNonLocals,
+				CallGoalInfo) },
 			{ CallGoal = call(PredId, ProcId, NewArgs,
-				not_builtin, no, Name)
-					- CallGoalInfo }
+				not_builtin, no, Name) - CallGoalInfo }
 		;	
 			% Transform away the input arguments. 
 			magic_util__handle_input_args(PredProcId0, PredProcId,
@@ -1633,15 +1638,11 @@
 			% and for the internal recursive calls in
 			% a multi-linear rule, the inputs must be the
 			% inputs to the procedure. 
-			% The lists of variables are the list of inputs
-			% to the procedure and to the erroneous call.
 
 	;	outputs_of_recursive_call
 			% for the last recursive call in a right- or
 			% multi-linear rule, the outputs must be the
 			% outputs of the procedure. 
-			% The lists of variables are the list of inputs
-			% to the procedure and to the erroneous call.
 
 	;	inputs_occur_in_other_goals
 			% For left-linear rules, the inputs to the procedure
Index: compiler/context.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/context.m,v
retrieving revision 1.1
diff -u -u -r1.1 context.m
--- context.m	1998/12/06 23:43:02	1.1
+++ context.m	2000/02/21 00:04:10
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998 University of Melbourne.
+% Copyright (C) 1998-2000 University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -66,7 +66,7 @@
 		pair(context_rule, hlds_goal_info)::out,
 		magic_info::in, magic_info::out) is det.
 
-context__categorize_rule(PredProcId, InputArgs, OutputArgs, Goal,
+context__categorize_rule(OldPredProcId, InputArgs, OutputArgs, Goal,
 		ContextRule - GoalInfo) -->
 	{ goal_to_conj_list(Goal, GoalList) },
 	magic_info_get_module_info(ModuleInfo),
@@ -75,7 +75,7 @@
 	magic_info_get_pred_map(PredMap),
 	{ context__get_db_calls(ModuleInfo, PredMap, GoalList,
 		[], [], CallList, AfterGoals) },
-	{ context__categorize_call_list(Context, PredProcId, InputArgs,
+	{ context__categorize_call_list(Context, OldPredProcId, InputArgs,
 		OutputArgs, CallList, AfterGoals, ContextRule) }.
 
 %-----------------------------------------------------------------------------%
@@ -299,9 +299,9 @@
 context__check_nonlocals(Context, Inputs, NonLocals, Errors0, Errors) :-
 	set__intersect(Inputs, NonLocals, Intersection),
 	( set__empty(Intersection) ->
-		Errors = [inputs_occur_in_other_goals - Context | Errors0]
-	;
 		Errors = Errors0
+	;
+		Errors = [inputs_occur_in_other_goals - Context | Errors0]
 	).
 
 %-----------------------------------------------------------------------------%
@@ -350,7 +350,17 @@
 		Inputs, Outputs, Disjuncts0, [Disjunct | Disjuncts0]) -->
 	% For a left-linear rule, just factor the rule into 
 	% a form that rl_gen.m can handle.
-	{ Call = db_call(_, CallGoal, _, _, _, _, _) },
+
+	{ Call = db_call(_, _ - RecGoalInfo, _, Args0, _, _, _) },
+	magic_info_get_magic_vars(MagicVars),
+	{ list__append(MagicVars, Args0, Args) },
+	magic_info_get_pred_info(PredInfo),
+	{ pred_info_module(PredInfo, PredModule) },
+	{ pred_info_name(PredInfo, PredName) },
+	magic_info_get_curr_pred_proc_id(proc(PredId, ProcId)),
+	{ CallGoal = call(PredId, ProcId, Args, not_builtin, no, 
+			qualified(PredModule, PredName)) - RecGoalInfo },
+
 	magic_info_get_magic_vars(Vars),
 	{ list__condense([Vars, Inputs, Outputs], NonLocals0) },
 	{ set__list_to_set(NonLocals0, NonLocals) },
@@ -371,11 +381,11 @@
 	{ set__insert_list(CallNonLocals, NonLocals, NonLocals1) },
 	{ set__insert_list(NonLocals1, MagicInputArgs, NonLocals2) },
 	{ set__union(NonLocals2, GoalNonLocals, NonLocals3) },
-	magic_util__restrict_nonlocals(NonLocals3, NonLocals4),
+	magic_util__restrict_nonlocals(NonLocals3, AllNonLocals),
 
 	% Put the goal into a form that rl_gen.m can handle.
 	context__factor_goal_list(PredProcId, MagicCall, CallList,
-		NonLocals4, FactoredGoal),
+		AllNonLocals, FactoredGoal),
 
 	% Add the rule to the context magic predicate.
 	{ magic_util__db_call_input_args(Call, CallInputs) },
@@ -384,7 +394,7 @@
 	{ list__append(FactoredGoal, Goals, AllGoals) },
 	{ goal_list_instmap_delta(AllGoals, Delta) },
 	{ goal_list_determinism(AllGoals, Det) },
-	{ goal_info_init(NonLocals3, Delta, Det, MagicRuleInfo) },
+	{ goal_info_init(AllNonLocals, Delta, Det, MagicRuleInfo) },
 	{ conj_list_to_goal(AllGoals, MagicRuleInfo, MagicGoal) },
 	magic_util__add_to_magic_predicate(PredProcId1, MagicGoal, MagicArgs).
 
@@ -495,7 +505,11 @@
 		{ ThisProcInfo = magic_proc_info(OldArgModes, _, _, _, _) },
 		magic_util__create_input_test_unifications(Args, InputArgs,
 			OldArgModes, NewArgs, [], Tests,
-			GoalInfo0, GoalInfo),
+			GoalInfo0, GoalInfo1),
+		{ goal_info_get_nonlocals(GoalInfo1, GoalNonLocals1) },
+		magic_util__restrict_nonlocals(GoalNonLocals1, GoalNonLocals),
+		{ goal_info_set_nonlocals(GoalInfo1,
+			GoalNonLocals, GoalInfo) },
 		magic_info_get_pred_info(PredInfo),
 		{ pred_info_module(PredInfo, PredModule) },
 		{ pred_info_name(PredInfo, PredName) },
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/Mmakefile,v
retrieving revision 1.53
diff -u -u -r1.53 Mmakefile
--- Mmakefile	2000/02/18 07:44:58	1.53
+++ Mmakefile	2000/02/21 00:04:19
@@ -30,6 +30,7 @@
 	compl_unify_bug.m \
 	complicated_unify.m \
 	constructor_arg_names.m \
+	context_anc.m \
 	dcg_test.m \
 	deforest_loop.m \
 	deforest_rerun_det.m \
@@ -181,6 +182,7 @@
 
 MCFLAGS-aditi_update		= --aditi
 MCFLAGS-compl_unify_bug		= -O3
+MCFLAGS-context_anc		= --aditi
 MCFLAGS-deforest_loop		= -O3 --intermodule-optimization
 MCFLAGS-deforest_rerun_det	= -O3 --check-termination
 MCFLAGS-double_vn		= -O4
Index: tests/valid/context_anc.m
===================================================================
RCS file: context_anc.m
diff -N context_anc.m
--- /dev/null	Mon Feb 21 11:03:46 2000
+++ context_anc.m	Fri Feb 18 13:12:58 2000
@@ -0,0 +1,52 @@
+% Test for the context transformation (compiler/context.m).
+:- module context_anc.
+
+:- interface.
+
+:- import_module aditi.
+
+:- pred left_anc(aditi:state, int, int).
+:- mode left_anc(aditi:aditi_ui, in, out) is nondet.
+:- pragma aditi(left_anc/3).
+
+:- pred right_anc(aditi:state, int, int).
+:- mode right_anc(aditi:aditi_ui, in, out) is nondet.
+:- pragma aditi(right_anc/3).
+
+:- pred multi_anc(aditi:state, int, int).
+:- mode multi_anc(aditi:aditi_ui, in, out) is nondet.
+:- pragma aditi(multi_anc/3).
+
+:- pred chain(aditi:state, int, int).
+:- mode chain(aditi:aditi_ui, out, out) is nondet.
+:- pragma base_relation(chain/3).
+
+:- implementation.
+
+:- pragma aditi_no_memo(left_anc/3).
+:- pragma context(left_anc/3).
+
+left_anc(DB, X, Y) :-
+	left_anc(DB, X, Z),
+	chain(DB, Z, Y).
+left_anc(DB, X, Y) :-
+	chain(DB, X, Y).
+
+:- pragma aditi_no_memo(right_anc/3).
+:- pragma context(right_anc/3).
+
+right_anc(DB, X, Y) :-
+	chain(DB, X, Z),
+	right_anc(DB, Z, Y).
+right_anc(DB, X, Y) :-
+	chain(DB, X, Y).
+
+:- pragma aditi_no_memo(multi_anc/3).
+:- pragma context(multi_anc/3).
+
+multi_anc(DB, X, Y) :-
+	multi_anc(DB, X, Z),
+	multi_anc(DB, Z, Y).
+multi_anc(DB, X, Y) :-
+	chain(DB, X, Y).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------