[m-rev.] diff: fix bug in record syntax

[Simon Taylor]

Estimated hours taken: 1
Branches: main, release

Fix a bug in record syntax.

compiler/post_typecheck.m:
	Check for higher-order terms before field access functions
	when resolving a var-functor unification, because it's easier
	to check that the argument types of a higher-order term match.

compiler/hlds_module.m:
	Export get_proc_id for use by post_typecheck.m.

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

Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.67
diff -u -u -r1.67 hlds_module.m
--- compiler/hlds_module.m	2001/06/27 05:04:06	1.67
+++ compiler/hlds_module.m	2001/09/04 20:52:53
@@ -1226,6 +1226,11 @@
 				module_info, pred_id).
 :- mode get_pred_id(in, in, in, in, in, out) is semidet.
 
+	% Given a pred_id, return the single proc_id, aborting
+	% if there are no modes or more than one mode.
+:- pred get_proc_id(module_info, pred_id, proc_id).
+:- mode get_proc_id(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -1796,15 +1801,10 @@
 		error(Msg)
 
 	),
-	module_info_get_predicate_table(ModuleInfo, PredicateTable),
-	get_proc_id(PredicateTable, PredId, ProcId).
-
-:- pred get_proc_id(predicate_table, pred_id, proc_id).
-:- mode get_proc_id(in, in, out) is det.
+	get_proc_id(ModuleInfo, PredId, ProcId).
 
-get_proc_id(PredicateTable, PredId, ProcId) :-
-	predicate_table_get_preds(PredicateTable, Preds),
-	map__lookup(Preds, PredId, PredInfo),
+get_proc_id(ModuleInfo, PredId, ProcId) :-
+	module_info_pred_info(ModuleInfo, PredId, PredInfo),
 	pred_info_procids(PredInfo, ProcIds),
 	( ProcIds = [ProcId0] ->
 		ProcId = ProcId0
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.32
diff -u -u -r1.32 post_typecheck.m
--- compiler/post_typecheck.m	2001/07/10 10:45:29	1.32
+++ compiler/post_typecheck.m	2001/09/05 09:07:35
@@ -1062,9 +1062,44 @@
 		Goal = FuncCall - GoalInfo0
 	;
 		%
+		% Is the function symbol a higher-order predicate
+		% or function constant?
+		%
+		ConsId0 = cons(Name, _),
+		type_is_higher_order(TypeOfX, PredOrFunc,
+			EvalMethod, HOArgTypes),
+
+		%
+		% We don't do this for the clause introduced by the
+		% compiler for a field access function -- that needs
+		% to be expanded into unifications below.
+		%
+		\+ pred_info_is_field_access_function(ModuleInfo, PredInfo0),
+
+		%
+		% Find the pred_id of the constant.
+		%
+		map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
+		AllArgTypes = ArgTypes0 ++ HOArgTypes,
+		pred_info_typevarset(PredInfo0, TVarSet),
+		get_pred_id(Name, PredOrFunc, TVarSet, AllArgTypes,
+			ModuleInfo, PredId)
+	->
+		get_proc_id(ModuleInfo, PredId, ProcId),
+		ConsId = pred_const(PredId, ProcId, EvalMethod),
+		Goal = unify(X0, functor(ConsId, ArgVars0), Mode0,
+			Unification0, UnifyContext) - GoalInfo0,
+		PredInfo = PredInfo0,
+		VarTypes = VarTypes0,
+		VarSet = VarSet0
+	;
+		%
 		% Is it a call to an automatically generated field access
-		% function. This test must be after conversion of function
-		% calls into predicate calls above.
+		% function. This test must come after the tests for
+		% function calls and higher-order terms above.
+		% It's done that way because it's easier to check
+		% that the types match for functions calls and
+		% higher-order terms.
 		%
 		ConsId0 = cons(Name, Arity),
 		is_field_access_function_name(ModuleInfo, Name, Arity,
@@ -1091,33 +1126,6 @@
 			PredInfo0, PredInfo, VarTypes0, VarTypes,
 			VarSet0, VarSet, AccessType, FieldName,
 			UnifyContext, X0, ArgVars0, GoalInfo0, Goal)
-	;
-		%
-		% Is the function symbol a higher-order predicate
-		% or function constant?
-		% This test needs to come after the test to recognise
-		% function calls and field access function calls
-		% to avoid being confused by functions that return
-		% higher-order terms.
-		%
-		ConsId0 = cons(Name, _),
-		type_is_higher_order(TypeOfX, PredOrFunc,
-			EvalMethod, HOArgTypes)
-	->
-		%
-		% Find the pred_id and proc_id of the constant.
-		%
-		map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
-		AllArgTypes = ArgTypes0 ++ HOArgTypes,
-		pred_info_typevarset(PredInfo0, TVarSet),
-		get_pred_id_and_proc_id(Name, PredOrFunc, TVarSet,
-			AllArgTypes, ModuleInfo, PredId, ProcId),
-		ConsId = pred_const(PredId, ProcId, EvalMethod),
-		Goal = unify(X0, functor(ConsId, ArgVars0), Mode0,
-			Unification0, UnifyContext) - GoalInfo0,
-		PredInfo = PredInfo0,
-		VarTypes = VarTypes0,
-		VarSet = VarSet0
 	;
 		%
 		% Module qualify ordinary construction/deconstruction
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.89
diff -u -u -r1.89 Mmakefile
--- tests/valid/Mmakefile	2001/06/27 08:09:03	1.89
+++ tests/valid/Mmakefile	2001/09/04 21:18:59
@@ -134,6 +134,7 @@
 	record_syntax_bug.m \
 	record_syntax_bug_2.m \
 	record_syntax_bug_3.m \
+	record_syntax_bug_4.m \
 	recursive_no_tag_type.m \
 	same_length_2.m \
 	semidet_disj.m \
Index: tests/valid/record_syntax_bug_4.m
===================================================================
RCS file: record_syntax_bug_4.m
diff -N record_syntax_bug_4.m
--- /dev/null	Mon Apr 16 11:57:05 2001
+++ record_syntax_bug_4.m	Wed Sep  5 07:18:45 2001
@@ -0,0 +1,26 @@
+:- module record_syntax_bug_4.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+
+:- type info
+	---> info(
+		field :: int
+	).
+		
+main -->
+	{ List = list__map(field(info(1)), [1, 2, 3]) },
+	io__write(List),
+	io__nl.
+
+:- func field(info, int) = int.
+
+field(_Info, Int) = Int.
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------