[m-dev.] diff: update alias branch [3/3]

Simon Taylor stayl at cs.mu.OZ.AU
Mon Jul 19 11:47:07 AEST 1999


--- modecheck_unify.m	1999/07/14 00:26:57	1.2
+++ modecheck_unify.m	1999/07/16 05:22:31
@@ -212,18 +212,10 @@
 	).
 
 modecheck_unification(X, 
-<<<<<<< modecheck_unify.m
-		lambda_goal(PredOrFunc, ArgVars, Vars, Modes0, Det,
-				_, LambdaGoal0),
+		lambda_goal(PredOrFunc, EvalMethod, _, ArgVars,
+			Vars, Modes0, Det, _, LambdaGoal0),
 		Unification0, UnifyContext, GoalInfo0, 
 		Goal, ModeInfo0, ModeInfo) :-
-=======
-		lambda_goal(PredOrFunc, EvalMethod, _, ArgVars,
-			Vars, Modes0, Det, Goal0),
-		Unification0, UnifyContext, _GoalInfo, 
-		unify(X, RHS, Mode, Unification, UnifyContext),
-		ModeInfo0, ModeInfo) :-
->>>>>>> 1.40
 	%
 	% First modecheck the lambda goal itself:
 	%
@@ -389,13 +381,9 @@
 		% Now modecheck the unification of X with the lambda-expression.
 		%
 
-<<<<<<< modecheck_unify.m
-		RHS0 = lambda_goal(PredOrFunc, ArgVars, Vars, Modes, Det,
-				IMDelta, LambdaGoal),
-=======
 		RHS0 = lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
-				ArgVars, Vars, Modes, Det, Goal),
->>>>>>> 1.40
+				ArgVars, Vars, Modes, Det,
+				IMDelta, LambdaGoal),
 		modecheck_unify_lambda(X, PredOrFunc, ArgVars, Modes,
 				Det, RHS0, Unification0, Mode,
 				RHS, Unification, ModeInfo15, ModeInfo)
@@ -418,16 +406,10 @@
 			error("modecheck_unification(lambda): very strange var")
 		),
 			% return any old garbage
-<<<<<<< modecheck_unify.m
-		RHS = lambda_goal(PredOrFunc, ArgVars, Vars,
-				Modes0, Det, IMDelta, LambdaGoal0),
+		RHS = lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
+			ArgVars, Vars, Modes0, Det, IMDelta, LambdaGoal0),
 		Mode = (free(unique) - free(unique)) -
 			(free(unique) - free(unique)),
-=======
-		RHS = lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
-				ArgVars, Vars, Modes0, Det, Goal0),
-		Mode = (free -> free) - (free -> free),
->>>>>>> 1.40
 		Unification = Unification0
 	),
 	Goal = unify(X, RHS, Mode, Unification, UnifyContext).
@@ -1116,16 +1098,27 @@
 		RHS, Unification, ModeInfo) :-
 	% if we are re-doing mode analysis, preserve the existing cons_id
 	list__length(ArgVars, Arity),
-	( Unification0 = construct(_, ConsId0, _, _, _, _, AditiInfo0) ->
-		AditiInfo = AditiInfo0,
+	(
+		Unification0 = construct(_, ConsId0, _, _,
+			ReuseVar0, CellIsUnique0, RLExprnId0)
+	->
+		ReuseVar = ReuseVar0,
+		CellIsUnique = CellIsUnique0,
+		RLExprnId = RLExprnId0,
 		ConsId = ConsId0
-	; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
-		AditiInfo = no,
+	;
+		Unification0 = deconstruct(_, ConsId1, _, _, _)
+	->
+		ReuseVar = no,
+		CellIsUnique = cell_is_unique,
+		RLExprnId = no,
 		ConsId = ConsId1
 	;
 		% the real cons_id will be computed by lambda.m;
 		% we just put in a dummy one for now
-		AditiInfo = no,
+		ReuseVar = no,
+		CellIsUnique = cell_is_unique,
+		RLExprnId = no,
 		ConsId = cons(unqualified("__LambdaGoal__"), Arity)
 	),
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
@@ -1147,21 +1140,12 @@
 			% converted back to a predicate constant, but
 			% that doesn't matter since the code will be
 			% pruned away later by simplify.m.
-<<<<<<< modecheck_unify.m
-			ConsId = pred_const(PredId, ProcId),
-			instmap__is_reachable(InstMapAfter)
-=======
 			ConsId = pred_const(PredId, ProcId, EvalMethod),
-			instmap__is_reachable(InstMap)
->>>>>>> 1.40
+			instmap__is_reachable(InstMapAfter)
 		->
 			( 
-<<<<<<< modecheck_unify.m
-				RHS0 = lambda_goal(_, _, _, _, _, _, Goal),
-=======
 				RHS0 = lambda_goal(_, EvalMethod, _,
-					_, _, _, _, Goal),
->>>>>>> 1.40
+					_, _, _, _, _, Goal),
 				Goal = call(PredId, ProcId, _, _, _, _) - _
 			->
 				module_info_pred_info(ModuleInfo,
@@ -1180,7 +1164,7 @@
 			RHS = RHS0
 		),
 		Unification = construct(X, ConsId, ArgVars, ArgModes,
-			no, cell_is_unique, AditiInfo),
+			ReuseVar, CellIsUnique, RLExprnId),
 		ModeInfo = ModeInfo0
 	;
 		instmap__is_reachable(InstMapAfter)
@@ -1224,11 +1208,25 @@
 	mode_info_get_inst_table(ModeInfo0, InstTable0),
 	map__lookup(VarTypes, X, TypeOfX),
 	% if we are re-doing mode analysis, preserve the existing cons_id
-	( Unification0 = construct(_, ConsId0, _, _, _, _, _) ->
-		ConsId = ConsId0
-	; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
+	(
+		Unification0 = construct(_, ConsId0, _, _,
+			ReuseVar0, CellIsUnique0, RLExprnId0)
+	->
+		ConsId = ConsId0,
+		ReuseVar = ReuseVar0,
+		CellIsUnique = CellIsUnique0,
+		RLExprnId = RLExprnId0
+	;
+		Unification0 = deconstruct(_, ConsId1, _, _, _)
+	->
+		ReuseVar = no,
+		CellIsUnique = cell_is_unique,
+		RLExprnId = no,
 		ConsId = ConsId1
 	;
+		ReuseVar = no,
+		CellIsUnique = cell_is_unique,
+		RLExprnId = no,
 		ConsId = NewConsId
 	),
 	mode_util__inst_pairs_to_uni_modes(ModeOfXArgs, ArgModes0, ArgModes),
@@ -1237,10 +1235,8 @@
 		inst_is_bound(FX, InstMapAfter, InstTable0, ModuleInfo)
 	->
 		% It's a construction.
-		ReuseVar = no,
-		RLExprnId = no,
 		Unification = construct(X, ConsId, ArgVars, ArgModes,
-			ReuseVar, cell_is_unique, RLExprnId),
+			ReuseVar, CellIsUnique, RLExprnId),
 
 		% For existentially quantified data types,
 		% check that any type_info or type_class_info variables in the
--- modes.m	1999/07/14 00:26:57	1.2
+++ modes.m	1999/07/16 05:22:31
@@ -1088,13 +1088,9 @@
 	mode_info_set_instmap(InstMap0),
 	mode_checkpoint(exit, "not", GoalInfo0).
 
-<<<<<<< modes.m
-modecheck_goal_expr(some(Vs, G0), GoalInfo0, some(Vs, G)) -->
+modecheck_goal_expr(some(Vs, CanRemove, G0), GoalInfo0,
+		some(Vs, CanRemove, G)) -->
 	mode_checkpoint(enter, "some", GoalInfo0),
-=======
-modecheck_goal_expr(some(Vs, CanRemove, G0), _, some(Vs, CanRemove, G)) -->
-	mode_checkpoint(enter, "some"),
->>>>>>> 1.232
 	modecheck_goal(G0, G),
 	mode_checkpoint(exit, "some", GoalInfo0).
 
@@ -1102,13 +1098,7 @@
 		GoalInfo0, Goal) -->
 	{ prog_out__sym_name_to_string(PredName, PredNameString) },
 	{ string__append("call ", PredNameString, CallString) },
-<<<<<<< modes.m
 	mode_checkpoint(enter, CallString, GoalInfo0),
-	mode_info_set_call_context(call(PredId)),
-=======
-	mode_checkpoint(enter, CallString),
-
->>>>>>> 1.232
 	=(ModeInfo0),
 	{ mode_info_get_call_id(ModeInfo0, PredId, CallId) },
 	mode_info_set_call_context(call(call(CallId))),
@@ -1130,7 +1120,7 @@
 
 modecheck_goal_expr(generic_call(GenericCall, Args0, Modes0, _),
 		GoalInfo0, Goal) -->
-	mode_checkpoint(enter, "generic_call"),
+	mode_checkpoint(enter, "generic_call", GoalInfo0),
 	mode_info_dcg_get_instmap(InstMap0),
 
 	{ hlds_goal__generic_call_id(GenericCall, CallId) },
@@ -1161,7 +1151,7 @@
 		InstMap0, Goal),
 		
 	mode_info_unset_call_context,
-	mode_checkpoint(exit, "generic_call").
+	mode_checkpoint(exit, "generic_call", GoalInfo0).
 
 modecheck_goal_expr(unify(A0, B0, _, UnifyInfo0, UnifyContext), GoalInfo0, Goal)
 		-->
@@ -1193,13 +1183,7 @@
 	% which it is the goal.
 modecheck_goal_expr(pragma_c_code(IsRecursive, PredId, ProcId0, Args0,
 		ArgNameMap, OrigArgTypes, PragmaCode), GoalInfo, Goal) -->
-<<<<<<< modes.m
 	mode_checkpoint(enter, "pragma_c_code", GoalInfo),
-	mode_info_set_call_context(call(PredId)),
-
-=======
-	mode_checkpoint(enter, "pragma_c_code"),
->>>>>>> 1.232
 	=(ModeInfo0),
 	{ mode_info_get_call_id(ModeInfo0, PredId, CallId) },
 
@@ -1222,13 +1206,8 @@
 
 unify_rhs_vars(var(Var), [Var]).
 unify_rhs_vars(functor(_Functor, Vars), Vars).
-<<<<<<< modes.m
-unify_rhs_vars(lambda_goal(_PredOrFunc, LambdaNonLocals, LambdaVars, 
-			_Modes, _Det, _IMDelta, _Goal - GoalInfo), Vars) :-
-=======
 unify_rhs_vars(lambda_goal(_PredOrFunc, _EvalMethod, _Fix, LambdaNonLocals,
-		LambdaVars, _Modes, _Det, _Goal - GoalInfo), Vars) :-
->>>>>>> 1.232
+		LambdaVars, _Modes, _Det, _IMDelta, _Goal - GoalInfo), Vars) :-
 	goal_info_get_nonlocals(GoalInfo, NonLocals0),
 	set__delete_list(NonLocals0, LambdaVars, NonLocals1),
 	set__insert_list(NonLocals1, LambdaNonLocals, NonLocals),
--- module_qual.m	1999/07/14 00:26:57	1.2
+++ module_qual.m	1999/07/16 05:22:31
@@ -51,6 +51,8 @@
 :- mode module_qual__qualify_type_qualification(in, out, in, in,
 		out, di, uo) is det.
 
+	% The type mq_info holds information needed for doing module
+	% qualification.
 :- type mq_info.
 
 :- pred mq_info_get_num_errors(mq_info::in, int::out) is det.
@@ -59,6 +61,40 @@
 :- pred mq_info_set_need_qual_flag(mq_info::in, 
 		need_qualifier::in, mq_info::out) is det.
 :- pred mq_info_get_need_qual_flag(mq_info::in, need_qualifier::out) is det.
+:- pred mq_info_get_partial_qualifier_info(mq_info::in,
+		partial_qualifier_info::out) is det.
+
+	% The type partial_qualifier_info holds info need for computing which
+	% partial quantifiers are visible -- see get_partial_qualifiers/3.
+:- type partial_qualifier_info.
+
+% Suppose we are processing a definition which defines the symbol
+% foo:bar:baz:quux/1.  Then we insert the following symbols
+% into the symbol table:
+%	- if the current value of the NeedQual flag at this point
+%		is `may_be_unqualified',
+%		i.e. module `foo:bar:baz' was imported
+%		then we insert the fully unqualified symbol quux/1;
+%	- if module `foo:bar:baz' occurs in the "imported" section,
+%		i.e. if module `foo:bar' was imported,
+%		then we insert the partially qualified symbol baz:quux/1;
+%	- if module `foo:bar' occurs in the "imported" section,
+%		i.e. if module `foo' was imported,
+%		then we insert the partially qualified symbol bar:baz:quux/1;
+%	- we always insert the fully qualified symbol foo:bar:baz:quux/1.
+%
+% The predicate `get_partial_qualifiers' returns all of the
+% partial qualifiers for which we need to insert definitions,
+% i.e. all the ones which are visible.  For example,
+% given as input `foo:bar:baz', it returns a list containing
+%	(1) `baz', iff `foo:bar' is imported
+% and 	(2) `bar:baz', iff `foo' is imported.
+% Note that the caller will still need to handle the fully-qualified
+% and fully-unqualified versions separately.
+
+:- pred get_partial_qualifiers(module_name, partial_qualifier_info,
+		list(module_name)).
+:- mode get_partial_qualifiers(in, in, out) is det.
 
 %-----------------------------------------------------------------------------%
 :- implementation.
@@ -119,13 +155,20 @@
 				% explicitly module qualified.
 	).
 
+:- type partial_qualifier_info --->
+	partial_qualifier_info(module_id_set).
+
+mq_info_get_partial_qualifier_info(MQInfo, QualifierInfo) :-
+	mq_info_get_modules(MQInfo, ModuleIdSet),
+	QualifierInfo = partial_qualifier_info(ModuleIdSet).
+
 	% We only need to keep track of what is exported and what isn't,
 	% so we use a simpler data type here than hlds_pred__import_status.
 :- type import_status
 	--->	exported
 	;	not_exported.
 		
-	% The `module_eqv_map' field is unused junk -- feel free to replace it.
+	% The `junk' field is unused junk -- feel free to replace it.
 :- type junk == unit.
 
 	% Pass over the item list collecting all defined module, type, mode and
@@ -1453,5 +1496,78 @@
 	;
 		MatchingModules = []
 	).
+
+%-----------------------------------------------------------------------------%
+
+get_partial_qualifiers(ModuleName, PartialQualInfo, PartialQualifiers) :-
+	PartialQualInfo = partial_qualifier_info(ModuleIdSet),
+	(
+		ModuleName = unqualified(_),
+		PartialQualifiers = []
+	;
+		ModuleName = qualified(Parent, Child),
+		get_partial_qualifiers_2(Parent, unqualified(Child),
+			ModuleIdSet, [], PartialQualifiers)
+	).
+
+:- pred get_partial_qualifiers_2(module_name, module_name, module_id_set,
+		list(module_name), list(module_name)).
+:- mode get_partial_qualifiers_2(in, in, in, in, out) is det.
+
+get_partial_qualifiers_2(ImplicitPart, ExplicitPart, ModuleIdSet,
+		Qualifiers0, Qualifiers) :-
+	%
+	% if the ImplicitPart module was imported, rather than just being
+	% used, then insert the ExplicitPart module into the list of
+	% valid partial qualifiers.
+	%
+	( parent_module_is_imported(ImplicitPart, ExplicitPart, ModuleIdSet) ->
+		Qualifiers1 = [ExplicitPart | Qualifiers0]
+	;
+		Qualifiers1 = Qualifiers0
+	),
+	%
+	% recursively try to add the other possible partial qualifiers
+	%
+	( ImplicitPart = qualified(Parent, Child) ->
+		NextImplicitPart = Parent,
+		insert_module_qualifier(Child, ExplicitPart, NextExplicitPart),
+		get_partial_qualifiers_2(NextImplicitPart, NextExplicitPart,
+			ModuleIdSet, Qualifiers1, Qualifiers)
+	;
+		Qualifiers = Qualifiers1
+	).
+
+	% Check whether the parent module was imported, given the name of a
+	% child (or grandchild, etc.) module occurring in that parent module.
+	%
+:- pred parent_module_is_imported(module_name, module_name, module_id_set).
+:- mode parent_module_is_imported(in, in, in) is semidet.
+
+parent_module_is_imported(ParentModule, ChildModule, ModuleIdSet) :-
+	% Find the module name at the start of the ChildModule;
+	% this sub-module will be a direct sub-module of ParentModule
+	get_first_module_name(ChildModule, DirectSubModuleName),
+
+	% Check that the ParentModule was imported.
+	% We do this by looking up the definitions for the direct sub-module
+	% and checking that the one in ParentModule came from an
+	% imported module.
+	Arity = 0,
+	map__search(ModuleIdSet, DirectSubModuleName - Arity,
+			ImportModules - _UseModules),
+	set__member(ParentModule, ImportModules).
+
+	% Given a module name, possibly module-qualified,
+	% return the name of the first module in the qualifier list.
+	% e.g. given `foo:bar:baz', this returns `foo',
+	% and given just `baz', it returns `baz'.
+	%
+:- pred get_first_module_name(module_name, string).
+:- mode get_first_module_name(in, out) is det.
+
+get_first_module_name(unqualified(ModuleName), ModuleName).
+get_first_module_name(qualified(Parent, _), ModuleName) :-
+	get_first_module_name(Parent, ModuleName).
 
 %----------------------------------------------------------------------------%
--- modules.m	1999/07/14 00:26:57	1.2
+++ modules.m	1999/07/16 05:22:32
@@ -432,14 +432,6 @@
 :- pred get_ancestors(module_name, list(module_name)).
 :- mode get_ancestors(in, out) is det.
 
-	% get_partial_qualifiers(ModuleName, PartialQualifiers):
-	%	PartialQualifiers is the list of partial module
-	%	qualifiers for ModuleName; e.g. if the ModuleName is 
-	%	`foo:bar:baz', then ParentDeps would be [`bar:baz', `baz']).
-	%
-:- pred get_partial_qualifiers(module_name, list(module_name)).
-:- mode get_partial_qualifiers(in, out) is det.
-
 %-----------------------------------------------------------------------------%
 
 	% touch_interface_datestamp(ModuleName, Ext).
@@ -3372,12 +3364,6 @@
 
 %-----------------------------------------------------------------------------%
 
-get_partial_qualifiers(unqualified(_), []).
-get_partial_qualifiers(qualified(ParentQual, ChildName),
-			[PartialQual | PartialQuals]) :-
-	drop_one_qualifier(ParentQual, ChildName, PartialQual),
-	get_partial_qualifiers(PartialQual, PartialQuals).
-	
 :- pred drop_one_qualifier(module_name, string, module_name).
 :- mode drop_one_qualifier(in, in, out) is det.
 
--- passes_aux.m	1999/07/14 00:26:57	1.2
+++ passes_aux.m	1999/07/16 05:22:33
@@ -33,6 +33,9 @@
 		;	update_module(pred(
 				proc_info, proc_info,
 				module_info, module_info))
+		;	update_module_predid(pred(
+				pred_id, proc_info, proc_info,
+				module_info, module_info))
 		;	update_module_io(pred(
 				pred_id, proc_id, proc_info, proc_info,
 				module_info, module_info,
@@ -88,6 +91,8 @@
 		;	update_pred_error(pred(in, in, out, in, out,
 				out, out, di, uo) is det)
 		;	update_module(pred(in, out, in, out) is det)
+		;	update_module_predid(pred(in,
+				in, out, in, out) is det)
 		;	update_module_io(pred(in, in, in, out,
 				in, out, di, uo) is det)
 		;	update_module_cookie(pred(in, in, in, out, in, out,
@@ -269,6 +274,11 @@
 	(
 		Task0 = update_module(Closure),
 		call(Closure, Proc0, Proc, ModuleInfo0, ModuleInfo8),
+		Task1 = Task0,
+		State9 = State0
+	;
+		Task0 = update_module_predid(Closure),
+		call(Closure, PredId, Proc0, Proc, ModuleInfo0, ModuleInfo8),
 		Task1 = Task0,
 		State9 = State0
 	;
--- polymorphism.m	1999/07/14 00:26:57	1.2
+++ polymorphism.m	1999/07/16 05:22:35
@@ -1011,7 +1011,9 @@
 		{ in_mode(InMode) },
 		{ list__length(TypeInfoVars, NumTypeInfos) },
 		{ list__duplicate(NumTypeInfos, InMode, TypeInfoModes) },
-		{ list__append(TypeInfoModes, Modes0, Modes) },
+		{ Modes0 = argument_modes(ArgInstTable, ArgModes0) },
+		{ list__append(TypeInfoModes, ArgModes0, ArgModes) },
+		{ Modes = argument_modes(ArgInstTable, ArgModes) },
 
 		{ goal_info_get_nonlocals(GoalInfo0, NonLocals0) },
 		{ set__insert_list(NonLocals0, TypeInfoVars, NonLocals) },
@@ -1176,13 +1178,8 @@
 		polymorphism__process_unify_functor(XVar, ConsId, Args, Mode,
 			Unification0, UnifyContext, GoalInfo0, Goal)
 	;
-<<<<<<< polymorphism.m
-		{ Y = lambda_goal(PredOrFunc, ArgVars0, LambdaVars,
-			Modes, Det, IMD, LambdaGoal0) },
-=======
 		{ Y = lambda_goal(PredOrFunc, EvalMethod, FixModes,
-			ArgVars0, LambdaVars, Modes, Det, LambdaGoal0) },
->>>>>>> 1.167
+			ArgVars0, LambdaVars, Modes, Det, IMD, LambdaGoal0) },
 		%
 		% for lambda expressions, we must recursively traverse the
 		% lambda goal
@@ -1197,13 +1194,8 @@
 		{ set__to_sorted_list(NonLocalTypeInfos,
 				NonLocalTypeInfosList) },
 		{ list__append(NonLocalTypeInfosList, ArgVars0, ArgVars) },
-<<<<<<< polymorphism.m
-		{ Y1 = lambda_goal(PredOrFunc, ArgVars, LambdaVars,
-			Modes, Det, IMD, LambdaGoal) },
-=======
 		{ Y1 = lambda_goal(PredOrFunc, EvalMethod, FixModes,
-			ArgVars, LambdaVars, Modes, Det, LambdaGoal) },
->>>>>>> 1.167
+			ArgVars, LambdaVars, Modes, Det, IMD, LambdaGoal) },
                 { goal_info_get_nonlocals(GoalInfo0, NonLocals0) },
 		{ set__union(NonLocals0, NonLocalTypeInfos, NonLocals) },
 		{ goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo) },
@@ -1275,15 +1267,10 @@
 		Modes = [],
 		inst_table_init(IT),
 		Det = erroneous,
-<<<<<<< polymorphism.m
-		HOCall = higher_order_call(FuncVar, ArgVars, ArgTypes,
-			argument_modes(IT, Modes), Det, function),
-=======
 		adjust_func_arity(function, Arity, FullArity),
 		HOCall = generic_call(
 			higher_order(FuncVar, function, FullArity),
-			ArgVars, Modes, Det),
->>>>>>> 1.167
+			ArgVars, argument_modes(IT, Modes), Det),
 
 		/*******
 		%
@@ -1546,14 +1533,9 @@
 	%
 	% construct the lambda expression
 	%
-<<<<<<< polymorphism.m
-	Functor = lambda_goal(PredOrFunc, ArgVars0, LambdaVars, 
-			argument_modes(ArgIT, LambdaModes), LambdaDet,
-			InstMapDelta, LambdaGoal).
-=======
 	Functor = lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
-		ArgVars0, LambdaVars, LambdaModes, LambdaDet, LambdaGoal).
->>>>>>> 1.167
+		ArgVars0, LambdaVars, argument_modes(ArgIT, LambdaModes),
+		LambdaDet, InstMapDelta, LambdaGoal).
 
 :- pred make_fresh_vars(list(type), prog_varset, map(prog_var, type),
 			list(prog_var), prog_varset, map(prog_var, type)).
@@ -2441,18 +2423,12 @@
 	BaseTypeClassInfoTerm = functor(ConsId, []),
 
 		% create the construction unification to initialize the variable
-<<<<<<< polymorphism.m
-	BaseUnification = construct(BaseVar, ConsId, [], []),
-	BaseUnifyMode = (free(unique) - ground(shared, no)) -
-			(ground(shared, no) - ground(shared, no)),
-=======
 	ReuseVar = no,
 	RLExprnId = no,
 	BaseUnification = construct(BaseVar, ConsId, [], [],
 			ReuseVar, cell_is_shared, RLExprnId),
-	BaseUnifyMode = (free -> ground(shared, no)) -
-			(ground(shared, no) -> ground(shared, no)),
->>>>>>> 1.167
+	BaseUnifyMode = (free(unique) - ground(shared, no)) -
+			(ground(shared, no) - ground(shared, no)),
 	BaseUnifyContext = unify_context(explicit, []),
 		% XXX the UnifyContext is wrong
 	BaseUnify = unify(BaseVar, BaseTypeClassInfoTerm, BaseUnifyMode,
@@ -2484,15 +2460,9 @@
 	list__length(NewArgVars, NumArgVars),
 	list__duplicate(NumArgVars, UniMode, UniModes),
 	Unification = construct(NewVar, NewConsId, NewArgVars,
-<<<<<<< polymorphism.m
-		UniModes),
+		UniModes, ReuseVar, cell_is_unique, RLExprnId),
 	UnifyMode = (free(unique) - ground(shared, no)) -
 			(ground(shared, no) - ground(shared, no)),
-=======
-		UniModes, ReuseVar, cell_is_unique, RLExprnId),
-	UnifyMode = (free -> ground(shared, no)) -
-			(ground(shared, no) -> ground(shared, no)),
->>>>>>> 1.167
 	UnifyContext = unify_context(explicit, []),
 		% XXX the UnifyContext is wrong
 	Unify = unify(NewVar, TypeClassInfoTerm, UnifyMode,
@@ -2933,18 +2903,12 @@
 		   ground(shared, no) - ground(shared, no)),
 	list__length(ArgVars, NumArgVars),
 	list__duplicate(NumArgVars, UniMode, UniModes),
-<<<<<<< polymorphism.m
-	Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes),
-	UnifyMode = (free(unique) - ground(shared, no)) -
-			(ground(shared, no) - ground(shared, no)),
-=======
 	ReuseVar = no,
 	RLExprnId = no,
 	Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes,
 			ReuseVar, cell_is_unique, RLExprnId),
-	UnifyMode = (free -> ground(shared, no)) -
-			(ground(shared, no) -> ground(shared, no)),
->>>>>>> 1.167
+	UnifyMode = (free(unique) - ground(shared, no)) -
+			(ground(shared, no) - ground(shared, no)),
 	UnifyContext = unify_context(explicit, []),
 		% XXX the UnifyContext is wrong
 	Unify = unify(TypeInfoVar, TypeInfoTerm, UnifyMode,
@@ -2995,18 +2959,12 @@
 		VarSet0, VarTypes0, TypeCtorInfoVar, VarSet, VarTypes),
 
 	% create the construction unification to initialize the variable
-<<<<<<< polymorphism.m
-	Unification = construct(TypeCtorInfoVar, ConsId, [], []),
-	UnifyMode = (free(unique) - ground(shared, no)) -
-			(ground(shared, no) - ground(shared, no)),
-=======
 	ReuseVar = no,
 	RLExprnId = no,
 	Unification = construct(TypeCtorInfoVar, ConsId, [], [],
 			ReuseVar, cell_is_shared, RLExprnId),
-	UnifyMode = (free -> ground(shared, no)) -
-			(ground(shared, no) -> ground(shared, no)),
->>>>>>> 1.167
+	UnifyMode = (free(unique) - ground(shared, no)) -
+			(ground(shared, no) - ground(shared, no)),
 	UnifyContext = unify_context(explicit, []),
 		% XXX the UnifyContext is wrong
 	Unify = unify(TypeCtorInfoVar, TypeInfoTerm, UnifyMode,
@@ -3389,12 +3347,7 @@
 	map__lookup(VarMap, InstanceConstraint, TypeClassInfoVar),
 
 	proc_info_headvars(ProcInfo0, HeadVars0),
-<<<<<<< polymorphism.m
-	proc_info_vartypes(ProcInfo0, Types0),
 	proc_info_argmodes(ProcInfo0, argument_modes(ArgInstTable, Modes0)),
-=======
-	proc_info_argmodes(ProcInfo0, Modes0),
->>>>>>> 1.167
 	proc_info_declared_determinism(ProcInfo0, Detism0),
 	(
 		Detism0 = yes(Detism1)
@@ -3420,18 +3373,13 @@
 		error("expand_one_body: typeclass_info var not found")
 	),
 
-<<<<<<< polymorphism.m
-	BodyGoalExpr = class_method_call(TypeClassInfoVar, ProcNum0,
-		HeadVars, Types, argument_modes(ArgInstTable, Modes), Detism),
-=======
 	InstanceConstraint = constraint(ClassName, InstanceArgs),
 	list__length(InstanceArgs, InstanceArity),
 	pred_info_get_call_id(PredInfo0, CallId),
 	BodyGoalExpr = generic_call(
 		class_method(TypeClassInfoVar, ProcNum0,
 			class_id(ClassName, InstanceArity), CallId),
-		HeadVars, Modes, Detism),
->>>>>>> 1.167
+		HeadVars, argument_modes(ArgInstTable, Modes), Detism),
 
 		% Make the goal info for the call. 
 	set__list_to_set(HeadVars0, NonLocals),
--- post_typecheck.m	1999/07/14 00:26:57	1.2
+++ post_typecheck.m	1999/07/16 05:22:35
@@ -73,7 +73,7 @@
 	%
 :- pred post_typecheck__finish_aditi_builtin(module_info, pred_info,
 		list(prog_var), term__context, aditi_builtin, aditi_builtin,
-		simple_call_id, simple_call_id, list(mode),
+		simple_call_id, simple_call_id, argument_modes,
 		io__state, io__state).
 :- mode post_typecheck__finish_aditi_builtin(in, in, in, in,
 		in, out, in, out, out, di, uo) is det.
@@ -107,7 +107,8 @@
 
 :- implementation.
 
-:- import_module typecheck, clause_to_proc, mode_util, inst_match, (inst).
+:- import_module (assertion), 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 globals, options.
 
@@ -389,7 +390,9 @@
 	in_mode(InMode),
 	aditi_builtin_modes(InMode, (aditi_top_down),
 		ArgTypes, InsertArgModes),
-	list__append(InsertArgModes, [aditi_di_mode, aditi_uo_mode], Modes).
+	inst_table_init(ArgInstTable),
+	list__append(InsertArgModes, [aditi_di_mode, aditi_uo_mode], ModeList),
+	Modes = argument_modes(ArgInstTable, ModeList).
 
 post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
 		aditi_delete(PredId0, Syntax), aditi_delete(PredId, Syntax),
@@ -410,9 +413,11 @@
 	in_mode(InMode),
 	aditi_builtin_modes(InMode, (aditi_top_down),
 		ArgTypes, DeleteArgModes),
+	inst_table_init(ArgInstTable),
 	Inst = ground(shared, yes(pred_inst_info(PredOrFunc,
-		DeleteArgModes, semidet))),
-	Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
+		argument_modes(ArgInstTable, DeleteArgModes), semidet))),
+	ModeList = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode],
+	Modes = argument_modes(ArgInstTable, ModeList).
 
 post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
 		aditi_bulk_operation(Op, PredId0), Builtin,
@@ -431,9 +436,11 @@
 	pred_info_arg_types(RelationPredInfo, ArgTypes),
 	out_mode(OutMode),
 	aditi_builtin_modes(OutMode, (aditi_bottom_up), ArgTypes, OpArgModes),
+	inst_table_init(ArgInstTable),
 	Inst = ground(shared, yes(pred_inst_info(PredOrFunc,
-		OpArgModes, nondet))),
-	Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
+		argument_modes(ArgInstTable, OpArgModes), nondet))),
+	ModeList = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode],
+	Modes = argument_modes(ArgInstTable, ModeList).
 
 post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
 		aditi_modify(PredId0, Syntax), Builtin,
@@ -456,7 +463,7 @@
 	resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
 		AdjustArgTypes, PredId0, PredId, SymName0, SymName),
 
-	Builtin = aditi_delete(PredId, Syntax),
+	Builtin = aditi_modify(PredId, Syntax),
 	ModifyCallId = PredOrFunc - SymName/Arity,
 
 	module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
@@ -471,9 +478,11 @@
 	aditi_builtin_modes(OutMode, (aditi_top_down),
 		ArgTypes, OutputArgModes),
 	list__append(InputArgModes, OutputArgModes, ModifyArgModes),
-	Inst = ground(shared,
-		yes(pred_inst_info(predicate, ModifyArgModes, semidet))),
-	Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
+	inst_table_init(ArgInstTable),
+	Inst = ground(shared, yes(pred_inst_info(predicate,
+		argument_modes(ArgInstTable, ModifyArgModes), semidet))),
+	ModeList = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode],
+	Modes = argument_modes(ArgInstTable, ModeList).
 
 	% Use the type of the closure passed to an `aditi_delete',
 	% `aditi_bulk_insert', `aditi_bulk_delete' or `aditi_modify'
@@ -594,11 +603,25 @@
 	post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
 		PredInfo0, PredInfo).
 
+	%
+	% Remove the assertion from the list of pred ids to be processed
+	% in the future and place the pred_info associated with the
+	% assertion into the assertion table.
+	% Also records for each predicate that is used in an assertion
+	% which assertion it is used in.
+	% 
 post_typecheck__finish_assertion(Module0, PredId, Module) :-
-	module_info_assertion_table(Module0, AssertionTable0),
-	assertion_table_add_assertion(PredId, AssertionTable0, AssertionTable),
-	module_info_set_assertion_table(Module0, AssertionTable, Module1),
-	module_info_remove_predid(Module1, PredId, Module).
+		% store into assertion table.
+	module_info_assertion_table(Module0, AssertTable0),
+	assertion_table_add_assertion(PredId, AssertTable0, Id, AssertTable),
+	module_info_set_assertion_table(Module0, AssertTable, Module1),
+		
+		% Remove from further processing.
+	module_info_remove_predid(Module1, PredId, Module2),
+
+		% record which predicates are used in assertions
+	assertion__goal(Id, Module2, Goal),
+	assertion__record_preds_used_in(Goal, Id, Module2, Module).
 	
 
 	% 
--- prog_io_pragma.m	1999/07/14 00:26:57	1.2
+++ prog_io_pragma.m	1999/07/16 05:22:37
@@ -930,12 +930,9 @@
 	).
 
 :- type maybe_pred_or_func_modes ==
-<<<<<<< prog_io_pragma.m
 		maybe2(pair(sym_name, pred_or_func), argument_modes).
+
 :- type maybe_pred_or_func(T) == maybe2(sym_name, pair(list(T), maybe(T))).
-=======
-		maybe2(pair(sym_name, pred_or_func), list(mode)).
->>>>>>> 1.21
 
 :- pred parse_pred_or_func_and_arg_modes(maybe(module_name), term, term,
 		string, maybe_pred_or_func_modes).
--- prog_util.m	1999/07/14 00:26:57	1.2
+++ prog_util.m	1999/07/16 05:22:38
@@ -61,6 +61,12 @@
 :- pred match_sym_name(sym_name, sym_name).
 :- mode match_sym_name(in, in) is semidet.
 
+	% insert_module_qualifier(ModuleName, SymName0, SymName):
+	%	prepend the specified ModuleName onto the module
+	%	qualifiers in SymName0, giving SymName.
+:- pred insert_module_qualifier(string, sym_name, sym_name).
+:- mode insert_module_qualifier(in, in, out) is det.
+
         % Given a possible module qualified sym_name and a list of
 	% argument types and a context, construct a term. This is
 	% used to construct types. 
@@ -295,9 +301,6 @@
     ;
     	Result = unqualified(String)
     ).
-
-:- pred insert_module_qualifier(string, sym_name, sym_name).
-:- mode insert_module_qualifier(in, in, out) is det.
 
 insert_module_qualifier(ModuleName, unqualified(PlainName),
 		qualified(unqualified(ModuleName), PlainName)).
--- purity.m	1999/07/14 00:26:57	1.2
+++ purity.m	1999/07/16 05:22:38
@@ -459,17 +459,12 @@
 		pure, NumErrors0, NumErrors) -->
 	{ Unif0 = unify(A,RHS0,C,D,E) },
 	{ Unif  = unify(A,RHS,C,D,E) },
-<<<<<<< purity.m
-	( { RHS0 = lambda_goal(F, G, H, I, J, K, Goal0 - Info0) } ->
-		{ RHS = lambda_goal(F, G, H, I, J, K, Goal - Info0) },
-=======
 	(
 		{ RHS0 = lambda_goal(F, EvalMethod, FixModes, H, Vars,
-			Modes0, K, Goal0 - Info0) }
+			Modes0, K, L, Goal0 - Info0) }
 	->
 		{ RHS = lambda_goal(F, EvalMethod, modes_are_ok, H, Vars,
-			Modes, K, Goal - Info0) },
->>>>>>> 1.17
+			Modes, K, L, Goal - Info0) },
 		compute_expr_purity(Goal0, Goal, Info0, PredInfo, ModuleInfo,
 				    yes, Purity, NumErrors0, NumErrors1),
 		error_if_closure_impure(GoalInfo, Purity,
@@ -502,8 +497,10 @@
 			pred_info_clauses_info(PredInfo, ClausesInfo),
 			clauses_info_vartypes(ClausesInfo, VarTypes),
 			map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
+			Modes0 = argument_modes(ArgInstTable, ArgModes0),
 			fix_aditi_state_modes(StateMode, LambdaVarTypes,
-				Modes0, Modes)
+				ArgModes0, ArgModes),
+			Modes = argument_modes(ArgInstTable, ArgModes)
 		}
 	;
 		{ RHS = RHS0 },
@@ -539,10 +536,6 @@
 	{ module_info_preds(ModuleInfo, Preds) },
 	{ map__lookup(Preds, PredId, PredInfo) },
 	{ pred_info_get_purity(PredInfo, Purity) }.
-<<<<<<< purity.m
-	
-=======
->>>>>>> 1.17
 
 
 :- pred compute_goal_purity(hlds_goal, hlds_goal, pred_info,
--- quantification.m	1999/07/14 00:26:57	1.2
+++ quantification.m	1999/07/16 05:22:39
@@ -382,22 +382,12 @@
 	{ set__list_to_set(ArgVars, Vars) },
 	quantification__set_nonlocals(Vars).
 implicitly_quantify_unify_rhs(
-<<<<<<< quantification.m
-		lambda_goal(PredOrFunc, LambdaNonLocals0,
-			LambdaVars0, Modes, Det, IMD, Goal0),
-=======
 		lambda_goal(PredOrFunc, EvalMethod, FixModes, LambdaNonLocals0,
-			LambdaVars0, Modes, Det, Goal0),
->>>>>>> 1.68
+			LambdaVars0, Modes, Det, IMD, Goal0),
 		Unification0,
 		Context,
-<<<<<<< quantification.m
-		lambda_goal(PredOrFunc, LambdaNonLocals,
-			LambdaVars, Modes, Det, IMD, Goal),
-=======
 		lambda_goal(PredOrFunc, EvalMethod, FixModes, LambdaNonLocals,
-			LambdaVars, Modes, Det, Goal),
->>>>>>> 1.68
+			LambdaVars, Modes, Det, IMD, Goal),
 		Unification
 		) -->
 	%
@@ -739,11 +729,7 @@
 		Set, LambdaSet) :-
 	set__insert_list(Set0, ArgVars, Set).
 quantification__unify_rhs_vars(
-<<<<<<< quantification.m
-		lambda_goal(_POrF, _NonLocals, LambdaVars, _M, _D, _IMD, Goal), 
-=======
-		lambda_goal(_POrF, _E, _F, _N, LambdaVars, _M, _D, Goal), 
->>>>>>> 1.68
+		lambda_goal(_POrF, _E, _F, _N, LambdaVars, _M, _D, _IMD, Goal), 
 		Set, LambdaSet0, Set, LambdaSet) :-
 	% Note that the NonLocals list is not counted, since all the 
 	% variables in that list must occur in the goal.
--- rl.m	1999/07/14 00:26:57	1.2
+++ rl.m	1999/07/16 05:22:40
@@ -654,16 +654,10 @@
 	).
 
 rl__goal_produces_tuple(RLGoal) :-
-<<<<<<< rl.m
 	RLGoal = rl_goal(_, _, _, _, _, _, yes(_), _, _).
 
 %-----------------------------------------------------------------------------%
 
-=======
-	RLGoal = rl_goal(_, _, _, _, _, yes(_), _, _).
-
-%-----------------------------------------------------------------------------%
-
 rl__get_entry_proc_name(ModuleInfo, proc(PredId, ProcId), ProcName) :-
 	code_util__make_proc_label(ModuleInfo, PredId, ProcId, Label),
 	llds_out__get_proc_label(Label, no, ProcLabel),
@@ -694,7 +688,6 @@
 
 %-----------------------------------------------------------------------------%
 
->>>>>>> 1.6
 rl__proc_name_to_string(rl_proc_name(User, Module, Pred, Arity), Str) :-
 	string__int_to_string(Arity, ArStr),
 	string__append_list([User, "/", Module, "/", Pred, "/", ArStr], Str).
--- rl_gen.m	1999/07/14 00:26:57	1.2
+++ rl_gen.m	1999/07/16 05:22:42
@@ -967,13 +967,8 @@
 		{ DBCall = db_call(called_pred(PredProcId), MaybeNegGoals, 
 				InputArgs, OutputArgs, GoalInfo) }
 	;
-<<<<<<< rl_gen.m
-		{ CallGoal = higher_order_call(Var, Args, _,
-			argument_modes(_, ArgModes), _, predicate) - GoalInfo }
-=======
 		{ CallGoal = generic_call(higher_order(Var, predicate, _),
-			Args, ArgModes, _) - GoalInfo }
->>>>>>> 1.5
+			Args, argument_modes(_, ArgModes), _) - GoalInfo }
 	->
 		{ CallId = ho_called_var(Var) },
 		rl_info_get_module_info(ModuleInfo),
--- saved_vars.m	1999/07/14 00:26:57	1.2
+++ saved_vars.m	1999/07/16 05:22:46
@@ -305,15 +305,6 @@
 				PlaceAtEnd, SlotInfo1, Goals1, SlotInfo),
 			Goals = [NewConstruct, Goal1 | Goals1]
 		;
-			Goal0Expr = higher_order_call(_, _, _, _, _, _),
-			rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
-			goal_util__rename_vars_in_goal(Construct, Subst,
-				NewConstruct),
-			goal_util__rename_vars_in_goal(Goal0, Subst, Goal1),
-			saved_vars_delay_goal(Goals0, Construct, Var,
-				PlaceAtEnd, SlotInfo1, Goals1, SlotInfo),
-			Goals = [NewConstruct, Goal1 | Goals1]
-		;
 			Goal0Expr = generic_call(_, _, _, _),
 			rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
 			goal_util__rename_vars_in_goal(Construct, Subst,
--- simplify.m	1999/07/14 00:26:57	1.2
+++ simplify.m	1999/07/16 05:22:46
@@ -844,13 +844,9 @@
 		true_goal(Context, Goal - GoalInfo),
 		Info = Info0
 	;
-<<<<<<< simplify.m
-		RT0 = lambda_goal(PredOrFunc, NonLocals, Vars, 
-			Modes, LambdaDeclaredDet, IMDelta, LambdaGoal0)
-=======
 		RT0 = lambda_goal(PredOrFunc, EvalMethod, FixModes,
-			NonLocals, Vars, Modes, LambdaDeclaredDet, LambdaGoal0)
->>>>>>> 1.68
+			NonLocals, Vars, Modes, LambdaDeclaredDet, IMDelta,
+			LambdaGoal0)
 	->
 		simplify_info_enter_lambda(Info0, Info1),
 		simplify_info_get_common_info(Info1, Common1),
@@ -868,13 +864,8 @@
 		simplify__goal(LambdaGoal0, LambdaGoal, Info3, Info4),
 		simplify_info_set_common_info(Info4, Common1, Info5),
 		simplify_info_set_instmap(Info5, InstMap1, Info6),
-<<<<<<< simplify.m
-		RT = lambda_goal(PredOrFunc, NonLocals, Vars, Modes, 
-			LambdaDeclaredDet, IMDelta, LambdaGoal),
-=======
 		RT = lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals,
-			Vars, Modes, LambdaDeclaredDet, LambdaGoal),
->>>>>>> 1.68
+			Vars, Modes, LambdaDeclaredDet, IMDelta, LambdaGoal),
 		simplify_info_leave_lambda(Info6, Info),
 		Goal = unify(LT0, RT, M, U0, C),
 		GoalInfo = GoalInfo0
--- store_alloc.m	1999/07/14 00:26:57	1.2
+++ store_alloc.m	1999/07/16 05:22:47
@@ -60,12 +60,8 @@
 		proc_info_goal(ProcInfo0, Goal0),
 
 		find_final_follow_vars(ProcInfo0, FollowVars0),
-<<<<<<< store_alloc.m
-		find_follow_vars_in_goal(Goal0, InstTable, ModuleInfo,
-=======
 		proc_info_vartypes(ProcInfo0, VarTypes),
-		find_follow_vars_in_goal(Goal0, VarTypes, ModuleInfo,
->>>>>>> 1.69
+		find_follow_vars_in_goal(Goal0, VarTypes, InstTable, ModuleInfo,
 			FollowVars0, Goal1, FollowVars),
 		Goal1 = GoalExpr1 - GoalInfo1,
 		goal_info_set_follow_vars(GoalInfo1, yes(FollowVars),
@@ -201,16 +197,8 @@
 	store_alloc_in_goal(Goal0, Liveness0, ResumeVars0, ModuleInfo,
 		StackSlotInfo, Goal, Liveness).
 
-store_alloc_in_goal_2(higher_order_call(A, B, C, D, E, F), Liveness, _, _,
-		_, higher_order_call(A, B, C, D, E, F), Liveness).
-
-<<<<<<< store_alloc.m
-store_alloc_in_goal_2(class_method_call(A, B, C, D, E, F), Liveness, _, _,
-		_, class_method_call(A, B, C, D, E, F), Liveness).
-=======
 store_alloc_in_goal_2(generic_call(A, B, C, D), Liveness, _, _,
 		_, generic_call(A, B, C, D), Liveness).
->>>>>>> 1.69
 
 store_alloc_in_goal_2(call(A, B, C, D, E, F), Liveness, _, _,
 		_, call(A, B, C, D, E, F), Liveness).
--- stratify.m	1999/07/14 00:26:57	1.2
+++ stratify.m	1999/07/16 05:22:47
@@ -759,13 +759,9 @@
 		% lambda goal have addresses taken. this is not
 		% always to case, but should be a suitable approximation for
 		% the stratification analysis
-<<<<<<< stratify.m
-		RHS = lambda_goal(_PredOrFunc, _NonLocals, _Vars, _Modes,
-				_Determinism, _IMDelta, Goal - _GoalInfo)
-=======
 		RHS = lambda_goal(_PredOrFunc, _EvalMethod, _Fix, _NonLocals,
-				_Vars, _Modes, _Determinism, Goal - _GoalInfo)
->>>>>>> 1.20
+				_Vars, _Modes, _Determinism, _IMDelta,
+				Goal - _GoalInfo)
 	->
 		get_called_procs(Goal, [], CalledProcs),
 		set__insert_list(HasAT0, CalledProcs, HasAT)
@@ -863,13 +859,9 @@
 		% lambda goal have addresses taken. this is not
 		% always to case, but should be a suitable approximation for
 		% the stratification analysis
-<<<<<<< stratify.m
-		RHS = lambda_goal(_PredOrFunc, _NonLocals, _Vars, _Modes,
-				_Determinism, _IMDelta, Goal - _GoalInfo)
-=======
 		RHS = lambda_goal(_PredOrFunc, _EvalMethod, _Fix, _NonLocals,
-				_Vars, _Modes, _Determinism, Goal - _GoalInfo)
->>>>>>> 1.20
+				_Vars, _Modes, _Determinism, _IMDelta,
+				Goal - _GoalInfo)
 	->
 		get_called_procs(Goal, Calls0, Calls)
 	;
--- switch_detection.m	1999/07/14 00:26:57	1.2
+++ switch_detection.m	1999/07/16 05:22:47
@@ -183,77 +183,38 @@
 detect_switches_in_goal_2(if_then_else(Vars, Cond0, Then0, Else0, SM),
 		_GoalInfo, InstMap0, VarTypes, InstTable, ModuleInfo,
 		if_then_else(Vars, Cond, Then, Else, SM)) :-
-<<<<<<< switch_detection.m
-	detect_switches_in_goal_1(Cond0, InstMap0, VarTypes, InstTable, ModuleInfo,
-		Cond, InstMap1),
-	detect_switches_in_goal(Then0, InstMap1, VarTypes, InstTable, ModuleInfo,
-		Then),
-	detect_switches_in_goal(Else0, InstMap0, VarTypes, InstTable, ModuleInfo,
-		Else).
-
-detect_switches_in_goal_2(some(Vars, Goal0), _GoalInfo, InstMap0,
-		VarTypes, InstTable, ModuleInfo, some(Vars, Goal)) :-
-	detect_switches_in_goal(Goal0, InstMap0, VarTypes, InstTable, ModuleInfo,
-		Goal).
-
-detect_switches_in_goal_2(higher_order_call(A,B,C,D,E,F), _, _, _, _, _,
-		higher_order_call(A,B,C,D,E,F)).
-=======
-	detect_switches_in_goal_1(Cond0, InstMap0, VarTypes, ModuleInfo, Cond,
-		InstMap1),
-	detect_switches_in_goal(Then0, InstMap1, VarTypes, ModuleInfo, Then),
-	detect_switches_in_goal(Else0, InstMap0, VarTypes, ModuleInfo, Else).
+	detect_switches_in_goal_1(Cond0, InstMap0, VarTypes,
+		InstTable, ModuleInfo, Cond, InstMap1),
+	detect_switches_in_goal(Then0, InstMap1, VarTypes,
+		InstTable, ModuleInfo, Then),
+	detect_switches_in_goal(Else0, InstMap0, VarTypes,
+		InstTable, ModuleInfo, Else).
 
 detect_switches_in_goal_2(some(Vars, CanRemove, Goal0), _GoalInfo, InstMap0,
-		VarTypes, ModuleInfo, some(Vars, CanRemove, Goal)) :-
-	detect_switches_in_goal(Goal0, InstMap0, VarTypes, ModuleInfo, Goal).
->>>>>>> 1.86
+		VarTypes, InstTable, ModuleInfo,
+		some(Vars, CanRemove, Goal)) :-
+	detect_switches_in_goal(Goal0, InstMap0, VarTypes,
+		InstTable, ModuleInfo, Goal).
 
-<<<<<<< switch_detection.m
-detect_switches_in_goal_2(class_method_call(A,B,C,D,E,F), _, _, _, _, _,
-		class_method_call(A,B,C,D,E,F)).
-=======
-detect_switches_in_goal_2(generic_call(A,B,C,D), _, _, _, _,
+detect_switches_in_goal_2(generic_call(A,B,C,D), _, _, _, _, _,
 		generic_call(A,B,C,D)).
->>>>>>> 1.86
 
-<<<<<<< switch_detection.m
 detect_switches_in_goal_2(call(A,B,C,D,E,F), _, _, _, _, _,
-=======
-detect_switches_in_goal_2(call(A,B,C,D,E,F), _, _, _, _,
->>>>>>> 1.86
 		call(A,B,C,D,E,F)).
 
-detect_switches_in_goal_2(unify(A,RHS0,C,D,E), __GoalInfo, InstMap0,
-<<<<<<< switch_detection.m
+detect_switches_in_goal_2(unify(A,RHS0,C,D,E), _GoalInfo, InstMap0,
 		VarTypes, InstTable, ModuleInfo, unify(A,RHS,C,D,E)) :-
 	(
-		RHS0 = lambda_goal(PredOrFunc, NonLocals,
-				Vars, Modes, Det, IMDelta, Goal0)
-	->
-=======
-		VarTypes, ModuleInfo, unify(A,RHS,C,D,E)) :-
-	(
 		RHS0 = lambda_goal(PredOrFunc, EvalMethod, FixModes,
-			NonLocals, Vars, Modes, Det, Goal0)
+			NonLocals, Vars, Modes, Det, IMDelta, Goal0)
 	->
->>>>>>> 1.86
 		% we need to insert the initial insts for the lambda
 		% variables in the instmap before processing the lambda goal
-<<<<<<< switch_detection.m
 		instmap__apply_instmap_delta(InstMap0, IMDelta, InstMap1),
 		detect_switches_in_goal(Goal0, InstMap1, VarTypes, InstTable,
 			ModuleInfo, Goal),
-		RHS = lambda_goal(PredOrFunc, NonLocals, 
-			Vars, Modes, Det, IMDelta, Goal)
-=======
-		instmap__pre_lambda_update(ModuleInfo, 
-			Vars, Modes, InstMap0, InstMap1),
-		detect_switches_in_goal(Goal0, InstMap1, VarTypes, ModuleInfo,
-			Goal),
 		RHS = lambda_goal(PredOrFunc, EvalMethod, FixModes,
-			NonLocals, Vars, Modes, Det, Goal)
->>>>>>> 1.86
+			NonLocals, Vars, Modes, Det, IMDelta, Goal)
 	;
 		RHS = RHS0
 	).
--- table_gen.m	1999/07/14 00:26:57	1.2
+++ table_gen.m	1999/07/16 05:22:48
@@ -625,21 +625,7 @@
 	generate_new_table_var("PredTable", VarTypes0, VarTypes,
 		VarSet0, VarSet, PredTableVar),
 	ConsId = tabling_pointer_const(PredId, ProcId),
-<<<<<<< table_gen.m
-	VarInst = ground(unique, no),
-	UnifyMode = (free(unique) - VarInst) - (VarInst - VarInst),
-	UnifyContext = unify_context(explicit, []),
-	GoalExpr = unify(PredTableVar, functor(ConsId, []), UnifyMode,
-			construct(PredTableVar, ConsId, [], []), UnifyContext),
-
-	set__singleton_set(NonLocals, PredTableVar),
-	instmap_delta_from_assoc_list([PredTableVar - VarInst],
-		InstMapDelta),
-	goal_info_init(NonLocals, InstMapDelta, det,
-		GoalInfo0),
-=======
 	make_const_construction(PredTableVar, ConsId, GoalExpr - GoalInfo0),
->>>>>>> 1.10
 	goal_info_add_feature(GoalInfo0, impure, GoalInfo),
 	Goal = GoalExpr - GoalInfo.
 
@@ -1223,26 +1209,6 @@
 		VarTypes0, VarTypes, VarSet0, VarSet1),
 	varset__name_var(VarSet1, Var, VarName, VarSet).
 
-<<<<<<< table_gen.m
-	varset__new_named_var(VarSet0, VarName, Var, VarSet),
-	term__context_init(Context),
-	VarType = term__functor(term__atom("int"), [], Context),
-	map__set(VarTypes0, Var, VarType, VarTypes),
-
-	Inst = bound(unique, [functor(int_const(VarValue), [])]),
-	VarUnify = unify(Var, functor(int_const(VarValue), []),
-		(free(unique) - Inst) - (Inst - Inst),
-		construct(Var, int_const(VarValue), [], []),
-		unify_context(explicit, [])),
-	set__singleton_set(VarNonLocals, Var),
-	instmap_delta_from_assoc_list([Var - Inst],
-		VarInstMapDelta),
-	goal_info_init(VarNonLocals, VarInstMapDelta, det,
-		VarGoalInfo),
-	Goal = VarUnify - VarGoalInfo.
-
-=======
->>>>>>> 1.10
 :- pred gen_string_construction(string, string, map(prog_var, type),
 		map(prog_var, type), prog_varset, prog_varset, prog_var,
 		hlds_goal).
@@ -1250,29 +1216,9 @@
 
 gen_string_construction(VarName, VarValue, VarTypes0, VarTypes, VarSet0, VarSet,
 		Var, Goal) :-
-<<<<<<< table_gen.m
-
-	varset__new_named_var(VarSet0, VarName, Var, VarSet),
-	term__context_init(Context),
-	VarType = term__functor(term__atom("string"), [], Context),
-	map__set(VarTypes0, Var, VarType, VarTypes),
-
-	Inst = bound(unique, [functor(string_const(VarValue), [])]),
-	VarUnify = unify(Var, functor(string_const(VarValue), []),
-		(free(unique) - Inst) - (Inst - Inst),
-		construct(Var, string_const(VarValue), [], []),
-		unify_context(explicit, [])),
-	set__singleton_set(VarNonLocals, Var),
-	instmap_delta_from_assoc_list([Var - Inst],
-		VarInstMapDelta),
-	goal_info_init(VarNonLocals, VarInstMapDelta, det,
-		VarGoalInfo),
-	Goal = VarUnify - VarGoalInfo.
-=======
 	make_string_const_construction(VarValue, Goal, Var,
 		VarTypes0, VarTypes, VarSet0, VarSet1),
 	varset__name_var(VarSet1, Var, VarName, VarSet).
->>>>>>> 1.10
 
 :- pred get_table_var_type(type).
 :- mode get_table_var_type(out) is det.
--- term_traversal.m	1999/07/14 00:26:57	1.2
+++ term_traversal.m	1999/07/16 05:22:49
@@ -181,13 +181,9 @@
 		% but it shouldn't hurt either.
 	traverse_goal(Goal, InstMap0, _, Params, Info0, Info).
 
-<<<<<<< term_traversal.m
-traverse_goal_2(some(_Vars, Goal), _GoalInfo, InstMap0, Params, Info0, Info) :-
+traverse_goal_2(some(_Vars, _, Goal), _GoalInfo,
+		InstMap0, Params, Info0, Info) :-
 	traverse_goal(Goal, InstMap0, _, Params, Info0, Info).
-=======
-traverse_goal_2(some(_Vars, _, Goal), _GoalInfo, Params, Info0, Info) :-
-	traverse_goal(Goal, Params, Info0, Info).
->>>>>>> 1.10
 
 traverse_goal_2(if_then_else(_, Cond, Then, Else, _), _, InstMap0,
 		Params, Info0, Info) :-
@@ -208,26 +204,13 @@
 	goal_info_get_context(GoalInfo, Context),
 	error_if_intersect(OutVars, Context, pragma_c_code, Info0, Info).
 
-<<<<<<< term_traversal.m
-traverse_goal_2(higher_order_call(_, _, _, _, _, _),
-		GoalInfo, _InstMap0, Params, Info0, Info) :-
-	goal_info_get_context(GoalInfo, Context),
-	add_error(Context, horder_call, Params, Info0, Info).
-
-=======
->>>>>>> 1.10
-	% For now, we'll pretend that the class method call is a higher order
+	% For now, we'll pretend that a class method call is a higher order
 	% call. In reality, we could probably analyse further than this, since
 	% we know that the method being called must come from one of the
 	% instance declarations, and we could potentially (globally) analyse
 	% these.
-<<<<<<< term_traversal.m
-traverse_goal_2(class_method_call(_, _, _, _, _, _),
-		GoalInfo, _InstMap0, Params, Info0, Info) :-
-=======
 traverse_goal_2(generic_call(_, _, _, _),
-		GoalInfo, Params, Info0, Info) :-
->>>>>>> 1.10
+		GoalInfo, _InstMap0, Params, Info0, Info) :-
 	goal_info_get_context(GoalInfo, Context),
 	add_error(Context, horder_call, Params, Info0, Info).
 
--- typecheck.m	1999/07/14 00:26:57	1.2
+++ typecheck.m	1999/07/16 05:22:51
@@ -2057,17 +2057,11 @@
 	typecheck_unify_var_functor(X, F, As),
 	perform_context_reduction(OrigTypeAssignSet).
 typecheck_unification(X, 
-<<<<<<< typecheck.m
-	    lambda_goal(PredOrFunc, NonLocals, Vars, Modes, Det, IMD, Goal0),
-	    lambda_goal(PredOrFunc, NonLocals, Vars, Modes, Det, IMD, Goal)) -->
- 	typecheck_lambda_var_has_type(PredOrFunc, X, Vars),
-=======
 		lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals, Vars,
-			Modes, Det, Goal0),
+			Modes, Det, IMD, Goal0),
 		lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals, Vars,
-			Modes, Det, Goal)) -->
+			Modes, Det, IMD, Goal)) -->
  	typecheck_lambda_var_has_type(PredOrFunc, EvalMethod, X, Vars),
->>>>>>> 1.264
 	typecheck_goal(Goal0, Goal).
 
 :- pred typecheck_unify_var_var(prog_var, prog_var,
--- unify_gen.m	1999/07/14 00:26:57	1.2
+++ unify_gen.m	1999/07/16 05:22:51
@@ -61,11 +61,7 @@
 	;
 		{ Uni = construct(Var, ConsId, Args, Modes, _, _, AditiInfo) },
 		unify_gen__generate_construction(Var, ConsId,
-<<<<<<< unify_gen.m
-			Args, Modes, IMD, Code)
-=======
-			Args, Modes, AditiInfo, Code)
->>>>>>> 1.101
+			Args, Modes, IMD, AditiInfo, Code)
 	;
 		{ Uni = deconstruct(Var, ConsId, Args, Modes, _Det) },
 		( { CodeModel = model_det } ->
@@ -270,75 +266,34 @@
 	% instantiate the arguments of that term.
 
 :- pred unify_gen__generate_construction(prog_var, cons_id,
-<<<<<<< unify_gen.m
-	list(prog_var), list(uni_mode), instmap_delta, code_tree,
-	code_info, code_info).
-:- mode unify_gen__generate_construction(in, in, in, in, in, out, in, out)
+	list(prog_var), list(uni_mode), instmap_delta, maybe(rl_exprn_id),
+	code_tree, code_info, code_info).
+:- mode unify_gen__generate_construction(in, in, in, in, in, in, out, in, out)
 	is det.
-=======
-		list(prog_var), list(uni_mode), maybe(rl_exprn_id),
-		code_tree, code_info, code_info).
-:- mode unify_gen__generate_construction(in, in, in, in,
-		in, out, in, out) is det.
->>>>>>> 1.101
-
-<<<<<<< unify_gen.m
-unify_gen__generate_construction(Var, Cons, Args, Modes, InstMapDelta, Code) -->
-=======
-unify_gen__generate_construction(Var, Cons, Args, Modes, AditiInfo, Code) -->
->>>>>>> 1.101
+
+unify_gen__generate_construction(Var, Cons, Args, Modes,
+		InstMapDelta, AditiInfo, Code) -->
 	code_info__cons_id_to_tag(Var, Cons, Tag),
-<<<<<<< unify_gen.m
-	unify_gen__generate_construction_2(Tag, Var, Args, Modes,
-			InstMapDelta, Code).
-=======
 	unify_gen__generate_construction_2(Tag, Var, Args,
-		Modes, AditiInfo, Code).
->>>>>>> 1.101
+		Modes, InstMapDelta, AditiInfo, Code).
 
-<<<<<<< unify_gen.m
 :- pred unify_gen__generate_construction_2(cons_tag, prog_var, list(prog_var),
-	list(uni_mode), instmap_delta, code_tree, code_info, code_info).
-:- mode unify_gen__generate_construction_2(in, in, in, in, in, out,
+	list(uni_mode), instmap_delta, maybe(rl_exprn_id),
+	code_tree, code_info, code_info).
+:- mode unify_gen__generate_construction_2(in, in, in, in, in, in, out,
 	in, out) is det.
-=======
-:- pred unify_gen__generate_construction_2(cons_tag, prog_var, 
-		list(prog_var), list(uni_mode), maybe(rl_exprn_id),
-		code_tree, code_info, code_info).
-:- mode unify_gen__generate_construction_2(in, in, in, in, in, out,
-					in, out) is det.
->>>>>>> 1.101
 
 unify_gen__generate_construction_2(string_constant(String),
-<<<<<<< unify_gen.m
-		Var, _Args, _Modes, _IMDelta, Code) -->
+		Var, _Args, _Modes, _IMDelta, _, Code) -->
 	unify_gen__cache_unification(Var, const(string_const(String)), Code).
-=======
-		Var, _Args, _Modes, _, Code) -->
-	{ Code = empty },
-	code_info__cache_expression(Var, const(string_const(String))).
->>>>>>> 1.101
 unify_gen__generate_construction_2(int_constant(Int),
-<<<<<<< unify_gen.m
-		Var, _Args, _Modes, _IMDelta, Code) -->
+		Var, _Args, _Modes, _IMDelta, _, Code) -->
 	unify_gen__cache_unification(Var, const(int_const(Int)), Code).
-=======
-		Var, _Args, _Modes, _, Code) -->
-	{ Code = empty },
-	code_info__cache_expression(Var, const(int_const(Int))).
->>>>>>> 1.101
 unify_gen__generate_construction_2(float_constant(Float),
-<<<<<<< unify_gen.m
-		Var, _Args, _Modes, _IMDelta, Code) -->
+		Var, _Args, _Modes, _IMDelta, _, Code) -->
 	unify_gen__cache_unification(Var, const(float_const(Float)), Code).
-unify_gen__generate_construction_2(no_tag,
-		Var, Args, Modes, IMDelta, Code) -->
-=======
-		Var, _Args, _Modes, _, Code) -->
-	{ Code = empty },
-	code_info__cache_expression(Var, const(float_const(Float))).
-unify_gen__generate_construction_2(no_tag, Var, Args, Modes, _, Code) -->
->>>>>>> 1.101
+unify_gen__generate_construction_2(no_tag, Var, Args, Modes,
+		IMDelta, _, Code) -->
 	( { Args = [Arg], Modes = [Mode] } ->
 		code_info__variable_type(Arg, Type),
 		unify_gen__generate_sub_unify(ref(Var), ref(Arg),
@@ -348,11 +303,7 @@
 		"unify_gen__generate_construction_2: no_tag: arity != 1") }
 	).
 unify_gen__generate_construction_2(unshared_tag(UnsharedTag),
-<<<<<<< unify_gen.m
-		Var, Args, Modes, IMDelta, Code) -->
-=======
-		Var, Args, Modes, _, Code) -->
->>>>>>> 1.101
+		Var, Args, Modes, IMDelta, _, Code) -->
 	code_info__get_module_info(ModuleInfo),
 	code_info__get_inst_table(InstTable),
 	code_info__get_instmap(InstMap0),
@@ -374,11 +325,7 @@
 	unify_gen__maybe_place_refs(Var, Code1),
 	{ Code = tree(Code0, Code1) }.
 unify_gen__generate_construction_2(shared_remote_tag(Bits0, Num0),
-<<<<<<< unify_gen.m
-		Var, Args, Modes, IMDelta, Code) -->
-=======
-		Var, Args, Modes, _, Code) -->
->>>>>>> 1.101
+		Var, Args, Modes, IMDelta, _, Code) -->
 	code_info__get_module_info(ModuleInfo),
 	code_info__get_inst_table(InstTable),
 	code_info__get_instmap(InstMap0),
@@ -401,23 +348,12 @@
 	unify_gen__maybe_place_refs(Var, Code1),
 	{ Code = tree(Code0, Code1) }.
 unify_gen__generate_construction_2(shared_local_tag(Bits1, Num1),
-<<<<<<< unify_gen.m
-		Var, _Args, _Modes, _IMDelta, Code) -->
+		Var, _Args, _Modes, _IMDelta, _, Code) -->
 	unify_gen__cache_unification(Var, 
 		mkword(Bits1, unop(mkbody, const(int_const(Num1)))),
 		Code).
-=======
-		Var, _Args, _Modes, _, Code) -->
-	{ Code = empty },
-	code_info__cache_expression(Var,
-		mkword(Bits1, unop(mkbody, const(int_const(Num1))))).
->>>>>>> 1.101
 unify_gen__generate_construction_2(type_ctor_info_constant(ModuleName,
-<<<<<<< unify_gen.m
-		TypeName, TypeArity), Var, Args, _Modes, _IMDelta, Code) -->
-=======
-		TypeName, TypeArity), Var, Args, _Modes, _, Code) -->
->>>>>>> 1.101
+		TypeName, TypeArity), Var, Args, _Modes, _IMDelta, _, Code) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -426,11 +362,7 @@
 	unify_gen__cache_unification(Var, const(data_addr_const(data_addr(
 		ModuleName, type_ctor(info, TypeName, TypeArity)))), Code).
 unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
-<<<<<<< unify_gen.m
-		ClassId, Instance), Var, Args, _Modes, _IMDelta, Code) -->
-=======
-		ClassId, Instance), Var, Args, _Modes, _, Code) -->
->>>>>>> 1.101
+		ClassId, Instance), Var, Args, _Modes, _IMDelta, _, Code) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -440,11 +372,7 @@
 		ModuleName, base_typeclass_info(ClassId, Instance)))),
 		Code).
 unify_gen__generate_construction_2(tabling_pointer_constant(PredId, ProcId),
-<<<<<<< unify_gen.m
-		Var, Args, _Modes, _IMDelta, Code) -->
-=======
-		Var, Args, _Modes, _, Code) -->
->>>>>>> 1.101
+		Var, Args, _Modes, _IMDelta, _, Code) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -457,11 +385,7 @@
 	unify_gen__cache_unification(Var, const(data_addr_const(DataAddr)),
 		Code).
 unify_gen__generate_construction_2(code_addr_constant(PredId, ProcId),
-<<<<<<< unify_gen.m
-		Var, Args, _Modes, _IMDelta, Code) -->
-=======
-		Var, Args, _Modes, _, Code) -->
->>>>>>> 1.101
+		Var, Args, _Modes, _IMDelta, _, Code) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -469,17 +393,11 @@
 	),
 	code_info__get_module_info(ModuleInfo),
 	code_info__make_entry_label(ModuleInfo, PredId, ProcId, no, CodeAddr),
-<<<<<<< unify_gen.m
 	unify_gen__cache_unification(Var, const(code_addr_const(CodeAddr)),
 		Code).
-unify_gen__generate_construction_2(pred_closure_tag(PredId, ProcId),
-		Var, Args, Modes, IMDelta, Code) -->
-=======
-	code_info__cache_expression(Var, const(code_addr_const(CodeAddr))).
 unify_gen__generate_construction_2(
 		pred_closure_tag(PredId, ProcId, EvalMethod),
-		Var, Args, _Modes, _AditiInfo, Code) -->
->>>>>>> 1.101
+		Var, Args, Modes, IMDelta, _AditiInfo, Code) -->
 	% This code constructs or extends a closure.
 	% The structure of closures is defined in runtime/mercury_ho_call.h.
 
--- unique_modes.m	1999/07/14 00:26:57	1.2
+++ unique_modes.m	1999/07/16 05:32:23
@@ -391,108 +391,65 @@
 	mode_info_set_instmap(InstMap0),
 	mode_checkpoint(exit, "not", GoalInfo0).
 
-<<<<<<< unique_modes.m
-unique_modes__check_goal_2(some(Vs, G0), GoalInfo0, some(Vs, G)) -->
-	mode_checkpoint(enter, "some", GoalInfo0),
-=======
-unique_modes__check_goal_2(some(Vs, CanRemove, G0), _,
+unique_modes__check_goal_2(some(Vs, CanRemove, G0), GoalInfo0,
 		some(Vs, CanRemove, G)) -->
-	mode_checkpoint(enter, "some"),
->>>>>>> 1.54
+	mode_checkpoint(enter, "some", GoalInfo0),
 	unique_modes__check_goal(G0, G),
 	mode_checkpoint(exit, "some", GoalInfo0).
 
-<<<<<<< unique_modes.m
-unique_modes__check_goal_2(higher_order_call(PredVar, Args, Types, Modes, Det,
-		PredOrFunc), GoalInfo0, Goal) -->
-	mode_checkpoint(enter, "higher-order call", GoalInfo0),
-	mode_info_set_call_context(higher_order_call(PredOrFunc)),
-=======
-unique_modes__check_goal_2(generic_call(GenericCall, Args, Modes, Det),
-		_GoalInfo0, Goal) -->
-	mode_checkpoint(enter, "generic_call"),
+unique_modes__check_goal_2(Goal,
+		GoalInfo0, Goal) -->
+	{ Goal = generic_call(GenericCall, Args, Modes, Det) },
+	mode_checkpoint(enter, "generic_call", GoalInfo0),
 	{ hlds_goal__generic_call_id(GenericCall, CallId) },
 	mode_info_set_call_context(call(CallId)),
->>>>>>> 1.54
 	{ determinism_components(Det, _, at_most_zero) ->
 		NeverSucceeds = yes
 	;
 		NeverSucceeds = no
 	},
 	{ determinism_to_code_model(Det, CodeModel) },
-<<<<<<< unique_modes.m
 	{ Modes = argument_modes(ArgInstTable, ArgModes0) },
 	mode_info_dcg_get_inst_table(InstTable0),
 	{ inst_table_create_sub(InstTable0, ArgInstTable, Sub, InstTable) },
 	mode_info_set_inst_table(InstTable),
 	{ list__map(apply_inst_key_sub_mode(Sub), ArgModes0, ArgModes) },
 
-	unique_modes__check_call_modes(Args, ArgModes, 0, CodeModel,
-		NeverSucceeds),
-	{ Goal = higher_order_call(PredVar, Args, Types, Modes, Det,
-			PredOrFunc) },
-	mode_info_unset_call_context,
-	mode_checkpoint(exit, "higher-order call", GoalInfo0).
-=======
->>>>>>> 1.54
-
-<<<<<<< unique_modes.m
-unique_modes__check_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
-		Det), GoalInfo0, Goal) -->
-	mode_checkpoint(enter, "class method call", GoalInfo0),
-		% Setting the context to `higher_order_call(...)' is a little
-		% white lie.  However, since there can't really be a unique 
-		% mode error in a class_method_call, this lie will never be
-		% used. There can't be an error because the class_method_call 
-		% is introduced by the compiler as the body of a class method.
-	mode_info_set_call_context(higher_order_call(predicate)),
-	{ determinism_components(Det, _, at_most_zero) ->
-		NeverSucceeds = yes
-=======
-	% `aditi_insert' goals have type_info arguments for each
-	% of the arguments of the tuple to insert added to the
-	% start of the argument list by polymorphism.m.
-	{ GenericCall = aditi_builtin(aditi_insert(_), _ - _/Arity) ->
-		ArgOffset = -Arity
->>>>>>> 1.54
+	{
+		GenericCall = higher_order(_, _, _),
+		ArgOffset = 1
 	;
+		% Class method calls are introduced by the compiler
+		% and should be mode correct.
+		GenericCall = class_method(_, _, _, _),
 		ArgOffset = 0
+	;
+		% `aditi_insert' goals have type_info arguments for each
+		% of the arguments of the tuple to insert added to the
+		% start of the argument list by polymorphism.m.
+		GenericCall = aditi_builtin(Builtin, UpdatedCallId),
+		( Builtin = aditi_insert(_), UpdatedCallId = _ - _/Arity ->
+			ArgOffset = -Arity
+		;
+			ArgOffset = 0
+		)
 	},
-<<<<<<< unique_modes.m
-	{ determinism_to_code_model(Det, CodeModel) },
-	{ Modes = argument_modes(_ArgInstTable, ArgModes) },
-	% YYY What about if ArgInstTable is non-null?
-	unique_modes__check_call_modes(Args, ArgModes, 0, CodeModel,
-			NeverSucceeds),
-	{ Goal = class_method_call(TCVar, Num, Args, Types, Modes, Det) },
-=======
 
-	unique_modes__check_call_modes(Args, Modes, ArgOffset,
-		CodeModel, NeverSucceeds),
-	{ Goal = generic_call(GenericCall, Args, Modes, Det) },
->>>>>>> 1.54
+	unique_modes__check_call_modes(Args, ArgModes, ArgOffset, CodeModel,
+		NeverSucceeds),
 	mode_info_unset_call_context,
-<<<<<<< unique_modes.m
-	mode_checkpoint(exit, "class method call", GoalInfo0).
-=======
-	mode_checkpoint(exit, "generic_call").
->>>>>>> 1.54
+	mode_checkpoint(exit, "generic_call", GoalInfo0).
 
 unique_modes__check_goal_2(call(PredId, ProcId0, Args, Builtin, CallContext,
 		PredName), GoalInfo0, Goal) -->
 	{ prog_out__sym_name_to_string(PredName, PredNameString) },
 	{ string__append("call ", PredNameString, CallString) },
-<<<<<<< unique_modes.m
 	mode_checkpoint(enter, CallString, GoalInfo0),
-	mode_info_set_call_context(call(PredId)),
-=======
-	mode_checkpoint(enter, CallString),
 
 	=(ModeInfo),
 	{ mode_info_get_call_id(ModeInfo, PredId, CallId) },
 	mode_info_set_call_context(call(call(CallId))),
 
->>>>>>> 1.54
 	unique_modes__check_call(PredId, ProcId0, Args, ProcId),
 	{ Goal = call(PredId, ProcId, Args, Builtin, CallContext, PredName) },
 	mode_info_unset_call_context,
@@ -530,17 +487,11 @@
 	% which it is the goal.
 unique_modes__check_goal_2(pragma_c_code(IsRecursive, PredId, ProcId0,
 		Args, ArgNameMap, OrigArgTypes, PragmaCode),
-<<<<<<< unique_modes.m
 		GoalInfo, Goal) -->
 	mode_checkpoint(enter, "pragma_c_code", GoalInfo),
-	mode_info_set_call_context(call(PredId)),
-=======
-		_GoalInfo, Goal) -->
-	mode_checkpoint(enter, "pragma_c_code"),
 	=(ModeInfo),
 	{ mode_info_get_call_id(ModeInfo, PredId, CallId) },
 	mode_info_set_call_context(call(call(CallId))),
->>>>>>> 1.54
 	unique_modes__check_call(PredId, ProcId0, Args, ProcId),
 	{ Goal = pragma_c_code(IsRecursive, PredId, ProcId, Args,
 			ArgNameMap, OrigArgTypes, PragmaCode) },
--- unused_args.m	1999/07/14 00:26:57	1.2
+++ unused_args.m	1999/07/16 05:22:53
@@ -472,33 +472,17 @@
 		UseInf0, UseInf).
 
 % handle quantification
-<<<<<<< unused_args.m
-traverse_goal(InstMap0, InstTable, ModuleInfo, some(_,  Goal - GoalInfo), _,
+traverse_goal(InstMap0, InstTable, ModuleInfo, some(_, _, Goal - GoalInfo), _,
 		UseInf0, UseInf) :-
 	traverse_goal(InstMap0, InstTable, ModuleInfo, Goal, GoalInfo,
 		UseInf0, UseInf).
 
-=======
-traverse_goal(ModuleInfo, some(_, _, Goal - _), UseInf0, UseInf) :-
-	traverse_goal(ModuleInfo, Goal, UseInf0, UseInf).
->>>>>>> 1.59
-
-% we assume that higher-order predicate calls use all variables involved
-<<<<<<< unused_args.m
-traverse_goal(_, _, _, higher_order_call(PredVar,Args,_,_,_,_), _,
+% we assume that generic calls use all variables involved
+traverse_goal(_, _, _, generic_call(GenericCall, Args, _, _), _,
 		UseInf0, UseInf) :-
-	set_list_vars_used(UseInf0, [PredVar|Args], UseInf).
-
-% we assume that class method calls use all variables involved
-traverse_goal(_, _, _, class_method_call(PredVar,_,Args,_,_,_), _,
-		UseInf0, UseInf) :-
-	set_list_vars_used(UseInf0, [PredVar|Args], UseInf).
-=======
-traverse_goal(_, generic_call(GenericCall, Args, _, _), UseInf0, UseInf) :-
 	goal_util__generic_call_vars(GenericCall, CallArgs),
 	set_list_vars_used(UseInf0, CallArgs, UseInf1),
 	set_list_vars_used(UseInf1, Args, UseInf).
->>>>>>> 1.59
 
 % handle pragma c_code(...) -
 % only those arguments which have C names can be used in the C code.
@@ -551,12 +535,8 @@
 
 	).
 
-<<<<<<< unused_args.m
-traverse_goal(_, _, _, unify(Var1, _, _, construct(_, _, Args, _), _), _,
-=======
-traverse_goal(_, unify(Var1, _, _, construct(_, _, Args, _, _, _, _), _),
->>>>>>> 1.59
-					UseInf0, UseInf) :-
+traverse_goal(_, _, _, unify(Var1, _, _, construct(_, _, Args, _, _, _, _), _),
+		_, UseInf0, UseInf) :-
 	( local_var_is_used(UseInf0, Var1) ->
 		set_list_vars_used(UseInf0, Args, UseInf)
 	;
@@ -1357,17 +1337,10 @@
 			Changed3, Else0, Else),
 	bool__or_list([Changed1, Changed2, Changed3], Changed).
 
-<<<<<<< unused_args.m
 fixup_goal_expr(InstMap0, InstTable, ModuleInfo, UnusedVars, ProcCallInfo,
-		Changed, some(Vars, SubGoal0) - GoalInfo,
-		some(Vars, SubGoal) - GoalInfo) :-
-	fixup_goal(InstMap0, InstTable, ModuleInfo, UnusedVars, ProcCallInfo,
-=======
-fixup_goal_expr(ModuleInfo, UnusedVars, ProcCallInfo, Changed,
-		some(Vars, CanRemove, SubGoal0) - GoalInfo,
+		Changed, some(Vars, CanRemove, SubGoal0) - GoalInfo,
 		some(Vars, CanRemove, SubGoal) - GoalInfo) :-
-	fixup_goal(ModuleInfo, UnusedVars, ProcCallInfo,
->>>>>>> 1.59
+	fixup_goal(InstMap0, InstTable, ModuleInfo, UnusedVars, ProcCallInfo,
 				Changed, SubGoal0, SubGoal).
 
 fixup_goal_expr(_, _InstTable, _ModuleInfo, _UnusedVars, ProcCallInfo,
@@ -1408,14 +1381,6 @@
 
 fixup_goal_expr(_, _InstTable, _ModuleInfo, _UnusedVars, _ProcCallInfo, no,
 			GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
-	GoalExpr = higher_order_call(_, _, _, _, _, _).
-
-<<<<<<< unused_args.m
-fixup_goal_expr(_, _InstTable, _ModuleInfo, _UnusedVars, _ProcCallInfo, no,
-=======
-fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
->>>>>>> 1.59
-			GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
 	GoalExpr = generic_call(_, _, _, _).
 
 fixup_goal_expr(_, _InstTable, _ModuleInfo, _UnusedVars, _ProcCallInfo, no,
@@ -1516,25 +1481,13 @@
 	\+ list__member(Var1, UnusedVars).
 
 	% LVar unused => we don't need the unification
-<<<<<<< unused_args.m
-fixup_unify(_, _, _, UnusedVars, no,
-		construct(LVar, ConsId, ArgVars, ArgModes), _,
-		construct(LVar, ConsId, ArgVars, ArgModes)) :-	
-=======
-fixup_unify(_, UnusedVars, no, Unify, Unify) :-
+fixup_unify(_, _, _, UnusedVars, no, Unify, _, Unify) :-
 	Unify = construct(LVar, _, _, _, _, _, _),
->>>>>>> 1.59
 	\+ list__member(LVar, UnusedVars).
 	
-<<<<<<< unused_args.m
 fixup_unify(InstMapBefore, InstTable, ModuleInfo, UnusedVars, Changed,
-		deconstruct(LVar, ConsId, ArgVars, ArgModes, CanFail),
-		InstMapDelta,
-		deconstruct(LVar, ConsId, ArgVars, ArgModes, CanFail)) :-
-=======
-fixup_unify(ModuleInfo, UnusedVars, Changed, Unify, Unify) :-
+		Unify, InstMapDelta, Unify) :-
 	Unify =	deconstruct(LVar, _, ArgVars, ArgModes, CanFail),
->>>>>>> 1.59
 	\+ list__member(LVar, UnusedVars),
 	instmap__apply_instmap_delta(InstMapBefore, InstMapDelta,
 			InstMapAfter),
Index: .alias_trunk_sync_tag
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/.alias_trunk_sync_tag,v
retrieving revision 1.1.2.18
diff -u -u -r1.1.2.18 .alias_trunk_sync_tag
--- .alias_trunk_sync_tag	1999/07/13 04:42:50	1.1.2.18
+++ .alias_trunk_sync_tag	1999/07/19 01:21:39
@@ -1 +1 @@
-trunk_snapshot_19990712123833
+trunk_snapshot_19990716145932
--------------------------------------------------------------------------
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