[m-dev.] for review: recognise associativity assertions

[Peter Ross]

Hi,

This is for Fergus to review.

===================================================================


Estimated hours taken: 30

Recognise associativity assertions, and use them to introduce
accumulators.

mercury/compiler/assertion.m:
    Add assertion__is_associativity_assertion, which for an assert_id
    determines whether the assertion is associative.
    
mercury/compiler/accumulator.m:
    Call assertion__is_associativity_assertion to determine whether a
    call is associative.
    Rather than failing if a call is associative and nothing is known
    about the effect of rearranging the argument order, report a
    suppressible warning.
    Fix a bug where the mode of the introduced pred wasn't correct.
    
mercury/compiler/mercury_compile.m:
    Move accumulator introduction before inlining and unused_args, as
    inlining can inline an associative call making it unrecognisable and
    unused_args eliminates arguments which make it difficult to relate
    the assertion with the actual call.

mercury/compiler/notes/compiler_design.html:
    Document the constraints on when the module accumulator.m can be
    called for it to be effective.

mercury/compiler/options.m:
    Add the new option "--inhibit-accumulator-warnings".

mercury/doc/user_guide.texi:
    Document "--inhibit-accumulator-warnings".

mercury/library/list.m:
    Declare list__append to be associative.

tests/general/accumulator/runtests:
    Turn the tests back on, they *should* work under different
    optimization levels now.

Index: promise/compiler/accumulator.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/accumulator.m,v
retrieving revision 1.7
diff -u -r1.7 accumulator.m
--- accumulator.m	1999/09/12 04:26:36	1.7
+++ accumulator.m	1999/11/17 03:53:30
@@ -95,8 +95,8 @@
 
 :- implementation.
 
-:- import_module (assertion), goal_util, globals.
-:- import_module hlds_data, hlds_goal, hlds_out.
+:- import_module (assertion), error_util, goal_util, globals.
+:- import_module hlds_data, hlds_goal, hlds_out, (inst).
 :- import_module inst_match, instmap, mode_util, options, prog_data, prog_util.
 
 :- import_module assoc_list, bool, list, map, multi_map.
@@ -163,9 +163,17 @@
 			orig_dynvar_map,
 			subst,		% Y0s -> As
 			subst,		% Hs -> As
-			set(prog_var)	% Ys
+			set(prog_var),	% Ys
+			warnings
 		).
 
+:- type warning 
+			% warn that two prog_vars in call to pred_id
+			% at prog_context were swapped.
+	--->	w(prog_context, pred_id, prog_var, prog_var).
+
+:- type warnings == list(warning).
+
 	% is the pred commutative?
 :- type commutative == bool.
 
@@ -209,7 +217,7 @@
 		{ module_info_pred_info(ModuleInfo0, PredId, PredInfo) },
 		{ accumulator__attempt_transform(ProcId, ProcInfo0, PredId,
 				PredInfo, DoLCO, FullyStrict, ModuleInfo0,
-				ProcInfo1, ModuleInfo1) }
+				Warnings, ProcInfo1, ModuleInfo1) }
 	->
 		globals__io_lookup_bool_option(very_verbose, VeryVerbose),
 		( 
@@ -222,8 +230,46 @@
 			[]
 		),
 
-		{ ProcInfo   = ProcInfo1 },
-		{ ModuleInfo = ModuleInfo1 }
+		globals__io_lookup_bool_option(inhibit_accumulator_warnings,
+				InhibitWarnings),
+		(
+			( { Warnings = [] } ; { InhibitWarnings = yes } )
+		->
+			{ ModuleInfo = ModuleInfo1 }
+		;
+			{ error_util__describe_one_pred_name(ModuleInfo1,
+					PredId, PredName) },
+			{ pred_info_context(PredInfo, Context) },
+
+			error_util__write_error_pieces(Context, 0,
+					[words("In the"), words(PredName)]),
+
+			{ proc_info_varset(ProcInfo, VarSet) },
+			accumulator__warnings(Warnings, VarSet, ModuleInfo1),
+
+			error_util__write_error_pieces(Context, 2, 
+					[
+					words("Please ensure that these"),
+					words("argument rearrangements"),
+					words("do not introduce"),
+					words("performance problems."),
+					words("These warnings can"),
+					words("be supressed by"),
+					words("--inhibit-accumulator-warnings.")
+					]),
+
+			globals__io_lookup_bool_option(halt_at_warn,
+					HaltAtWarn),
+			(
+				{ HaltAtWarn = yes }
+			->
+				{ module_info_incr_errors(ModuleInfo1,
+						ModuleInfo) }
+			;
+				{ ModuleInfo = ModuleInfo1 }
+			)
+		),
+		{ ProcInfo   = ProcInfo1 }
 	;
 		{ ProcInfo   = ProcInfo0 },
 		{ ModuleInfo = ModuleInfo0 }
@@ -236,10 +282,10 @@
 	%
 :- pred accumulator__attempt_transform(proc_id::in, proc_info::in,
 		pred_id::in, pred_info::in, bool::in, bool::in, module_info::in,
-		proc_info::out, module_info::out) is semidet.
+		warnings::out, proc_info::out, module_info::out) is semidet.
 
 accumulator__attempt_transform(ProcId, ProcInfo0, PredId, PredInfo0, DoLCO,
-		FullyStrict, ModuleInfo0, ProcInfo, ModuleInfo) :-
+		FullyStrict, ModuleInfo0, Warnings, ProcInfo, ModuleInfo) :-
 	proc_info_goal(ProcInfo0, Goal0),
 	proc_info_headvars(ProcInfo0, HeadVars),
 	proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InitialInstMap),
@@ -254,7 +300,7 @@
 
 	accumulator__transform(GoalType, Base, Rec, Goal, DoLCO, FullyStrict,
 			ModuleInfo1, HeadVars, HstoAs_Subst, NewPredId,
-			NewProcId, NewPredName, OrigGoal, AccGoal),
+			NewProcId, NewPredName, OrigGoal, Warnings, AccGoal),
 
 	accumulator__update_accumulator_pred(NewPredId, NewProcId, AccGoal,
 			ModuleInfo1, ModuleInfo),
@@ -264,6 +310,33 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
+:- pred accumulator__warnings(list(warning)::in, prog_varset::in,
+		module_info::in, io__state::di, io__state::uo) is det.
+
+accumulator__warnings([], _, _) --> [].
+accumulator__warnings([W | Ws], VarSet, ModuleInfo) -->
+	{ accumulator__warning(W, VarSet, ModuleInfo, Context, Format) },
+	error_util__write_error_pieces(Context, 2, Format),
+	accumulator__warnings(Ws, VarSet, ModuleInfo).
+
+:- pred accumulator__warning(warning::in, prog_varset::in, module_info::in,
+		prog_context::out, list(format_component)::out) is det.
+
+accumulator__warning(w(Context, PredId, VarA, VarB), VarSet, ModuleInfo,
+		Context, Formats) :-
+	error_util__describe_one_pred_name(ModuleInfo, PredId, PredStr),
+	varset__lookup_name(VarSet, VarA, VarAStr),
+	varset__lookup_name(VarSet, VarB, VarBStr),
+	Formats = [words("warning: The"), words(PredStr),
+			words("has had the location of the variables"),
+			words(VarAStr), words("and"), words(VarBStr),
+			words("swapped to allow accumulator introduction.")
+			].
+
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 	%
 	% accumulator__simplify
 	%
@@ -549,7 +622,13 @@
 	map__lookup(VarTypes0, Var, Type),
 	map__det_insert(VarTypes1, NewVar, Type, VarTypes),
 
-	instmap__lookup_var(InstMap, Var, Inst),
+		% XXX we don't want to use the inst of the var as it can
+		% be more specific than it should be. ie int_const(1)
+		% when it should be any integer.
+		% However this will no longer handle partially
+		% instantiated data structures.
+	% instmap__lookup_var(InstMap, Var, Inst),
+	Inst = ground(shared, no),
 	inst_lists_to_mode_list([Inst], [Inst], Mode),
 	list__append(Mode, Modes0, Modes).
 
@@ -605,11 +684,12 @@
 		hlds_goal::in, bool::in, bool::in, module_info::in,
 		prog_vars::in, subst::in, pred_id::in,
 		proc_id::in, sym_name::in,
-		hlds_goal::out, hlds_goal::out) is semidet.
+		hlds_goal::out, warnings::out, hlds_goal::out) is semidet.
 
 accumulator__transform(TopLevel, base(BaseGoalList), recursive(PreDP, DP, R, C),
-		Goal, DoLCO, FullyStrict, ModuleInfo, HeadVars, HstoAs_Subst,
-		NewPredId, NewProcId, NewPredName, OrigGoal, NewGoal) :-
+		Goal, DoLCO, FullyStrict, ModuleInfo, HeadVars,
+		HstoAs_Subst, NewPredId, NewProcId, NewPredName,
+		OrigGoal, Warnings, NewGoal) :-
 
 	accumulator__Ys_descended_from_Y0s(HeadVars, DP, ModuleInfo),
 
@@ -623,8 +703,8 @@
 			Y0stoYs_Subst, HstoAs_Subst, NewBaseGoal),
 	accumulator__new_recursive_case(DP, C, R, DoLCO, FullyStrict,
 			ModuleInfo, NewPredId, NewProcId, NewPredName,
-			Vars, HeadVars,
-			Y0stoYs_Subst, HstoAs_Subst, NewRecGoal),
+			Vars, HeadVars, Y0stoYs_Subst, HstoAs_Subst,
+			Warnings, NewRecGoal),
 
 	accumulator__top_level(TopLevel, Goal, OrigBaseGoal, OrigRecGoal,
 			NewBaseGoal, NewRecGoal, OrigGoal, NewGoal).
@@ -1073,11 +1153,11 @@
 		a_goal::in, bool::in, bool::in,
 		module_info::in, pred_id::in, proc_id::in,
 		sym_name::in, prog_vars::in, prog_vars::in, subst::in,
-		subst::in, hlds_goal::out) is semidet.
+		subst::in, warnings::out, hlds_goal::out) is semidet.
 
 accumulator__new_recursive_case(DP, C, R0, DoLCO, FullyStrict,
 		ModuleInfo, PredId, ProcId, Name, Hs, HeadVars,
-		Y0stoYs_Subst, HstoAs_Subst, Goal) :-
+		Y0stoYs_Subst, HstoAs_Subst, Warnings, Goal) :-
 	DP = goal(DecomposeProcess, _InstMapBeforeDecomposeProcess),
 	C  = goal(Compose, InstMapBeforeCompose),
 	R0 = goal(Recursive0, _InstMapBeforeRecursive0),
@@ -1107,6 +1187,7 @@
 	),
 
 	assoc_info_Y0stoAs(Y0stoAs_Subst, AssocInfo, _),
+	assoc_info_warnings(Warnings, AssocInfo, _),
 
 	accumulator__rename_prerec_goals(PreRecGoal0, Y0stoAs_Subst,
 			Y0stoYs_Subst, LCO_Subst, HstoAs_Subst, PreRecGoal),
@@ -1347,21 +1428,10 @@
 	assoc_info_module_info(ModuleInfo),
 	accumulator__call_dynamic_var(Arg0s, DynamicCallVar),
 
-	{ accumulator__is_associative(PredId, ProcId, ModuleInfo, Arg0s, Args,
-		PossibleStaticVars, Commutative) },
+	{ goal_info_get_context(GoalInfo, ProgContext) },
+	accumulator__is_associative(PredId, ProcId, ProgContext, ModuleInfo,
+			Arg0s, Args, PossibleStaticVars, Commutative),
 
-	(
-			% Make sure that after rearrangement of the
-			% arguments the new proc will be at least as
-			% efficient as the old pred.
-		{ Commutative = no },
-		assoc_info_static_set(StaticSet),
-		{ accumulator__obey_heuristic(PredId, ModuleInfo,
-				Args, StaticSet) }
-	;
-		{ Commutative = yes }
-	),
-
 	accumulator__check_previous_calls(DynamicCallVar,
 			PredId, ProcId, Commutative),
 	accumulator__new_dynamic_var(Arg0s, DynamicCallVar, NewDynamicVar),
@@ -1630,12 +1700,14 @@
 	% and an indicator of whether or not the predicate is
 	% commutative.
 	%
-:- pred accumulator__is_associative(pred_id::in, proc_id::in, module_info::in,
-		prog_vars::in, prog_vars::out, set(prog_var)::out,
-		commutative::out) is semidet.
+:- pred accumulator__is_associative(pred_id::in, proc_id::in, prog_context::in,
+		module_info::in, prog_vars::in, prog_vars::out,
+		set(prog_var)::out, commutative::out,
+		assoc_info::in, assoc_info::out) is semidet.
 
-accumulator__is_associative(PredId, ProcId, ModuleInfo,
-		Args0, Args, PossibleStaticVars, Commutative):-
+accumulator__is_associative(PredId, ProcId, Context, ModuleInfo,
+		Args0, Args, PossibleStaticVars, Commutative,
+		AssocInfo0, AssocInfo):-
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, 
 			PredInfo, ProcInfo),
 
@@ -1649,19 +1721,85 @@
 		check_modes(Args0, PossibleStaticVars0, Modes, ModuleInfo),
 		Args = Args0,
 		PossibleStaticVars = PossibleStaticVars0,
+		AssocInfo = AssocInfo0,
 		Commutative = yes
 	;
+		associativity_assertion(set__to_sorted_list(Assertions),
+				ModuleInfo, Args0, VarA - VarB),
+
+		PossibleStaticVars = set__list_to_set([VarA, VarB]),
+
+			% Swap the order of the arguments
+		list__map((pred(V0::in, V::out) is det :-
+				(
+					V0 = VarA
+				->
+					V = VarB
+				;
+					V0 = VarB
+				->
+					V = VarA
+				;
+					V = V0
+				)
+			), Args0, Args),
 
-			% Check if it is associative
+		check_modes(Args, PossibleStaticVars, Modes, ModuleInfo),
+
+			% Determine what variables can be static
 		pred_info_module(PredInfo, ModuleName),
 		pred_info_name(PredInfo, PredName),
 		pred_info_arity(PredInfo, Arity),
-
-		assoc_fact(ModuleName, PredName, Arity, Modes,
-				ModuleInfo, Args0, Args, PossibleStaticVars),
+		(
+			has_heuristic(ModuleName, PredName, Arity)
+		->
+				% If there is a heuristic for that call
+				% then ensure that the call obeys
+				% the heuristic that the static
+				% variables are in certain positions.
+				%
+				% For example, a call to append in the
+				% forward mode will have the following
+				% types of variables: (static, dynamic,
+				% dynamic).  After rearrangment that
+				% order will be (dynamic, static,
+				% dynamic).  Having a dynamic variable
+				% in the first position will probably
+				% take O(N) time to process while having
+				% a static variable will probably take
+				% O(1) time.  Therefore the complexity
+				% of the predicate as a whole will
+				% change, we must ensure that it changes
+				% for the better.
+				%
+			heuristic(ModuleName, PredName, Arity, Args,
+					MustBeStaticVars),
+			assoc_info_static_set(StaticSet, AssocInfo0,
+					AssocInfo),
+			(StaticSet `intersect` MustBeStaticVars) `equal`
+					MustBeStaticVars
+		;
+				% If no heuristic is known, then record
+				% which variables were swapped and warn
+				% the user.
+			assoc_info_add_warning(w(Context, PredId, VarA, VarB),
+					AssocInfo0, AssocInfo)
+		),
 		Commutative = no
 	).
 
+
+:- pred has_heuristic(module_name::in, string::in, arity::in) is semidet.
+
+has_heuristic(unqualified("list"), "append", 3).
+
+:- pred heuristic(module_name::in, string::in, arity::in, prog_vars::in,
+		set(prog_var)::out) is semidet.
+
+heuristic(unqualified("list"), "append", 3, [_Typeinfo, A, _B, _C], Set) :-
+	set__list_to_set([A], Set).
+
+
 	%
 	% commutativity_assertion
 	%
@@ -1690,6 +1828,31 @@
 	
 
 	%
+	% associativity_assertion
+	%
+	% Does there exist one (and only one) associativity assertion for the 
+	% current predicate.
+	% The 'and only one condition' is required because we currently
+	% don't handle the case of predicates which have individual
+	% parts which are associative, because then we don't know which
+	% variable is descended from which.
+	%
+:- pred associativity_assertion(list(assert_id)::in, module_info::in,
+		prog_vars::in, pair(prog_var)::out) is semidet.
+
+associativity_assertion([AssertId | AssertIds], ModuleInfo, Args0, VarAB) :-
+	(
+		assertion__is_associativity_assertion(AssertId, ModuleInfo,
+				Args0, VarAB0)
+	->
+		\+ associativity_assertion(AssertIds, ModuleInfo, Args0, _),
+		VarAB = VarAB0
+	;
+		associativity_assertion(AssertIds, ModuleInfo, Args0, VarAB)
+	).
+	
+
+	%
 	% check_modes(Vs, CVs, Ms, MI)
 	%
 	% Given a list of variables, Vs, and associated modes, Ms, make
@@ -1713,106 +1876,9 @@
 	check_modes(Vs, PossibleStaticVars, Ms, ModuleInfo).
 
 
-	%
-	% XXX this fact table is only a temporary solution to whether or
-	% not a particular procedure is associative.  In the long term
-	% the user should be able to annotate their code to indicate
-	% which predicates are associative.
-	%
-	% The set is simply the set of vars that must be static.  It is
-	% a simple heuristic to ensure that the O() behaviour only
-	% improves.  ie for append after swapping the arguments the
-	% static variable must be in the first location.
-	%
-:- pred assoc_fact(module_name::in, string::in, arity::in,
-		list(mode)::in, module_info::in, prog_vars::in,
-		prog_vars::out, set(prog_var)::out) is semidet.
-
-assoc_fact(unqualified("list"), "append", 3, [TypeInfoIn, In, In, Out], 
-		ModuleInfo, [TypeInfo, A, B, C], 
-		[TypeInfo, B, A, C], PossibleStaticVars) :-
-	set__list_to_set([A, B], PossibleStaticVars),
-	mode_is_input(ModuleInfo, TypeInfoIn),
-	mode_is_input(ModuleInfo, In),
-	mode_is_output(ModuleInfo, Out).
-
-
-
-/* XXX introducing accumulators for floating point numbers can be bad.
-assoc_fact(unqualified("float"), "+", 3, [In, In, Out], ModuleInfo, 
-		[A, B, C], [A, B, C], PossibleStaticVars, no) :-
-	set__list_to_set([A, B], PossibleStaticVars),
-	mode_is_input(ModuleInfo, In),
-	mode_is_output(ModuleInfo, Out).
-
-assoc_fact(unqualified("float"), "*", 3, [In, In, Out], ModuleInfo, 
-		[A, B, C], [A, B, C], PossibleStaticVars, no) :-
-	set__list_to_set([A, B], PossibleStaticVars),
-	mode_is_input(ModuleInfo, In),
-	mode_is_output(ModuleInfo, Out).
-*/
-/*
-	XXX this no longer works, because set__insert isn't associative.
-
-	However set__insert obeys the following axiom, providing that you 
-	use user-defined equality (set__equals), not structural equality 
-	for S.
-
-		some [SA] (p(A, S0, SA), p(B, SA, S)) <=>
-			some [SB] (p(B, S0, SB), p(A, SB, S))
-
-	My previous attempt at this transformation handled this case 
-	and I thought the current one did as well.  I was wrong.  I need
-	to reintegrate my old code.
-
-assoc_fact(unqualified("set"), "insert", 3, [TypeInfoIn, In, In, Out], 
-		Moduleinfo, [TypeInfo, A, B, C], 
-		[TypeInfo, A, B, C], PossibleStaticVars, no) :-
-	set__list_to_set([A, B], PossibleStaticVars),
-	mode_is_input(Moduleinfo, TypeInfoIn),
-	mode_is_input(Moduleinfo, In),
-	mode_is_output(Moduleinfo, Out).
-*/
-
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-	% 
-	% accumulator__obey_heuristic
-	%
-	% for calls which rearrange the order of variables ensure that
-	% the call obeys the heuristic that the static variables are in 
-	% certain positions.
-	%
-	% For example, a call to append in the forward mode will have
-	% the following types of variables: (static, dynamic, dynamic).
-	% After rearrangment that order will be (dynamic, static, dynamic).
-	% Having a dynamic variable in the first position will probably
-	% take O(N) time to process while having a static variable will 
-	% probably take O(1) time.  Therefore the complexity of the
-	% predicate as a whole will change, we must ensure that it
-	% changes for the better.
-	%
-:- pred accumulator__obey_heuristic(pred_id::in, module_info::in,
-		prog_vars::in, set(prog_var)::in) is semidet.
-
-accumulator__obey_heuristic(Predid, ModuleInfo, Args, StaticSet) :-
-	module_info_pred_info(ModuleInfo, Predid, PredInfo),
-	pred_info_module(PredInfo, ModuleName),
-	pred_info_name(PredInfo, PredName),
-	pred_info_arity(PredInfo, Arity),
-	heuristic(ModuleName, PredName, Arity, Args, MustBeStaticVars),
-	set__intersect(StaticSet, MustBeStaticVars, Intersection),
-	set__equal(MustBeStaticVars, Intersection).
-
-:- pred heuristic(module_name::in, string::in, arity::in, prog_vars::in,
-		set(prog_var)::out) is semidet.
-
-heuristic(unqualified("list"), "append", 3, [_Typeinfo, A, _B, _C], Set) :-
-	set__list_to_set([A], Set).
-
-%-----------------------------------------------------------------------------%
-
 :- pred assoc_info_init(module_info::in, prog_vars::in, a_goals::in,
 		a_goals::in, a_goal::in,
 		subst::in, subst::in, assoc_info::out) is det.
@@ -1864,76 +1930,91 @@
 		%
 	set__list_to_set(Ys, YsSet),
 
+	ErrorMessages = [],
+
 	AssocInfo = assoc_info(StaticSet, DynamicSet,
 			ModuleInfo, PrevCallMap, OrigDynVarMap,
-			Y0stoAs_Subst, HstoAs_Subst, YsSet).
+			Y0stoAs_Subst, HstoAs_Subst, YsSet,
+			ErrorMessages).
 
 :- pred assoc_info_static_set(set(prog_var)::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_static_set(StaticSet, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(StaticSet, _, _, _, _, _, _, _).
+	AssocInfo = assoc_info(StaticSet, _, _, _, _, _, _, _, _).
 
 :- pred assoc_info_dynamic_set(set(prog_var)::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_dynamic_set(DynamicSet, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(_, DynamicSet, _, _, _, _, _, _).
+	AssocInfo = assoc_info(_, DynamicSet, _, _, _, _, _, _, _).
 
 :- pred assoc_info_module_info(module_info::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_module_info(ModuleInfo, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(_, _, ModuleInfo, _, _, _, _, _).
+	AssocInfo = assoc_info(_, _, ModuleInfo, _, _, _, _, _, _).
 
 :- pred assoc_info_prev_call_map(prev_call_map::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_prev_call_map(PrevCallMap, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(_, _, _, PrevCallMap, _, _, _, _).
+	AssocInfo = assoc_info(_, _, _, PrevCallMap, _, _, _, _, _).
 
 :- pred assoc_info_orig_dynvar_map(orig_dynvar_map::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_orig_dynvar_map(OrigDynVarMap, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(_, _, _, _, OrigDynVarMap, _, _, _).
+	AssocInfo = assoc_info(_, _, _, _, OrigDynVarMap, _, _, _, _).
 
 :- pred assoc_info_Y0stoAs(subst::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_Y0stoAs(Y0stoAs_Subst, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(_, _, _, _, _, Y0stoAs_Subst, _, _).
+	AssocInfo = assoc_info(_, _, _, _, _, Y0stoAs_Subst, _, _, _).
 
 :- pred assoc_info_HstoAs(subst::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_HstoAs(HstoAs_Subst, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(_, _, _, _, _, _, HstoAs_Subst, _).
+	AssocInfo = assoc_info(_, _, _, _, _, _, HstoAs_Subst, _, _).
 
 :- pred assoc_info_Ys(set(prog_var)::out,
 		assoc_info::in, assoc_info::out) is det.
 assoc_info_Ys(Ys, AssocInfo, AssocInfo) :-
-	AssocInfo = assoc_info(_, _, _, _, _, _, _, Ys).
+	AssocInfo = assoc_info(_, _, _, _, _, _, _, Ys, _).
 
+:- pred assoc_info_warnings(warnings::out,
+		assoc_info::in, assoc_info::out) is det.
+assoc_info_warnings(Warnings, AssocInfo, AssocInfo) :-
+	AssocInfo = assoc_info(_, _, _, _, _, _, _, _, Warnings).
+
 /*
 :- pred assoc_info_set_static_set(set(prog_var)::in, assoc_info::in,
 		assoc_info::out) is det.
-assoc_info_set_static_set(StaticSet, assoc_info(_, B, C, D, E, F, G, H),
-		assoc_info(StaticSet, B, C, D, E, F, G, H)).
+assoc_info_set_static_set(StaticSet, assoc_info(_, B, C, D, E, F, G, H, I),
+		assoc_info(StaticSet, B, C, D, E, F, G, H, I)).
 */
 
 :- pred assoc_info_set_dynamic_set(set(prog_var)::in, assoc_info::in,
 		assoc_info::out) is det.
-assoc_info_set_dynamic_set(DynamicSet, assoc_info(A, _, C, D, E, F, G, H),
-		assoc_info(A, DynamicSet, C, D, E, F, G, H)).
+assoc_info_set_dynamic_set(DynamicSet, assoc_info(A, _, C, D, E, F, G, H, I),
+		assoc_info(A, DynamicSet, C, D, E, F, G, H, I)).
 
 :- pred assoc_info_set_prev_call_map(prev_call_map::in, assoc_info::in,
 		assoc_info::out) is det.
-assoc_info_set_prev_call_map(PrevCallMap, assoc_info(A, B, C, _, E, F, G, H),
-		assoc_info(A, B, C, PrevCallMap, E, F, G, H)).
+assoc_info_set_prev_call_map(PrevCallMap, assoc_info(A, B, C, _, E, F, G, H, I),
+		assoc_info(A, B, C, PrevCallMap, E, F, G, H, I)).
 
 :- pred assoc_info_set_orig_dynvar_map(orig_dynvar_map::in, assoc_info::in,
 		assoc_info::out) is det.
-assoc_info_set_orig_dynvar_map(OrigDynMap, assoc_info(A, B, C, D, _, F, G, H),
-		assoc_info(A, B, C, D, OrigDynMap, F, G, H)).
+assoc_info_set_orig_dynvar_map(OrigDynMap,
+		assoc_info(A, B, C, D, _, F, G, H, I),
+		assoc_info(A, B, C, D, OrigDynMap, F, G, H, I)).
 
 :- pred assoc_info_set_Y0stoAs(subst::in, assoc_info::in,
+		assoc_info::out) is det.
+assoc_info_set_Y0stoAs(Y0stoAs_Subst, assoc_info(A, B, C, D, E, _, G, H, I),
+		assoc_info(A, B, C, D, E, Y0stoAs_Subst, G, H, I)).
+
+:- pred assoc_info_add_warning(warning::in, assoc_info::in,
 		assoc_info::out) is det.
-assoc_info_set_Y0stoAs(Y0stoAs_Subst, assoc_info(A, B, C, D, E, _, G, H),
-		assoc_info(A, B, C, D, E, Y0stoAs_Subst, G, H)).
+assoc_info_add_warning(Warning,
+		assoc_info(A, B, C, D, E, F, G, H, Warnings),
+		assoc_info(A, B, C, D, E, F, G, H, [Warning | Warnings])).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: promise/compiler/assertion.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/assertion.m,v
retrieving revision 1.5
diff -u -r1.5 assertion.m
--- assertion.m	1999/11/12 09:08:12	1.5
+++ assertion.m	1999/11/16 03:26:39
@@ -58,6 +58,31 @@
 		prog_vars::in, pair(prog_var)::out) is semidet.
 
 	%
+	% assertion__is_associativity_assertion(Id, MI, Vs, CVs)
+	%
+	% Does the assertion represented by the assertion id, Id,
+	% state the associativity of a pred/func?
+	% We extend the usual definition of associativity to apply to
+	% predicates or functions with more than two arguments as
+	% follows by allowing extra arguments which must be invariant.
+	% If so, this predicate returns (in CVs) the two variables which
+	% can be swapped in order if it was a call to Vs.
+	%
+	% The assertion must be in a form similar to this
+	% 	all [Is,A,B,C,ABC] 
+	% 	(
+	% 	  some [AB] p(Is,A,B,AB), p(Is,AB,C,ABC)
+	% 	<=>
+	% 	  some [BC] p(Is,B,C,BC), p(Is,A,BC,ABC)
+	% 	)
+	% for the predicate to return true (note that the invariant
+	% arguments, Is, can be any where providing they are in
+	% identical locations on both sides of the equivalence).
+	%
+:- pred assertion__is_associativity_assertion(assert_id::in, module_info::in,
+		prog_vars::in, pair(prog_var)::out) is semidet.
+
+	%
 	% assertion__in_interface_check
 	%
 	% Ensure that an assertion which is defined in an interface
@@ -73,7 +98,7 @@
 :- implementation.
 
 :- import_module globals, goal_util, hlds_out, options, prog_out, type_util.
-:- import_module bool, list, map, require, set, std_util.
+:- import_module assoc_list, bool, list, map, require, set, std_util.
 
 :- type subst == map(prog_var, prog_var).
 
@@ -124,6 +149,105 @@
 		Q = VarP,
 		Ps = Qs
 	).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+assertion__is_associativity_assertion(AssertId, Module, CallVars,
+		AssociativeVars) :-
+	assertion__goal(AssertId, Module, Goal - GoalInfo),
+	equivalent(Goal - GoalInfo, P, Q),
+
+	goal_info_get_nonlocals(GoalInfo, UniversiallyQuantifiedVars),
+
+	P = some(_, _, conj(PCalls) - _) - _PGoalInfo,
+	Q = some(_, _, conj(QCalls) - _) - _QGoalInfo,
+
+	AssociativeVars = promise_only_solution(associative(PCalls, QCalls,
+				UniversiallyQuantifiedVars, CallVars)).
+
+
+	% associative(Ps, Qs, Us, R)
+	%
+	% If the assertion was in the form
+	% 	all [Us] (some [] (Ps)) <=> (some [] (Qs))
+	% try and rearrange the order of Ps and Qs so that the assertion
+	% is in the standard from
+	%
+	% 	compose( A, B,  AB),		compose(B,  C,  BC),
+	% 	compose(AB, C, ABC) 	<=>	compose(A, BC, ABC)
+
+:- pred associative(hlds_goals::in, hlds_goals::in, set(prog_var)::in,
+		prog_vars::in, pair(prog_var)::out) is cc_nondet.
+
+associative(PCalls, QCalls, UniversiallyQuantifiedVars, CallVars,
+		CallVarA - CallVarB) :-
+	reorder(PCalls, QCalls, LHSCalls, RHSCalls),
+	process_one_side(LHSCalls, UniversiallyQuantifiedVars, AB, PairsL, Vs),
+	process_one_side(RHSCalls, UniversiallyQuantifiedVars, BC, PairsR, _),
+
+		% If you read the predicate documentation, you will note
+		% that for each pair of variables on the left hand side
+		% their is an equivalent pair of variables on the right
+		% hand side.
+	assoc_list__from_corresponding_lists(PairsL, PairsR, Pairs),
+	list__perm(Pairs, [(A - AB) - (B - A), (B - C) - (C - BC),
+			(AB - ABC) - (BC - ABC)]),
+
+	assoc_list__from_corresponding_lists(Vs, CallVars, AssocList),
+	list__filter((pred(X-_Y::in) is semidet :- X = A),
+			AssocList, [_A - CallVarA]),
+	list__filter((pred(X-_Y::in) is semidet :- X = B),
+			AssocList, [_B - CallVarB]).
+
+	% reorder(Ps, Qs, Ls, Rs)
+	%
+	% Given both sides of the equivalence return another possible
+	% ordering.
+
+:- pred reorder(hlds_goals::in, hlds_goals::in,
+		hlds_goals::out, hlds_goals::out) is nondet.
+
+reorder(PCalls, QCalls, LHSCalls, RHSCalls) :-
+	list__perm(PCalls, LHSCalls),
+	list__perm(QCalls, RHSCalls).
+reorder(PCalls, QCalls, LHSCalls, RHSCalls) :-
+	list__perm(PCalls, RHSCalls),
+	list__perm(QCalls, LHSCalls).
+
+	% process_one_side(Gs, Us, L, Ps)
+	% 
+	% Given the list of goals, Gs, which are one side of a possible
+	% associative equivalence, and the universally quantified
+	% variables, Us, of the goals return L the existentially
+	% quantified variable that links the two calls and Ps the list
+	% of variables which are not invariants.
+	%
+	% ie for app(TypeInfo, X, Y, XY), app(TypeInfo, XY, Z, XYZ)
+	% L <= XY and Ps <= [X - XY, Y - Z, XY - XYZ]
+
+:- pred process_one_side(hlds_goals::in, set(prog_var)::in, prog_var::out,
+		assoc_list(prog_var)::out, prog_vars::out) is semidet.
+
+process_one_side(Goals, UniversiallyQuantifiedVars, LinkingVar, Vars, VarsA) :-
+	Goals = [call(PredId, _, VarsA, _, _, _) - _,
+			call(PredId, _, VarsB, _, _, _) - _],
+
+		% Determine the linking variable, L.
+		% By definition it must be existentially quantified and
+		% a member of both variable lists.
+	CommonVars = list_to_set(VarsA) `intersect` list_to_set(VarsB),
+	set__singleton_set(CommonVars `difference` UniversiallyQuantifiedVars,
+			LinkingVar),
+
+		% Filter out all the invariant arguments, and then make
+		% sure that their is only 3 arguments left.
+	assoc_list__from_corresponding_lists(VarsA, VarsB, Vars0),
+	list__filter((pred(X-Y::in) is semidet :- not X = Y), Vars0, Vars),
+	list__length(Vars, number_of_associative_vars).
+
+:- func number_of_associative_vars = int.
+number_of_associative_vars = 3.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: promise/compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.144
diff -u -r1.144 mercury_compile.m
--- mercury_compile.m	1999/11/10 16:21:07	1.144
+++ mercury_compile.m	1999/11/17 03:54:01
@@ -36,9 +36,9 @@
 :- import_module stratify, check_typeclass, simplify, intermod, trans_opt.
 :- import_module table_gen.
 :- import_module bytecode_gen, bytecode.
-:- import_module (lambda), termination, higher_order, inlining.
-:- import_module deforest, dnf, unused_args, magic, dead_proc_elim.
-:- import_module accumulator, lco, saved_vars, liveness.
+:- import_module (lambda), termination, higher_order, accumulator, inlining.
+:- import_module deforest, dnf, magic, dead_proc_elim.
+:- import_module unused_args, lco, saved_vars, liveness.
 :- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
 :- import_module code_gen, optimize, export, base_type_info, base_type_layout.
 :- import_module rl_gen, rl_opt, rl_out.
@@ -1009,19 +1009,19 @@
 	mercury_compile__maybe_higher_order(HLDS30, Verbose, Stats, HLDS32), !,
 	mercury_compile__maybe_dump_hlds(HLDS32, "32", "higher_order"), !,
 
-	mercury_compile__maybe_do_inlining(HLDS32, Verbose, Stats, HLDS34), !,
+	mercury_compile__maybe_introduce_accumulators(HLDS32,
+			Verbose, Stats, HLDS33), !,
+	mercury_compile__maybe_dump_hlds(HLDS33, "33", "accum"), !,
+
+	mercury_compile__maybe_do_inlining(HLDS33, Verbose, Stats, HLDS34), !,
 	mercury_compile__maybe_dump_hlds(HLDS34, "34", "inlining"), !,
 
 	mercury_compile__maybe_deforestation(HLDS34, 
 			Verbose, Stats, HLDS36), !,
 	mercury_compile__maybe_dump_hlds(HLDS36, "36", "deforestation"), !,
-
-	mercury_compile__maybe_unused_args(HLDS36, Verbose, Stats, HLDS38), !,
-	mercury_compile__maybe_dump_hlds(HLDS38, "38", "unused_args"), !,
 
-	mercury_compile__maybe_introduce_accumulators(HLDS38,
-			Verbose, Stats, HLDS39), !,
-	mercury_compile__maybe_dump_hlds(HLDS39, "39", "accum"), !,
+	mercury_compile__maybe_unused_args(HLDS36, Verbose, Stats, HLDS39), !,
+	mercury_compile__maybe_dump_hlds(HLDS39, "39", "unused_args"), !,
 
 	mercury_compile__maybe_lco(HLDS39, Verbose, Stats, HLDS40), !,
 	mercury_compile__maybe_dump_hlds(HLDS40, "40", "lco"), !,
Index: promise/compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.274
diff -u -r1.274 options.m
--- options.m	1999/11/15 00:57:38	1.274
+++ options.m	1999/11/16 05:27:48
@@ -46,6 +46,7 @@
 :- type option	
 	% Warning options
 		--->	inhibit_warnings
+		;	inhibit_accumulator_warnings
 		;	halt_at_warn
 		;	halt_at_syntax_errors
 		;	warn_singleton_vars
@@ -404,6 +405,7 @@
 option_defaults_2(warning_option, [
 		% Warning Options
 	inhibit_warnings	-	bool_special,
+	inhibit_accumulator_warnings -	bool(no),
 	halt_at_warn		-	bool(no),
 	halt_at_syntax_errors	-	bool(no),
 	%
@@ -763,6 +765,7 @@
 
 % warning options
 long_option("inhibit-warnings",		inhibit_warnings).
+long_option("inhibit-accumulator-warnings",	inhibit_accumulator_warnings).
 long_option("halt-at-warn",		halt_at_warn).
 long_option("halt-at-syntax-errors",	halt_at_syntax_errors).
 long_option("warn-singleton-variables",	warn_singleton_vars).
@@ -1174,6 +1177,7 @@
 		:-
 	bool__not(Inhibit, Enable),
 	override_options([
+			inhibit_accumulator_warnings	-	bool(Inhibit),
 			warn_singleton_vars	-	bool(Enable),
 			warn_overlapping_scopes	-	bool(Enable),
 			warn_det_decls_too_lax	-	bool(Enable),
@@ -1417,6 +1421,9 @@
 		"\tThis option causes the compiler to halt immediately",
 		"\tafter syntax checking and not do any semantic checking",
 		"\tif it finds any syntax errors in the program.",
+		"--inhibit-accumulator-warnings",
+		"\tDon't warn about argument order rearrangement caused",
+		"\tby --introduce-accumulators.",
 		"--no-warn-singleton-variables",
 		"\tDon't warn about variables which only occur once.",
 		"--no-warn-overlapping-scopes",
Index: promise/compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.41
diff -u -r1.41 compiler_design.html
--- compiler_design.html	1999/11/08 22:27:59	1.41
+++ compiler_design.html	1999/11/16 04:03:01
@@ -519,6 +519,16 @@
   value of the higher-order/type_info/typeclass_info arguments are known
   (higher_order.m)
 
+<li> attempt to introduce accumulators (accumulator.m).  This optimizes
+  procedures whose tail consists of independent associative computations
+  or independant chains of commutative computations into a tail
+  recursive form by the introduction of accumulators.  If lco is turned
+  on it can also transform some procedures so that only construction
+  unifications are after the recursive call.  This pass must come before
+  lco, unused_args (eliminating arguments makes it hard to relate the
+  code back to the assertion) and inlining (can make the associative
+  call disappear).
+
 <li> inlining (i.e. unfolding) of simple procedures (inlining.m)
 
 <li> pushing constraints as far left as possible (constraint.m);
@@ -548,14 +558,6 @@
 <li> issue warnings about unused arguments from predicates, and create
   specialized versions without them (unused_args.m); type_infos are
   often unused.
-
-<li> attempt to introduce accumulators (accumulator.m).  This optimizes
-  procedures whose tail consists of independent associative computations
-  or independant chains of commutative computations into a tail
-  recursive form by the introduction of accumulators.  If lco is turned
-  on it can also transform some procedures so that only construction
-  unifications are after the recursive call.  This pass must come before
-  lco.
 
 <li> elimination of dead procedures (dead_proc_elim.m). Inlining, higher-order
   specialization and the elimination of unused args can make procedures dead
Index: promise/doc/user_guide.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/user_guide.texi,v
retrieving revision 1.194
diff -u -r1.194 user_guide.texi
--- user_guide.texi	1999/11/15 00:58:13	1.194
+++ user_guide.texi	1999/11/17 03:59:18
@@ -2513,6 +2513,11 @@
 if it finds any syntax errors in the program.
 
 @sp 1
+ at item --inhibit-accumulator-warnings
+Don't warn about argument order rearrangement caused by
+ at samp{--introduce-accumulators}.
+
+ at sp 1
 @item --no-warn-singleton-variables
 Don't warn about variables which only occur once.
 
Index: promise/library/list.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/list.m,v
retrieving revision 1.88
diff -u -r1.88 list.m
--- list.m	1999/07/07 15:19:40	1.88
+++ list.m	1999/11/16 03:30:49
@@ -72,6 +72,16 @@
 %	that it is semidet.  Use list__remove_suffix instead.
 % :- mode list__append(out, in, in) is semidet.
 
+	% associativity of append
+:- promise all [A, B, C, ABC]
+	(
+		( some [AB]
+			(list__append(A, B, AB), list__append(AB, C, ABC)) )
+	<=>
+		( some [BC]
+			(list__append(B, C, BC), list__append(A, BC, ABC)) )
+	).
+
 	% list__remove_suffix(List, Suffix, Prefix):
 	%	The same as list__append(Prefix, Suffix, List) except that
 	%	this is semidet whereas list__append(out, in, in) is nondet.
Index: tests/general/accumulator/runtests
===================================================================
RCS file: /home/staff/zs/imp/tests/general/accumulator/runtests,v
retrieving revision 1.5
diff -u -r1.5 runtests
--- runtests	1999/11/02 05:27:21	1.5
+++ runtests	1999/11/16 07:56:05
@@ -22,10 +22,6 @@
 cat *.res > .allres
 if test ! -s .allres -a "$checkstatus" = 0
 then
-    # XXX disable these checks until we pass them
-    echo "the tests in the general/accumulator directory are not fully enabled"
-    exit 0
-
     grep -h "% mode.*AccFrom" *hlds*acc* | sed -e 's/number//' \
         | sed -e 's/ of predicate//g' > I.$$
     diff -u INTRODUCED I.$$ > INTRODUCED.diff

----
 +----------------------------------------------------------------------+
 | Peter Ross      M Sci/Eng Melbourne Uni                              |
 | petdr at cs.mu.oz.au  WWW: www.cs.mu.oz.au/~petdr/ ph: +61 3 9344 9158  |
 +----------------------------------------------------------------------+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------