[m-rev.] diff: clean up Aditi updates

Simon Taylor stayl at cs.mu.OZ.AU
Fri Sep 19 21:06:15 AEST 2003


Estimated hours taken: 0.5
Branches: main

compiler/*.m:
	Remove the unimplemented aditi_filter and aditi_modify
	goals -- they will never be implemented.

	Remove the `aditi_top_down' lambda_eval_method, which was only
	used for those update goals.  Even if those update goals were
	to be implemented, a special type of lambda expression
	shouldn't actually be needed.

	Use clearer names for the updates in the constructors
	of the aditi_builtin type.

Index: compiler/aditi_builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/aditi_builtin_ops.m,v
retrieving revision 1.4
diff -u -u -r1.4 aditi_builtin_ops.m
--- compiler/aditi_builtin_ops.m	23 Aug 2003 14:00:04 -0000	1.4
+++ compiler/aditi_builtin_ops.m	18 Sep 2003 07:04:36 -0000
@@ -232,10 +232,9 @@
 			(CastInputInst - CastInputInst)) },
 	{ list__duplicate(NumBuiltinArgs, UniMode, UniModes) },
 	{ BuiltinConsId = pred_const(BuiltinPredId, BuiltinProcId, normal) },
-	{ ExprnId = no },
 	{ Unification = construct(NewVar, BuiltinConsId, BuiltinArgs,
 			UniModes, construct_dynamically,
-			cell_is_unique, ExprnId) },
+			cell_is_unique, no) },
 	{ set__list_to_set([NewVar | BuiltinArgs], NonLocals) },
 	{ instmap_delta_from_assoc_list([NewVar - ground_inst],
 		InstMapDelta) },
@@ -322,7 +321,7 @@
 :- mode transform_aditi_builtin_2(in, in, in, in, in, in, in, in,
 		out, in, out) is det.
 
-transform_aditi_builtin_2(aditi_tuple_insert_delete(_, _),
+transform_aditi_builtin_2(aditi_tuple_update(_, _),
 		Args0, _Modes0, _Det, _GoalInfo, BuiltinPredProcId,
 		BuiltinSymName, ConstArgs, Goals) -->
 
@@ -365,7 +364,7 @@
 	{ Goals = list__append(TupleGoals, [CallGoal]) }. 
 
 transform_aditi_builtin_2(
-		aditi_insert_delete_modify(Op, PredId, _),
+		aditi_bulk_update(Op, PredId, _),
 		Args, _Modes, _Det, _GoalInfo, BuiltinPredProcId,
 		BuiltinSymName, ConstArgs, Goals) -->
 
@@ -390,7 +389,7 @@
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 	{ list__length(ArgTypes, PredArity) },
 	{
-		Op = delete(_),
+		Op = bulk_delete,
 		ClosurePredOrFunc = PredOrFunc,
 		ClosureArity = PredArity
 	;
@@ -398,7 +397,7 @@
 		ClosurePredOrFunc = PredOrFunc,
 		ClosureArity = PredArity
 	;
-		Op = modify(_),
+		Op = bulk_modify,
 		ClosurePredOrFunc = predicate,
 		ClosureArity = PredArity * 2
 	},
@@ -658,7 +657,7 @@
 		string, arity, list(const_arg)).
 :- mode aditi_builtin_info(in, in, out, out, out) is det.
 
-aditi_builtin_info(ModuleInfo, aditi_tuple_insert_delete(Op, PredId),
+aditi_builtin_info(ModuleInfo, aditi_tuple_update(Op, PredId),
 		BuiltinProcName, BuiltinProcArity, ConstArgs) :-
 	rl__permanent_relation_name(ModuleInfo, PredId, RelName),
 	(
@@ -681,25 +680,21 @@
 		UpdateProcArgs = [string(DeleteProcStr), string(InputSchema)]
 	),
 	ConstArgs = [string(RelName) | UpdateProcArgs].
-aditi_builtin_info(ModuleInfo, aditi_insert_delete_modify(Op, PredId, _),
+aditi_builtin_info(ModuleInfo, aditi_bulk_update(Op, PredId, _),
 		BuiltinProcName, BuiltinProcArity, ConstArgs) :-
 
 	rl__permanent_relation_name(ModuleInfo, PredId, RelName),
 	(
-		Op = delete(BulkFilter),
+		Op = bulk_delete,
 		BuiltinProcName = "do_bulk_delete",
-		require(unify(BulkFilter, bulk),
-			"sorry, top-down Aditi updates not yet implemented"),
 		rl__get_delete_proc_name(ModuleInfo, PredId, UpdateProcName)
 	;
 		Op = bulk_insert,
 		BuiltinProcName = "do_bulk_insert",
 		rl__get_insert_proc_name(ModuleInfo, PredId, UpdateProcName)
 	;
-		Op = modify(BulkFilter),
+		Op = bulk_modify,
 		BuiltinProcName = "do_bulk_modify",
-		require(unify(BulkFilter, bulk),
-			"sorry, top-down Aditi updates not yet implemented"),
 		rl__get_modify_proc_name(ModuleInfo, PredId, UpdateProcName)
 	),
 	BuiltinProcArity = 5,
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.106
diff -u -u -r1.106 hlds_goal.m
--- compiler/hlds_goal.m	7 May 2003 00:50:21 -0000	1.106
+++ compiler/hlds_goal.m	18 Sep 2003 07:04:36 -0000
@@ -375,21 +375,7 @@
 			construct_is_unique	:: cell_is_unique,
 					% Can the cell be allocated
 					% in shared data.
-			construct_exprn_id	:: maybe(rl_exprn_id)
-					% Used for `aditi_top_down' closures
-					% passed to `aditi_delete' and
-					% `aditi_modify' calls where the
-					% relation being modified has a
-					% B-tree index.
-					% The Aditi-RL expression referred
-					% to by this field constructs a key
-					% range which restricts the deletion
-					% or modification of the relation using
-					% the index so that the deletion or
-					% modification closure is only applied
-					% to tuples for which the closure could
-					% succeed, reducing the number of
-					% tuples read from disk.
+			maybe(unit)	% Unused.
 		)
 
 		% A deconstruction unification is a unification with a functor
@@ -1037,8 +1023,8 @@
 		% Arguments:
 		%   the arguments of tuple to insert
 		%   aditi__state::di, aditi__state::uo
-		aditi_tuple_insert_delete(
-			aditi_insert_delete,
+		aditi_tuple_update(
+			aditi_tuple_update,
 			pred_id		% base relation to insert into
 		)
 
@@ -1073,35 +1059,22 @@
 		%		q(DB, X, Y)
 		% ),
 		% aditi_bulk_delete(pred p/3, DeletePred).
-	;	aditi_insert_delete_modify(
-			aditi_insert_delete_modify,
+	;	aditi_bulk_update(
+			aditi_bulk_update,
 			pred_id,
 			aditi_builtin_syntax
 		)
 	.
 
-:- type aditi_insert_delete
+:- type aditi_tuple_update
 	--->	delete			% `aditi_delete'
 	;	insert			% `aditi_insert'
 	.
 
-:- type aditi_insert_delete_modify
-	--->	delete(bulk_or_filter)	% `aditi_bulk_delete' or `aditi_filter'
+:- type aditi_bulk_update
+	--->	bulk_delete		% `aditi_bulk_delete'
 	;	bulk_insert		% `aditi_bulk_insert'
-	;	modify(bulk_or_filter)	% `aditi_bulk_modify' or `aditi_modify'
-	.
-
-	% Deletions and modifications can either be done by computing
-	% all tuples for which the update applies, then applying the
-	% update for all tuples in one go (`bulk'), or by applying
-	% the update to each tuple during a pass over the relation
-	% being modified (`filter').
-	%
-	% The `filter' updates are not yet implemented in Aditi, and
-	% it may be difficult to ever implement them.
-:- type bulk_or_filter
-	--->	bulk
-	;	filter
+	;	bulk_modify		% `aditi_bulk_modify'
 	.
 
 	% Which syntax was used for an `aditi_delete' or `aditi_modify'
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.314
diff -u -u -r1.314 hlds_out.m
--- compiler/hlds_out.m	25 Jul 2003 02:27:19 -0000	1.314
+++ compiler/hlds_out.m	18 Sep 2003 07:04:36 -0000
@@ -589,7 +589,7 @@
 :- mode hlds_out__write_aditi_builtin_arg_number(in, in, in, di, uo) is det.
 
 hlds_out__write_aditi_builtin_arg_number(
-		aditi_tuple_insert_delete(InsertDelete, _),
+		aditi_tuple_update(InsertDelete, _),
 		_ - _/Arity, ArgNum) -->
 	io__write_string("argument "),
 	( { ArgNum =< Arity } ->
@@ -605,13 +605,13 @@
 	).
 
 hlds_out__write_aditi_builtin_arg_number(
-		aditi_insert_delete_modify(_, _, pred_term),
+		aditi_bulk_update(_, _, pred_term),
 		_, ArgNum) -->
 	io__write_string("argument "),
 	io__write_int(ArgNum).
 
 hlds_out__write_aditi_builtin_arg_number(
-		aditi_insert_delete_modify(_, _, sym_name_and_closure),
+		aditi_bulk_update(_, _, sym_name_and_closure),
 		_, ArgNum) -->
 	% The original goal had a sym_name/arity
 	% at the front of the argument list.
@@ -1020,7 +1020,6 @@
 hlds_out__marker_name(check_termination, "check_termination").
 hlds_out__marker_name(does_not_terminate, "does_not_terminate").
 hlds_out__marker_name(aditi, "aditi").
-hlds_out__marker_name((aditi_top_down), "aditi_top_down").
 hlds_out__marker_name(base_relation, "base_relation").
 hlds_out__marker_name(generate_inline, "generate_inline").
 hlds_out__marker_name(aditi_memo, "aditi_memo").
@@ -2070,7 +2069,7 @@
 	di, uo) is det.
 
 hlds_out__write_aditi_builtin(_ModuleInfo,
-		aditi_tuple_insert_delete(InsertDelete, PredId), CallId,
+		aditi_tuple_update(InsertDelete, PredId), CallId,
 		ArgVars, VarSet, AppendVarnums, Indent, Follow) -->
 	% make_hlds.m checks the arity so this cannot fail. 
 	{ get_state_args_det(ArgVars, Args, State0Var, StateVar) },
@@ -2106,7 +2105,7 @@
 
 hlds_out__write_aditi_builtin(_ModuleInfo, Builtin, CallId,
 		ArgVars, VarSet, AppendVarnums, Indent, Follow) -->
-	{ Builtin = aditi_insert_delete_modify(_, PredId, _Syntax) },
+	{ Builtin = aditi_bulk_update(_, PredId, _Syntax) },
 	hlds_out__write_indent(Indent),	
 	{ hlds_out__aditi_builtin_name(Builtin, UpdateName) },
 	io__write_string(UpdateName),
@@ -2135,20 +2134,16 @@
 	io__write_int(PredInt),
 	io__write_string(".\n").
 
-hlds_out__aditi_builtin_name(aditi_tuple_insert_delete(_, _), "aditi_insert").
-hlds_out__aditi_builtin_name(aditi_insert_delete_modify(InsertDelMod, _, _),
-		Name) :-
-	hlds_out__aditi_insert_delete_modify_name(InsertDelMod, Name).
-
-:- pred hlds_out__aditi_insert_delete_modify_name(aditi_insert_delete_modify,
-		string).
-:- mode hlds_out__aditi_insert_delete_modify_name(in, out) is det.
-
-hlds_out__aditi_insert_delete_modify_name(bulk_insert, "aditi_bulk_insert").
-hlds_out__aditi_insert_delete_modify_name(delete(bulk), "aditi_bulk_delete").
-hlds_out__aditi_insert_delete_modify_name(delete(filter), "aditi_delete").
-hlds_out__aditi_insert_delete_modify_name(modify(bulk), "aditi_bulk_modify").
-hlds_out__aditi_insert_delete_modify_name(modify(filter), "aditi_modify").
+hlds_out__aditi_builtin_name(aditi_tuple_update(_, _), "aditi_insert").
+hlds_out__aditi_builtin_name(aditi_bulk_update(Update, _, _), Name) :-
+	hlds_out__aditi_bulk_update_name(Update, Name).
+
+:- pred hlds_out__aditi_bulk_update_name(aditi_bulk_update, string).
+:- mode hlds_out__aditi_bulk_update_name(in, out) is det.
+
+hlds_out__aditi_bulk_update_name(bulk_insert, "aditi_bulk_insert").
+hlds_out__aditi_bulk_update_name(bulk_delete, "aditi_bulk_delete").
+hlds_out__aditi_bulk_update_name(bulk_modify, "aditi_bulk_modify").
 
 :- pred hlds_out__write_unification(unification, module_info, prog_varset,
 		inst_varset, bool, int, io__state, io__state).
@@ -2304,9 +2299,6 @@
 	;
 		EvalMethod = (aditi_bottom_up),
 		EvalStr = "aditi_bottom_up "
-	;
-		EvalMethod = (aditi_top_down),
-		EvalStr = "aditi_top_down "
 	},
 	(
 		{ PredOrFunc = predicate },
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.128
diff -u -u -r1.128 hlds_pred.m
--- compiler/hlds_pred.m	23 Jun 2003 17:02:54 -0000	1.128
+++ compiler/hlds_pred.m	18 Sep 2003 07:04:36 -0000
@@ -114,15 +114,6 @@
 
 %-----------------------------------------------------------------------------%
 
-	% This is used for a closure executed top-down on the Aditi
-	% side of the connection.
-	% These expression numbers are stored in the proc_info - the owner
-	% and module name from the pred_info are also required to completely
-	% identify the expressions.
-:- type rl_exprn_id == int.
-
-%-----------------------------------------------------------------------------%
-
 	% The clauses_info structure contains the clauses for a predicate
 	% after conversion from the item_list by make_hlds.m.
 	% Typechecking is performed on the clauses info, then the clauses
@@ -411,12 +402,6 @@
 	;	aditi		% Generate bottom-up Aditi-RL for this
 				% predicate.
 
-	;	(aditi_top_down)
-				% Generate top-down Aditi-RL, not C, for this
-				% predicate. This is used for the builtin
-				% `delete' predicate - the closure is used
-				% to select which tuples are to be deleted.
-
 	;	base_relation	% This predicate is an Aditi base relation.
 
 			% `naive' and `psn' are mutually exclusive.
@@ -1884,12 +1869,6 @@
 :- pred proc_info_set_address_taken(proc_info, is_address_taken, proc_info).
 :- mode proc_info_set_address_taken(in, in, out) is det.
 
-:- pred proc_info_get_rl_exprn_id(proc_info, maybe(rl_exprn_id)).
-:- mode proc_info_get_rl_exprn_id(in, out) is det.
-
-:- pred proc_info_set_rl_exprn_id(proc_info, rl_exprn_id, proc_info).
-:- mode proc_info_set_rl_exprn_id(in, in, out) is det.
-
 :- pred proc_info_get_need_maxfr_slot(proc_info, bool).
 :- mode proc_info_get_need_maxfr_slot(in, out) is det.
 
@@ -2097,13 +2076,6 @@
 					% must be considered as having its
 					% address taken, since it is possible
 					% that some other module may do so.
-			maybe_aditi_rl_id :: maybe(rl_exprn_id),
-					% For predicates with an
-					% `aditi_top_down' marker, which are
-					% executed top-down on the Aditi side
-					% of the connection, we generate an RL
-					% expression, for which this is an
-					% identifier. See rl_update.m.
  			need_maxfr_slot	:: bool,
 					% True iff tracing is enabled, this
  					% is a procedure that lives on the det
@@ -2190,13 +2162,12 @@
 	CanProcess = yes,
 	map__init(TVarsMap),
 	map__init(TCVarsMap),
-	RLExprn = no,
 	NewProc = procedure(
 		BodyVarSet, BodyTypes, HeadVars, Modes, ModeErrors, InstVarSet,
 		MaybeArgLives, ClauseBody, MContext, StackSlots, MaybeDet,
 		InferredDet, CanProcess, ArgInfo, InitialLiveness, TVarsMap,
 		TCVarsMap, eval_normal, no, no, DeclaredModes, IsAddressTaken,
-		RLExprn, no, no, no, no
+		no, no, no, no
 	).
 
 proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
@@ -2204,14 +2175,13 @@
 		InferredDetism, CanProcess, ArgInfo, Liveness, TVarMap,
 		TCVarsMap, ArgSizes, Termination, IsAddressTaken,
 		ProcInfo) :-
-	RLExprn = no,
 	ModeErrors = [],
 	ProcInfo = procedure(
 		BodyVarSet, BodyTypes, HeadVars, HeadModes, ModeErrors,
 		InstVarSet, HeadLives, Goal, Context,
 		StackSlots, DeclaredDetism, InferredDetism, CanProcess, ArgInfo,
 		Liveness, TVarMap, TCVarsMap, eval_normal, ArgSizes,
-		Termination, no, IsAddressTaken, RLExprn, no, no, no, no).
+		Termination, no, IsAddressTaken, no, no, no, no).
 
 proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet,
 		Detism, Goal, Context, TVarMap, TCVarsMap,
@@ -2226,13 +2196,12 @@
 	map__init(StackSlots),
 	set__init(Liveness),
 	MaybeHeadLives = no,
-	RLExprn = no,
 	ModeErrors = [],
 	ProcInfo = procedure(VarSet, VarTypes, HeadVars, HeadModes, ModeErrors,
 		InstVarSet, MaybeHeadLives, Goal, Context, StackSlots,
 		MaybeDeclaredDetism, Detism, yes, no, Liveness, TVarMap,
 		TCVarsMap, eval_normal, no, no, no, IsAddressTaken,
-		RLExprn, no, no, no, no).
+		no, no, no, no).
 
 proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal,
 		TI_VarMap, TCI_VarMap, ProcInfo) :-
@@ -2324,7 +2293,6 @@
 proc_info_get_maybe_termination_info(ProcInfo, ProcInfo^maybe_termination).
 proc_info_maybe_declared_argmodes(ProcInfo, ProcInfo^maybe_declared_head_modes).
 proc_info_is_address_taken(ProcInfo, ProcInfo^is_address_taken).
-proc_info_get_rl_exprn_id(ProcInfo, ProcInfo^maybe_aditi_rl_id).
 proc_info_get_need_maxfr_slot(ProcInfo, ProcInfo^need_maxfr_slot).
 proc_info_get_call_table_tip(ProcInfo, ProcInfo^call_table_tip).
 proc_info_get_maybe_proc_table_info(ProcInfo, ProcInfo^maybe_table_info).
@@ -2355,7 +2323,6 @@
 proc_info_set_maybe_termination_info(ProcInfo, MT,
 	ProcInfo^maybe_termination := MT).
 proc_info_set_address_taken(ProcInfo, AT, ProcInfo^is_address_taken := AT).
-proc_info_set_rl_exprn_id(ProcInfo, ID, ProcInfo^maybe_aditi_rl_id := yes(ID)).
 proc_info_set_need_maxfr_slot(ProcInfo, NMS, ProcInfo^need_maxfr_slot := NMS).
 proc_info_set_call_table_tip(ProcInfo, CTT, ProcInfo^call_table_tip := CTT).
 proc_info_set_maybe_proc_table_info(ProcInfo, MTI,
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.145
diff -u -u -r1.145 intermod.m
--- compiler/intermod.m	21 Aug 2003 07:01:12 -0000	1.145
+++ compiler/intermod.m	18 Sep 2003 07:04:36 -0000
@@ -723,17 +723,7 @@
 intermod__module_qualify_unify_rhs(_LVar,
 		lambda_goal(A,B,EvalMethod,C,D,E,Modes,G,Goal0),
 		lambda_goal(A,B,EvalMethod,C,D,E,Modes,G,Goal), DoWrite) -->
-	( { EvalMethod = (aditi_top_down) } ->
-		% XXX Predicates which build this type of lambda expression
-		% can't be exported because the importing modules have
-		% no way of knowing which Aditi-RL bytecode fragment
-		% to use. The best way to handle these is probably to
-		% add some sort of lookup table to Aditi.
-		{ DoWrite = no },
-		{ Goal = Goal0 }
-	;
-		intermod__traverse_goal(Goal0, Goal, DoWrite)
-	).	
+	intermod__traverse_goal(Goal0, Goal, DoWrite).
 
 	% Fully module-qualify the right-hand-side of a unification.
 	% For function calls and higher-order terms, call intermod__add_proc
@@ -745,23 +735,13 @@
 		% Is this a higher-order predicate or higher-order function
 		% term?
 		%
-		{ Functor = pred_const(PredId, _, EvalMethod) }
+		{ Functor = pred_const(PredId, _, _) }
 	->
-		( { EvalMethod = (aditi_top_down) } ->
-			% XXX Predicates which build this type of lambda
-			% expression can't be exported because the importing
-			% modules have no way of knowing which Aditi-RL
-			% bytecode fragment to use. The best way to handle
-			% these is probably to add some sort of lookup table
-			% to Aditi. 
-			{ DoWrite = no }
-		;
-			%
-			% Yes, the unification creates a higher-order term.
-			% Make sure that the predicate/function is exported.
-			%
-			intermod__add_proc(PredId, DoWrite)
-		)
+		%
+		% Yes, the unification creates a higher-order term.
+		% Make sure that the predicate/function is exported.
+		%
+		intermod__add_proc(PredId, DoWrite)
 	;
 		%
 		% It's an ordinary constructor, or a constant of a builtin
@@ -1864,11 +1844,6 @@
 intermod__should_output_marker(no_inline, yes).
 intermod__should_output_marker(dnf, yes).
 intermod__should_output_marker(aditi, yes).
-intermod__should_output_marker((aditi_top_down), _) :-
-	% We don't write out code for predicates which depend on
-	% predicates with this marker: see the comments in
-	% intermod__module_qualify_unify_rhs.
-	error("intermod__should_output_marker: aditi_top_down").
 intermod__should_output_marker(base_relation, yes).
 intermod__should_output_marker(aditi_memo, yes).
 intermod__should_output_marker(aditi_no_memo, yes).
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.81
diff -u -u -r1.81 lambda.m
--- compiler/lambda.m	9 May 2003 01:03:22 -0000	1.81
+++ compiler/lambda.m	18 Sep 2003 07:04:36 -0000
@@ -393,10 +393,6 @@
 			Call_PredInfo, Call_ProcInfo),
 
 		(
-			EvalMethod = (aditi_top_down),
-			pred_info_get_markers(Call_PredInfo, Call_Markers),
-			check_marker(Call_Markers, (aditi_top_down))
-		;
 			EvalMethod = (aditi_bottom_up),
 			pred_info_get_markers(Call_PredInfo, Call_Markers),
 			check_marker(Call_Markers, aditi)
@@ -549,11 +545,6 @@
 		->
 			add_marker(LambdaMarkers0, aditi, LambdaMarkers)
 		;
-			EvalMethod = (aditi_top_down)
-		->
-			add_marker(LambdaMarkers0, aditi_top_down,
-				LambdaMarkers)
-		; 
 			LambdaMarkers = LambdaMarkers0
 		),
 
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.445
diff -u -u -r1.445 make_hlds.m
--- compiler/make_hlds.m	21 Aug 2003 07:01:12 -0000	1.445
+++ compiler/make_hlds.m	18 Sep 2003 07:04:36 -0000
@@ -6534,10 +6534,6 @@
 		; Name1 = "aditi_bulk_insert"
 		; Name1 = "aditi_bulk_delete"
 		; Name1 = "aditi_bulk_modify"
-
-		% These are not yet implemented in Aditi.
-		%; Name1 = "aditi_filter"
-		%; Name1 = "aditi_modify"
 		}
 	->
 		{ term__apply_substitution_to_list(Args1, Subst, Args2) },
@@ -7077,9 +7073,7 @@
 	;	"aditi_delete"
 	;	"aditi_bulk_insert"
 	;	"aditi_bulk_delete"
-	;	"aditi_filter"
 	;	"aditi_bulk_modify"
-	;	"aditi_modify"
 	).
 
 	% See the "Aditi update syntax" section of the
@@ -7094,55 +7088,36 @@
 transform_aditi_builtin(UpdateStr, Args0, Context, VarSet0,
 		Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
 	(
-		{ UpdateStr = "aditi_insert", InsertDelete = insert
-		; UpdateStr = "aditi_delete", InsertDelete = delete
+		{ UpdateStr = "aditi_insert", Update = insert
+		; UpdateStr = "aditi_delete", Update = delete
 		}
 	->
-		transform_aditi_tuple_insert_delete(UpdateStr, InsertDelete,
+		transform_aditi_tuple_update(UpdateStr, Update,
 			Args0, Context, VarSet0, Goal,
 			VarSet, Info0, Info, SInfo0, SInfo)
 	;
-		{
-			UpdateStr = "aditi_insert",
-			% This is handled above
-			error("transform_aditi_builtin: aditi_insert")
-		;
-			UpdateStr = "aditi_delete",
-			% This is handled above
-			error("transform_aditi_builtin: aditi_delete")
-		;
-			UpdateStr = "aditi_bulk_insert",
-			Update = bulk_insert
-		;
-			UpdateStr = "aditi_bulk_delete",
-			Update = delete(bulk)
-		;
-			UpdateStr = "aditi_bulk_modify",
-			Update = modify(bulk)
-		;
-			UpdateStr = "aditi_filter",
-			% not yet implemented
-			Update = delete(filter)
-		;
-			UpdateStr = "aditi_modify",
-			% not yet implemented
-			Update = modify(filter)
-		},
-		transform_aditi_insert_delete_modify(UpdateStr,
+		{ UpdateStr = "aditi_bulk_insert", Update = bulk_insert
+		; UpdateStr = "aditi_bulk_delete", Update = bulk_delete
+		; UpdateStr = "aditi_bulk_modify", Update = bulk_modify
+		}
+	->
+		transform_aditi_bulk_update(UpdateStr,
 			Update, Args0, Context, VarSet0, Goal,
 			VarSet, Info0, Info, SInfo0, SInfo)
 		
+	;
+		{ error("transform_aditi_builtin") }
 	).
 
-:- pred transform_aditi_tuple_insert_delete(string, aditi_insert_delete,
+:- pred transform_aditi_tuple_update(string, aditi_tuple_update,
 		list(prog_term), prog_context,
 		prog_varset, hlds_goal, prog_varset,
 		transform_info, transform_info, svar_info, svar_info,
 		io__state, io__state).
-:- mode transform_aditi_tuple_insert_delete(in, in, in, in,
+:- mode transform_aditi_tuple_update(in, in, in, in,
 		in, out, out, in, out, in, out, di, uo) is det.
 
-transform_aditi_tuple_insert_delete(UpdateStr, InsertDelete, Args0, Context,
+transform_aditi_tuple_update(UpdateStr, Update, Args0, Context,
 		VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
 	% Build an empty goal_info. 
 	{ goal_info_init(Context, GoalInfo) },
@@ -7177,8 +7152,7 @@
 			list__length(TupleArgVars, InsertArity),
 
 			invalid_pred_id(PredId),
-			Builtin = aditi_tuple_insert_delete(InsertDelete,
-					PredId),
+			Builtin = aditi_tuple_update(Update, PredId),
 			InsertCallId = PredOrFunc - SymName/InsertArity,
 			Call = generic_call(
 				aditi_builtin(Builtin, InsertCallId),
@@ -7206,7 +7180,7 @@
 			io__set_exit_status(1),
 			prog_out__write_context(Context),
 			io__write_string("Error: expected tuple to "),
-			io__write(InsertDelete),
+			io__write(Update),
 			io__write_string(" in `"),
 			io__write_string(UpdateStr),
 			io__write_string("'.\n"),
@@ -7224,14 +7198,14 @@
 	).
 
 	% Parse an `aditi_delete' or `aditi_modify' goal.
-:- pred transform_aditi_insert_delete_modify(string,
-		aditi_insert_delete_modify, list(prog_term), prog_context,
+:- pred transform_aditi_bulk_update(string,
+		aditi_bulk_update, list(prog_term), prog_context,
 		prog_varset, hlds_goal, prog_varset, transform_info, 
 		transform_info, svar_info, svar_info, io__state, io__state).
-:- mode transform_aditi_insert_delete_modify(in, in, in, in, in, out, out,
+:- mode transform_aditi_bulk_update(in, in, in, in, in, out, out,
 		in, out, in, out, di, uo) is det.
 
-transform_aditi_insert_delete_modify(Descr, InsertDelMod, Args0, Context,
+transform_aditi_bulk_update(Descr, Update, Args0, Context,
 		VarSet0, UpdateGoal, VarSet, Info0, Info, SInfo0, SInfo) -->
 	{ goal_info_init(Context, GoalInfo) },
 	(
@@ -7259,17 +7233,17 @@
 		{ Args0 = [HOTerm, AditiState0Term, AditiStateTerm] },
 		{ parse_rule_term(Context, HOTerm, HeadTerm, GoalTerm1) },
 		{ 
-			InsertDelMod = bulk_insert,
+			Update = bulk_insert,
 			parse_pred_or_func_and_args(HeadTerm,
 				PredOrFunc, SymName, HeadArgs1),
 			list__length(HeadArgs1, PredArity)
 		;
-			InsertDelMod = delete(_),
+			Update = bulk_delete,
 			parse_pred_or_func_and_args(HeadTerm,
 				PredOrFunc, SymName, HeadArgs1),
 			list__length(HeadArgs1, PredArity)
 		;
-			InsertDelMod = modify(_),
+			Update = bulk_modify,
 			HeadTerm = term__functor(term__atom("==>"),
 				[LeftHeadTerm, RightHeadTerm], _),
 			parse_pred_or_func_and_args(LeftHeadTerm,
@@ -7321,15 +7295,14 @@
 		{ set__delete_list(LambdaGoalVars0,
 			HeadArgs, LambdaGoalVars1) },
 		{ set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals) },
-		{ aditi_delete_insert_delete_modify_goal_info(InsertDelMod,
+		{ aditi_bulk_update_goal_info(Update,
 			PredOrFunc, SymName, PredArity, HeadArgs,
 			LambdaPredOrFunc, EvalMethod, LambdaModes,
 			Detism, PredGoal0, PredGoal) },
 		{ ModifiedCallId = PredOrFunc - SymName/PredArity },
 
 		{ invalid_pred_id(PredId) },
-		{ Builtin = aditi_insert_delete_modify(InsertDelMod,
-				PredId, Syntax) },
+		{ Builtin = aditi_bulk_update(Update, PredId, Syntax) },
 		{ MainContext =
 			call(generic_call(
 				aditi_builtin(Builtin, ModifiedCallId)),
@@ -7391,8 +7364,6 @@
 		% Second syntax -
 		% aditi_bulk_delete(pred p/3,
 		%	(aditi_bottom_up pred(..) :- ..), DB0, DB).
-		% aditi_bulk_modify(pred p/3,
-		%	(aditi_top_down pred(..) :- ..), DB0, DB).
 		%
 		% The `pred_term' syntax parsed above is transformed
 		% into the equivalent of this syntax.
@@ -7410,8 +7381,7 @@
 			VarSet0, OtherArgs, VarSet1) },
 		{ invalid_pred_id(PredId) },
 
-		{ Builtin = aditi_insert_delete_modify(InsertDelMod,
-				PredId, Syntax) },
+		{ Builtin = aditi_bulk_update(Update, PredId, Syntax) },
 
 		{ ModifiedCallId = PredOrFunc - SymName/Arity },
 		
@@ -7434,18 +7404,18 @@
 			QualInfo) },
 		{ Info = Info0 ^ qual_info := QualInfo },
 		io__set_exit_status(1),
-		output_expected_aditi_update_syntax(Context, InsertDelMod),
+		output_expected_aditi_update_syntax(Context, Update),
 		{ SInfo = SInfo0 }
 	).
 
-:- pred aditi_delete_insert_delete_modify_goal_info(aditi_insert_delete_modify,
+:- pred aditi_bulk_update_goal_info(aditi_bulk_update,
 		pred_or_func, sym_name, arity, list(prog_var), pred_or_func,
 		lambda_eval_method, list(mode), determinism,
 		hlds_goal, hlds_goal).
-:- mode aditi_delete_insert_delete_modify_goal_info(in, in, in, in, in, out,
+:- mode aditi_bulk_update_goal_info(in, in, in, in, in, out,
 		out, out, out, in, out) is det.
 
-aditi_delete_insert_delete_modify_goal_info(bulk_insert, PredOrFunc, _SymName,
+aditi_bulk_update_goal_info(bulk_insert, PredOrFunc, _SymName,
 		PredArity, _Args, LambdaPredOrFunc, EvalMethod,
 		LambdaModes, Detism, Goal, Goal) :-
 	LambdaPredOrFunc = PredOrFunc,
@@ -7455,32 +7425,21 @@
 	% Modes for the arguments of the input tuple.
 	list__duplicate(PredArity, OutMode, LambdaModes).
 
-aditi_delete_insert_delete_modify_goal_info(delete(BulkOrFilter), PredOrFunc, 
+aditi_bulk_update_goal_info(bulk_delete, PredOrFunc, 
 		SymName, PredArity, Args, LambdaPredOrFunc, EvalMethod,
 		LambdaModes, Detism, Goal0, Goal) :-
 	LambdaPredOrFunc = PredOrFunc,
+	EvalMethod = (aditi_bottom_up),
+	Detism = nondet,
+	out_mode(OutMode),
+	list__duplicate(PredArity, OutMode, LambdaModes),
 
-	(
-		BulkOrFilter = filter,
-		EvalMethod = (aditi_top_down),
-		in_mode(InMode),
-		list__duplicate(PredArity, InMode, LambdaModes),
-		Detism = semidet,
-		Goal = Goal0
-	;
-		BulkOrFilter = bulk,
-		EvalMethod = (aditi_bottom_up),
-		Detism = nondet,
-		out_mode(OutMode),
-		list__duplicate(PredArity, OutMode, LambdaModes),
-
-		% Join the result of the deletion goal with the
-		% relation to be updated.
-		conjoin_aditi_update_goal_with_call(PredOrFunc, SymName,
-			Args, Goal0, Goal)
-	).
+	% Join the result of the deletion goal with the
+	% relation to be updated.
+	conjoin_aditi_update_goal_with_call(PredOrFunc, SymName,
+		Args, Goal0, Goal).
 
-aditi_delete_insert_delete_modify_goal_info(modify(BulkOrFilter), PredOrFunc, 
+aditi_bulk_update_goal_info(bulk_modify, PredOrFunc, 
 		SymName, PredArity, Args, LambdaPredOrFunc, EvalMethod,
 		LambdaModes, Detism, Goal0, Goal) :-
 
@@ -7488,42 +7447,28 @@
 	% is always a predicate closure.
 	LambdaPredOrFunc = predicate,
 
-	in_mode(InMode),
 	out_mode(OutMode),
-	(
-		BulkOrFilter = filter,
+	EvalMethod = (aditi_bottom_up),
+	Detism = nondet,
 
-		% Modes for the arguments corresponding to
-		% the input tuple.
-		list__duplicate(PredArity, InMode,
-			DeleteModes),
-		EvalMethod = (aditi_top_down),
-		Detism = semidet,
-		Goal = Goal0
+	% Modes for the arguments corresponding to
+	% the input tuple.
+	list__duplicate(PredArity, OutMode,
+		DeleteModes),
+
+	% `Args' must have length `PredArity * 2',
+	% so this will always succeed.
+	( list__take(PredArity, Args, CallArgs0) ->
+		CallArgs = CallArgs0
 	;
-		BulkOrFilter = bulk,
-		EvalMethod = (aditi_bottom_up),
-		Detism = nondet,
-
-		% Modes for the arguments corresponding to
-		% the input tuple.
-		list__duplicate(PredArity, OutMode,
-			DeleteModes),
-
-		% `Args' must have length `PredArity * 2',
-		% so this will always succeed.
-		( list__take(PredArity, Args, CallArgs0) ->
-			CallArgs = CallArgs0
-		;
-			error("aditi_delete_insert_delete_modify_goal_info")
-		),
-
-		% Join the result of the modify goal with the
-		% relation to be updated.
-		conjoin_aditi_update_goal_with_call(PredOrFunc, SymName,
-			CallArgs, Goal0, Goal)
+		error("aditi_delete_insert_delete_modify_goal_info")
 	),
 
+	% Join the result of the modify goal with the
+	% relation to be updated.
+	conjoin_aditi_update_goal_with_call(PredOrFunc, SymName,
+		CallArgs, Goal0, Goal),
+
 	% Modes for the arguments corresponding to
 	% the output tuple.
 	list__duplicate(PredArity, OutMode, InsertModes),
@@ -7538,7 +7483,7 @@
 	Goal0 = _ - GoalInfo,
 
 	% The predicate is recorded as used in
-	% transform_aditi_tuple_insert_delete and
+	% transform_aditi_tuple_update and
 	% transform_aditi_insert_delete_modify
 	do_construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
 		GoalInfo, CallGoal),
@@ -7546,19 +7491,15 @@
 	Goal = conj([CallGoal, Goal0]) - GoalInfo.
 	
 :- pred output_expected_aditi_update_syntax(prog_context,
-		aditi_insert_delete_modify, io__state, io__state). 
+		aditi_bulk_update, io__state, io__state). 
 :- mode output_expected_aditi_update_syntax(in, in, di, uo) is det.
 
 output_expected_aditi_update_syntax(Context, bulk_insert) -->
 	output_insert_or_delete_expected_syntax(Context, "aditi_bulk_insert").
-output_expected_aditi_update_syntax(Context, delete(bulk)) -->
+output_expected_aditi_update_syntax(Context, bulk_delete) -->
 	output_insert_or_delete_expected_syntax(Context, "aditi_bulk_delete").
-output_expected_aditi_update_syntax(Context, delete(filter)) -->
-	output_insert_or_delete_expected_syntax(Context, "aditi_delete").
-output_expected_aditi_update_syntax(Context, modify(BulkOrFilter)) -->
-	{ BulkOrFilter = bulk, Name = "aditi_bulk_modify"
-	; BulkOrFilter = filter, Name = "aditi_modify"
-	},
+output_expected_aditi_update_syntax(Context, bulk_modify) -->
+	{ Name = "aditi_bulk_modify" },
 	prog_out__write_context(Context),
 	io__write_string("Error: expected\n"),
 	prog_out__write_context(Context),
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.233
diff -u -u -r1.233 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	25 Jul 2003 02:27:21 -0000	1.233
+++ compiler/mercury_to_mercury.m	18 Sep 2003 07:04:36 -0000
@@ -3953,8 +3953,6 @@
 
 output_lambda_eval_method(normal) -->
 	output_string("normal").
-output_lambda_eval_method(aditi_top_down) -->
-	output_string("aditi_top_down").
 output_lambda_eval_method(aditi_bottom_up) -->
 	output_string("aditi_bottom_up").
 
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.18
diff -u -u -r1.18 ml_closure_gen.m
--- compiler/ml_closure_gen.m	26 May 2003 09:00:01 -0000	1.18
+++ compiler/ml_closure_gen.m	18 Sep 2003 20:14:56 -0000
@@ -110,12 +110,8 @@
 		{ EvalMethod = normal }
 	;
 		{ EvalMethod = (aditi_bottom_up) },
-		% XXX not yet implemented
+		% These are transformed away by aditi_builtin_ops.m.
 		{ sorry(this_file, "`aditi_bottom_up' closures") }
-	;
-		{ EvalMethod = (aditi_top_down) },
-		% XXX not yet implemented
-		{ sorry(this_file, "`aditi_top_down' closures") }
 	),
 
 	%
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.44
diff -u -u -r1.44 modecheck_call.m
--- compiler/modecheck_call.m	28 Jul 2003 21:50:44 -0000	1.44
+++ compiler/modecheck_call.m	18 Sep 2003 07:04:36 -0000
@@ -165,8 +165,8 @@
 :- pred aditi_builtin_determinism(aditi_builtin, determinism).
 :- mode aditi_builtin_determinism(in, out) is det.
 
-aditi_builtin_determinism(aditi_tuple_insert_delete(_, _), det).
-aditi_builtin_determinism(aditi_insert_delete_modify(_, _, _), det).
+aditi_builtin_determinism(aditi_tuple_update(_, _), det).
+aditi_builtin_determinism(aditi_bulk_update(_, _, _), det).
 
 modecheck_builtin_cast(Args0, Modes, Det, Args, ExtraGoals) -->
 	{ Det = det },
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.25
diff -u -u -r1.25 pd_util.m
--- compiler/pd_util.m	26 May 2003 09:00:05 -0000	1.25
+++ compiler/pd_util.m	18 Sep 2003 07:04:36 -0000
@@ -1144,11 +1144,11 @@
 :- pred match_aditi_builtin(aditi_builtin::in, aditi_builtin::in) is semidet.
 
 	% The other fields are all implied by the pred_proc_id.
-match_aditi_builtin(aditi_tuple_insert_delete(InsertDelete, PredId),
-		aditi_tuple_insert_delete(InsertDelete, PredId)).
+match_aditi_builtin(aditi_tuple_update(Update, PredId),
+		aditi_tuple_update(Update, PredId)).
 	% The syntax used does not change the result of the call.
-match_aditi_builtin(aditi_insert_delete_modify(Op, PredId, _),
-		aditi_insert_delete_modify(Op, PredId, _)).
+match_aditi_builtin(aditi_bulk_update(Update, PredId, _),
+		aditi_bulk_update(Update, PredId, _)).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.55
diff -u -u -r1.55 post_typecheck.m
--- compiler/post_typecheck.m	25 Jul 2003 02:27:23 -0000	1.55
+++ compiler/post_typecheck.m	18 Sep 2003 07:04:36 -0000
@@ -488,7 +488,7 @@
 %-----------------------------------------------------------------------------%
 
 post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
-		aditi_tuple_insert_delete(InsertDelete, PredId0), Builtin,
+		aditi_tuple_update(Update, PredId0), Builtin,
 		PredOrFunc - SymName0/Arity, InsertCallId,
 		Modes, MaybeError) :-
 	% make_hlds.m checks the arity, so this is guaranteed to succeed.
@@ -499,7 +499,7 @@
 	post_typecheck__resolve_pred_overloading(PredId0, OtherArgs,
 		CallerPredInfo, ModuleInfo, SymName0, SymName, PredId),
 
-	Builtin = aditi_tuple_insert_delete(InsertDelete, PredId),
+	Builtin = aditi_tuple_update(Update, PredId),
 	InsertCallId = PredOrFunc - SymName/Arity,
 
 	module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
@@ -518,16 +518,16 @@
 post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
 		Builtin0, Builtin, PredOrFunc - SymName0/Arity,
 		UpdateCallId, Modes, MaybeError) :-
-	Builtin0 = aditi_insert_delete_modify(InsertDelMod, PredId0, Syntax),
+	Builtin0 = aditi_bulk_update(Update, PredId0, Syntax),
 	UnchangedArgTypes = (pred(X::in, X::out) is det),
 	(
-		InsertDelMod = bulk_insert,
+		Update = bulk_insert,
 		AdjustArgTypes = UnchangedArgTypes
 	;
-		InsertDelMod = delete(_),
+		Update = bulk_delete,
 		AdjustArgTypes = UnchangedArgTypes
 	;
-		InsertDelMod = modify(_),
+		Update = bulk_modify,
 		% The argument types of the closure passed to `aditi_modify'
 		% contain two copies of the arguments of the base relation -
 		% one set input and one set output.
@@ -545,7 +545,7 @@
 	),
 	resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
 		AdjustArgTypes, PredId0, PredId, SymName0, SymName),
-	Builtin = aditi_insert_delete_modify(InsertDelMod, PredId, Syntax),
+	Builtin = aditi_bulk_update(Update, PredId, Syntax),
 
 	UpdateCallId = PredOrFunc - SymName/Arity,
 
@@ -554,7 +554,7 @@
 		Builtin, UpdateCallId, MaybeError),
 
 	pred_info_arg_types(RelationPredInfo, ArgTypes),
-	post_typecheck__insert_delete_modify_closure_info(InsertDelMod,
+	post_typecheck__bulk_update_closure_info(Update,
 		PredOrFunc, ArgTypes, ClosurePredOrFunc,
 		ClosureArgModes, ClosureDetism),
 
@@ -562,47 +562,32 @@
 		ClosureArgModes, ClosureDetism))),
 	Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
 
-:- pred post_typecheck__insert_delete_modify_closure_info(
-		aditi_insert_delete_modify, pred_or_func, list(type),
+:- pred post_typecheck__bulk_update_closure_info(
+		aditi_bulk_update, pred_or_func, list(type),
 		pred_or_func, list(mode), determinism).
-:- mode post_typecheck__insert_delete_modify_closure_info(in, in, in,
+:- mode post_typecheck__bulk_update_closure_info(in, in, in,
 		out, out, out) is det.
 
-post_typecheck__insert_delete_modify_closure_info(bulk_insert, PredOrFunc,
+post_typecheck__bulk_update_closure_info(bulk_insert, PredOrFunc,
 		ArgTypes, PredOrFunc, ClosureArgModes, nondet) :-
 	out_mode(OutMode),
 	AditiStateMode = aditi_mui_mode,
 	aditi_builtin_modes(OutMode, AditiStateMode,
 		ArgTypes, ClosureArgModes).
-post_typecheck__insert_delete_modify_closure_info(delete(BulkOrFilter),
+post_typecheck__bulk_update_closure_info(bulk_delete,
 		PredOrFunc, ArgTypes, PredOrFunc, ClosureArgModes, nondet) :-
-	(
-		BulkOrFilter = bulk,
-		out_mode(ArgMode)
-	;
-		BulkOrFilter = filter,
-		in_mode(ArgMode)
-	),
+	ArgMode = out_mode,
 	AditiStateMode = aditi_mui_mode,
 	aditi_builtin_modes(ArgMode, AditiStateMode,
 		ArgTypes, ClosureArgModes).
-post_typecheck__insert_delete_modify_closure_info(modify(BulkOrFilter),
+post_typecheck__bulk_update_closure_info(bulk_modify,
 		_PredOrFunc, ArgTypes, LambdaPredOrFunc,
 		ClosureArgModes, nondet) :-
 	LambdaPredOrFunc = predicate,
 	out_mode(OutMode),
-	in_mode(InMode),
 	unused_mode(UnusedMode),
-	(
-		BulkOrFilter = bulk,
-		DeleteArgMode = OutMode,
-		DeleteAditiStateMode = aditi_mui_mode
-	;
-		BulkOrFilter = filter,
-		DeleteArgMode = InMode,
-		DeleteAditiStateMode = UnusedMode
-	),
-
+	DeleteArgMode = OutMode,
+	DeleteAditiStateMode = aditi_mui_mode,
 	aditi_builtin_modes(DeleteArgMode, DeleteAditiStateMode,
 			ArgTypes, DeleteArgModes),
 
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.96
diff -u -u -r1.96 prog_data.m
--- compiler/prog_data.m	25 Jul 2003 02:27:23 -0000	1.96
+++ compiler/prog_data.m	18 Sep 2003 07:04:36 -0000
@@ -885,15 +885,10 @@
 	% expressions constructed for arguments of the builtin Aditi
 	% update constructs.
 	%
-	% `aditi_top_down' expressions are used by `aditi_delete'
-	% goals (see hlds_goal.m) to determine whether a tuple
-	% should be deleted.
-	%
 	% `aditi_bottom_up' expressions are used as database queries to
 	% produce a set of tuples to be inserted or deleted.
 :- type lambda_eval_method
 	--->	normal
-	;	(aditi_top_down)
 	;	(aditi_bottom_up)
 	.
 
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.24
diff -u -u -r1.24 prog_io_goal.m
--- compiler/prog_io_goal.m	15 Mar 2003 03:09:07 -0000	1.24
+++ compiler/prog_io_goal.m	18 Sep 2003 07:04:36 -0000
@@ -87,9 +87,9 @@
 		list(mode), determinism).
 :- mode parse_func_expression(in, out, out, out, out) is semidet.
 
-	% parse_lambda_eval_method/3 extracts the `aditi' or `aditi_top_down'
-	% annotation (if any) from a pred expression and returns the rest
-	% of the term.
+	% parse_lambda_eval_method/3 extracts the `aditi_bottom_up'
+	% annotation (if any) from a pred expression and returns the
+	% rest of the term.
 :- pred parse_lambda_eval_method(term(T), lambda_eval_method, term(T)).
 :- mode parse_lambda_eval_method(in, out, out) is det.
 
@@ -439,9 +439,6 @@
 	( Term0 = term__functor(term__atom(MethodStr), [Term1], _) ->
 		( MethodStr = "aditi_bottom_up" ->
 			EvalMethod = (aditi_bottom_up),
-			Term = Term1
-		; MethodStr = "aditi_top_down" ->
-			EvalMethod = (aditi_top_down),
 			Term = Term1
 		;	
 			EvalMethod = normal,
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.59
diff -u -u -r1.59 purity.m
--- compiler/purity.m	26 May 2003 09:00:07 -0000	1.59
+++ compiler/purity.m	18 Sep 2003 07:04:36 -0000
@@ -625,16 +625,6 @@
 				error(
 	"compute_expr_purity: modes need fixing for normal lambda_goal")
 			;
-				EvalMethod = (aditi_top_down),
-				% `aditi_top_down' predicates can't call
-				% database predicates, so their `aditi__state'
-				% arguments must have mode `unused'.
-				% The `aditi__state's are passed even
-				% though they are not used so that the
-				% arguments of the closure and the
-				% base relation being updated match.
-				unused_mode(StateMode)
-			;
 				EvalMethod = (aditi_bottom_up),
 				% Make sure `aditi_bottom_up' expressions have
 				% a `ui' mode for their aditi_state.
Index: compiler/rl_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_gen.m,v
retrieving revision 1.11
diff -u -u -r1.11 rl_gen.m
--- compiler/rl_gen.m	26 May 2003 09:00:08 -0000	1.11
+++ compiler/rl_gen.m	18 Sep 2003 07:04:36 -0000
@@ -1729,9 +1729,7 @@
 	(
 		% XXX The type declaration in extras/aditi/aditi.m
 		% should be changed to require that the eval_method
-		% for the UpdateAcc and ComputeInitial parameters
-		% is `aditi_top_down', and the InputRelationArg
-		% is `aditi_bottom_up'.
+		% for the InputRelationArg is `aditi_bottom_up'.
 		{ type_is_higher_order(ComputeInitialType, (pure),
 			predicate, _, ComputeInitialArgTypes) },
 		{ ComputeInitialArgTypes = [GrpByType, _NGrpByType, AccType] }
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.125
diff -u -u -r1.125 type_util.m
--- compiler/type_util.m	23 Aug 2003 13:31:03 -0000	1.125
+++ compiler/type_util.m	18 Sep 2003 07:04:36 -0000
@@ -677,12 +677,8 @@
 	;	
 		Args = [Type1],
 		Type1 = term__functor(term__atom(PorFStr), ArgTypes, _),
-		( Functor = "aditi_bottom_up" ->
-			EvalMethod = (aditi_bottom_up)
-		;
-			Functor = "aditi_top_down",
-			EvalMethod = (aditi_top_down)
-		)
+		Functor = "aditi_bottom_up",
+		EvalMethod = (aditi_bottom_up)
 	).
 
 type_ctor_is_higher_order(SymName - _Arity, Purity, PredOrFunc, EvalMethod) :-
@@ -706,10 +702,6 @@
 			EvalMethod = (aditi_bottom_up),
 			Purity = (pure)
 		;
-			Qualifier = "aditi_top_down",
-			EvalMethod = (aditi_top_down),
-			Purity = (pure)
-		;
 			Qualifier = "impure",
 			Purity = (impure),
 			EvalMethod = normal
@@ -870,10 +862,6 @@
 			insert_module_qualifier("aditi_bottom_up", SymName0,
 				SymName1)
 		;
-			EvalMethod = (aditi_top_down),
-			insert_module_qualifier("aditi_top_down", SymName0,
-				SymName1)
-		;
 			EvalMethod = normal,
 			SymName1 = SymName0
 		),
@@ -961,9 +949,6 @@
 :- mode qualify_higher_order_type(in, in, out) is det.
 
 qualify_higher_order_type(normal, Type, Type).
-qualify_higher_order_type((aditi_top_down), Type0,
-	    term__functor(term__atom("aditi_top_down"), [Type0], Context)) :- 
-	term__context_init(Context).
 qualify_higher_order_type((aditi_bottom_up), Type0,
 	    term__functor(term__atom("aditi_bottom_up"), [Type0], Context)) :-
 	term__context_init(Context).
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.341
diff -u -u -r1.341 typecheck.m
--- compiler/typecheck.m	22 Jul 2003 07:04:25 -0000	1.341
+++ compiler/typecheck.m	18 Sep 2003 07:04:36 -0000
@@ -1567,21 +1567,20 @@
 		typecheck_info_di, typecheck_info_uo) is det.
 
 typecheck_aditi_builtin_2(CallId, Args,
-		aditi_tuple_insert_delete(InsertDelete, _),
-		aditi_tuple_insert_delete(InsertDelete, PredId)) -->
+		aditi_tuple_update(Update, _),
+		aditi_tuple_update(Update, PredId)) -->
 	% The tuple to insert or delete has the same argument types
 	% as the relation being inserted into or deleted from.
 	typecheck_call_pred(CallId, Args, PredId).
 typecheck_aditi_builtin_2(CallId, Args,
-		aditi_insert_delete_modify(InsertDelMod, _, Syntax),
-		aditi_insert_delete_modify(InsertDelMod, PredId, Syntax)) -->
-	{ aditi_insert_del_mod_eval_method(InsertDelMod, EvalMethod) },
-
+		aditi_bulk_update(Update, _, Syntax),
+		aditi_bulk_update(Update, PredId, Syntax)) -->
 	{ CallId = PredOrFunc - _ },
 	{ InsertDeleteAdjustArgTypes = 
 	    lambda([RelationArgTypes::in, UpdateArgTypes::out] is det, (
 			construct_higher_order_type((pure), PredOrFunc,
-				EvalMethod, RelationArgTypes, ClosureType),
+				(aditi_bottom_up), RelationArgTypes,
+				ClosureType),
 			UpdateArgTypes = [ClosureType]
 	    )) },
 
@@ -1592,33 +1591,24 @@
 	    lambda([RelationArgTypes::in, AditiModifyTypes::out] is det, (
 			list__append(RelationArgTypes, RelationArgTypes,
 				ClosureArgTypes),
-			construct_higher_order_pred_type((pure), EvalMethod,
-				ClosureArgTypes, ClosureType),
+			construct_higher_order_pred_type((pure),
+				(aditi_bottom_up), ClosureArgTypes,
+				ClosureType),
 			AditiModifyTypes = [ClosureType]
 	    )) },
 
 	{
-		InsertDelMod = bulk_insert,
+		Update = bulk_insert,
 		AdjustArgTypes = InsertDeleteAdjustArgTypes
 	;
-		InsertDelMod = delete(_),
+		Update = bulk_delete,
 		AdjustArgTypes = InsertDeleteAdjustArgTypes
 	;
-		InsertDelMod = modify(_),
+		Update = bulk_modify,
 		AdjustArgTypes = ModifyAdjustArgTypes
 	},
 	typecheck_aditi_builtin_closure(CallId, Args, AdjustArgTypes, PredId).
 
-:- pred aditi_insert_del_mod_eval_method(aditi_insert_delete_modify,
-		lambda_eval_method).
-:- mode aditi_insert_del_mod_eval_method(in, out) is det.
-
-aditi_insert_del_mod_eval_method(bulk_insert, (aditi_bottom_up)).
-aditi_insert_del_mod_eval_method(delete(filter), (aditi_top_down)).
-aditi_insert_del_mod_eval_method(delete(bulk), (aditi_bottom_up)).
-aditi_insert_del_mod_eval_method(modify(filter), (aditi_top_down)).
-aditi_insert_del_mod_eval_method(modify(bulk), (aditi_bottom_up)).
-
 	% Check that there is only one argument (other than the `aditi__state'
 	% arguments) passed to an `aditi_delete', `aditi_bulk_insert',
 	% `aditi_bulk_delete' or `aditi_modify', then typecheck that argument.
@@ -1647,8 +1637,7 @@
 		typecheck_info_di, typecheck_info_uo) is det.
 
 typecheck_aditi_state_args(Builtin, CallId, AditiState0Var, AditiStateVar) -->
-	{ construct_type(qualified(unqualified("aditi"), "state") - 0,
-		[], StateType) },
+	{ StateType = aditi_state_type },
 	typecheck_var_has_type_list([AditiState0Var, AditiStateVar],
 		[StateType, StateType],
 		aditi_builtin_first_state_arg(Builtin, CallId)).
@@ -1657,12 +1646,12 @@
 	% `aditi__state' DCG argument.
 :- func aditi_builtin_first_state_arg(aditi_builtin, simple_call_id) = int.
 
-aditi_builtin_first_state_arg(aditi_tuple_insert_delete(_, _),
+aditi_builtin_first_state_arg(aditi_tuple_update(_, _),
 		_ - _/Arity) = Arity + 1.
 	% XXX removing the space between the 2 and the `.' will possibly
 	% cause lexing to fail as io__putback_char will be called twice
 	% in succession in lexer__get_int_dot.
-aditi_builtin_first_state_arg(aditi_insert_delete_modify(_, _, _), _) = 2 .
+aditi_builtin_first_state_arg(aditi_bulk_update(_, _, _), _) = 2 .
 
 %-----------------------------------------------------------------------------%
 
@@ -5228,7 +5217,6 @@
 
 	{ EvalMethod = normal, EvalStr = ""
 	; EvalMethod = (aditi_bottom_up), EvalStr = "aditi_bottom_up "
-	; EvalMethod = (aditi_top_down), EvalStr = "aditi_top_down "
 	},
 
 	(
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.131
diff -u -u -r1.131 unify_gen.m
--- compiler/unify_gen.m	25 Jul 2003 02:27:27 -0000	1.131
+++ compiler/unify_gen.m	18 Sep 2003 07:04:36 -0000
@@ -83,10 +83,10 @@
 			{ Code = empty }
 		)
 	;
-		{ Uni = construct(Var, ConsId, Args, Modes, _, _, AditiInfo) },
+		{ Uni = construct(Var, ConsId, Args, Modes, _, _, _) },
 		( code_info__variable_is_forward_live(Var) ->
 			unify_gen__generate_construction(Var, ConsId,
-				Args, Modes, AditiInfo, GoalInfo, Code)
+				Args, Modes, GoalInfo, Code)
 		;
 			{ Code = empty }
 		)
@@ -332,31 +332,28 @@
 	% instantiate the arguments of that term.
 
 :- pred unify_gen__generate_construction(prog_var::in, cons_id::in,
-	list(prog_var)::in, list(uni_mode)::in, maybe(rl_exprn_id)::in,
-	hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
-	is det.
+	list(prog_var)::in, list(uni_mode)::in, hlds_goal_info::in,
+	code_tree::out, code_info::in, code_info::out) is det.
 
-unify_gen__generate_construction(Var, Cons, Args, Modes, AditiInfo, GoalInfo,
-		Code) -->
+unify_gen__generate_construction(Var, Cons, Args, Modes, GoalInfo, Code) -->
 	code_info__cons_id_to_tag(Var, Cons, Tag),
 	unify_gen__generate_construction_2(Tag, Var, Args,
-		Modes, AditiInfo, GoalInfo, Code).
+		Modes, GoalInfo, Code).
 
 :- pred unify_gen__generate_construction_2(cons_tag::in, prog_var::in, 
-	list(prog_var)::in, list(uni_mode)::in, maybe(rl_exprn_id)::in,
-	hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
-	is det.
+	list(prog_var)::in, list(uni_mode)::in, hlds_goal_info::in,
+	code_tree::out, code_info::in, code_info::out) is det.
 
 unify_gen__generate_construction_2(string_constant(String),
-		Var, _Args, _Modes, _, _, empty) -->
+		Var, _Args, _Modes, _, empty) -->
 	code_info__assign_const_to_var(Var, const(string_const(String))).
 unify_gen__generate_construction_2(int_constant(Int),
-		Var, _Args, _Modes, _, _, empty) -->
+		Var, _Args, _Modes, _, empty) -->
 	code_info__assign_const_to_var(Var, const(int_const(Int))).
 unify_gen__generate_construction_2(float_constant(Float),
-		Var, _Args, _Modes, _, _, empty) -->
+		Var, _Args, _Modes, _, empty) -->
 	code_info__assign_const_to_var(Var, const(float_const(Float))).
-unify_gen__generate_construction_2(no_tag, Var, Args, Modes, _, _, Code) -->
+unify_gen__generate_construction_2(no_tag, Var, Args, Modes, _, Code) -->
 	( { Args = [Arg], Modes = [Mode] } ->
 		code_info__variable_type(Arg, Type),
 		unify_gen__generate_sub_unify(ref(Var), ref(Arg),
@@ -366,12 +363,12 @@
 		"unify_gen__generate_construction_2: no_tag: arity != 1") }
 	).
 unify_gen__generate_construction_2(single_functor,
-		Var, Args, Modes, AditiInfo, GoalInfo, Code) -->
+		Var, Args, Modes, GoalInfo, Code) -->
 	% treat single_functor the same as unshared_tag(0)
 	unify_gen__generate_construction_2(unshared_tag(0),
-			Var, Args, Modes, AditiInfo, GoalInfo, Code).
+			Var, Args, Modes, GoalInfo, Code).
 unify_gen__generate_construction_2(unshared_tag(Ptag),
-		Var, Args, Modes, _, _, Code) -->
+		Var, Args, Modes, _, Code) -->
 	code_info__get_module_info(ModuleInfo),
 	unify_gen__var_types(Args, ArgTypes),
 	{ unify_gen__generate_cons_args(Args, ArgTypes, Modes, ModuleInfo,
@@ -380,7 +377,7 @@
 	{ unify_gen__var_type_msg(VarType, VarTypeMsg) },
 	code_info__assign_cell_to_var(Var, Ptag, Rvals, VarTypeMsg, Code).
 unify_gen__generate_construction_2(shared_remote_tag(Ptag, Sectag),
-		Var, Args, Modes, _, _, Code) -->
+		Var, Args, Modes, _, Code) -->
 	code_info__get_module_info(ModuleInfo),
 	unify_gen__var_types(Args, ArgTypes),
 	{ unify_gen__generate_cons_args(Args, ArgTypes, Modes, ModuleInfo,
@@ -391,11 +388,11 @@
 	{ unify_gen__var_type_msg(VarType, VarTypeMsg) },
 	code_info__assign_cell_to_var(Var, Ptag, Rvals, VarTypeMsg, Code).
 unify_gen__generate_construction_2(shared_local_tag(Bits1, Num1),
-		Var, _Args, _Modes, _, _, empty) -->
+		Var, _Args, _Modes, _, empty) -->
 	code_info__assign_const_to_var(Var,
 		mkword(Bits1, unop(mkbody, const(int_const(Num1))))).
 unify_gen__generate_construction_2(type_ctor_info_constant(ModuleName,
-		TypeName, TypeArity), Var, Args, _Modes, _, _, empty) -->
+		TypeName, TypeArity), Var, Args, _Modes, _, empty) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -405,7 +402,7 @@
 	{ DataAddr = rtti_addr(ctor_rtti_id(RttiTypeCtor, type_ctor_info)) },
 	code_info__assign_const_to_var(Var, const(data_addr_const(DataAddr))).
 unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
-		ClassId, Instance), Var, Args, _Modes, _, _, empty) -->
+		ClassId, Instance), Var, Args, _Modes, _, empty) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -415,7 +412,7 @@
 		rtti_addr(tc_rtti_id(base_typeclass_info(ModuleName, ClassId,
 			Instance)))))).
 unify_gen__generate_construction_2(tabling_pointer_constant(PredId, ProcId),
-		Var, Args, _Modes, _, _, empty) -->
+		Var, Args, _Modes, _, empty) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -428,7 +425,7 @@
 	code_info__assign_const_to_var(Var, const(data_addr_const(DataAddr))).
 unify_gen__generate_construction_2(
 		deep_profiling_proc_static_tag(RttiProcLabel),
-		Var, Args, _Modes, _, _, empty) -->
+		Var, Args, _Modes, _, empty) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -437,7 +434,7 @@
 	{ DataAddr = layout_addr(proc_static(RttiProcLabel)) },
 	code_info__assign_const_to_var(Var, const(data_addr_const(DataAddr))).
 unify_gen__generate_construction_2(table_io_decl_tag(RttiProcLabel),
-		Var, Args, _Modes, _, _, empty) -->
+		Var, Args, _Modes, _, empty) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -446,7 +443,7 @@
 	{ DataAddr = layout_addr(table_io_decl(RttiProcLabel)) },
 	code_info__assign_const_to_var(Var, const(data_addr_const(DataAddr))).
 unify_gen__generate_construction_2(reserved_address(RA),
-		Var, Args, _Modes, _, _, empty) -->
+		Var, Args, _Modes, _, empty) -->
 	( { Args = [] } ->
 		[]
 	;
@@ -456,15 +453,15 @@
 		unify_gen__generate_reserved_address(RA)).
 unify_gen__generate_construction_2(
 		shared_with_reserved_addresses(_RAs, ThisTag),
-		Var, Args, Modes, AditiInfo, GoalInfo, Code) -->
+		Var, Args, Modes, GoalInfo, Code) -->
 	% For shared_with_reserved_address, the sharing is only
 	% important for tag tests, not for constructions,
 	% so here we just recurse on the real representation.
 	unify_gen__generate_construction_2(ThisTag,
-		Var, Args, Modes, AditiInfo, GoalInfo, Code).
+		Var, Args, Modes, GoalInfo, Code).
 unify_gen__generate_construction_2(
 		pred_closure_tag(PredId, ProcId, EvalMethod),
-		Var, Args, _Modes, _AditiInfo, GoalInfo, Code) -->
+		Var, Args, _Modes, GoalInfo, Code) -->
 	% This code constructs or extends a closure.
 	% The structure of closures is defined in runtime/mercury_ho_call.h.
 
@@ -625,13 +622,6 @@
 				CallArgsDataAddr),
 			{ CallArgsRval =
 				const(data_addr_const(CallArgsDataAddr)) }
-		;
-			{ EvalMethod = (aditi_top_down) },
-			% XXX Need to work out how to encode the procedure
-			% name. The update goals which take aditi_top_down
-			% closures aren't implemented on the Aditi side anyway.
-			{ error(
-			"Sorry, not implemented: `aditi_top_down' closures") }
 		),
 		{ continuation_info__generate_closure_layout(
 			ModuleInfo, PredId, ProcId, ClosureInfo) },
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list