[m-dev.] diff: fix bug in instance method clauses

[Simon Taylor]

This change fixes a bug reported by David Overton.


Estimated hours taken: 0.25

Fix a bug in the handling of typeclass method implementations which
call field access functions. The code to build the clauses was putting
the wrong arity in the functor field of the unification created
to represent the function call. The type-checker does not look at
the arity for calls to ordinary user-defined functions.

compiler/make_hlds.m:
	Call construct_pred_or_func_call from produce_instance_method_clauses,
	rather than incorrectly duplicating the code.

tests/hard_coded/typeclasses/record_syntax.{m,exp}:
	Add a test for this bug.


Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.348
diff -u -u -r1.348 make_hlds.m
--- compiler/make_hlds.m	2000/09/12 01:34:42	1.348
+++ compiler/make_hlds.m	2000/09/15 03:26:12
@@ -3664,23 +3664,8 @@
 	varset__init(VarSet0),
 	make_n_fresh_vars("HeadVar__", PredArity, VarSet0, HeadVars, VarSet), 
 	invalid_pred_id(InvalidPredId),
-	invalid_proc_id(InvalidProcId),
-	(
-		PredOrFunc = predicate,
-		Call = call(InvalidPredId, InvalidProcId, HeadVars, not_builtin,
-			no, InstancePredName),
-		IntroducedGoal = Call - GoalInfo
-	;
-		PredOrFunc = function,
-		pred_args_to_func_args(HeadVars, RealHeadVars, ReturnVar),
-		create_atomic_unification(ReturnVar, 
-			functor(cons(InstancePredName, PredArity),
-				RealHeadVars), 
-			Context, explicit, [], IntroducedGoal0),
-		% set the goal_info
-		IntroducedGoal0 = IntroducedGoalExpr - _,
-		IntroducedGoal = IntroducedGoalExpr - GoalInfo
-	),
+	construct_pred_or_func_call(InvalidPredId, PredOrFunc,
+		InstancePredName, HeadVars, GoalInfo, IntroducedGoal),
 	IntroducedClause = clause([], IntroducedGoal, Context),
 
 	map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
Index: tests/hard_coded/typeclasses/record_syntax.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/record_syntax.exp,v
retrieving revision 1.1
diff -u -u -r1.1 record_syntax.exp
--- tests/hard_coded/typeclasses/record_syntax.exp	2000/05/09 10:48:55	1.1
+++ tests/hard_coded/typeclasses/record_syntax.exp	2000/09/15 05:08:29
@@ -12,6 +12,7 @@
 size(List3 ^ e_next ^ e_data) = 9
 Pair0 ^ fst = 1
 Pair = "new first elem" - 2
+size of `type_and_size("string", 6)' = 6
 'fst:=' [4,5,6] = [4 - 2, 5 - 2, 6 - 2]
 DCG ^ arg1 = 1
 DCG ^ arg3 ^ arg4 = 3
Index: tests/hard_coded/typeclasses/record_syntax.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/record_syntax.m,v
retrieving revision 1.1
diff -u -u -r1.1 record_syntax.m
--- tests/hard_coded/typeclasses/record_syntax.m	2000/05/09 10:48:55	1.1
+++ tests/hard_coded/typeclasses/record_syntax.m	2000/09/15 04:10:12
@@ -30,6 +30,12 @@
 	;	e_nil
 	.
 
+:- type type_and_size(T)
+	---> type_and_size(
+		type_and_size_data :: T,
+		data_size :: int
+	).
+
 :- typeclass has_size(T) where [
 		func size(T) = int
 	].
@@ -37,6 +43,7 @@
 :- instance has_size(int).
 :- instance has_size(string).
 :- instance has_size(char).
+:- instance has_size(type_and_size(T)).
 
 :- type my_pair(T, U).
 
@@ -82,7 +89,11 @@
 	write_arg("Pair0 ^ fst", Pair0 ^ fst),
 	{ Pair = Pair0 ^ fst := "new first elem" },
 	write_arg("Pair", Pair),
-	
+
+	{ TypeAndSize = type_and_size("string", 6) },
+	io__write_string("size of `type_and_size(""string"", 6)' = "),
+	io__write_int(size(TypeAndSize)),
+	io__nl,
 
 	% Test taking the address of an update function
 	% for which a mode declaration has been supplied.
@@ -104,6 +115,10 @@
 
 :- instance has_size(char) where [
 		func(size/1) is char__to_int
+	].
+
+:- instance has_size(type_and_size(T)) where [
+		func(size/1) is data_size
 	].
 
 :- func id(T) = T.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------