diff: typeclasses bug fix

[Fergus Henderson]

Estimated hours taken: 2

Fix a bug with typeclasses where the compiler would sometimes
generate code that called the wrong method.

compiler/make_hlds.m:
	Ensure that the list(pred_proc_id) in the hlds_class_defn
	is sorted, to match the way that check_typeclass.m generates
	the corresponding list(pred_proc_id) for the hlds_instance_defn.

tests/hard_coded/typeclasses/Mmakefile:
tests/hard_coded/typeclasses/func_default_mode_bug.m:
tests/hard_coded/typeclasses/func_default_mode_bug.exp:
tests/hard_coded/typeclasses/mode_decl_order_bug.m:
tests/hard_coded/typeclasses/mode_decl_order_bug.exp:
	Add a couple of regression tests for problems fixed by
	the above change.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.289
diff -u -r1.289 make_hlds.m
--- make_hlds.m	1999/03/15 08:47:46	1.289
+++ make_hlds.m	1999/03/17 19:26:32
@@ -1626,7 +1626,16 @@
 				Maybe = yes(Pred - Proc),
 				PredProcId = hlds_class_proc(Pred, Proc)
 			)) },
-		{ list__filter_map(IsYes, PredProcIds0, PredProcIds) },
+		{ list__filter_map(IsYes, PredProcIds0, PredProcIds1) },
+
+			%
+			% The list must be sorted on pred_id and then
+			% proc_id -- check_typeclass.m assumes this
+			% when it is generating the corresponding list
+			% of pred_proc_ids for instance definitions.
+			%
+		{ list__sort(PredProcIds1, PredProcIds) },
+
 		{ Value = hlds_class_defn(Constraints, Vars, PredProcIds, 
 			VarSet, Context) },
 		{ map__det_insert(Classes0, ClassId, Value, Classes) },
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.14
diff -u -r1.14 Mmakefile
--- Mmakefile	1999/02/12 04:19:22	1.14
+++ Mmakefile	1999/03/17 20:01:33
@@ -11,12 +11,14 @@
 	extract_typeinfo \
 	existential_type_classes \
 	extra_typeinfo \
+	func_default_mode_bug \
 	ho_map \
 	implied_instance \
 	implied_instance_poly \
 	inference_test \
 	inference_test_2 \
 	lambda_multi_constraint_same_tvar \
+	mode_decl_order_bug \
 	multi_constraint_diff_tvar \
 	multi_constraint_same_tvar \
 	multi_parameter \
Index: tests/hard_coded/typeclasses/func_default_mode_bug.exp
===================================================================
RCS file: func_default_mode_bug.exp
diff -N func_default_mode_bug.exp
--- /dev/null	Thu Mar 18 07:11:41 1999
+++ func_default_mode_bug.exp	Thu Mar 18 07:00:49 1999
@@ -0,0 +1 @@
+bidon(value(value(-1.00000000000000, -1.00000000000000)))
Index: tests/hard_coded/typeclasses/func_default_mode_bug.m
===================================================================
RCS file: func_default_mode_bug.m
diff -N func_default_mode_bug.m
--- /dev/null	Thu Mar 18 07:11:41 1999
+++ func_default_mode_bug.m	Thu Mar 18 07:11:33 1999
@@ -0,0 +1,162 @@
+:- module func_default_mode_bug.
+
+% +++++++++++
+:- interface.
+% +++++++++++
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+% ----------
+:- type term
+% ----------
+
+--->	parameter(parameter)
+;	value(value).
+
+
+% -----------
+:- type bidon
+% -----------
+
+--->	bidon(term).
+
+
+% -----------
+:- type value
+% -----------
+
+--->	value(float,float).
+
+% ---------------
+:- type parameter
+% ---------------
+
+--->	parameter(string).
+
+
+% We declare a typeclass for the constants used in the expressions.
+% The user has to provide a null element for the mult operator
+% and a null element for the plus operator.
+% The user also has to provide a way to test whether term are null
+% or not.
+% Finally, the user has to provide a way of turning a minus operator
+% to a plus. Typically, this is done by doing :
+% A - B -> A + ( B * -1 )
+% where the constant -1 is up to the user to define...
+:- typeclass constant( C)
+where	[
+	func null_for_mult = C,
+
+	pred is_null_for_mult( C),
+	mode is_null_for_mult( in) is semidet,
+
+	func null_for_plus = C,
+
+	pred is_null_for_plus( C),
+	mode is_null_for_plus( in) is semidet,
+
+	func minus_one = C
+	].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Declares the predicates needed to handle the constants in
+% the expressions.
+
+:- instance constant( term)
+where	[
+	func( null_for_mult/0) is my_null_for_mult,
+
+	pred( is_null_for_mult/1) is my_is_null_for_mult,
+
+	func( null_for_plus/0) is my_null_for_plus,
+
+	pred( is_null_for_plus/1) is my_is_null_for_plus,
+
+	func( minus_one/0) is my_minus_one
+	].
+
+
+% ++++++++++++++++
+:- implementation.
+% ++++++++++++++++
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This function generates a null element for the multiplication.
+
+:- func my_null_for_mult = term.
+:- mode my_null_for_mult = out is det.
+
+my_null_for_mult = value( definition_value( 1.0)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This predicate succeeds if the argument is the 1.0 value.
+
+:- pred my_is_null_for_mult( term).
+:- mode my_is_null_for_mult( in) is semidet.
+
+my_is_null_for_mult( value( definition_value( 1.0))).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This function generates a null element for the addition.
+
+:- func my_null_for_plus = term.
+:- mode my_null_for_plus = out is det.
+
+my_null_for_plus = value( definition_value( 0.0)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This predicate succeeds if the argument is the 0.0 value.
+
+:- pred my_is_null_for_plus( term).
+:- mode my_is_null_for_plus( in) is semidet.
+
+my_is_null_for_plus( value( definition_value( 0.0))).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This function generates a null element for the addition.
+
+:- func my_minus_one = term.
+:- mode my_minus_one = out is det.
+
+my_minus_one = value( definition_value( -1.0)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This predicate is used to turn a float or a pair of floats
+% into the type value.
+:- func definition_value( float) = value.
+:- mode definition_value( in) = out is det.
+
+definition_value(X) = value( X, X).
+
+:- func definition_value( float, float) = value.
+:- mode definition_value( in, in) = out is det.
+
+definition_value( X, Y) = value( X, Y).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%:- pred main(io__state, io__state).
+%:- mode main(di, uo) is det.
+
+main( In, Out) :-
+	io__write( bidon( minus_one), In, Int3),
+	io__nl( Int3, Out).
Index: tests/hard_coded/typeclasses/mode_decl_order_bug.exp
===================================================================
RCS file: mode_decl_order_bug.exp
diff -N mode_decl_order_bug.exp
--- /dev/null	Thu Mar 18 07:11:41 1999
+++ mode_decl_order_bug.exp	Thu Mar 18 07:01:07 1999
@@ -0,0 +1 @@
+bidon(value(value(-1.00000000000000, -1.00000000000000)))
Index: tests/hard_coded/typeclasses/mode_decl_order_bug.m
===================================================================
RCS file: mode_decl_order_bug.m
diff -N mode_decl_order_bug.m
--- /dev/null	Thu Mar 18 07:11:41 1999
+++ mode_decl_order_bug.m	Thu Mar 18 07:11:33 1999
@@ -0,0 +1,166 @@
+:- module mode_decl_order_bug.
+
+% +++++++++++
+:- interface.
+% +++++++++++
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+% ----------
+:- type term
+% ----------
+
+--->	parameter(parameter)
+;	value(value).
+
+
+% -----------
+:- type bidon
+% -----------
+
+--->	bidon(term).
+
+
+% -----------
+:- type value
+% -----------
+
+--->	value(float,float).
+
+% ---------------
+:- type parameter
+% ---------------
+
+--->	parameter(string).
+
+
+% We declare a typeclass for the constants used in the expressions.
+% The user has to provide a null element for the mult operator
+% and a null element for the plus operator.
+% The user also has to provide a way to test whether term are null
+% or not.
+% Finally, the user has to provide a way of turning a minus operator
+% to a plus. Typically, this is done by doing :
+% A - B -> A + ( B * -1 )
+% where the constant -1 is up to the user to define...
+:- typeclass constant( C)
+where	[
+	func null_for_mult = C,
+
+	pred is_null_for_mult( C),
+	mode is_null_for_mult( in) is semidet,
+
+	func null_for_plus = C,
+	mode null_for_plus = out is det,
+
+	func minus_one = C,
+	mode minus_one = out is det,
+
+	mode null_for_mult = out is det,
+
+	pred is_null_for_plus( C),
+	mode is_null_for_plus( in) is semidet
+	].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Declares the predicates needed to handle the constants in
+% the expressions.
+
+:- instance constant( term)
+where	[
+	func( null_for_mult/0) is my_null_for_mult,
+
+	pred( is_null_for_mult/1) is my_is_null_for_mult,
+
+	func( null_for_plus/0) is my_null_for_plus,
+
+	pred( is_null_for_plus/1) is my_is_null_for_plus,
+
+	func( minus_one/0) is my_minus_one
+	].
+
+
+% ++++++++++++++++
+:- implementation.
+% ++++++++++++++++
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This function generates a null element for the multiplication.
+
+:- func my_null_for_mult = term.
+:- mode my_null_for_mult = out is det.
+
+my_null_for_mult = value( definition_value( 1.0)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This predicate succeeds if the argument is the 1.0 value.
+
+:- pred my_is_null_for_mult( term).
+:- mode my_is_null_for_mult( in) is semidet.
+
+my_is_null_for_mult( value( definition_value( 1.0))).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This function generates a null element for the addition.
+
+:- func my_null_for_plus = term.
+:- mode my_null_for_plus = out is det.
+
+my_null_for_plus = value( definition_value( 0.0)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This predicate succeeds if the argument is the 0.0 value.
+
+:- pred my_is_null_for_plus( term).
+:- mode my_is_null_for_plus( in) is semidet.
+
+my_is_null_for_plus( value( definition_value( 0.0))).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This function generates a null element for the addition.
+
+:- func my_minus_one = term.
+:- mode my_minus_one = out is det.
+
+my_minus_one = value( definition_value( -1.0)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This predicate is used to turn a float or a pair of floats
+% into the type value.
+:- func definition_value( float) = value.
+:- mode definition_value( in) = out is det.
+
+definition_value(X) = value( X, X).
+
+:- func definition_value( float, float) = value.
+:- mode definition_value( in, in) = out is det.
+
+definition_value( X, Y) = value( X, Y).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%:- pred main(io__state, io__state).
+%:- mode main(di, uo) is det.
+
+main( In, Out) :-
+	io__write( bidon( minus_one), In, Int3),
+	io__nl( Int3, Out).
-- 
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.