[m-dev.] for review: record syntax [2]

Simon Taylor stayl at cs.mu.OZ.AU
Tue Jan 4 17:06:26 AEDT 2000


Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.17
diff -u -u -r1.17 post_typecheck.m
--- post_typecheck.m	1999/11/11 23:12:08	1.17
+++ post_typecheck.m	1999/12/22 05:14:07
@@ -33,7 +33,7 @@
 
 :- module post_typecheck.
 :- interface.
-:- import_module hlds_goal, hlds_module, hlds_pred, prog_data.
+:- import_module hlds_data, hlds_goal, hlds_module, hlds_pred, prog_data.
 :- import_module list, io, bool.
 
 	% check_type_bindings(PredId, PredInfo, ModuleInfo, ReportErrors):
@@ -74,6 +74,15 @@
 :- mode post_typecheck__finish_aditi_builtin(in, in, in, in,
 		in, out, in, out, out, di, uo) is det.
 
+	% Work out whether a var-functor unification is actually a function
+	% call. If so, replace the unification goal with a call.
+	%
+:- pred post_typecheck__resolve_unify_functor(prog_var, cons_id,
+		list(prog_var), unify_mode, unification, unify_context,
+		hlds_goal_info, module_info, pred_info, pred_info, hlds_goal).
+:- mode post_typecheck__resolve_unify_functor(in, in, in, in, in, in,
+		in, in, in, out, out) is det.
+
 	% Do the stuff needed to initialize the pred_infos and proc_infos
 	% so that a pred is ready for running polymorphism and then
 	% mode checking.
@@ -104,11 +113,12 @@
 :- implementation.
 
 :- import_module (assertion), code_util, typecheck, clause_to_proc.
-:- import_module mode_util, inst_match, (inst).
-:- import_module mercury_to_mercury, prog_out, hlds_data, hlds_out, type_util.
+:- import_module mode_util, inst_match, (inst), prog_util.
+:- import_module mercury_to_mercury, prog_out, hlds_out, type_util.
 :- import_module globals, options.
 
 :- import_module map, set, assoc_list, bool, std_util, term, require, int.
+:- import_module varset.
 
 %-----------------------------------------------------------------------------%
 %			Check for unbound type variables
@@ -568,9 +578,7 @@
 	% 
 post_typecheck__finish_pred(ModuleInfo, PredId, PredInfo0, PredInfo) -->
 	post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
-			PredInfo0, PredInfo1),
-	{ post_typecheck__resolve_func_overloading(PredInfo1, ModuleInfo,
-			PredInfo) }.
+			PredInfo0, PredInfo).
 
 	%
 	% For ill-typed preds, we just need to set the modes up correctly
@@ -749,152 +757,11 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-	%
-	% post_typecheck__resolve_func_overloading
-	%
-	% Convert unifications that are function calls into HLDS call
-	% instructions.
-	%
-:- pred post_typecheck__resolve_func_overloading(pred_info::in,
-		module_info::in, pred_info::out) is det.
-
-post_typecheck__resolve_func_overloading(PredInfo0, ModuleInfo, PredInfo) :-
-
-	pred_info_clauses_info(PredInfo0, ClausesInfo0),
-	clauses_info_clauses(ClausesInfo0, Clauses0),
-
-	list__map(post_typecheck__resolve_func_overloading_clauses(PredInfo0,
-				ModuleInfo),
-			Clauses0, Clauses),
-
-	clauses_info_set_clauses(ClausesInfo0, Clauses, ClausesInfo),
-	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
-
-:- pred post_typecheck__resolve_func_overloading_clauses(pred_info::in,
-		module_info::in, clause::in, clause::out) is det.
-
-post_typecheck__resolve_func_overloading_clauses(PredInfo, ModuleInfo,
-		Clause0, Clause) :-
-	Clause0 = clause(ProcIds, Goal0, Context),
-	post_typecheck__resolve_data_cons_and_funcs(Goal0, ModuleInfo,
-			PredInfo, Goal),
-	Clause = clause(ProcIds, Goal, Context).
-
-%-----------------------------------------------------------------------------%
-
-	%
-	% post_typecheck__resolve_data_cons_and_funcs
-	%
-	% Traverse the hlds_goal structure transforming the unifications
-	% that are function application into the correct calls.
-	%
-:- pred post_typecheck__resolve_data_cons_and_funcs(hlds_goal::in,
-		module_info::in, pred_info::in,
-		hlds_goal::out) is det.
-
-post_typecheck__resolve_data_cons_and_funcs(
-		unify(XVar, Y, Mode, Unification, UnifyContext) - GoalInfo,
-		ModuleInfo, PredInfo, Goal) :-
-	(
-		Y = functor(ConsId, Args),
-		post_typecheck__resolve_unify_functor(XVar, ConsId,
-				Args, Mode, Unification, UnifyContext,
-				GoalInfo, ModuleInfo, PredInfo, Goal)
-	;
-		Y = lambda_goal(A, B, C, D, E, F, G, LambdaGoal0),
-		post_typecheck__resolve_data_cons_and_funcs(LambdaGoal0,
-				ModuleInfo, PredInfo, LambdaGoal),
-		NewY = lambda_goal(A, B, C, D, E, F, G, LambdaGoal),
-		Goal = unify(XVar, NewY, Mode, Unification, UnifyContext)
-				- GoalInfo
-	;
-		Y = var(_),
-		Goal = unify(XVar, Y, Mode, Unification, UnifyContext)
-				- GoalInfo
-	).
-
-	% Goals which simply traverse the hlds_goal structure.
-post_typecheck__resolve_data_cons_and_funcs(call(A,B,C,D,E,F) - GoalInfo,
-		_, _, call(A,B,C,D,E,F) - GoalInfo).
-post_typecheck__resolve_data_cons_and_funcs(generic_call(A,B,C,D) - GoalInfo,
-		_, _, generic_call(A,B,C,D) - GoalInfo).
-post_typecheck__resolve_data_cons_and_funcs(pragma_c_code(A,B,C,D,E,F,G) -
-		GoalInfo, _, _, pragma_c_code(A,B,C,D,E,F,G) - GoalInfo).
-post_typecheck__resolve_data_cons_and_funcs(conj(Goals0) - GoalInfo,
-		ModuleInfo, PredInfo, conj(Goals) - GoalInfo) :-
-	post_typecheck__resolve_data_cons_and_funcs_list(Goals0,
-			ModuleInfo, PredInfo, Goals).
-post_typecheck__resolve_data_cons_and_funcs(switch(A,B,Cases0,D) - GoalInfo,
-		ModuleInfo, PredInfo,
-		switch(A,B,Cases,D) - GoalInfo) :-
-	post_typecheck__resolve_data_cons_and_funcs_cases(Cases0,
-			ModuleInfo, PredInfo, Cases).
-post_typecheck__resolve_data_cons_and_funcs(disj(Goals0,B) - GoalInfo,
-		ModuleInfo, PredInfo, disj(Goals,B) - GoalInfo) :-
-	post_typecheck__resolve_data_cons_and_funcs_list(Goals0,
-			ModuleInfo, PredInfo, Goals).
-post_typecheck__resolve_data_cons_and_funcs(not(Goal0) - GoalInfo,
-		ModuleInfo, PredInfo, not(Goal) - GoalInfo) :-
-	post_typecheck__resolve_data_cons_and_funcs(Goal0,
-			ModuleInfo, PredInfo, Goal).
-post_typecheck__resolve_data_cons_and_funcs(some(A,B,Goal0) - GoalInfo,
-		ModuleInfo, PredInfo, some(A,B,Goal) - GoalInfo) :-
-	post_typecheck__resolve_data_cons_and_funcs(Goal0,
-			ModuleInfo, PredInfo, Goal).
-post_typecheck__resolve_data_cons_and_funcs(par_conj(Goals0,B) - GoalInfo,
-		ModuleInfo, PredInfo, par_conj(Goals,B) - GoalInfo) :-
-	post_typecheck__resolve_data_cons_and_funcs_list(Goals0,
-			ModuleInfo, PredInfo, Goals).
-post_typecheck__resolve_data_cons_and_funcs(if_then_else(A,If0,Then0,Else0,E)
-		- GoalInfo, ModuleInfo, PredInfo,
-		if_then_else(A,If,Then,Else,E) - GoalInfo) :-
-	post_typecheck__resolve_data_cons_and_funcs(If0, 
-			ModuleInfo, PredInfo, If),
-	post_typecheck__resolve_data_cons_and_funcs(Then0,
-			ModuleInfo, PredInfo, Then),
-	post_typecheck__resolve_data_cons_and_funcs(Else0,
-			ModuleInfo, PredInfo, Else).
-post_typecheck__resolve_data_cons_and_funcs(bi_implication(_, _) - _, _, _, _) :-
-	% these should have been expanded out by now
-	error("post_typecheck__resolve_data_cons_and_funcs: unexpected bi_implication").
-	
-:- pred post_typecheck__resolve_data_cons_and_funcs_list(list(hlds_goal)::in,
-		module_info::in, pred_info::in, list(hlds_goal)::out) is det.
-
-post_typecheck__resolve_data_cons_and_funcs_list([], _, _, []).
-post_typecheck__resolve_data_cons_and_funcs_list([Goal0 | Goal0s],
-		ModuleInfo, PredInfo, [Goal | Goals]) :-
-	post_typecheck__resolve_data_cons_and_funcs(Goal0,
-			ModuleInfo, PredInfo, Goal),
-	post_typecheck__resolve_data_cons_and_funcs_list(Goal0s,
-			ModuleInfo, PredInfo, Goals).
-
-:- pred post_typecheck__resolve_data_cons_and_funcs_cases(list(case)::in,
-		module_info::in, pred_info::in, list(case)::out) is det.
-
-post_typecheck__resolve_data_cons_and_funcs_cases([], _, _, []).
-post_typecheck__resolve_data_cons_and_funcs_cases([Case0 | Case0s],
-		ModuleInfo, PredInfo, [Case | Cases]) :-
-	Case0 = case(ConsId, Goal0),
-	post_typecheck__resolve_data_cons_and_funcs(Goal0,
-			ModuleInfo, PredInfo, Goal),
-	Case = case(ConsId, Goal),
-	post_typecheck__resolve_data_cons_and_funcs_cases(Case0s,
-			ModuleInfo, PredInfo, Cases).
-
-%-----------------------------------------------------------------------------%
-
-:- pred post_typecheck__resolve_unify_functor(prog_var, cons_id, list(prog_var),
-		unify_mode, unification, unify_context, hlds_goal_info,
-		module_info, pred_info, hlds_goal).
-:- mode post_typecheck__resolve_unify_functor(in, in, in, in, in, in,
-		in, in, in, out) is det.
-
 post_typecheck__resolve_unify_functor(X0, ConsId0, ArgVars0, Mode0,
 		Unification0, UnifyContext, GoalInfo0,
-		ModuleInfo0, PredInfo, Goal) :-
+		ModuleInfo0, PredInfo0, PredInfo, Goal) :-
 
-        pred_info_clauses_info(PredInfo, ClausesInfo),
+        pred_info_clauses_info(PredInfo0, ClausesInfo),
         clauses_info_vartypes(ClausesInfo, VarTypes0),
 
 	map__lookup(VarTypes0, X0, TypeOfX),
@@ -923,6 +790,7 @@
 			higher_order(FuncVar, function, FullArity),
 			ArgVars, Modes, Det),
 
+		PredInfo = PredInfo0,
 		Goal = HOCall - GoalInfo0
 	;
 		%
@@ -946,7 +814,7 @@
 		% a type ambiguity error, but compiler-generated
 		% predicates are not type-checked.)
 		%
-		\+ code_util__compiler_generated(PredInfo),
+		\+ code_util__compiler_generated(PredInfo0),
 
 		module_info_get_predicate_table(ModuleInfo0, PredTable),
 		predicate_table_search_func_sym_arity(PredTable,
@@ -956,7 +824,7 @@
 		% argument/return types which subsume the actual
 		% argument/return types of this function call
 
-		pred_info_typevarset(PredInfo, TVarSet),
+		pred_info_typevarset(PredInfo0, TVarSet),
 		map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
 		list__append(ArgTypes0, [TypeOfX], ArgTypes),
 		typecheck__find_matching_pred_id(PredIds, ModuleInfo0,
@@ -974,15 +842,341 @@
 		FuncCall = call(PredId, ProcId, ArgVars, not_builtin,
 			yes(FuncCallUnifyContext), QualifiedFuncName),
 
+		PredInfo = PredInfo0,
 		Goal = FuncCall - GoalInfo0
 	;
 		%
+		% Is it call to a field access function for
+		% which the user has not provided a definition.
+		% This test must be after conversion of function
+		% calls into predicate calls above.
+		%
+		ConsId0 = cons(Name, Arity),
+		is_field_access_function_name(ModuleInfo0, Name, Arity,
+			AccessType, _IsBuiltin, FieldName)
+	->
+		post_typecheck__finish_field_access_function(ModuleInfo0,
+			PredInfo0, PredInfo, AccessType, FieldName,
+			UnifyContext, X0, ArgVars0, GoalInfo0, Goal)
+	;
+		%
 		% ordinary construction/deconstruction unifications
 		% we leave alone
 		%
+		PredInfo = PredInfo0,
 		Goal = unify(X0, functor(ConsId0, ArgVars0), Mode0,
 				Unification0, UnifyContext) - GoalInfo0
 	).
+
+%-----------------------------------------------------------------------------%
+
+	% Convert a field access function call into the equivalent unifications
+	% so that later passes do not have to handle them as a special case.
+	% The error messages from mode analysis and determinism analysis
+	% shouldn't be too much worse than if the goals were special cases.
+	%
+:- pred post_typecheck__finish_field_access_function(module_info, pred_info,
+		pred_info, field_access_type, ctor_field_name,
+		unify_context, prog_var, list(prog_var),
+		hlds_goal_info, hlds_goal).
+:- mode post_typecheck__finish_field_access_function(in, in, out, in, in,
+		in, in, in, in, out) is det.
+
+post_typecheck__finish_field_access_function(ModuleInfo, PredInfo0, PredInfo,
+		AccessType, FieldName, UnifyContext,
+		Var, Args, GoalInfo, GoalExpr - GoalInfo) :-
+	(
+		AccessType = get,
+		field_extraction_function_args(Args, TermVar),
+		post_typecheck__translate_get_function(ModuleInfo,
+			PredInfo0, PredInfo, FieldName, UnifyContext,
+			Var, TermVar, GoalInfo, GoalExpr)
+	;
+		AccessType = set,
+		field_update_function_args(Args, TermInputVar, FieldVar),
+		post_typecheck__translate_set_function(ModuleInfo,
+			PredInfo0, PredInfo, FieldName, UnifyContext,
+			FieldVar, TermInputVar, Var,
+			GoalInfo, GoalExpr)
+	).
+
+:- pred post_typecheck__translate_get_function(module_info,
+		pred_info, pred_info, ctor_field_name, unify_context, prog_var,
+		prog_var, hlds_goal_info, hlds_goal_expr).
+:- mode post_typecheck__translate_get_function(in, in, out,
+		in, in, in, in, in, out) is det.
+
+post_typecheck__translate_get_function(ModuleInfo, PredInfo0, PredInfo,
+		FieldName, UnifyContext, FieldVar, TermInputVar,
+		OldGoalInfo, GoalExpr) :-
+	pred_info_clauses_info(PredInfo0, ClausesInfo0),
+	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+	map__lookup(VarTypes0, TermInputVar, TermType),
+	get_constructor_containing_field(ModuleInfo, TermType, FieldName,
+		ConsId, FieldNumber),
+
+	get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId,
+		TermType, ArgTypes, _, PredInfo0, PredInfo1),
+
+	split_list_at_index(FieldNumber, ArgTypes,
+		TypesBeforeField, _, TypesAfterField),
+
+	make_new_vars(TypesBeforeField, VarsBeforeField, PredInfo1, PredInfo2),
+	make_new_vars(TypesAfterField, VarsAfterField, PredInfo2, PredInfo),
+
+	list__append(VarsBeforeField, [FieldVar | VarsAfterField], ArgVars),
+
+	goal_info_get_nonlocals(OldGoalInfo, RestrictNonLocals),
+	create_atomic_unification_with_nonlocals(TermInputVar,
+		functor(ConsId, ArgVars), OldGoalInfo,
+		RestrictNonLocals, [FieldVar, TermInputVar],
+		UnifyContext, FunctorGoal),
+	FunctorGoal = GoalExpr - _.
+
+:- pred post_typecheck__translate_set_function(module_info,
+		pred_info, pred_info, ctor_field_name, unify_context, prog_var,
+		prog_var, prog_var, hlds_goal_info, hlds_goal_expr).
+:- mode post_typecheck__translate_set_function(in, in, out,
+		in, in, in, in, in, in, out) is det.
+
+post_typecheck__translate_set_function(ModuleInfo, PredInfo0, PredInfo,
+		FieldName, UnifyContext, FieldVar, TermInputVar, TermOutputVar,
+		OldGoalInfo, Goal) :-
+	pred_info_clauses_info(PredInfo0, ClausesInfo0),
+	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+	map__lookup(VarTypes0, TermInputVar, TermType),
+
+	get_constructor_containing_field(ModuleInfo, TermType, FieldName,
+		ConsId0, FieldNumber),
+
+	get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId0,
+		TermType, ArgTypes, ExistQVars, PredInfo0, PredInfo1),
+
+	split_list_at_index(FieldNumber, ArgTypes,
+		TypesBeforeField, TermFieldType, TypesAfterField),
+
+	make_new_vars(TypesBeforeField, VarsBeforeField, PredInfo1, PredInfo2),
+	make_new_var(TermFieldType, SingletonFieldVar, PredInfo2, PredInfo3),
+	make_new_vars(TypesAfterField, VarsAfterField, PredInfo3, PredInfo),
+
+	%
+	% Build a goal to deconstruct the input.
+	%
+	list__append(VarsBeforeField, [SingletonFieldVar | VarsAfterField],
+		DeconstructArgs),
+	goal_info_get_nonlocals(OldGoalInfo, OldNonLocals),
+	list__append(VarsBeforeField, VarsAfterField, NonLocalArgs),
+	set__insert_list(OldNonLocals, NonLocalArgs,
+		DeconstructRestrictNonLocals),
+
+	create_atomic_unification_with_nonlocals(TermInputVar,
+		functor(ConsId0, DeconstructArgs), OldGoalInfo,
+		DeconstructRestrictNonLocals, [TermInputVar | DeconstructArgs],
+		UnifyContext, DeconstructGoal),
+
+	%
+	% Build a goal to construct the output.
+	%
+	list__append(VarsBeforeField, [FieldVar | VarsAfterField],
+		ConstructArgs),
+	set__insert_list(OldNonLocals, NonLocalArgs,
+		ConstructRestrictNonLocals),
+
+	% If the cons_id is existentially quantified, add a `new' prefix
+	% so that polymorphism.m adds the appropriate type_infos.
+	( ExistQVars = [] ->
+		ConsId = ConsId0
+	;
+		( ConsId0 = cons(ConsName0, ConsArity) ->
+			remove_new_prefix(ConsName, ConsName0),
+			ConsId = cons(ConsName, ConsArity)	
+		;
+			error(
+		"post_typecheck__translate_set_function: invalid cons_id")
+		)
+	),
+
+	create_atomic_unification_with_nonlocals(TermOutputVar,
+		functor(ConsId, ConstructArgs), OldGoalInfo,
+		ConstructRestrictNonLocals, [TermOutputVar | ConstructArgs],
+		UnifyContext, ConstructGoal),
+	
+	Conj = conj([DeconstructGoal, ConstructGoal]) - OldGoalInfo,
+
+	% Make mode analysis treat the translated access function
+	% as an atomic goal.
+	Goal = some([], can_remove, Conj).
+
+:- pred get_cons_id_arg_types_adding_existq_tvars(module_info, cons_id,
+		(type), list(type), list(tvar), pred_info, pred_info).
+:- mode get_cons_id_arg_types_adding_existq_tvars(in, in, in,
+		out, out, in, out) is det.
+
+get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId, TermType,
+		ArgTypes, NewExistQVars, PredInfo0, PredInfo) :-
+	%
+	% Split the list of argument types at the named field. 
+	%
+	type_util__get_type_and_cons_defn(ModuleInfo, TermType,
+		ConsId, TypeDefn, ConsDefn),
+	ConsDefn = hlds_cons_defn(ExistQVars, _, ArgTypes0, _, _),
+	( ExistQVars = [] ->
+		ArgTypes1 = ArgTypes0,
+		PredInfo = PredInfo0,
+		NewExistQVars = []
+	;
+		%
+		% Rename apart the existentially quantified type variables.
+		%
+		list__length(ExistQVars, NumExistQVars),
+		pred_info_typevarset(PredInfo0, TVarSet0),
+		varset__new_vars(TVarSet0, NumExistQVars, NewExistQVars,
+			TVarSet),
+		pred_info_set_typevarset(PredInfo0, TVarSet, PredInfo),
+		map__from_corresponding_lists(ExistQVars, NewExistQVars,
+			TVarSubst),
+		term__apply_variable_renaming_to_list(ArgTypes0, TVarSubst,
+			ArgTypes1)
+	),
+	hlds_data__get_type_defn_tparams(TypeDefn, TypeParams),
+	term__term_list_to_var_list(TypeParams, TypeDefnArgs),
+	( type_to_type_id(TermType, _, TypeArgs) ->
+		map__from_corresponding_lists(TypeDefnArgs, TypeArgs, TSubst)
+	;
+		error(
+	"get_cons_id_arg_types_adding_existq_tvars: type_to_type_id failed")
+
+	),
+	term__apply_substitution_to_list(ArgTypes1, TSubst, ArgTypes).
+
+:- pred split_list_at_index(int, list(T), list(T), T, list(T)).
+:- mode split_list_at_index(in, in, out, out, out) is det.
+
+split_list_at_index(Index, List, Before, At, After) :-
+	(
+		list__split_list(Index - 1, List, Before0, AtAndAfter),
+		AtAndAfter = [At0 | After0]
+	->
+		Before = Before0,
+		At = At0,
+		After = After0
+	;
+		error("post_typecheck__split_list_at_index")
+	).
+
+%-----------------------------------------------------------------------------%
+
+	% Work out which constructor of the type has an argument with the
+	% given field name.
+:- pred get_constructor_containing_field(module_info, (type), ctor_field_name,
+		cons_id, int).
+:- mode get_constructor_containing_field(in, in, in, out, out) is det.
+
+get_constructor_containing_field(ModuleInfo, TermType, FieldName,
+		ConsId, FieldNumber) :-
+	( type_to_type_id(TermType, TermTypeId0, _) ->
+		TermTypeId = TermTypeId0
+	;
+		error(
+		"get_constructor_containing_field: type_to_type_id failed")
+	),
+	module_info_types(ModuleInfo, Types),
+	map__lookup(Types, TermTypeId, TermTypeDefn),
+	hlds_data__get_type_defn_body(TermTypeDefn, TermTypeBody),
+	( TermTypeBody = du_type(Ctors, _, _, _) ->
+		get_constructor_containing_field_2(Ctors, FieldName, ConsId,
+			FieldNumber)
+	;
+		error("get_constructor_containing_field: not du type")
+	).
+
+:- pred get_constructor_containing_field_2(list(constructor),
+		ctor_field_name, cons_id, int).
+:- mode get_constructor_containing_field_2(in, in, out, out) is det.
+
+get_constructor_containing_field_2([], _, _, _) :-
+	error("get_constructor_containing_field: can't find field").
+get_constructor_containing_field_2([Ctor | Ctors], FieldName,
+		ConsId, FieldNumber) :-
+	Ctor = ctor(_, _, SymName, CtorArgs),
+	(
+		get_constructor_containing_field_3(CtorArgs,
+			FieldName, 1, FieldNumber0)
+	->
+		list__length(CtorArgs, Arity),
+		ConsId = cons(SymName, Arity),
+		FieldNumber = FieldNumber0
+	;
+		get_constructor_containing_field_2(Ctors, FieldName,
+			ConsId, FieldNumber)
+	).
+
+:- pred get_constructor_containing_field_3(list(constructor_arg),
+		ctor_field_name, int, int).
+:- mode get_constructor_containing_field_3(in, in, in, out) is semidet.
+
+get_constructor_containing_field_3([MaybeArgFieldName - _ | CtorArgs],
+		FieldName, FieldNumber0, FieldNumber) :-
+	(
+		MaybeArgFieldName = yes(ArgFieldName),
+		unqualify_name(ArgFieldName, UnqualFieldName),
+		unqualify_name(FieldName, UnqualFieldName)
+	->
+		FieldNumber = FieldNumber0
+	;
+		get_constructor_containing_field_3(CtorArgs, FieldName,
+			FieldNumber0 + 1, FieldNumber)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred create_atomic_unification_with_nonlocals(prog_var, unify_rhs,
+		hlds_goal_info, set(prog_var), list(prog_var),
+		unify_context, hlds_goal).
+:- mode create_atomic_unification_with_nonlocals(in, in,
+		in, in, in, in, out) is det.
+
+create_atomic_unification_with_nonlocals(Var, RHS, OldGoalInfo,
+		RestrictNonLocals, VarsList, UnifyContext, Goal) :-
+	goal_info_get_context(OldGoalInfo, Context),
+	UnifyContext = unify_context(UnifyMainContext, UnifySubContext),
+	create_atomic_unification(Var, RHS,
+		Context, UnifyMainContext, UnifySubContext, Goal0),
+	Goal0 = GoalExpr0 - GoalInfo0,
+
+	% Compute the nonlocals of the goal.
+	set__list_to_set(VarsList, NonLocals1),
+	set__intersect(RestrictNonLocals, NonLocals1, NonLocals),
+	goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo), 
+	Goal = GoalExpr0 - GoalInfo.
+
+:- pred make_new_vars(list(type), list(prog_var), pred_info, pred_info).
+:- mode make_new_vars(in, out, in, out) is det.
+
+make_new_vars(Types, Vars, PredInfo0, PredInfo) :-
+	pred_info_clauses_info(PredInfo0, ClausesInfo0),
+	clauses_info_varset(ClausesInfo0, VarSet0),
+	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+	list__length(Types, NumVars),
+	varset__new_vars(VarSet0, NumVars, Vars, VarSet),
+	map__det_insert_from_corresponding_lists(VarTypes0,
+		Vars, Types, VarTypes),
+	clauses_info_set_varset(ClausesInfo0, VarSet, ClausesInfo1),
+	clauses_info_set_vartypes(ClausesInfo1, VarTypes, ClausesInfo),
+	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
+
+:- pred make_new_var((type), prog_var, pred_info, pred_info).
+:- mode make_new_var(in, out, in, out) is det.
+
+make_new_var(Type, Var, PredInfo0, PredInfo) :-
+	pred_info_clauses_info(PredInfo0, ClausesInfo0),
+	clauses_info_varset(ClausesInfo0, VarSet0),
+	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+	varset__new_var(VarSet0, Var, VarSet),
+	map__det_insert(VarTypes0, Var, Type, VarTypes),
+	clauses_info_set_varset(ClausesInfo0, VarSet, ClausesInfo1),
+	clauses_info_set_vartypes(ClausesInfo1, VarTypes, ClausesInfo),
+	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.50
diff -u -u -r1.50 prog_data.m
--- prog_data.m	1999/11/11 23:12:09	1.50
+++ prog_data.m	1999/12/21 01:27:07
@@ -629,7 +629,13 @@
 			list(constructor_arg)
 		).
 
-:- type constructor_arg	==	pair(string, type).
+:- type constructor_arg	==
+		pair(
+			maybe(ctor_field_name),
+			type
+		).
+
+:- type ctor_field_name == sym_name.
 
 	% An equality_pred specifies the name of a user-defined predicate
 	% used for equality on a type.  See the chapter on them in the
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.185
diff -u -u -r1.185 prog_io.m
--- prog_io.m	1999/11/16 07:51:14	1.185
+++ prog_io.m	1999/11/23 03:13:33
@@ -1613,7 +1613,7 @@
 	),
 	parse_implicitly_qualified_term(ModuleName,
 		Term5, Term0, "constructor definition", ok(F, As)),
-	convert_constructor_arg_list(As, Args),
+	convert_constructor_arg_list(ModuleName, As, Args),
 	Result = ctor(ExistQVars, Constraints, F, Args).
 
 %-----------------------------------------------------------------------------%
@@ -2843,22 +2843,25 @@
 parse_type(T0, ok(T)) :-
 	term__coerce(T0, T).
 
-:- pred convert_constructor_arg_list(list(term), list(constructor_arg)).
-:- mode convert_constructor_arg_list(in, out) is det.
+:- pred convert_constructor_arg_list(module_name,
+		list(term), list(constructor_arg)).
+:- mode convert_constructor_arg_list(in, in, out) is semidet.
 
-convert_constructor_arg_list([], []).
-convert_constructor_arg_list([Term | Terms], [Arg | Args]) :-
+convert_constructor_arg_list(_, [], []).
+convert_constructor_arg_list(ModuleName, [Term | Terms], [Arg | Args]) :-
 	(
-		Term = term__functor(term__atom("::"), [NameTerm, TypeTerm], _),
-		NameTerm = term__functor(term__atom(Name), [], _)
+		Term = term__functor(term__atom("::"), [NameTerm, TypeTerm], _)
 	->
+		parse_implicitly_qualified_term(ModuleName, NameTerm, Term,
+			"field name", NameResult),
+		NameResult = ok(SymName, []),
 		convert_type(TypeTerm, Type),
-		Arg = Name - Type
+		Arg = yes(SymName) - Type
 	;
 		convert_type(Term, Type),
-		Arg = "" - Type
+		Arg = no - Type
 	),
-	convert_constructor_arg_list(Terms, Args).
+	convert_constructor_arg_list(ModuleName, Terms, Args).
 
 :- pred convert_type(term, type).
 :- mode convert_type(in, out) is det.
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.13
diff -u -u -r1.13 prog_io_dcg.m
--- prog_io_dcg.m	1998/11/20 04:08:57	1.13
+++ prog_io_dcg.m	1999/12/07 01:11:02
@@ -173,6 +173,13 @@
 	term__coerce(A0, A),
 	Goal = unify(A, term__variable(Var)) - Context.
 
+	% Call to ':='/1 - unify argument with DCG output arg.
+parse_dcg_goal_2(":=", [A0], Context, VarSet0, N0, _Var0,
+		Goal, VarSet, N, Var) :-
+	new_dcg_var(VarSet0, N0, VarSet, N, Var),
+	term__coerce(A0, A),
+	Goal = unify(A, term__variable(Var)) - Context.
+
 	% If-then (Prolog syntax).
 	% We need to add an else part to unify the DCG args.
 
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.47
diff -u -u -r1.47 prog_util.m
--- prog_util.m	1999/07/14 14:56:14	1.47
+++ prog_util.m	1999/12/07 01:11:37
@@ -61,6 +61,33 @@
 :- pred match_sym_name(sym_name, sym_name).
 :- mode match_sym_name(in, in) is semidet.
 
+	% remove_sym_name_prefix(SymName0, Prefix, SymName)
+	%    succeeds iff
+	%	SymName and SymName0 have the same module qualifier
+	%	and the unqualified part of SymName0 has the given prefix
+	%	and the unqualified part of SymName is the unqualified
+	%		part of SymName0 with the prefix removed
+:- pred remove_sym_name_prefix(sym_name, string, sym_name).
+:- mode remove_sym_name_prefix(in, in, out) is semidet.
+:- mode remove_sym_name_prefix(out, in, in) is det.
+
+	% remove_sym_name_suffix(SymName0, Suffix, SymName)
+	%    succeeds iff
+	%	SymName and SymName0 have the same module qualifier
+	%	and the unqualified part of SymName0 has the given suffix
+	%	and the unqualified part of SymName is the unqualified
+	%		part of SymName0 with the suffix removed
+:- pred remove_sym_name_suffix(sym_name, string, sym_name).
+:- mode remove_sym_name_suffix(in, in, out) is semidet.
+
+	% add_sym_name_suffix(SymName0, Suffix, SymName)
+	%    succeeds iff
+	%	SymName and SymName0 have the same module qualifier
+	%	and the unqualified part of SymName is the unqualified
+	%		part of SymName0 with the suffix added
+:- pred add_sym_name_suffix(sym_name, string, sym_name).
+:- mode add_sym_name_suffix(in, in, out) is det.
+
 	% insert_module_qualifier(ModuleName, SymName0, SymName):
 	%	prepend the specified ModuleName onto the module
 	%	qualifiers in SymName0, giving SymName.
@@ -319,6 +346,26 @@
 match_sym_name(unqualified(Name), unqualified(Name)).
 match_sym_name(unqualified(Name), qualified(_, Name)).
 
+%-----------------------------------------------------------------------------%
+
+remove_sym_name_prefix(qualified(Module, Name0), Prefix,
+		qualified(Module, Name)) :-
+	string__append(Prefix, Name, Name0).
+remove_sym_name_prefix(unqualified(Name0), Prefix, unqualified(Name)) :-
+	string__append(Prefix, Name, Name0).
+
+remove_sym_name_suffix(qualified(Module, Name0), Suffix,
+		qualified(Module, Name)) :-
+	string__remove_suffix(Name0, Suffix, Name).
+remove_sym_name_suffix(unqualified(Name0), Suffix, unqualified(Name)) :-
+	string__remove_suffix(Name0, Suffix, Name).
+
+add_sym_name_suffix(qualified(Module, Name0), Suffix,
+		qualified(Module, Name)) :-
+	string__append(Name0, Suffix, Name).
+add_sym_name_suffix(unqualified(Name0), Suffix, unqualified(Name)) :-
+	string__append(Name0, Suffix, Name).
+	
 %-----------------------------------------------------------------------------%
 
 make_pred_name_with_context(ModuleName, Prefix,
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.21
diff -u -u -r1.21 purity.m
--- purity.m	1999/11/03 04:13:15	1.21
+++ purity.m	1999/11/23 03:13:39
@@ -145,7 +145,7 @@
 
 :- implementation.
 
-:- import_module make_hlds, hlds_pred, prog_io_util.
+:- import_module hlds_pred, prog_io_util.
 :- import_module type_util, mode_util, code_util, prog_data, unify_proc.
 :- import_module globals, options, mercury_to_mercury, hlds_out.
 :- import_module passes_aux, typecheck, module_qual, clause_to_proc.
@@ -362,11 +362,15 @@
 	;   
 		{ pred_info_clauses_info(PredInfo0, ClausesInfo0) },
 		{ clauses_info_clauses(ClausesInfo0, Clauses0) },
-		compute_purity(Clauses0, Clauses, PredInfo0, ModuleInfo,
-				pure, Purity, 0, NumErrors0),
-		{ clauses_info_set_clauses(ClausesInfo0, Clauses,
+		compute_purity(Clauses0, Clauses, PredInfo0, PredInfo1,
+				ModuleInfo, pure, Purity, 0, NumErrors0),
+
+		% The code in post_typecheck.m to handle field access functions
+		% may modify the varset and vartypes in the clauses_info.
+		{ pred_info_clauses_info(PredInfo1, ClausesInfo1) },
+		{ clauses_info_set_clauses(ClausesInfo1, Clauses,
 				ClausesInfo) },
-		{ pred_info_set_clauses_info(PredInfo0, ClausesInfo,
+		{ pred_info_set_clauses_info(PredInfo1, ClausesInfo,
 				PredInfo) },
 		{ WorstPurity = Purity }
 	),
@@ -391,39 +395,42 @@
 
 % Infer the purity of a single (non-pragma c_code) predicate
 
-:- pred compute_purity(list(clause), list(clause), pred_info, module_info,
-	purity, purity, int, int, io__state, io__state).
-:- mode compute_purity(in, out, in, in, in, out, in, out, di, uo) is det.
+:- pred compute_purity(list(clause), list(clause), pred_info, pred_info,
+	module_info, purity, purity, int, int, io__state, io__state).
+:- mode compute_purity(in, out, in, out, in, in, out, in, out, di, uo) is det.
 
-compute_purity([], [], _, _, Purity, Purity, NumErrors, NumErrors) -->
+compute_purity([], [], PredInfo, PredInfo, _, Purity, Purity,
+		NumErrors, NumErrors) -->
 	[].
-compute_purity([Clause0|Clauses0], [Clause|Clauses], PredInfo, ModuleInfo,
-		Purity0, Purity, NumErrors0, NumErrors) -->
+compute_purity([Clause0|Clauses0], [Clause|Clauses], PredInfo0, PredInfo,
+		ModuleInfo, Purity0, Purity, NumErrors0, NumErrors) -->
 	{ Clause0 = clause(Ids, Body0 - Info0, Context) },
-	compute_expr_purity(Body0, Body, Info0, PredInfo, ModuleInfo,
-			    no, Bodypurity, NumErrors0, NumErrors1),
+	compute_expr_purity(Body0, Body, Info0, PredInfo0, PredInfo1,
+			ModuleInfo, no, Bodypurity, NumErrors0, NumErrors1),
 	{ add_goal_info_purity_feature(Info0, Bodypurity, Info) },
 	{ worst_purity(Purity0, Bodypurity, Purity1) },
 	{ Clause = clause(Ids, Body - Info, Context) },
-	compute_purity(Clauses0, Clauses, PredInfo, ModuleInfo,
+	compute_purity(Clauses0, Clauses, PredInfo1, PredInfo, ModuleInfo,
 		       Purity1, Purity, NumErrors1, NumErrors).
 
 :- pred compute_expr_purity(hlds_goal_expr, hlds_goal_expr, hlds_goal_info,
-	pred_info, module_info, bool, purity, int, int, io__state, io__state).
-:- mode compute_expr_purity(in, out, in, in, in, in, out, in, out, di, uo)
-	is det.
-
-compute_expr_purity(conj(Goals0), conj(Goals), _, PredInfo, ModuleInfo,
-		InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
-			     InClosure, pure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(par_conj(Goals0, SM), par_conj(Goals, SM), _, PredInfo,
+	pred_info, pred_info, module_info, bool, purity, int, int,
+	io__state, io__state).
+:- mode compute_expr_purity(in, out, in, in, out, in, in, out, in, out,
+	di, uo) is det.
+
+compute_expr_purity(conj(Goals0), conj(Goals), _, PredInfo0, PredInfo,
 		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
+	compute_goals_purity(Goals0, Goals, PredInfo0, PredInfo, ModuleInfo,
 			     InClosure, pure, Purity, NumErrors0, NumErrors).
+compute_expr_purity(par_conj(Goals0, SM), par_conj(Goals, SM), _,
+		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
+		NumErrors0, NumErrors) -->
+	compute_goals_purity(Goals0, Goals, PredInfo0, PredInfo, ModuleInfo,
+			     InClosure, pure, Purity, NumErrors0, NumErrors).
 compute_expr_purity(call(PredId0,ProcId,Vars,BIState,UContext,Name0),
 		call(PredId,ProcId,Vars,BIState,UContext,Name), GoalInfo,
-		PredInfo, ModuleInfo, InClosure, ActualPurity,
+		PredInfo, PredInfo, ModuleInfo, InClosure, ActualPurity,
 		NumErrors0, NumErrors) -->
 	{ post_typecheck__resolve_pred_overloading(PredId0, Vars, PredInfo,
 		ModuleInfo, Name0, Name, PredId) },
@@ -454,44 +461,50 @@
 						    DeclaredPurity),
 		{ NumErrors = NumErrors0 }
 	).
-compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det),
-		generic_call(GenericCall, Args, Modes, Det),
-		GoalInfo, PredInfo, ModuleInfo, _InClosure, Purity,
-		NumErrors, NumErrors) -->
-	{ Purity = pure },
+compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det), GoalExpr,
+		GoalInfo, PredInfo0, PredInfo, ModuleInfo, _InClosure, Purity,
+		NumErrors0, NumErrors) -->
 	(
 		{ GenericCall0 = higher_order(_, _, _) },
-		{ GenericCall = GenericCall0 },
-		{ Modes = Modes0 }
+		{ Purity = pure },
+		{ PredInfo = PredInfo0 },
+		{ NumErrors = NumErrors0 },
+		{ GoalExpr = generic_call(GenericCall0, Args, Modes0, Det) }
 	;
 		{ GenericCall0 = class_method(_, _, _, _) },
-		{ GenericCall = GenericCall0 },
-		{ Modes = Modes0 }
+		{ Purity = pure },
+		{ PredInfo = PredInfo0 },
+		{ NumErrors = NumErrors0 },
+		{ GoalExpr = generic_call(GenericCall0, Args, Modes0, Det) }
 	;
 		{ GenericCall0 = aditi_builtin(Builtin0, CallId0) },
+		{ Purity = pure },
 		{ goal_info_get_context(GoalInfo, Context) },
 		post_typecheck__finish_aditi_builtin(ModuleInfo, PredInfo,
 			Args, Context, Builtin0, Builtin,
 			CallId0, CallId, Modes),
-		{ GenericCall = aditi_builtin(Builtin, CallId) }
+		{ GenericCall = aditi_builtin(Builtin, CallId) },
+		{ GoalExpr = generic_call(GenericCall, Args, Modes, Det) },
+		{ PredInfo = PredInfo0 },
+		{ NumErrors = NumErrors0 }
 	).
 compute_expr_purity(switch(Var,Canfail,Cases0,Storemap),
-		switch(Var,Canfail,Cases,Storemap), _, PredInfo,
+		switch(Var,Canfail,Cases,Storemap), _, PredInfo0, PredInfo,
 		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_cases_purity(Cases0, Cases, PredInfo, ModuleInfo,
+	compute_cases_purity(Cases0, Cases, PredInfo0, PredInfo, ModuleInfo,
 			     InClosure, pure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(Unif0, Unif, GoalInfo, PredInfo, ModuleInfo, _,
-		pure, NumErrors0, NumErrors) -->
-	{ Unif0 = unify(A,RHS0,C,D,E) },
-	{ Unif  = unify(A,RHS,C,D,E) },
+compute_expr_purity(Unif0, GoalExpr, GoalInfo, PredInfo0, PredInfo,
+		ModuleInfo, _, pure, NumErrors0, NumErrors) -->
+	{ Unif0 = unify(Var, RHS0, Mode, Unification, UnifyContext) },
+
 	(
 		{ RHS0 = lambda_goal(F, EvalMethod, FixModes, H, Vars,
 			Modes0, K, Goal0 - Info0) }
 	->
 		{ RHS = lambda_goal(F, EvalMethod, modes_are_ok, H, Vars,
 			Modes, K, Goal - Info0) },
-		compute_expr_purity(Goal0, Goal, Info0, PredInfo, ModuleInfo,
-				    yes, Purity, NumErrors0, NumErrors1),
+		compute_expr_purity(Goal0, Goal, Info0, PredInfo0, PredInfo,
+			ModuleInfo, yes, Purity, NumErrors0, NumErrors1),
 		error_if_closure_impure(GoalInfo, Purity,
 					NumErrors1, NumErrors),
 		{
@@ -524,64 +537,77 @@
 			map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
 			fix_aditi_state_modes(StateMode, LambdaVarTypes,
 				Modes0, Modes)
-		}
+		},
+		{ GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext) }
 	;
-		{ RHS = RHS0 },
+		{ RHS0 = functor(ConsId, Args) } 
+	->
+		{ post_typecheck__resolve_unify_functor(Var, ConsId, Args,
+			Mode, Unification, UnifyContext, GoalInfo,
+			ModuleInfo, PredInfo0, PredInfo, Goal) },
+		{ Goal = GoalExpr - _ },
+		{ NumErrors = NumErrors0 }
+	;
+		{ PredInfo = PredInfo0 },
+		{ GoalExpr = Unif0 },
 		{ NumErrors = NumErrors0 }
 	).
-compute_expr_purity(disj(Goals0,Store), disj(Goals,Store), _, PredInfo,
-		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
+compute_expr_purity(disj(Goals0,Store), disj(Goals,Store), _,
+		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
+		NumErrors0, NumErrors) -->
+	compute_goals_purity(Goals0, Goals, PredInfo0, PredInfo, ModuleInfo,
 			     InClosure, pure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(not(Goal0), NotGoal, GoalInfo0, PredInfo, ModuleInfo,
-		InClosure, Purity, NumErrors0, NumErrors) -->
+compute_expr_purity(not(Goal0), NotGoal, GoalInfo0, PredInfo0, PredInfo,
+		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
 	%
 	% eliminate double negation
 	%
 	{ negate_goal(Goal0, GoalInfo0, NotGoal0) },
 	( { NotGoal0 = not(Goal1) - _GoalInfo1 } ->
-		compute_goal_purity(Goal1, Goal, PredInfo, ModuleInfo, 
-				    InClosure, Purity, NumErrors0, NumErrors),
+		compute_goal_purity(Goal1, Goal, PredInfo0, PredInfo,
+			ModuleInfo, InClosure, Purity, NumErrors0, NumErrors),
 		{ NotGoal = not(Goal) }
 	;
-		compute_goal_purity(NotGoal0, NotGoal1, PredInfo, ModuleInfo, 
-				    InClosure, Purity, NumErrors0, NumErrors),
+		compute_goal_purity(NotGoal0, NotGoal1, PredInfo0, PredInfo,
+			ModuleInfo, InClosure, Purity, NumErrors0, NumErrors),
 		{ NotGoal1 = NotGoal - _ }
 	).
 compute_expr_purity(some(Vars, CanRemove, Goal0), some(Vars, CanRemove, Goal),
-		_, PredInfo, ModuleInfo, InClosure, Purity,
+		_, PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
 		NumErrors0, NumErrors) -->
-	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
+	compute_goal_purity(Goal0, Goal, PredInfo0, PredInfo, ModuleInfo, 
 			    InClosure, Purity, NumErrors0, NumErrors).
 compute_expr_purity(if_then_else(Vars,Goali0,Goalt0,Goale0,Store),
-		if_then_else(Vars,Goali,Goalt,Goale,Store), _, PredInfo,
-		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_goal_purity(Goali0, Goali, PredInfo, ModuleInfo,
+		if_then_else(Vars,Goali,Goalt,Goale,Store), _,
+		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
+		NumErrors0, NumErrors) -->
+	compute_goal_purity(Goali0, Goali, PredInfo0, PredInfo1, ModuleInfo,
 			    InClosure, Purity1, NumErrors0, NumErrors1),
-	compute_goal_purity(Goalt0, Goalt, PredInfo, ModuleInfo,
+	compute_goal_purity(Goalt0, Goalt, PredInfo1, PredInfo2, ModuleInfo,
 			    InClosure, Purity2, NumErrors1, NumErrors2),
-	compute_goal_purity(Goale0, Goale, PredInfo, ModuleInfo,
+	compute_goal_purity(Goale0, Goale, PredInfo2, PredInfo, ModuleInfo,
 			    InClosure, Purity3, NumErrors2, NumErrors),
 	{ worst_purity(Purity1, Purity2, Purity12) },
 	{ worst_purity(Purity12, Purity3, Purity) }.
-compute_expr_purity(Ccode, Ccode, _, _, ModuleInfo, _, Purity,
+compute_expr_purity(Ccode, Ccode, _, PredInfo, PredInfo, ModuleInfo, _, Purity,
 		NumErrors, NumErrors) -->
 	{ Ccode = pragma_c_code(_,PredId,_,_,_,_,_) },
 	{ module_info_preds(ModuleInfo, Preds) },
-	{ map__lookup(Preds, PredId, PredInfo) },
-	{ pred_info_get_purity(PredInfo, Purity) }.
-compute_expr_purity(bi_implication(_, _), _, _, _, _, _, _, _, _) -->
+	{ map__lookup(Preds, PredId, CalledPredInfo) },
+	{ pred_info_get_purity(CalledPredInfo, Purity) }.
+compute_expr_purity(bi_implication(_, _), _, _, _, _, _, _, _, _, _) -->
 	% these should have been expanded out by now
 	{ error("compute_expr_purity: unexpected bi_implication") }.
 
-:- pred compute_goal_purity(hlds_goal, hlds_goal, pred_info,
+:- pred compute_goal_purity(hlds_goal, hlds_goal, pred_info, pred_info,
 	module_info, bool, purity, int, int, io__state, io__state).
-:- mode compute_goal_purity(in, out, in, in, in, out, in, out, di, uo) is det.
+:- mode compute_goal_purity(in, out, in, out, in, in,
+	out, in, out, di, uo) is det.
 
-compute_goal_purity(Goal0 - GoalInfo0, Goal - GoalInfo, PredInfo, ModuleInfo,
-		InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_expr_purity(Goal0, Goal, GoalInfo0, PredInfo, ModuleInfo,
-			    InClosure, Purity, NumErrors0, NumErrors),
+compute_goal_purity(Goal0 - GoalInfo0, Goal - GoalInfo, PredInfo0, PredInfo,
+		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
+	compute_expr_purity(Goal0, Goal, GoalInfo0, PredInfo0, PredInfo,
+		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors),
 	{ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) }.
 
 
@@ -589,38 +615,42 @@
 %  disjunction is computed the same way as the purity of a conjunction, we use
 %  the same code for both
 
-:- pred compute_goals_purity(list(hlds_goal), list(hlds_goal), pred_info,
-	module_info, bool, purity, purity, int, int, io__state, io__state).
-:- mode compute_goals_purity(in, out, in, in, in, in, out, in, out, di, uo)
-	is det.
+:- pred compute_goals_purity(list(hlds_goal), list(hlds_goal),
+	pred_info, pred_info, module_info, bool, purity, purity, int, int,
+	io__state, io__state).
+:- mode compute_goals_purity(in, out, in, out, in, in, in, out, in, out,
+	di, uo) is det.
 
-compute_goals_purity([], [], _, _, _, Purity, Purity, NumErrors, NumErrors) -->
+compute_goals_purity([], [], PredInfo, PredInfo, _, _, Purity, Purity,
+		NumErrors, NumErrors) -->
 	[].
-compute_goals_purity([Goal0|Goals0], [Goal|Goals], PredInfo, ModuleInfo,
-		InClosure, Purity0, Purity, NumErrors0, NumErrors) -->
-	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
-			    InClosure, Purity1, NumErrors0, NumErrors1),
+compute_goals_purity([Goal0|Goals0], [Goal|Goals], PredInfo0, PredInfo,
+		ModuleInfo, InClosure, Purity0, Purity,
+		NumErrors0, NumErrors) -->
+	compute_goal_purity(Goal0, Goal, PredInfo0, PredInfo1, ModuleInfo, 
+		InClosure, Purity1, NumErrors0, NumErrors1),
 	{ worst_purity(Purity0, Purity1, Purity2) },
-	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo, InClosure,
-			     Purity2, Purity, NumErrors1, NumErrors).
+	compute_goals_purity(Goals0, Goals, PredInfo1, PredInfo, ModuleInfo,
+		InClosure, Purity2, Purity, NumErrors1, NumErrors).
 
 
 
-:- pred compute_cases_purity(list(case), list(case), pred_info, module_info,
-	bool, purity, purity, int, int, io__state, io__state).
-:- mode compute_cases_purity(in, out, in, in, in, in, out, in, out, di, uo)
-	is det.
+:- pred compute_cases_purity(list(case), list(case), pred_info, pred_info,
+	module_info, bool, purity, purity, int, int, io__state, io__state).
+:- mode compute_cases_purity(in, out, in, out, in, in, in, out, in, out,
+	di, uo) is det.
 
-compute_cases_purity([], [], _, _, _, Purity, Purity, NumErrors, NumErrors) -->
+compute_cases_purity([], [], PredInfo, PredInfo, _, _, Purity, Purity,
+		NumErrors, NumErrors) -->
 	[].
 compute_cases_purity([case(Ctor,Goal0)|Goals0], [case(Ctor,Goal)|Goals],
-		PredInfo, ModuleInfo, InClosure, Purity0, Purity,
+		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity0, Purity,
 		NumErrors0, NumErrors) -->
-	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
-			    InClosure, Purity1, NumErrors0, NumErrors1),
+	compute_goal_purity(Goal0, Goal, PredInfo0, PredInfo1, ModuleInfo, 
+			InClosure, Purity1, NumErrors0, NumErrors1),
 	{ worst_purity(Purity0, Purity1, Purity2) },
-	compute_cases_purity(Goals0, Goals, PredInfo, ModuleInfo, InClosure,
-			     Purity2, Purity, NumErrors1, NumErrors).
+	compute_cases_purity(Goals0, Goals, PredInfo1, PredInfo, ModuleInfo,
+			InClosure, Purity2, Purity, NumErrors1, NumErrors).
 
 	% Make sure lambda expressions introduced by the compiler
 	% have the correct mode for their `aditi__state' arguments.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.75
diff -u -u -r1.75 type_util.m
--- type_util.m	1999/10/28 00:57:01	1.75
+++ type_util.m	1999/12/19 04:38:05
@@ -170,6 +170,12 @@
 :- pred type_util__get_cons_id_arg_types(module_info::in, (type)::in,
 		cons_id::in, list(type)::out) is det.
 
+	% Given a type and a cons_id, look up the definitions of that
+	% type and constructor. Aborts if the cons_id is not user-defined.
+:- pred type_util__get_type_and_cons_defn(module_info, (type), cons_id,
+		hlds_type_defn, hlds_cons_defn).
+:- mode type_util__get_type_and_cons_defn(in, in, in, out, out) is det.
+
 	% Given a type and a cons_id, look up the definition of that
 	% constructor; if it is existentially typed, return its definition,
 	% otherwise fail.
@@ -656,20 +662,13 @@
 
 type_util__get_cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :-
 	(
-		type_to_type_id(VarType, TypeId, TypeArgs),
-		module_info_ctors(ModuleInfo, Ctors),
-		% will fail for builtin cons_ids.
-		map__search(Ctors, ConsId, ConsDefns),
-		CorrectCons = lambda([ConsDefn::in] is semidet, (
-				ConsDefn = hlds_cons_defn(_, _, _, TypeId, _)
-			)),
-		list__filter(CorrectCons, ConsDefns,
-			[hlds_cons_defn(ExistQVars0, _Constraints0, ArgTypes0,
-				_, _)]),
+		type_to_type_id(VarType, _, TypeArgs),
+		type_util__do_get_type_and_cons_defn(ModuleInfo, VarType,
+			ConsId, TypeDefn, ConsDefn),
+		ConsDefn = hlds_cons_defn(ExistQVars0, _Constraints0,
+				ArgTypes0, _, _),
 		ArgTypes0 \= []
 	->
-		module_info_types(ModuleInfo, Types),
-		map__lookup(Types, TypeId, TypeDefn),
 		hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
 		term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
 
@@ -690,14 +689,8 @@
 		(type)::in, cons_id::in, hlds_cons_defn::out) is semidet.
 
 type_util__is_existq_cons(ModuleInfo, VarType, ConsId, ConsDefn) :-
-	type_to_type_id(VarType, TypeId, _TypeArgs),
-	module_info_ctors(ModuleInfo, Ctors),
-	% will fail for builtin cons_ids.
-	map__search(Ctors, ConsId, ConsDefns),
-	MatchingCons = lambda([ThisConsDefn::in] is semidet, (
-			ThisConsDefn = hlds_cons_defn(_, _, _, TypeId, _)
-		)),
-	list__filter(MatchingCons, ConsDefns, [ConsDefn]), 
+	type_to_type_id(VarType, TypeId, _),
+	type_util__get_cons_defn(ModuleInfo, TypeId, ConsId, ConsDefn),
 	ConsDefn = hlds_cons_defn(ExistQVars, _, _, _, _),
 	ExistQVars \= [].
 
@@ -712,10 +705,46 @@
 	map__lookup(Types, TypeId, TypeDefn),
 	hlds_data__get_type_defn_tvarset(TypeDefn, TypeVarSet),
 	hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
+	type_to_type_id(VarType, TypeId, _),
 	construct_type(TypeId, TypeDefnParams, RetType),
 	CtorDefn = ctor_defn(TypeVarSet, ExistQVars, Constraints,
 		ArgTypes, RetType).
 
+type_util__get_type_and_cons_defn(ModuleInfo, Type, ConsId,
+		TypeDefn, ConsDefn) :-
+	(
+		type_util__do_get_type_and_cons_defn(ModuleInfo,
+			Type, ConsId, TypeDefn0, ConsDefn0)
+	->
+		TypeDefn = TypeDefn0,
+		ConsDefn = ConsDefn0
+	;
+		error("type_util__get_type_and_cons_defn")
+	).
+
+:- pred type_util__do_get_type_and_cons_defn(module_info::in,
+		(type)::in, cons_id::in, hlds_type_defn::out,
+		hlds_cons_defn::out) is semidet.
+
+type_util__do_get_type_and_cons_defn(ModuleInfo, VarType, ConsId,
+		TypeDefn, ConsDefn) :-
+	type_to_type_id(VarType, TypeId, _TypeArgs),
+	type_util__get_cons_defn(ModuleInfo, TypeId, ConsId, ConsDefn),
+	module_info_types(ModuleInfo, Types),
+	map__lookup(Types, TypeId, TypeDefn).
+
+:- pred type_util__get_cons_defn(module_info::in, type_id::in, cons_id::in,
+		hlds_cons_defn::out) is semidet.
+
+type_util__get_cons_defn(ModuleInfo, TypeId, ConsId, ConsDefn) :-
+	module_info_ctors(ModuleInfo, Ctors),
+	% will fail for builtin cons_ids.
+	map__search(Ctors, ConsId, ConsDefns),
+	MatchingCons = lambda([ThisConsDefn::in] is semidet, (
+			ThisConsDefn = hlds_cons_defn(_, _, _, TypeId, _)
+		)),
+	list__filter(MatchingCons, ConsDefns, [ConsDefn]).
+	
 %-----------------------------------------------------------------------------%
 
 	% The checks for type_info and type_ctor_info
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.268
diff -u -u -r1.268 typecheck.m
--- typecheck.m	1999/12/08 09:44:56	1.268
+++ typecheck.m	1999/12/20 04:00:07
@@ -327,9 +327,11 @@
 	    Changed = no,
 	    IOState = IOState0
 	;
-	    pred_info_arg_types(PredInfo0, _ArgTypeVarSet, ExistQVars0,
+	    maybe_add_default_field_access_clauses(ModuleInfo,
+		    PredInfo0, PredInfo1),
+	    pred_info_arg_types(PredInfo1, _ArgTypeVarSet, ExistQVars0,
 		    ArgTypes0),
-	    pred_info_clauses_info(PredInfo0, ClausesInfo0),
+	    pred_info_clauses_info(PredInfo1, ClausesInfo0),
 	    clauses_info_clauses(ClausesInfo0, Clauses0),
 	    clauses_info_headvars(ClausesInfo0, HeadVars),
 	    clauses_info_varset(ClausesInfo0, VarSet),
@@ -340,7 +342,7 @@
 			% There are no clauses for class methods.
 			% The clauses are generated later on,
 			% in polymorphism__expand_class_method_bodies
-	        pred_info_get_markers(PredInfo0, Markers),
+	        pred_info_get_markers(PredInfo1, Markers),
 		( check_marker(Markers, class_method) ->
 			IOState = IOState0,
 				% For the moment, we just insert the types
@@ -349,29 +351,29 @@
 				VarTypes),
 			clauses_info_set_vartypes(ClausesInfo0, VarTypes,
 				ClausesInfo),
-			pred_info_set_clauses_info(PredInfo0, ClausesInfo,
-				PredInfo1),
+			pred_info_set_clauses_info(PredInfo1, ClausesInfo,
+				PredInfo2),
 				% We also need to set the head_type_params
 				% field to indicate that all the existentially
 				% quantified tvars in the head of this
 				% pred are indeed bound by this predicate.
 			term__vars_list(ArgTypes0,
 				HeadVarsIncludingExistentials),
-			pred_info_set_head_type_params(PredInfo1,
+			pred_info_set_head_type_params(PredInfo2,
 				HeadVarsIncludingExistentials, PredInfo),
 			Error = no,
 			Changed = no
 		;
-			report_error_no_clauses(PredId, PredInfo0, ModuleInfo,
+			report_error_no_clauses(PredId, PredInfo1, ModuleInfo,
 			    IOState0, IOState),
-			PredInfo = PredInfo0,
+			PredInfo = PredInfo1,
 			Error = yes,
 			Changed = no
 		)
 	    ;
-	        pred_info_typevarset(PredInfo0, TypeVarSet0),
-	        pred_info_import_status(PredInfo0, Status),
-	        pred_info_get_markers(PredInfo0, Markers),
+	        pred_info_typevarset(PredInfo1, TypeVarSet0),
+	        pred_info_import_status(PredInfo1, Status),
+	        pred_info_get_markers(PredInfo1, Markers),
 		( check_marker(Markers, infer_type) ->
 			% For a predicate whose type is inferred,
 			% the predicate is allowed to bind the type
@@ -391,7 +393,7 @@
 			term__vars_list(ArgTypes0, HeadTypeParams0),
 			list__delete_elems(HeadTypeParams0, ExistQVars0,
 				HeadTypeParams1),
-			pred_info_get_class_context(PredInfo0,
+			pred_info_get_class_context(PredInfo1,
 				PredConstraints)
 		),
 
@@ -427,10 +429,10 @@
 		clauses_info_set_vartypes(ClausesInfo0, InferredVarTypes,
 				ClausesInfo1),
 		clauses_info_set_clauses(ClausesInfo1, Clauses, ClausesInfo),
-		pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo1),
-		pred_info_set_typevarset(PredInfo1, TypeVarSet, PredInfo2),
-		pred_info_set_constraint_proofs(PredInfo2, ConstraintProofs,
-			PredInfo3),
+		pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2),
+		pred_info_set_typevarset(PredInfo2, TypeVarSet, PredInfo3),
+		pred_info_set_constraint_proofs(PredInfo3, ConstraintProofs,
+			PredInfo4),
 
 		%
 		% Split the inferred type class constraints into those that
@@ -452,8 +454,8 @@
 		% bound in to types that make the constraints satisfiable,
 		% causing the error to go away.
 		%
-		pred_info_set_unproven_body_constraints(PredInfo3,
-				UnprovenBodyConstraints, PredInfo4),
+		pred_info_set_unproven_body_constraints(PredInfo4,
+				UnprovenBodyConstraints, PredInfo5),
 
 		is_bool(Inferring),
 		( Inferring = yes ->
@@ -467,13 +469,13 @@
 			%
 			% Now save the information we inferred in the pred_info
 			%
-			pred_info_set_head_type_params(PredInfo4,
-				HeadTypeParams, PredInfo5),
-			pred_info_set_arg_types(PredInfo5, TypeVarSet,
-				ExistQVars, ArgTypes, PredInfo6),
-			pred_info_get_class_context(PredInfo0,
+			pred_info_set_head_type_params(PredInfo5,
+				HeadTypeParams, PredInfo6),
+			pred_info_set_arg_types(PredInfo6, TypeVarSet,
+				ExistQVars, ArgTypes, PredInfo7),
+			pred_info_get_class_context(PredInfo1,
 				OldTypeConstraints),
-			pred_info_set_class_context(PredInfo6,
+			pred_info_set_class_context(PredInfo7,
 				InferredTypeConstraints, PredInfo),
 			%
 			% Check if anything changed
@@ -493,8 +495,8 @@
 				Changed = yes
 			)
 		; % Inferring = no
-			pred_info_set_head_type_params(PredInfo4,
-				HeadTypeParams2, PredInfo5),
+			pred_info_set_head_type_params(PredInfo5,
+				HeadTypeParams2, PredInfo6),
 
 			%
 			% leave the original argtypes etc., but 
@@ -533,9 +535,9 @@
 				PredConstraints1, RenamedOldConstraints),
 
 			% save the results in the pred_info
-			pred_info_set_arg_types(PredInfo5, TypeVarSet,
-				ExistQVars, RenamedOldArgTypes, PredInfo6),
-			pred_info_set_class_context(PredInfo6,
+			pred_info_set_arg_types(PredInfo6, TypeVarSet,
+				ExistQVars, RenamedOldArgTypes, PredInfo7),
+			pred_info_set_class_context(PredInfo7,
 				RenamedOldConstraints, PredInfo),
 
 			Changed = no
@@ -730,6 +732,56 @@
 
 %-----------------------------------------------------------------------------%
 
+	%
+	% For a field access function for which the user has supplied
+	% a declaration but no clauses, add a clause
+	% 'foo:='(X, Y) = 'builtin foo:='(X, Y).
+	%
+:- pred maybe_add_default_field_access_clauses(module_info,
+		pred_info, pred_info).
+:- mode maybe_add_default_field_access_clauses(in, in, out) is det.
+
+maybe_add_default_field_access_clauses(ModuleInfo, PredInfo0, PredInfo) :-
+	pred_info_module(PredInfo0, FuncModule),
+	pred_info_name(PredInfo0, FuncName),
+	pred_info_arity(PredInfo0, PredArity),
+	pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
+	pred_info_import_status(PredInfo0, ImportStatus),
+	FuncSymName = qualified(FuncModule, FuncName),
+	pred_info_clauses_info(PredInfo0, ClausesInfo0),
+	clauses_info_clauses(ClausesInfo0, Clauses0),
+	(
+		PredOrFunc = function,
+		Clauses0 = [],
+		status_defined_in_this_module(ImportStatus, yes),
+		adjust_func_arity(function, FuncArity, PredArity),
+		is_field_access_function_name(ModuleInfo, FuncSymName,
+			FuncArity, AccessType, non_builtin_field_access,
+			FieldName)
+	->
+		field_access_function_name(AccessType, FieldName,
+			builtin_field_access, BuiltinFuncName),
+		clauses_info_headvars(ClausesInfo0, HeadVars),
+		pred_args_to_func_args(HeadVars, FuncArgs, FuncRetVal),
+		pred_info_context(PredInfo0, Context),
+		create_atomic_unification(FuncRetVal,
+			functor(cons(BuiltinFuncName, FuncArity), FuncArgs),
+			Context, explicit, [], Goal0),
+		Goal0 = GoalExpr - GoalInfo0,
+		set__list_to_set(HeadVars, NonLocals),
+		goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
+		Goal = GoalExpr - GoalInfo,
+		ProcIds = [], % the clause applies to all procedures.
+		Clause = clause(ProcIds, Goal, Context),
+		clauses_info_set_clauses(ClausesInfo0, [Clause], ClausesInfo),
+		pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo)
+	;
+		PredInfo = PredInfo0
+	).
+
+
+%-----------------------------------------------------------------------------%
+
 	% Iterate over the list of clauses for a predicate.
 
 :- pred typecheck_clause_list(list(clause), list(prog_var), list(type),
@@ -2102,11 +2154,11 @@
 	%
 	list__length(Args, Arity),
 	typecheck_info_get_ctor_list(TypeCheckInfo0, Functor, Arity,
-			ConsDefnList),
+			ConsDefnList, InvalidConsDefnList),
 	( ConsDefnList = [] ->
 		typecheck_info_get_io_state(TypeCheckInfo0, IOState0),
-		report_error_undef_cons(TypeCheckInfo0, Functor, Arity, 
-				IOState0, IOState1),
+		report_error_undef_cons(TypeCheckInfo0, InvalidConsDefnList,
+				Functor, Arity, IOState0, IOState1),
 		typecheck_info_set_io_state(TypeCheckInfo0, IOState1,
 				TypeCheckInfo1),
 		typecheck_info_set_found_error(TypeCheckInfo1, yes,
@@ -2757,6 +2809,323 @@
 	ConsTypeInfos = [cons_type_info(TypeVarSet, ExistQVars, RetType,
 					[FuncType | ArgTypes], Constraints)].
 
+	% builtin_field_access_function_type(TypeCheckInfo, Functor,
+	%	Arity, ConsTypeInfos):
+	% Succeed if Functor is the name of one the automatically
+	% generated field access functions (fieldname, '<fieldname>:=') for
+	% which the user has not supplied a definition.
+:- pred builtin_field_access_function_type(typecheck_info, cons_id, arity,
+		list(cons_type_info), list(invalid_field_update)).
+:- mode builtin_field_access_function_type(typecheck_info_ui, in, in,
+		out, out) is semidet.
+
+builtin_field_access_function_type(TypeCheckInfo, Functor, Arity,
+		ConsTypeInfos, InvalidFieldUpdates) :-
+	%
+	% Taking the address of automatically generated field access
+	% functions is not allowed, so currying does have to be
+	% considered here.
+	%
+	Functor = cons(Name, Arity),
+	typecheck_info_get_module_info(TypeCheckInfo, ModuleInfo),
+	is_field_access_function_name(ModuleInfo, Name, Arity,
+		AccessType, IsBuiltin, FieldName),
+
+	module_info_ctor_field_table(ModuleInfo, CtorFieldTable),
+	map__search(CtorFieldTable, FieldName, FieldDefns),
+	
+	list__filter_map(
+		make_field_access_function_cons_type_info(TypeCheckInfo, Name,
+			Arity, AccessType, IsBuiltin, FieldName),
+		FieldDefns, MaybeConsTypeInfos),
+
+	list__filter_map(
+		(pred(MaybeConsTypeInfo::in, ConsTypeInfo::out) is semidet :-
+			MaybeConsTypeInfo = cons_type_info(ConsTypeInfo)
+		), MaybeConsTypeInfos, ConsTypeInfos),	
+
+	list__filter_map(
+		(pred(MaybeConsTypeInfo::in, InvalidCons::out) is semidet :-
+			MaybeConsTypeInfo = invalid_field_update(InvalidCons)
+		), MaybeConsTypeInfos, InvalidFieldUpdates).
+
+:- pred make_field_access_function_cons_type_info(typecheck_info,
+		sym_name, arity, field_access_type,
+		field_access_function_is_builtin,
+		ctor_field_name, hlds_ctor_field_defn, maybe_cons_type_info).
+:- mode make_field_access_function_cons_type_info(in,
+		in, in, in, in, in, in, out) is semidet.
+
+make_field_access_function_cons_type_info(TypeCheckInfo, FuncName, Arity,
+		AccessType, IsBuiltin, FieldName, FieldDefn, ConsTypeInfo) :-
+	get_field_access_constructor(TypeCheckInfo, FuncName, Arity,
+		AccessType, IsBuiltin, FieldDefn, FunctorConsTypeInfo),
+	convert_field_access_cons_type_info(AccessType, FieldName, FieldDefn,
+		FunctorConsTypeInfo, ConsTypeInfo).
+
+:- pred get_field_access_constructor(typecheck_info, sym_name, arity,
+		field_access_type, field_access_function_is_builtin,
+		hlds_ctor_field_defn, cons_type_info).
+:- mode get_field_access_constructor(typecheck_info_ui,
+		in, in, in, in, in, out) is semidet.
+
+get_field_access_constructor(TypeCheckInfo, FuncName, Arity, _AccessType,
+		IsBuiltin, FieldDefn, FunctorConsTypeInfo) :-
+
+	FieldDefn = hlds_ctor_field_defn(_, _, TypeId, ConsId, _),
+	TypeId = qualified(TypeModule, _) - _,
+
+	%
+	% If the user has supplied a definition, we use that instead
+	% of the automatically generated version.
+	% Those cases will be picked up by builtin_pred_type.
+	%
+	typecheck_info_get_module_info(TypeCheckInfo, ModuleInfo),
+	module_info_get_predicate_table(ModuleInfo, PredTable),
+	unqualify_name(FuncName, UnqualFuncName),
+	\+ predicate_table_search_func_m_n_a(PredTable, TypeModule,
+		UnqualFuncName, Arity, _),
+
+	%
+	% Only allow calls to the `'builtin <field>'/1' and
+	% `'builtin field:='/2' functions from within the same module
+	% as the type definition.
+	%
+	(
+		IsBuiltin = builtin_field_access,
+		typecheck_info_get_predid(TypeCheckInfo, PredId),
+		module_info_pred_info(ModuleInfo, PredId, PredInfo),
+		pred_info_module(PredInfo, PredModule),
+		PredModule = TypeModule
+	;
+		IsBuiltin = non_builtin_field_access
+	),
+	
+	module_info_ctors(ModuleInfo, Ctors),
+	map__lookup(Ctors, ConsId, ConsDefns0),
+	list__filter(
+		(pred(CtorDefn::in) is semidet :-
+			CtorDefn = hlds_cons_defn(_, _, _, TypeId, _)
+		), ConsDefns0, ConsDefns),
+	ConsDefns = [ConsDefn],
+	convert_cons_defn(TypeCheckInfo, ConsDefn, FunctorConsTypeInfo).
+
+:- type maybe_cons_type_info
+	--->	cons_type_info(cons_type_info)
+	;	invalid_field_update(invalid_field_update)
+	.
+
+:- type invalid_field_update
+	--->	invalid_field_update(ctor_field_name, hlds_ctor_field_defn,
+			tvarset, list(tvar)).
+
+:- pred convert_field_access_cons_type_info(field_access_type,
+		ctor_field_name, hlds_ctor_field_defn,
+		cons_type_info, maybe_cons_type_info) is det.
+:- mode convert_field_access_cons_type_info(in, in, in, in, out) is det.
+
+convert_field_access_cons_type_info(AccessType, FieldName, FieldDefn,
+		FunctorConsTypeInfo, ConsTypeInfo) :-
+    FunctorConsTypeInfo = cons_type_info(TVarSet0, ExistQVars0,
+			FunctorType, ConsArgTypes, ClassConstraints0),
+    FieldDefn = hlds_ctor_field_defn(_, _, _, _, FieldNumber),
+    list__index1_det(ConsArgTypes, FieldNumber, FieldType),
+
+    (
+	AccessType = get,
+	RetType = FieldType,
+	ArgTypes = [FunctorType],
+	TVarSet = TVarSet0,
+	ExistQVars = ExistQVars0,
+	ClassConstraints = ClassConstraints0,
+	ConsTypeInfo = cons_type_info(cons_type_info(TVarSet, ExistQVars,
+				RetType, ArgTypes, ClassConstraints))
+    ;
+	AccessType = set,
+
+	%
+	% A `'field:='/2' function has no existentially
+	% quantified type variables - the values of all
+	% type variables in the field are supplied by
+	% the caller, all the others are supplied by
+	% the input term.
+	%
+	ExistQVars = [],
+
+	%
+	% When setting a polymorphic field, the type of the
+	% field in the result is not necessarily the
+	% same as in the input.
+	% If a type variable occurs only in the field being set,
+	% create a new type variable for it in the result type.
+	%
+	% This allows code such as
+	% :- type pair(T, U)
+	%	---> '-'(fst::T, snd::U).
+	%
+	%	Pair0 = 1 - 'a',
+	% 	Pair = Pair0 ^ snd := 2.
+	%
+	term__vars(FieldType, TVarsInField),
+	( TVarsInField = [] ->
+		TVarSet = TVarSet0,
+		RetType = FunctorType,
+		ArgTypes = [FunctorType, FieldType],
+
+		%
+		% Remove any existential constraints - the
+		% typeclass-infos supplied by the input term
+		% are local to the set function, so they don't
+		% have to be considered here.
+		%
+		ClassConstraints0 = constraints(UnivConstraints, _),
+		ClassConstraints = constraints(UnivConstraints, []),
+		ConsTypeInfo = cons_type_info(
+			cons_type_info(TVarSet, ExistQVars,
+				RetType, ArgTypes, ClassConstraints))
+	;		
+		%
+		% XXX This demonstrates a problem - if a
+		% type variable occurs in the types of multiple
+		% fields, any predicates changing values of
+		% one of these fields cannot change their types.
+		% This especially a problem for existentially typed
+		% fields, because setting the field always changes
+		% the type.
+		%
+		% Haskell gets around this problem by allowing
+		% multiple fields to be set by the same expression.
+		% Haskell doesn't handle all cases -- it is not
+		% possible to get multiple existentially typed fields
+		% using record syntax and pass them to a function
+		% whose type requires that the fields are of the
+		% same type. It probably won't come up too often.
+		%
+		list__replace_nth_det(ConsArgTypes, FieldNumber, int_type, 
+			ArgTypesWithoutField),
+		term__vars_list(ArgTypesWithoutField,
+			TVarsInOtherArgs),
+		set__intersect(
+			set__list_to_set(TVarsInField),
+			set__intersect(
+				set__list_to_set(TVarsInOtherArgs),
+				set__list_to_set(ExistQVars0)
+			),
+			ExistQVarsInFieldAndOthers),
+		(
+			set__empty(ExistQVarsInFieldAndOthers)
+		->
+			%
+			% Rename apart type variables occurring only in the
+			% field to be replaced - the values of those
+			% type variables will be supplied by the
+			% replacement field value.
+			%
+			list__delete_elems(TVarsInField, TVarsInOtherArgs,
+				TVarsOnlyInField0),
+			list__sort_and_remove_dups(TVarsOnlyInField0,
+				TVarsOnlyInField),
+			list__length(TVarsOnlyInField, NumNewTVars),
+			varset__new_vars(TVarSet0, NumNewTVars,
+				NewTVars, TVarSet),
+			map__from_corresponding_lists(TVarsOnlyInField,
+				NewTVars, TVarRenaming),
+			term__apply_variable_renaming(FieldType, TVarRenaming,
+				RenamedFieldType), 
+			term__apply_variable_renaming(FunctorType,
+				TVarRenaming, OutputFunctorType),
+
+			%
+			% Rename the class constraints, projecting
+			% the constraints onto the set of type variables
+			% occuring in the types of the arguments of
+			% the call to `'field:='/2'. 
+			%
+			term__vars_list([FunctorType, FieldType],
+				CallTVars0),
+			set__list_to_set(CallTVars0, CallTVars),
+			project_rename_flip_class_constraints(CallTVars,
+				TVarRenaming, ClassConstraints0,
+				ClassConstraints),
+
+			RetType = OutputFunctorType,
+			ArgTypes = [FunctorType, RenamedFieldType],
+			ConsTypeInfo = cons_type_info(
+				cons_type_info(TVarSet, ExistQVars,
+					RetType, ArgTypes, ClassConstraints))
+		;
+			%
+			% This field cannot be set. Pass out some information
+			% so that we can give a better error message.
+			% Errors involving changing the types of universally
+			% quantified type variables will be caught by 
+			% typecheck_functor_arg_types.
+			%
+			set__to_sorted_list(ExistQVarsInFieldAndOthers,
+				ExistQVarsInFieldAndOthers1),
+			ConsTypeInfo =
+				invalid_field_update(
+				invalid_field_update(FieldName, FieldDefn,
+					TVarSet0, ExistQVarsInFieldAndOthers1))
+		)
+	)
+    ).
+
+	% Rename constraints containing variables that have been renamed.
+	% These constraints are all universal constraints - the values
+	% of the type variables are supplied by the caller.
+:- pred project_rename_flip_class_constraints(set(tvar), map(tvar, tvar),
+		class_constraints, class_constraints).
+:- mode project_rename_flip_class_constraints(in, in, in, out) is det.
+
+project_rename_flip_class_constraints(CallTVars, TVarRenaming,
+		Constraints0, Constraints) :-
+	Constraints0 = constraints(UnivConstraints0, ExistConstraints0),
+
+	%
+	% XXX We currently don't allow universal constraints on
+	% types or data constructors (but we should). When we
+	% implement handling of those, they will need to be renamed
+	% here as well.
+	%
+	( UnivConstraints0 = [] ->
+		true
+	;
+		error(
+		"project_rename_flip_class_constraints: universal constraints")
+	),
+
+	%
+	% Project the constraints down onto the list of tvars
+	% in the call.
+	%
+	ProjectConstraints =
+		(pred(ConstraintToCheck::in) is semidet :-
+			ConstraintToCheck = constraint(_, TypesToCheck),
+			term__vars_list(TypesToCheck, TVarsToCheck0),
+			set__list_to_set(TVarsToCheck0, TVarsToCheck),
+			set__intersect(TVarsToCheck, CallTVars, RelevantTVars),
+			\+ set__empty(RelevantTVars)
+		),
+	list__filter(ProjectConstraints, ExistConstraints0, ExistConstraints1),
+	
+	RenameConstraints = 
+		(pred(Constraint0::in, Constraint::out) is semidet :-
+			Constraint0 = constraint(ClassName, ConstraintTypes0),
+			some [Var] (
+				term__contains_var_list(ConstraintTypes0, Var),
+				map__contains(TVarRenaming, Var)
+			),
+			term__apply_variable_renaming_to_list(ConstraintTypes0,
+				TVarRenaming, ConstraintTypes),
+			Constraint = constraint(ClassName, ConstraintTypes)
+		), 
+	list__filter_map(RenameConstraints, ExistConstraints1, NewConstraints),
+
+	% The variables which were previously existentially quantified
+	% are now universally quantified.
+	Constraints = constraints(NewConstraints, []).
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -3322,25 +3691,30 @@
 %-----------------------------------------------------------------------------%
 
 :- pred typecheck_info_get_ctor_list(typecheck_info, cons_id, int, 
-			list(cons_type_info)).
-:- mode typecheck_info_get_ctor_list(typecheck_info_ui, in, in, out) is det.
+			list(cons_type_info), list(invalid_field_update)).
+:- mode typecheck_info_get_ctor_list(typecheck_info_ui,
+			in, in, out, out) is det.
 
-typecheck_info_get_ctor_list(TypeCheckInfo, Functor, Arity, ConsInfoList) :-
+typecheck_info_get_ctor_list(TypeCheckInfo, Functor, Arity,
+		ConsInfoList, InvalidFieldUpdates) :-
 	(
 		builtin_apply_type(TypeCheckInfo, Functor, Arity,
 			ApplyConsInfoList)
 	->
-		ConsInfoList = ApplyConsInfoList
+		ConsInfoList = ApplyConsInfoList,
+		InvalidFieldUpdates = []
 	;
 		typecheck_info_get_ctor_list_2(TypeCheckInfo, Functor, Arity,
-			ConsInfoList)
+			ConsInfoList, InvalidFieldUpdates)
 	).
 
 :- pred typecheck_info_get_ctor_list_2(typecheck_info, cons_id,
-		int, list(cons_type_info)).
-:- mode typecheck_info_get_ctor_list_2(typecheck_info_ui, in, in, out) is det.
+		int, list(cons_type_info), list(invalid_field_update)).
+:- mode typecheck_info_get_ctor_list_2(typecheck_info_ui,
+		in, in, out, out) is det.
 
-typecheck_info_get_ctor_list_2(TypeCheckInfo, Functor, Arity, ConsInfoList) :-
+typecheck_info_get_ctor_list_2(TypeCheckInfo, Functor, Arity,
+		ConsInfoList, InvalidFieldUpdates) :-
 	% Check if `Functor/Arity' has been defined as a constructor
 	% in some discriminated union type(s).  This gives
 	% us a list of possible cons_type_infos.
@@ -3414,9 +3788,26 @@
 		builtin_pred_type(TypeCheckInfo, Functor, Arity,
 			PredConsInfoList)
 	->
-		list__append(ConsInfoList2, PredConsInfoList, ConsInfoList)
+		list__append(ConsInfoList2, PredConsInfoList, ConsInfoList3)
 	;
-		ConsInfoList = ConsInfoList2
+		ConsInfoList3 = ConsInfoList2
+	),
+	
+	%
+	% Check if Functor is a field access function which has not
+	% been overridden by the user.
+	%
+	(
+		builtin_field_access_function_type(TypeCheckInfo,
+			Functor, Arity, FieldAccessConsInfoList,
+			InvalidFieldUpdates0)
+	->
+		list__append(FieldAccessConsInfoList,
+			ConsInfoList3, ConsInfoList),
+		InvalidFieldUpdates = InvalidFieldUpdates0
+	;
+		InvalidFieldUpdates = [],
+		ConsInfoList = ConsInfoList3
 	).
 
 :- pred flip_quantifiers(cons_type_info, cons_type_info).
@@ -4867,66 +5258,67 @@
 :- pred write_type_stuff_list(list(type_stuff), io__state, io__state).
 :- mode write_type_stuff_list(in, di, uo) is det.
 
-write_type_stuff_list([]) --> [].
-write_type_stuff_list([type_stuff(T, TVarSet, TBinding) | Ts]) -->
-	write_type_b(T, TVarSet, TBinding),
-	write_type_stuff_list_2(Ts).
+write_type_stuff_list(Ts) -->
+	write_comma_separated_error_list(write_type_stuff, Ts).
 
-:- pred write_type_stuff_list_2(list(type_stuff), io__state, io__state).
-:- mode write_type_stuff_list_2(in, di, uo) is det.
+:- pred write_type_stuff(type_stuff, io__state, io__state).
+:- mode write_type_stuff(in, di, uo) is det.
 
-write_type_stuff_list_2([]) --> [].
-write_type_stuff_list_2([type_stuff(T, TVarSet, TBinding) | Ts]) -->
-	io__write_string(", "),
-	write_type_b(T, TVarSet, TBinding),
-	write_type_stuff_list_2(Ts).
+write_type_stuff(type_stuff(T, TVarSet, TBinding)) -->
+	write_type_b(T, TVarSet, TBinding).
 
 :- pred write_var_type_stuff_list(list(type_stuff), type, io__state, io__state).
 :- mode write_var_type_stuff_list(in, in, di, uo) is det.
 
-write_var_type_stuff_list([], _Type) --> [].
-write_var_type_stuff_list([type_stuff(VT, TVarSet, TBinding) | Ts], T) -->
-	write_type_b(VT, TVarSet, TBinding),
-	io__write_string("/"),
-	write_type_b(T, TVarSet, TBinding),
-	write_var_type_stuff_list_2(Ts, T).
-
-:- pred write_var_type_stuff_list_2(list(type_stuff), type,
-					io__state, io__state).
-:- mode write_var_type_stuff_list_2(in, in, di, uo) is det.
+write_var_type_stuff_list(Ts, T) -->
+	write_comma_separated_error_list(write_var_type_stuff(T), Ts).
 
-write_var_type_stuff_list_2([], _Type) --> [].
-write_var_type_stuff_list_2([type_stuff(VT, TVarSet, TBinding) | Ts], T) -->
-	io__write_string(", "),
+:- pred write_var_type_stuff(type, type_stuff, io__state, io__state).
+:- mode write_var_type_stuff(in, in, di, uo) is det.
+	
+write_var_type_stuff(T, type_stuff(VT, TVarSet, TBinding)) -->
 	write_type_b(VT, TVarSet, TBinding),
 	io__write_string("/"),
-	write_type_b(T, TVarSet, TBinding),
-	write_type_stuff_list_2(Ts).
+	write_type_b(T, TVarSet, TBinding).
 
 :- pred write_arg_type_stuff_list(list(arg_type_stuff), io__state, io__state).
 :- mode write_arg_type_stuff_list(in, di, uo) is det.
+
+write_arg_type_stuff_list(Ts) -->
+	write_comma_separated_error_list(write_arg_type_stuff, Ts).
+
+:- pred write_arg_type_stuff(arg_type_stuff, io__state, io__state).
+:- mode write_arg_type_stuff(in, di, uo) is det.
 
-write_arg_type_stuff_list([]) --> [].
-write_arg_type_stuff_list([arg_type_stuff(T0, VT0, TVarSet) | Ts]) -->
+write_arg_type_stuff(arg_type_stuff(T0, VT0, TVarSet)) -->
 	{ strip_builtin_qualifiers_from_type(VT0, VT) },
 	mercury_output_term(VT, TVarSet, no),
 	io__write_string("/"),
 	{ strip_builtin_qualifiers_from_type(T0, T) },
-	mercury_output_term(T, TVarSet, no),
-	write_arg_type_stuff_list_2(Ts).
+	mercury_output_term(T, TVarSet, no).
 
-:- pred write_arg_type_stuff_list_2(list(arg_type_stuff), io__state, io__state).
-:- mode write_arg_type_stuff_list_2(in, di, uo) is det.
+%-----------------------------------------------------------------------------%
+
+:- pred write_comma_separated_error_list(pred(T, io__state, io__state),
+		list(T), io__state, io__state).
+:- mode write_comma_separated_error_list(pred(in, di, uo) is det, in,
+		di, uo) is det.
+
+write_comma_separated_error_list(_, []) --> [].
+write_comma_separated_error_list(Pred, [Error | Errors]) -->
+	Pred(Error),
+	write_comma_separated_error_list_2(Pred, Errors).
 
-write_arg_type_stuff_list_2([]) --> [].
-write_arg_type_stuff_list_2([arg_type_stuff(T0, VT0, TVarSet) | Ts]) -->
+:- pred write_comma_separated_error_list_2(pred(T, io__state, io__state),
+		list(T), io__state, io__state).
+:- mode write_comma_separated_error_list_2(pred(in, di, uo) is det, in,
+		di, uo) is det.
+
+write_comma_separated_error_list_2(_, []) --> [].
+write_comma_separated_error_list_2(Pred, [Error | Errors]) -->
 	io__write_string(", "),
-	{ strip_builtin_qualifiers_from_type(VT0, VT) },
-	mercury_output_term(VT, TVarSet, no),
-	io__write_string("/"),
-	{ strip_builtin_qualifiers_from_type(T0, T) },
-	mercury_output_term(T, TVarSet, no),
-	write_arg_type_stuff_list_2(Ts).
+	Pred(Error),
+	write_comma_separated_error_list_2(Pred, Errors).
 
 %-----------------------------------------------------------------------------%
 
@@ -5121,11 +5513,12 @@
 	prog_out__write_sym_name(SymName),
 	io__write_string("'.\n").
 
-:- pred report_error_undef_cons(typecheck_info, cons_id, int, io__state, 
-			io__state).
-:- mode report_error_undef_cons(typecheck_info_no_io, in, in, di, uo) is det.
+:- pred report_error_undef_cons(typecheck_info, list(invalid_field_update),
+			cons_id, int, io__state, io__state).
+:- mode report_error_undef_cons(typecheck_info_no_io, in,
+			in, in, di, uo) is det.
 
-report_error_undef_cons(TypeCheckInfo, Functor, Arity) -->
+report_error_undef_cons(TypeCheckInfo, InvalidFieldUpdates, Functor, Arity) -->
 	{ typecheck_info_get_called_predid(TypeCheckInfo, CalledPredId) },
 	{ typecheck_info_get_arg_num(TypeCheckInfo, ArgNum) },
 	{ typecheck_info_get_context(TypeCheckInfo, Context) },
@@ -5224,7 +5617,13 @@
 		;
 			[]
 		)
-	; 
+	; { InvalidFieldUpdates = [_ | _] } ->
+		io__write_string(
+			"  error: invalid field update `"),
+		hlds_out__write_cons_id(Functor),
+		io__write_string("':\n"),
+		report_invalid_field_updates(InvalidFieldUpdates)
+	;
 		(
 			{ Functor = cons(Constructor, Arity) },
 			{ typecheck_info_get_ctors(TypeCheckInfo, ConsTable) },
@@ -5254,6 +5653,45 @@
 			)
 		)
 	).
+
+:- pred report_invalid_field_updates(list(invalid_field_update),
+			io__state, io__state).
+:- mode report_invalid_field_updates(in, di, uo) is det.
+
+report_invalid_field_updates(Updates) -->
+	write_comma_separated_error_list(report_invalid_field_update, Updates).
+
+:- pred report_invalid_field_update(invalid_field_update,
+			io__state, io__state).
+:- mode report_invalid_field_update(in, di, uo) is det.
+
+report_invalid_field_update(invalid_field_update(FieldName, FieldDefn,
+				TVarSet, TVars)) -->
+	{ FieldDefn = hlds_ctor_field_defn(Context, _, _, ConsId, _) },
+	prog_out__write_context(Context),
+	io__write_string("  existentially quantified type "),
+	(
+		{ TVars = [] },
+		{ error("report_invalid_field_update: no type variables") }
+	;
+		{ TVars = [TVar] },
+		io__write_string("variable `"),
+		mercury_output_var(TVar, TVarSet, no),
+		io__write_string("' occurs\n")
+	;
+		{ TVars = [_, _ | _] },
+		io__write_string("variables `"),
+		mercury_output_vars(TVars, TVarSet, no),
+		io__write_string("' occur\n")
+	),
+	prog_out__write_context(Context),
+	io__write_string("  in the types of field `"),
+	prog_out__write_sym_name(FieldName),
+	io__write_string("' and some other field\n"),
+	prog_out__write_context(Context),
+	io__write_string("  in definition of constructor `"),
+	hlds_out__write_cons_id(ConsId),
+	io__write_string(" '.\n").
 
 :- pred report_wrong_arity_constructor(sym_name, arity, list(int), 
 		prog_context, io__state, io__state).
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.162
diff -u -u -r1.162 reference_manual.texi
--- reference_manual.texi	1999/12/13 13:30:47	1.162
+++ reference_manual.texi	2000/01/04 05:27:34
@@ -713,6 +713,41 @@
 transform(V_in, V_out, =(Term)) = (Term = V_in, V_out = V_in)
 @end example
 
+ at item :=(@var{Term})
+A DCG output unification.  Unifies @var{Term} with the implicit DCG output
+argument, ignoring the input DCG argument.
+ at var{Term} must be a valid data-term.
+
+Semantics:
+ at example
+transform(V_in, V_out, :=(Term)) = (V_out = Term)
+ at end example
+
+ at item @var{Term} := ^ @var{Field1} ^ ... ^ @var{FieldN}
+Unifies @var{Term} with the field of the implicit DCG argument
+labelled by @var{Field}. 
+ at var{Term} must be a valid data-term.
+ at var{Field1} @dots{} @var{FieldN} must be valid field names.
+ at xref{Record syntax}.
+
+Semantics:
+ at example
+transform(V_in, V_out, Term := ^ Field1 ^ @dots{} ^ FieldN ) =
+        (Term = V_in ^ Field1 ^ @dots{} ^ FieldN, V_out = V_in)
+ at end example
+
+ at item ^ @var{Field} := @var{Term}
+Replaces a field in the implicit DCG argument. 
+ at var{Term} must be a valid data-term.
+ at var{Field1} @dots{} @var{FieldN} must be valid field names.
+ at xref{Record syntax}.
+
+Semantics:
+ at example
+transform(V_in, V_out, ^ Field1 ^ @dots{} ^ FieldN := Term) =
+        (V_out = V_in ^ Field1 ^ @dots{} ^ FieldN := Term)
+ at end example
+
 @item @var{DCG-call}
 Any term which does not match any of the above forms
 must be a DCG predicate call.
@@ -745,6 +780,7 @@
 
 @menu
 * Data-functors::
+* Record syntax::
 * Conditional expressions::
 * Lambda expressions::
 * Higher-order function applications::
@@ -762,6 +798,51 @@
 must name a function, predicate, or data constructor declared
 in the program or in the interface of an imported module.
 
+ at node Record syntax
+ at subsection Record syntax
+
+Record syntax provides a convenient way to extract or update fields
+of data constructors, independent of the definition of the constructor.
+
+A field within a term is specified by a list of
+(possibly module-qualified) field names separated by the operator `^'.
+For example @samp{field1}, @samp{module__field1} and
+ at samp{field1 ^ field2} are all valid field specifiers.
+
+Record syntax expressions are transformed into sequences of calls
+to field extraction or update functions (@pxref{Field access functions}).
+
+ at table @code
+ at item @var{Term} ^ @var{Field1} ^ @dots{} ^ @var{FieldN}
+
+A field extraction.
+ at var{Term} must be a valid data-term.
+ at var{Field1} @dots{} @var{FieldN} must be valid field names.
+
+This is equivalent to a sequence of function calls:
+ at example
+ at var{FieldN}(@dots{} @var{Field1}(@var{Term}) @dots{}).
+ at end example
+
+ at item @var{Term} ^ @var{Field1} ^ @dots{} ^ @var{FieldN} := @var{FieldValue}
+
+A field update.
+ at var{Term} must be a valid data-term.
+ at var{Field1} @dots{} @var{FieldN} must be valid field names.
+
+This is equivalent to the code:
+ at example
+OldField1 = Term ^ Field1,
+OldField2 = OldField1 ^ OldField2,
+ at dots{}
+NewField_N_Minus_1 = 'FieldN:='(OldField_N_Minus_1, FieldValue),
+ at dots{}
+NewField1 = 'Field2:='(OldField1, NewField2),
+Result = 'Field1:='(Term, NewField1)
+ at end example
+
+ at end table
+
 @node Conditional expressions
 @subsection Conditional expressions
 
@@ -915,6 +996,16 @@
 type classes (@pxref{Type classes}), and existentially quantified types
 (@pxref{Existential types}).
 
+ at menu
+* Builtin types::
+* User-defined types::
+* Predicate and function types::
+* Field access functions::
+ at end menu
+
+ at node Builtin types
+ at section Builtin types
+
 Certain special types are builtin, or are defined in the Mercury library:
 
 @table @asis
@@ -945,13 +1036,22 @@
 
 @end table
 
+ at node User-defined types
+ at section User-defined types
+
 New types can be introduced with @samp{:- type} declarations.
 There are several categories of derived types:
 
- at itemize @bullet
- at item
-Discriminated unions: these encompass both enumeration and
-record types in other languages.
+ at menu
+* Discriminated unions::
+* Equivalence types::
+* Abstract types::
+ at end menu
+
+ at node Discriminated unions
+ at subsection Discriminated unions
+
+These encompass both enumeration and record types in other languages.
 A derived type is defined using @samp{:- type @var{type} ---> @var{body}}. 
 (Note there are @emph{three} dashes in that arrow.
 It should not be confused with the two-dash arrow used for DCGs
@@ -976,6 +1076,12 @@
 Existentially typed discriminated union definitions need not be
 transparent.
 
+The arguments of constructor definitions may be labelled.
+These labels can be used to conveniently extract and update fields
+of a constructor in a manner independent of the definition of the
+constructor (@pxref{Field access functions}). A labelled argument
+is of the form `@code{@var{FieldName} :: @var{Type}}'.
+
 Here are some examples of discriminated union definitions:
 
 @example
@@ -991,9 +1097,9 @@
 
 :- type employee
         --->    employee(
-                       string,               % name
-                       int,                  % age
-                       string                % department
+                       name        :: string,
+                       age         :: int,
+                       department  :: string
                 ).
 
 :- type tree
@@ -1033,8 +1139,22 @@
 Having two different definitions of a type with the same name and arity in
 the same module is an error.
 
- at item
-Equivalence types: these are type abbreviations.
+Constructors may be overloaded among different types:
+there may be any number of constructors with a given name and arity,
+so long as they all have different types.
+However, there must not be more than one constructor
+with the same name, arity, and result type in the same module.
+(There is no particularly good reason for this restriction;
+in the future we may allow several such functors
+as long as they have different argument types.)
+Note that excessive overloading of constructors can slow down type checking
+and can make the program confusing for human readers,
+so overloading should not be over-used.
+
+ at node Equivalence types
+ at subsection Equivalence types
+
+These are type abbreviations.
 They are defined using @samp{==} as follows.
 They may be polymorphic.
 
@@ -1056,8 +1176,10 @@
 the two are equivalent in all respects
 in scopes where the equivalence type is visible.
 
- at item
-Abstract types: these are types whose implementation is hidden.
+ at node Abstract types
+ at subsection Abstract types
+
+These are types whose implementation is hidden.
 The type declarations
 
 @example
@@ -1076,20 +1198,9 @@
 Abstract types may be defined as either discriminated union types
 or as equivalence types.
 
- at end itemize
+ at node Predicate and function types 
+ at section Predicate and function types 
 
-Constructors may be overloaded among different types:
-there may be any number of constructors with a given name and arity,
-so long as they all have different types.
-However, there must not be more than one constructor
-with the same name, arity, and result type in the same module.
-(There is no particularly good reason for this restriction;
-in the future we may allow several such functors
-as long as they have different argument types.)
-Note that excessive overloading of constructors can slow down type checking
-and can make the program confusing for human readers,
-so overloading should not be over-used.
-
 The argument types of each predicate
 must be explicitly declared with a @samp{:- pred} declaration.
 The argument types and return type of each function must be
@@ -1183,6 +1294,154 @@
 if there is a unique (up to renaming) most general valid type assignment.
 Every clause in a Mercury program must be type-correct.
 
+ at node Field access functions
+ at section Field access functions
+
+Fields of constructors of discriminated union types may be
+labelled. These labels can be used to extract and update individual
+fields of a constructor a manner independent of the definition of
+the constructor.
+
+The Mercury language includes syntactic sugar to make it more convenient
+to extract and update fields inside nested terms (@pxref{Record syntax})
+and to extract and update fields of the DCG arguments of a
+clause (@pxref{DCG-goals}).
+
+ at menu
+* Field extraction::
+* Field update::
+* Overriding field access functions::
+* Field access examples::
+ at end menu
+
+ at node Field extraction
+ at subsection Field extraction
+
+ at example
+ at var{Field}(@var{Term})
+ at end example
+
+Each field label @samp{@var{Field}} in a constructor causes generation
+of a field extraction function @samp{@var{Field}/1}, which takes a data-term
+of the same type as the constructor and returns the value of the
+labelled field, failing if the top-level constructor of the argument
+is not the constructor containing the field.
+
+By default, this function has no modes --- the modes are inferred at
+each call to the function.
+
+An explicit lambda expression must be used to create a higher-order term
+from a field extraction function, unless a mode declaration is supplied.
+
+ at node Field update
+ at subsection Field update
+
+ at example
+'@var{Field}:='(@var{Term}, @var{ValueTerm})
+ at end example
+
+Each field label @samp{@var{Field}} in a constructor causes generation
+of a field update function @samp{'@var{Field}:='/2}.
+The first argument of this function is a data-term of the same type as the
+constructor. The second argument is a data-term of the same type as the
+labelled field. The return value is a copy of the first argument with
+value of the labelled field replaced by the second argument.
+ at samp{'@var{Field}:='/2} fails if the top-level constructor of the
+first argument is not the constructor containing the labelled field.
+
+By default, this function has no modes --- the modes
+are inferred at each call to the function.
+
+Some fields cannot be updated using field update functions.
+For the constructor @samp{unsettable/2} below, neither field may be updated
+because the resulting term would not be well-typed. A future release
+may allow multiple fields to be updated by a single expression to avoid
+this problem.
+
+ at example
+:- type unsettable
+        ---> some [T] unsettable(
+                unsettable1 :: T,
+                unsettable2 :: T
+        ).
+ at end example
+
+An explicit lambda expression must be used to create a higher-order term
+from a field update function, unless a mode declaration is supplied.
+
+ at node Overriding field access functions
+ at subsection Overriding field access functions
+
+Users can provide declarations and clauses for field access
+functions @samp{@var{Field}/1} and @samp{'@var{Field}:='/2},
+overriding the compiler-generated default declarations and
+clauses.
+
+The compiler-generated field access functions can always
+be called using the functions @samp{'builtin @var{Field}'/1} and
+ at samp{'builtin @var{Field}:='/2}. These functions may not be overridden
+by the user. They are visible only in the module containing the declaration
+of the type containing the field --- client modules must always use the
+user-supplied field access functions.
+
+Declarations for user-supplied field access functions for fields occurring
+in the interface section of a module must also occur in the interface section.
+
+Declarations for field access functions for fields local
+to a module may be placed in the interface section of the module. This allows
+the implementation of a type to be hidden while still allowing
+client modules to use record syntax to manipulate values of the type.
+Clauses need not be supplied for such functions --- the compiler adds
+a default clause containing a call to the corresponding builtin
+field access function.
+
+Declarations of field access functions can also be supplied for fields
+which are not a part of any type. This is useful when the data structures of
+a program change so that a value which was previously stored as part
+of a type is now computed each time it is requested. It also
+allows record syntax to be used for type class methods.
+
+ at node Field access examples
+ at subsection Field access examples
+
+The type declaration
+ at example
+:- type type1
+        ---> type1(
+                field1 :: int,
+                field2 :: string
+        ).
+ at end example
+causes the following functions to be automatically defined by the compiler:
+ at example
+:- func field1(type1) = int.
+field1(type1(Field1, _)) = Field1.
+
+:- func 'field1:='(type1, int) = type1.
+'field1:='(type1(_, Field2), Field1) = type1(Field1, Field2).
+
+:- func field2(type1) = string.
+field2(type1(_, Field2)) = Field2.
+
+:- func 'field2:='(type1, string) = type1.
+'field2:='(type1(Field1, _), Field2) = type1(Field1, Field2).
+ at end example
+
+The programmer can add a restriction on the domain of
+ at samp{field1} (checked at runtime), by overriding the
+update function for @samp{field1}:
+
+ at example
+:- func 'field1:='(type1, int) = type1.
+
+'field1:='(Term, Field1) = 'builtin field1:='(Term, Field1) :-
+        ( Field1 < 0 ->
+                error("'field1:=': negative value for field1")
+        ;
+                true
+        ).
+ at end example
+
 @node Modes
 @chapter Modes
 
@@ -2759,8 +3018,8 @@
 @code{import_module} or @code{use_module} declaration should be in 
 the implementation section.
 
-The names of predicates, functions, constructors, types, modes, insts,
-type classes,
+The names of predicates, functions, constructors, constructor fields,
+types, modes, insts, type classes,
 and (sub-)modules can be explicitly module qualified using the @samp{:}
 operator, e.g. @samp{module:name} or @samp{module:submodule:name}.
 This is useful both for readability and for resolving name conflicts.
Index: doc/transition_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/transition_guide.texi,v
retrieving revision 1.31
diff -u -u -r1.31 transition_guide.texi
--- transition_guide.texi	1999/11/12 09:12:35	1.31
+++ transition_guide.texi	1999/11/23 03:15:34
@@ -126,6 +126,7 @@
 :-              xfx             1200
 :-              fx              1200
 ::              xfx             1175
+:=              xfx             650
 ;               xfy             1100
 <               xfx             700
 <<              yfx             400
@@ -143,7 +144,8 @@
 \+              fy              900
 \/              yfx             500
 \=              xfx             700
-^               xfy             200
+^               xfy             99
+^               fx              100
 ~               fy              900
 aditi_bottom_up fx              500
 aditi_top_down  fx              500
Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.27
diff -u -u -r1.27 ops.m
--- ops.m	1999/11/16 07:51:20	1.27
+++ ops.m	1999/12/21 01:28:31
@@ -141,6 +141,7 @@
 ops__op_table(":-", after, xfx, 1200).		% standard ISO Prolog
 ops__op_table(":-", before, fx, 1200).		% standard ISO Prolog
 ops__op_table("::", after, xfx, 1175).		% Mercury extension
+ops__op_table(":=", after, xfx, 650).		% Mercury extension
 ops__op_table(";", after, xfy, 1100).		% standard ISO Prolog
 ops__op_table("<", after, xfx, 700).		% standard ISO Prolog
 ops__op_table("<<", after, yfx, 400).		% standard ISO Prolog
@@ -167,7 +168,11 @@
 ops__op_table("\\/", after, yfx, 500).		% standard ISO Prolog
 ops__op_table("\\=", after, xfx, 700).		% standard ISO Prolog
 ops__op_table("\\==", after, xfx, 700).		% standard ISO Prolog (*)
-ops__op_table("^", after, xfy, 200).		% standard ISO Prolog
+ops__op_table("^", after, xfy, 99).		% ISO Prolog (prec. 200,
+						%	bitwise xor)
+						% Mercury (record syntax)
+ops__op_table("^", before, fx, 100).		% Mercury extension
+						% (record syntax)
 ops__op_table("aditi_bottom_up", before, fx, 500). % Mercury extension
 ops__op_table("aditi_top_down", before, fx, 500). % Mercury extension
 ops__op_table("all", before, fxy, 950).		% Mercury/NU-Prolog extension
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.73
diff -u -u -r1.73 Mmakefile
--- Mmakefile	1999/11/17 02:13:56	1.73
+++ Mmakefile	1999/12/21 03:33:34
@@ -86,6 +86,7 @@
 	quantifier2 \
 	quoting_bug_test \
 	rational_test \
+	record_syntax \
 	redoip_clobber \
 	relation_test \
 	remove_file \
Index: tests/hard_coded/record_syntax.exp
===================================================================
RCS file: record_syntax.exp
diff -N record_syntax.exp
--- /dev/null	Tue Jan  4 16:29:29 2000
+++ record_syntax.exp	Wed Dec 22 12:49:02 1999
@@ -0,0 +1,18 @@
+X ^ arg1 = 1
+X ^ arg2 = 2
+X ^ arg3 = foo2(3, 4)
+X ^ arg3 ^ arg4 = 3
+updated arg1 = foo(5, 2, foo2(3, 4))
+updated arg2 = foo(1, 6, foo2(3, 4))
+updated arg3 ^ arg4 = foo(1, 2, foo2(7, 4))
+List1 = cons(1, cons(2, cons(4, nil)))
+List2 ^ e_next ^ e_data = 'b'
+List3 = e_cons(1, e_cons("new value", e_nil))
+List3 ^ e_next ^ e_data = "new value"
+size(List3 ^ e_next ^ e_data) = 9
+Pair0 ^ fst = 1
+Pair = "new first elem" - 2
+DCG ^ arg1 = 1
+DCG ^ arg3 ^ arg4 = 3
+updated DCG arg1 = foo(8, 2, foo2(3, 4))
+updated DCG arg3 ^ arg4 = foo(8, 2, foo2(9, 4))
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.56
diff -u -u -r1.56 Mmakefile
--- Mmakefile	1999/12/27 11:07:33	1.56
+++ Mmakefile	2000/01/04 03:41:55
@@ -52,6 +52,7 @@
 	prog_io_erroneous.m \
 	qual_basic_test2.m \
 	qualified_cons_id2.m \
+	record_syntax_errors.m \
 	some.m \
 	spurious_mode_error.m \
 	test_nested.m \
Index: tests/invalid/record_syntax_errors.err_exp
===================================================================
RCS file: record_syntax_errors.err_exp
diff -N record_syntax_errors.err_exp
--- /dev/null	Tue Jan  4 16:29:29 2000
+++ record_syntax_errors.err_exp	Thu Dec 23 11:55:41 1999
@@ -0,0 +1,36 @@
+record_syntax_errors.m:028: In DCG field update goal:
+record_syntax_errors.m:028:   error: expected field name at term `Field'.
+record_syntax_errors.m:031: Error: expected `Field := ^ field1 ^ ... ^ fieldN'
+record_syntax_errors.m:031:   or `^ field1 ^ ... ^ fieldN := Field'.
+record_syntax_errors.m:031:   in DCG field access goal.
+record_syntax_errors.m:048: Error: clause for predicate `record_syntax_errors:term_type_error/1'
+record_syntax_errors.m:048:   without preceding `pred' declaration.
+record_syntax_errors.m:054: In declaration of function `record_syntax_errors:field4/1':
+record_syntax_errors.m:054:   error: a field access function for an
+record_syntax_errors.m:054:   exported field must also be exported.
+record_syntax_errors.m:056: Error: redefinition of builtin field access function `record_syntax_errors:builtin field4/1'.
+record_syntax_errors.m:056: In declaration of function `record_syntax_errors:builtin field4/1':
+record_syntax_errors.m:056:   error: a field access function for an
+record_syntax_errors.m:056:   exported field must also be exported.
+record_syntax_errors.m:014: Error: no clauses for predicate `record_syntax_errors:dcg_syntax/2'.
+record_syntax_errors.m:016: Error: no clauses for predicate `record_syntax_errors:dcg_syntax_2/2'.
+record_syntax_errors.m:042: In clause for predicate `record_syntax_errors:construct_exist_cons/1':
+record_syntax_errors.m:042:   error: invalid field update `field2:=/2':
+record_syntax_errors.m:005:   existentially quantified type variable `T' occurs
+record_syntax_errors.m:005:   in the types of field `field2' and some other field
+record_syntax_errors.m:005:   in definition of constructor `record_syntax_errors:exist_cons/3 '.
+record_syntax_errors.m:046: In clause for predicate `record_syntax_errors:arg_type_error/1':
+record_syntax_errors.m:046:   in argument 2 of functor `field6:=/2':
+record_syntax_errors.m:046:   in argument 2 of functor `field7:=/2':
+record_syntax_errors.m:046:   type error in unification of argument
+record_syntax_errors.m:046:   and constant `"invalid value"'.
+record_syntax_errors.m:046:   argument has type `int',
+record_syntax_errors.m:046:   constant `"invalid value"' has type `string'.
+record_syntax_errors.m:050: In clause for predicate `record_syntax_errors:term_type_error/1':
+record_syntax_errors.m:050:   in argument 2 of functor `field6:=/2':
+record_syntax_errors.m:050:   in unification of argument
+record_syntax_errors.m:050:   and term `'field4:='(V_5, V_4)':
+record_syntax_errors.m:050:   type error in argument(s) of functor `field4:=/2'.
+record_syntax_errors.m:050:   Argument 1 has type `(record_syntax_errors:cons2)',
+record_syntax_errors.m:050:   expected type was `(record_syntax_errors:cons)'.
+For more information, try recompiling with `-E'.

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the developers mailing list