diff: cleanup of marker list handling

Fergus Henderson fjh at cs.mu.oz.au
Sun Nov 23 19:17:11 AEDT 1997


Hi,

Any objections to this change?

--------------------------------------------------

Clean up the handling of predicate markers (flags).

compiler/hlds_pred.m:
	Delete the `marker_status' type.
	It was just adding complexity which wasn't being used.
	Change the "markers list" field of the pred_info from a
	list(marker_status) to an abstract data type representing
	a set of markers. 
	Add new access predicates for this ADT.

	Currently the ADT is still implemented as a list, but it might
	be a good idea to eventually change it to be an int, using a
	different bit for each flag.

compiler/dnf.m:
	Don't bother to record `done(dnf)' markers, since they're not needed.

compiler/make_hlds.m:
	Change add_pred_marker so that it adds a single marker, rather
	than a list of markers.  Allowing a list of markers was just
	adding extra complexity which wasn't being used.

compiler/dnf.m:
compiler/higher_order.m:
compiler/hlds_out.m:
compiler/intermod.m:
compiler/lambda.m:
compiler/make_hlds.m:
compiler/mode_errors.m:
compiler/modecheck_call.m:
compiler/modes.m:
compiler/simplify.m:
compiler/stratify.m:
compiler/term_util.m:
compiler/termination.m:
compiler/typecheck.m:
compiler/unused_args.m:
	Update to use the new ADT.

cvs diff  compiler/dnf.m compiler/higher_order.m compiler/hlds_out.m compiler/hlds_pred.m compiler/intermod.m compiler/lambda.m compiler/make_hlds.m compiler/mode_errors.m compiler/modecheck_call.m compiler/modes.m compiler/simplify.m compiler/stratify.m compiler/term_util.m compiler/termination.m compiler/typecheck.m compiler/unused_args.m
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.23
diff -u -r1.23 dnf.m
--- dnf.m	1997/10/31 00:14:22	1.23
+++ dnf.m	1997/11/23 07:41:16
@@ -80,8 +80,8 @@
 		;
 			module_info_preds(ModuleInfo0, PredTable),
 			map__lookup(PredTable, PredId, PredInfo),
-			pred_info_get_marker_list(PredInfo, Markers),
-			list__member(request(dnf), Markers)
+			pred_info_get_markers(PredInfo, Markers),
+			check_marker(Markers, dnf)
 		)
 	->
 		dnf__transform_pred(PredId, MaybeNonAtomic,
@@ -103,19 +103,7 @@
 	map__lookup(PredTable0, PredId, PredInfo0),
 	pred_info_non_imported_procids(PredInfo0, ProcIds),
 	dnf__transform_procs(ProcIds, PredId, MaybeNonAtomic,
-		ModuleInfo0, ModuleInfo1, [], NewPredIds),
-
-	% We must look up the pred table again
-	% since dnf__transform_procs may have added new predicates
-	module_info_preds(ModuleInfo1, PredTable1),
-	map__lookup(PredTable1, PredId, PredInfo1),
-
-	pred_info_get_marker_list(PredInfo1, Markers1),
-	list__delete_all(Markers1, request(dnf), Markers2),
-	pred_info_set_marker_list(PredInfo1, [done(dnf) | Markers2], PredInfo),
-
-	map__det_update(PredTable1, PredId, PredInfo, PredTable),
-	module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo).
+		ModuleInfo0, ModuleInfo, [], NewPredIds).
 
 :- pred dnf__transform_procs(list(proc_id)::in, pred_id::in,
 	maybe(set(pred_proc_id))::in, module_info::in, module_info::out,
@@ -148,7 +136,7 @@
 		ModuleInfo0, ModuleInfo, ProcInfo, NewPredIds0, NewPredIds) :-
 	pred_info_name(PredInfo0, PredName),
 	pred_info_typevarset(PredInfo0, TVarSet),
-	pred_info_get_marker_list(PredInfo0, Markers),
+	pred_info_get_markers(PredInfo0, Markers),
 	proc_info_goal(ProcInfo0, Goal0),
 	proc_info_variables(ProcInfo0, VarSet),
 	proc_info_vartypes(ProcInfo0, VarTypes),
@@ -166,7 +154,7 @@
 				tvarset,
 				map(var, type),
 				varset,
-				list(marker_status)
+				pred_markers
 			).
 
 :- pred dnf__transform_goal(hlds_goal::in, instmap::in,
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.33
diff -u -r1.33 higher_order.m
--- higher_order.m	1997/09/01 14:01:46	1.33
+++ higher_order.m	1997/11/23 06:44:41
@@ -839,7 +839,7 @@
 	pred_info_typevarset(PredInfo0, TypeVars),
 	remove_listof_higher_order_args(Types0, 1, HOArgs, Types),
 	pred_info_context(PredInfo0, Context),
-	pred_info_get_marker_list(PredInfo0, MarkerList),
+	pred_info_get_markers(PredInfo0, MarkerList),
 	pred_info_get_goal_type(PredInfo0, GoalType),
 	Name = qualified(PredModule, PredName),
 	varset__init(EmptyVarSet),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.174
diff -u -r1.174 hlds_out.m
--- hlds_out.m	1997/10/13 08:09:43	1.174
+++ hlds_out.m	1997/11/23 07:42:21
@@ -445,7 +445,7 @@
 	{ pred_info_context(PredInfo, Context) },
 	{ pred_info_name(PredInfo, PredName) },
 	{ pred_info_import_status(PredInfo, ImportStatus) },
-	{ pred_info_get_marker_list(PredInfo, Markers) },
+	{ pred_info_get_markers(PredInfo, Markers) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 	mercury_output_pred_type(TVarSet, qualified(Module, PredName), ArgTypes,
 		no, Context),
@@ -459,11 +459,12 @@
 	io__write_string(", status: "),
 	hlds_out__write_import_status(ImportStatus),
 	io__write_string("\n"),
-	( { Markers = [] } ->
+	{ markers_to_marker_list(Markers, MarkerList) },
+	( { MarkerList = [] } ->
 		[]
 	;
 		io__write_string("% markers:"),
-		hlds_out__write_marker_list(Markers),
+		hlds_out__write_marker_list(MarkerList),
 		io__write_string("\n")
 	),
 	globals__io_lookup_string_option(verbose_dump_hlds, Verbose),
@@ -487,25 +488,13 @@
 		ImportStatus, ProcTable),
 	io__write_string("\n").
 
-:- pred hlds_out__write_marker_list(list(marker_status), io__state, io__state).
+:- pred hlds_out__write_marker_list(list(marker), io__state, io__state).
 :- mode hlds_out__write_marker_list(in, di, uo) is det.
 
 hlds_out__write_marker_list([]) --> [].
 hlds_out__write_marker_list([Marker | Markers]) -->
-	hlds_out__write_marker_status(Marker),
-	hlds_out__write_marker_list(Markers).
-
-:- pred hlds_out__write_marker_status(marker_status, io__state, io__state).
-:- mode hlds_out__write_marker_status(in, di, uo) is det.
-
-hlds_out__write_marker_status(request(Marker)) -->
-	io__write_string(" request("),
 	hlds_out__write_marker(Marker),
-	io__write_string(")").
-hlds_out__write_marker_status(done(Marker)) -->
-	io__write_string(" done("),
-	hlds_out__write_marker(Marker),
-	io__write_string(")").
+	hlds_out__write_marker_list(Markers).
 
 hlds_out__marker_name(infer_type, "infer_type").
 hlds_out__marker_name(infer_modes, "infer_modes").
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.37
diff -u -r1.37 hlds_pred.m
--- hlds_pred.m	1997/10/31 00:14:25	1.37
+++ hlds_pred.m	1997/11/23 07:57:41
@@ -170,36 +170,23 @@
 	--->	predicate
 	;	function.
 
-	% Predicates can be marked, to request that transformations be
-	% performed on them and to record that these transformations have been
-	% done and are still valid.
-	%
-	% The code that performs the transformation should remove the request
-	% marker status and substitute the done marker status.
-	%
-	% In the future, we can use markers to request the use of a different
-	% code generator for certain predicates, e.g. to generate RL instead
-	% of normal C code, with a C code stub to link to the RL.
+	% Predicates can be marked with various boolean flags, called
+	% "markers".
+
+	% an abstract set of markers.
+:- type pred_markers. 
 
 :- type marker
 	--->	infer_type	% Requests type inference for the predicate
 				% These markers are inserted by make_hlds
 				% for undeclared predicates.
-				% The `done' status could be meaningful,
-				% but it is currently not used.
 	;	infer_modes	% Requests mode inference for the predicate
 				% These markers are inserted by make_hlds
 				% for undeclared predicates.
-				% The `done' status could be meaningful,
-				% but it is currently not used.
 	;	obsolete	% Requests warnings if this predicate is used.
 				% Used for pragma(obsolete).
-				% The `done' status is not meaningful.
 	;	inline		% Requests that this be predicate be inlined.
 				% Used for pragma(inline).
-				% Since the transformation affects *other*
-				% predicates, the `done' status is not
-				% meaningful.
 	;	no_inline	% Requests that this be predicate not be 
 				% inlined.
 				% Used for pragma(no_inline).
@@ -222,29 +209,19 @@
 				% ProcInfos directly.
 	;	terminates	% The user guarantees that this predicate
 				% will terminate for all (finite?) input
-				% The `done' status could be meaningful,
-				% but it is currently not used.
 	;	does_not_terminate
 				% States that this predicate does not
 				% terminate.  This is useful for pragma c
 				% code, which the compiler assumes to be
 				% terminating.
-				% The `done' status could be meaningful,
-				% but it is currently not used.
 	;	check_termination
 				% The user requires the compiler to guarantee
 				% the termination of this predicate.
 				% If the compiler cannot guarantee termination
 				% then it must give an error message.
-				% The `done' status could be meaningful,
-				% but it is currently not used.
 	.
 	
 
-:- type marker_status
-	--->	request(marker)
-	;	done(marker).
-
 
 	% hlds_pred__define_new_pred(Goal, CallGoal, Args, InstMap, PredName,
 	% 	TVarSet, VarTypes, VarSet, Markers, ModuleInfo0, ModuleInfo,
@@ -255,7 +232,7 @@
 	% polymorphism.m.
 :- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(var),
 		instmap, string, tvarset, map(var, type), varset, 
-		list(marker_status), module_info, module_info, pred_proc_id).
+		pred_markers, module_info, module_info, pred_proc_id).
 :- mode hlds_pred__define_new_pred(in, out, in, in, in, 
 		in, in, in, in, in, out, out) is det.
 
@@ -264,19 +241,19 @@
 
 :- pred pred_info_init(module_name, sym_name, arity, tvarset, list(type),
 	condition, term__context, clauses_info, import_status,
-	list(marker_status), goal_type, pred_or_func, pred_info).
+	pred_markers, goal_type, pred_or_func, pred_info).
 :- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, out)
 	is det.
 
 :- pred pred_info_create(module_name, sym_name, tvarset, list(type),
-	condition, term__context, import_status, list(marker_status),
+	condition, term__context, import_status, pred_markers,
 	pred_or_func, proc_info, proc_id, pred_info).
 :- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, out, out)
 	is det.
 
 :- pred pred_info_set(tvarset, list(type), condition, clauses_info, proc_table,
 	term__context, module_name, string, arity, import_status,
-	tvarset, goal_type, list(marker_status), pred_or_func, pred_info).
+	tvarset, goal_type, pred_markers, pred_or_func, pred_info).
 :- mode pred_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
 	out) is det.
 
@@ -371,15 +348,33 @@
 :- pred pred_info_requested_no_inlining(pred_info).
 :- mode pred_info_requested_no_inlining(in) is semidet.
 
-:- pred pred_info_get_marker_list(pred_info, list(marker_status)).
-:- mode pred_info_get_marker_list(in, out) is det.
-
-:- pred pred_info_set_marker_list(pred_info, list(marker_status), pred_info).
-:- mode pred_info_set_marker_list(in, in, out) is det.
-
 :- pred pred_info_get_is_pred_or_func(pred_info, pred_or_func).
 :- mode pred_info_get_is_pred_or_func(in, out) is det.
 
+:- type pred_markers.
+
+:- pred pred_info_get_markers(pred_info, pred_markers).
+:- mode pred_info_get_markers(in, out) is det.
+
+:- pred pred_info_set_markers(pred_info, pred_markers, pred_info).
+:- mode pred_info_set_markers(in, in, out) is det.
+
+	% create an empty set of markers
+:- pred init_markers(pred_markers).
+:- mode init_markers(out) is det.
+
+	% check if a particular is in the set
+:- pred check_marker(pred_markers, marker).
+:- mode check_marker(in, in) is semidet.
+
+	% a a marker to the set
+:- pred add_marker(pred_markers, marker, pred_markers).
+:- mode add_marker(in, in, out) is det.
+
+	% convert the set to a list
+:- pred markers_to_marker_list(pred_markers, list(marker)).
+:- mode markers_to_marker_list(in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -441,9 +436,7 @@
 			goal_type,	% whether the goals seen so far for
 					% this pred are clauses, 
 					% pragma(c_code, ...) decs, or none
-			list(marker_status),
-					% records which transformations
-					% have been done or are to be done
+			pred_markers,	% various boolean flags
 			pred_or_func	% whether this "predicate" was really
 					% a predicate or a function
 		).
@@ -586,23 +579,34 @@
 	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, M, N).
 
 pred_info_requested_inlining(PredInfo0) :-
-	pred_info_get_marker_list(PredInfo0, Markers),
-	list__member(request(inline), Markers).
+	pred_info_get_markers(PredInfo0, Markers),
+	check_marker(Markers, inline).
 
 pred_info_requested_no_inlining(PredInfo0) :-
-	pred_info_get_marker_list(PredInfo0, Markers),
-	list__member(request(no_inline), Markers).
+	pred_info_get_markers(PredInfo0, Markers),
+	check_marker(Markers, no_inline).
 
-pred_info_get_marker_list(PredInfo, Markers) :-
+pred_info_get_markers(PredInfo, Markers) :-
 	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, Markers, _).
 
-pred_info_set_marker_list(PredInfo0, Markers, PredInfo) :-
+pred_info_set_markers(PredInfo0, Markers, PredInfo) :-
 	PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, N),
 	PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers, N).
 
 pred_info_get_is_pred_or_func(PredInfo, IsPredOrFunc) :-
 	PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _,
 			IsPredOrFunc).
+
+:- type pred_markers == list(marker).
+
+init_markers([]).
+
+check_marker(Markers, Marker) :-
+	list__member(Marker, Markers).
+
+add_marker(Markers, Marker, [Marker | Markers]).
+
+markers_to_marker_list(Markers, Markers).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.35
diff -u -r1.35 intermod.m
--- intermod.m	1997/11/21 00:38:14	1.35
+++ intermod.m	1997/11/23 08:00:45
@@ -179,10 +179,8 @@
 			(
 				{ inlining__is_simple_goal(Goal,
 						InlineThreshold) },
-				{ pred_info_get_marker_list(PredInfo0, 
-					Markers) },
-				{ \+ list__member(request(no_inline), 
-					Markers) }
+				{ pred_info_get_markers(PredInfo0, Markers) },
+				{ \+ check_marker(Markers, no_inline) }
 			;
 				{ pred_info_requested_inlining(PredInfo0) }
 			;
@@ -454,8 +452,8 @@
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
 	{ pred_info_import_status(PredInfo, Status) },
 	{ pred_info_procids(PredInfo, ProcIds) },
-	{ pred_info_get_marker_list(PredInfo, Markers) },
-	( { list__member(request(infer_modes), Markers) } ->
+	{ pred_info_get_markers(PredInfo, Markers) },
+	( { check_marker(Markers, infer_modes) } ->
 		% Don't write this pred if it calls preds without mode decls.
 		{ DoWrite = no }
 	; 
@@ -921,9 +919,10 @@
 	{ pred_info_module(PredInfo, Module) },
 	{ pred_info_name(PredInfo, Name) },
 	{ SymName = qualified(Module, Name) },
-	{ pred_info_get_marker_list(PredInfo, Markers) },
+	{ pred_info_get_markers(PredInfo, Markers) },
+	{ markers_to_marker_list(Markers, MarkerList) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
-	intermod__write_pragmas(SymName, Arity, Markers, PredOrFunc),
+	intermod__write_pragmas(SymName, Arity, MarkerList, PredOrFunc),
 	{ pred_info_clauses_info(PredInfo, ClausesInfo) },
 	{ ClausesInfo = clauses_info(Varset, _, _VarTypes, HeadVars, Clauses) },
 		% handle pragma(c_code, ...) separately
@@ -939,17 +938,11 @@
 	),
 	intermod__write_preds(ModuleInfo, PredIds).
 
-:- pred intermod__write_pragmas(sym_name::in, int::in, list(marker_status)::in,
+:- pred intermod__write_pragmas(sym_name::in, int::in, list(marker)::in,
 		pred_or_func::in, io__state::di, io__state::uo) is det.
 
 intermod__write_pragmas(_, _, [], _) --> [].
-intermod__write_pragmas(SymName, Arity, [MarkerStatus | Markers], PredOrFunc)
-		-->
-	(
-		{ MarkerStatus = request(Marker) }
-	;
-		{ MarkerStatus = done(Marker) }
-	),
+intermod__write_pragmas(SymName, Arity, [Marker | Markers], PredOrFunc) -->
 	(
 		\+ (
 			% Since the inferred declarations are output, these
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.32
diff -u -r1.32 lambda.m
--- lambda.m	1997/09/01 14:02:47	1.32
+++ lambda.m	1997/11/23 07:47:12
@@ -362,9 +362,10 @@
 			PermutedArgModes, Detism, LambdaGoal, LambdaContext,
 			TVarMap, ProcInfo),
 
+		init_markers(Markers),
 		pred_info_create(ModuleName, PredName, TVarSet, ArgTypes,
-			true, LambdaContext, local, [], PredOrFunc, ProcInfo,
-			ProcId, PredInfo),
+			true, LambdaContext, local, Markers, PredOrFunc,
+			ProcInfo, ProcId, PredInfo),
 
 		% save the new predicate in the predicate table
 
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.244
diff -u -r1.244 make_hlds.m
--- make_hlds.m	1997/11/23 05:18:21	1.244
+++ make_hlds.m	1997/11/23 08:13:38
@@ -297,21 +297,21 @@
 	;
 		{ Pragma = memo(Name, Arity) },
 		add_pred_marker(Module0, "memo", Name, Arity, Context,
-			[request(memo)], [], Module1),
+			memo, [], Module1),
 		add_stratified_pred(Module1, "memo", Name, Arity, Context, 
 			Module)
 	;
 		{ Pragma = inline(Name, Arity) },
 		add_pred_marker(Module0, "inline", Name, Arity, Context,
-			[request(inline)], [request(no_inline)], Module)
+			inline, [no_inline], Module)
 	;
 		{ Pragma = no_inline(Name, Arity) },
 		add_pred_marker(Module0, "no_inline", Name, Arity, Context,
-			[request(no_inline)], [request(inline)], Module)
+			no_inline, [inline], Module)
 	;
 		{ Pragma = obsolete(Name, Arity) },
 		add_pred_marker(Module0, "obsolete", Name, Arity, Context,
-			[request(obsolete)], [], Module)
+			obsolete, [], Module)
 	;
 		{ Pragma = export(Name, PredOrFunc, Modes, C_Function) },
 		{ module_info_get_predicate_table(Module0, PredTable) },
@@ -445,20 +445,18 @@
 	;
 		{ Pragma = terminates(Name, Arity) },
 		add_pred_marker(Module0, "terminates", Name, Arity,
-			Context, [request(terminates)],
-			[request(check_termination), 
-			request(does_not_terminate)], Module)
+			Context, terminates,
+			[check_termination, does_not_terminate], Module)
 	;
 		{ Pragma = does_not_terminate(Name, Arity) },
 		add_pred_marker(Module0, "does_not_terminate", Name, Arity,
-			Context, [request(does_not_terminate)],
-			[request(check_termination), request(terminates)], 
-			Module)
+			Context, does_not_terminate,
+			[check_termination, terminates], Module)
 	;
 		{ Pragma = check_termination(Name, Arity) },
 		add_pred_marker(Module0, "check_termination", Name, Arity, 
-			Context, [request(check_termination)], 
-			[request(terminates), request(does_not_terminate)], 
+			Context, check_termination, 
+			[terminates, does_not_terminate], 
 			Module)
 	).
 
@@ -617,18 +615,18 @@
 %-----------------------------------------------------------------------------%
 
 	% add_pred_marker(ModuleInfo0, PragmaName, Name, Arity, Context, 
-	% 	Markers, ConflictMarkers, ModuleInfo, IO0, IO)
-	% Adds Markers to the marker list of pred with give Name and
-	% Arity, updating the ModuleInfo. If the pred does not exist,
+	% 	Marker, ConflictMarkers, ModuleInfo, IO0, IO)
+	% Adds Marker to the marker list of the pred(s) with give Name and
+	% Arity, updating the ModuleInfo. If the named pred does not exist,
 	% or the pred already has a marker in ConflictMarkers, report
 	% an error.
 
 :- pred add_pred_marker(module_info, string, sym_name, arity,
-	term__context, list(marker_status), list(marker_status), 
-	module_info, io__state, io__state).
+	term__context, marker, list(marker), module_info,
+	io__state, io__state).
 :- mode add_pred_marker(in, in, in, in, in, in, in, out, di, uo) is det.
 
-add_pred_marker(Module0, PragmaName, Name, Arity, Context, Markers,
+add_pred_marker(Module0, PragmaName, Name, Arity, Context, Marker,
 		ConflictMarkers, Module) --> 
 	{ module_info_get_predicate_table(Module0, PredTable0) },
 	% check that the pragma is module qualified.
@@ -641,7 +639,7 @@
 			Arity, PredIds) }
 	->
 		{ predicate_table_get_preds(PredTable0, Preds0) },
-		{ pragma_add_markers(Preds0, PredIds, Markers, Preds) },
+		{ pragma_add_marker(Preds0, PredIds, Marker, Preds) },
 		{ predicate_table_set_preds(PredTable0, Preds, 
 			PredTable) },
 		{ module_info_set_predicate_table(Module0, PredTable, 
@@ -1141,9 +1139,10 @@
 		{ Module1 = Module0 },
 		{ module_info_get_predicate_table(Module1, PredicateTable0) },
 		{ clauses_info_init(Arity, ClausesInfo) },
+		{ init_markers(Markers) },
 		{ pred_info_init(ModuleName, PredName, Arity, TVarSet, Types,
-				Cond, Context, ClausesInfo, Status, [], none,	
-				PredOrFunc, PredInfo0) },
+				Cond, Context, ClausesInfo, Status, Markers,
+				none, PredOrFunc, PredInfo0) },
 		(
 			{ predicate_table_search_pf_m_n_a(PredicateTable0,
 				PredOrFunc, MNameOfPred, PName, Arity,
@@ -1321,8 +1320,10 @@
 	Cond = true,
 	clauses_info_init(Arity, ClausesInfo0),
 	adjust_special_pred_status(Status0, SpecialPredId, Status),
+	init_markers(Markers),
 	pred_info_init(ModuleName, PredName, Arity, TVarSet, ArgTypes, Cond,
-		Context, ClausesInfo0, Status, [], none, predicate, PredInfo0),
+		Context, ClausesInfo0, Status, Markers, none, predicate,
+		PredInfo0),
 	ArgLives = no,
 	add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
 		ArgLives, yes(Det), Context, PredInfo, _),
@@ -1468,9 +1469,12 @@
 	term__var_list_to_term_list(TypeVars, Types),
 	Cond = true,
 	clauses_info_init(Arity, ClausesInfo),
+	init_markers(Markers0),
 	pred_info_init(ModuleName, PredName, Arity, TVarSet, Types, Cond,
-		Context, ClausesInfo, local, [], none, PredOrFunc, PredInfo0),
-	pred_info_set_marker_list(PredInfo0, [request(infer_type)], PredInfo),
+		Context, ClausesInfo, local, Markers0, none, PredOrFunc,
+		PredInfo0),
+	add_marker(Markers0, infer_type, Markers),
+	pred_info_set_markers(PredInfo0, Markers, PredInfo),
 	(
 		\+ predicate_table_search_pf_sym_arity(PredicateTable0,
 			PredOrFunc, PredName, Arity, _)
@@ -1656,10 +1660,9 @@
 		% and if so, set the `infer_modes' flag for that predicate
 		%
 		( ModeIds = [] ->
-			pred_info_get_marker_list(PredInfo5, Markers0),
-			Markers = [request(infer_modes) | Markers0],
-			pred_info_set_marker_list(PredInfo5, Markers,
-				PredInfo)
+			pred_info_get_markers(PredInfo5, Markers0),
+			add_marker(Markers0, infer_modes, Markers),
+			pred_info_set_markers(PredInfo5, Markers, PredInfo)
 		;
 			PredInfo = PredInfo5
 		),
@@ -1854,56 +1857,44 @@
 
 %---------------------------------------------------------------------------%
 
-	% For each pred_id in the list, check that the given markers are
-	% present in the list of conflicting markers in the corresponding 
-	% pred_info.
+	% For each pred_id in the list, check whether markers
+	% present in the list of conflicting markers are
+	% also present in the corresponding pred_info.
 	% The bool indicates whether there was a conflicting marker
 	% present.
 
-:- pred pragma_check_markers(pred_table, list(pred_id), list(marker_status),
-	bool).
+:- pred pragma_check_markers(pred_table, list(pred_id), list(marker), bool).
 :- mode pragma_check_markers(in, in, in, out) is det.
 
 pragma_check_markers(_, [], _, no).
 pragma_check_markers(PredTable, [PredId | PredIds], ConflictList, 
 		WasConflict) :-
 	map__lookup(PredTable, PredId, PredInfo),
-	pred_info_get_marker_list(PredInfo, MarkerList),
-	pragma_check_markers(PredTable, PredIds, ConflictList, WasConflicts0),
-	( list__delete_elems(ConflictList, MarkerList, ConflictList) ->
-		WasConflict = WasConflicts0
-	;
+	pred_info_get_markers(PredInfo, Markers),
+	(
+		list__member(Marker, ConflictList),
+		check_marker(Markers, Marker)
+	->
 		WasConflict = yes
+	;
+		pragma_check_markers(PredTable, PredIds, ConflictList,
+			WasConflict)
 	).
 
 	% For each pred_id in the list, add the given markers to the
 	% list of markers in the corresponding pred_info.
 
-:- pred pragma_add_markers(pred_table, list(pred_id), list(marker_status),
-	pred_table).
-:- mode pragma_add_markers(in, in, in, out) is det.
+:- pred pragma_add_marker(pred_table, list(pred_id), marker, pred_table).
+:- mode pragma_add_marker(in, in, in, out) is det.
 
-pragma_add_markers(PredTable, [], _, PredTable).
-pragma_add_markers(PredTable0, [PredId | PredIds], Markers, PredTable) :-
+pragma_add_marker(PredTable, [], _, PredTable).
+pragma_add_marker(PredTable0, [PredId | PredIds], Marker, PredTable) :-
 	map__lookup(PredTable0, PredId, PredInfo0),
-	pred_info_get_marker_list(PredInfo0, MarkerList0),
-	pragma_add_markers_2(Markers, MarkerList0, MarkerList),
-	pred_info_set_marker_list(PredInfo0, MarkerList, PredInfo),
+	pred_info_get_markers(PredInfo0, Markers0),
+	add_marker(Markers0, Marker, Markers),
+	pred_info_set_markers(PredInfo0, Markers, PredInfo),
 	map__det_update(PredTable0, PredId, PredInfo, PredTable1),
-	pragma_add_markers(PredTable1, PredIds, Markers, PredTable).
-
-:- pred pragma_add_markers_2(list(marker_status), list(marker_status),
-	list(marker_status)).
-:- mode pragma_add_markers_2(in, in, out) is det.
-
-pragma_add_markers_2([], MarkerList, MarkerList).
-pragma_add_markers_2([Marker | Markers], MarkerList0, MarkerList) :-
-	( list__member(Marker, MarkerList0) ->
-		MarkerList1 = MarkerList0
-	;
-		MarkerList1 = [Marker | MarkerList0]
-	),
-	pragma_add_markers_2(Markers, MarkerList1, MarkerList).
+	pragma_add_marker(PredTable1, PredIds, Marker, PredTable).
 
 %---------------------------------------------------------------------------%
 
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.48
diff -u -r1.48 mode_errors.m
--- mode_errors.m	1997/11/23 05:18:24	1.48
+++ mode_errors.m	1997/11/23 07:22:36
@@ -825,8 +825,8 @@
 write_mode_inference_messages([], _) --> [].
 write_mode_inference_messages([PredId | PredIds], ModuleInfo) -->
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-	{ pred_info_get_marker_list(PredInfo, Markers) },
-	( { list__member(request(infer_modes), Markers) } ->
+	{ pred_info_get_markers(PredInfo, Markers) },
+	( { check_marker(Markers, infer_modes) } ->
 		{ pred_info_procedures(PredInfo, Procs) },
 		{ map__keys(Procs, ProcIds) },
 		write_mode_inference_messages_2(ProcIds, Procs, PredInfo)
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.18
diff -u -r1.18 modecheck_call.m
--- modecheck_call.m	1997/11/23 05:18:25	1.18
+++ modecheck_call.m	1997/11/23 07:23:18
@@ -175,14 +175,14 @@
 	maybe_add_default_mode(PredInfo0, PredInfo),
 	pred_info_procedures(PredInfo, Procs),
 	map__keys(Procs, ProcIds),
-	pred_info_get_marker_list(PredInfo, Markers),
+	pred_info_get_markers(PredInfo, Markers),
 
 		% In order to give better diagnostics, we handle the
 		% cases where there are zero or one modes for the called
 		% predicate specially.
 	(
 		ProcIds = [],
-		\+ list__member(request(infer_modes), Markers)
+		\+ check_marker(Markers, infer_modes)
 	->
 		set__init(WaitingVars),
 		mode_info_error(WaitingVars, mode_error_no_mode_decl,
@@ -192,7 +192,7 @@
 		ExtraGoals = no_extra_goals
 	;
 		ProcIds = [ProcId],
-		\+ list__member(request(infer_modes), Markers)
+		\+ check_marker(Markers, infer_modes)
 	->
 		TheProcId = ProcId,
 		map__lookup(Procs, ProcId, ProcInfo),
@@ -265,8 +265,8 @@
 	%
 	mode_info_get_preds(ModeInfo0, Preds),
 	map__lookup(Preds, PredId, PredInfo),
-	pred_info_get_marker_list(PredInfo, Markers),
-	( list__member(request(infer_modes), Markers) ->
+	pred_info_get_markers(PredInfo, Markers),
+	( check_marker(Markers, infer_modes) ->
 		insert_new_mode(PredId, ArgVars, TheProcId,
 			ModeInfo0, ModeInfo1),
 		% we don't yet know the final insts for the newly created mode
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.207
diff -u -r1.207 modes.m
--- modes.m	1997/11/23 05:18:27	1.207
+++ modes.m	1997/11/23 07:52:06
@@ -380,8 +380,8 @@
 		{ Changed1 = Changed0 },
 		{ NumErrors1 = NumErrors0 }
 	;
-		{ pred_info_get_marker_list(PredInfo0, Markers) },
-		( { list__member(request(infer_modes), Markers) } ->
+		{ pred_info_get_markers(PredInfo0, Markers) },
+		( { check_marker(Markers, infer_modes) } ->
 			write_pred_progress_message("% Mode-analysing ",
 				PredId, ModuleInfo0)
 		;
@@ -582,8 +582,8 @@
 			Context, LiveVars, InstMap0, ModeInfo0),
 	mode_info_set_changed_flag(Changed0, ModeInfo0, ModeInfo1),
 	modecheck_goal(Body0, Body, ModeInfo1, ModeInfo2),
-	pred_info_get_marker_list(PredInfo, Markers),
-	( list__member(request(infer_modes), Markers) ->
+	pred_info_get_markers(PredInfo, Markers),
+	( check_marker(Markers, infer_modes) ->
 		InferModes = yes
 	;
 		InferModes = no
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.46
diff -u -r1.46 simplify.m
--- simplify.m	1997/09/01 14:04:39	1.46
+++ simplify.m	1997/11/23 07:25:39
@@ -430,8 +430,8 @@
 		simplify_do_warn(Info0),
 		simplify_info_get_module_info(Info0, ModuleInfo),
 		module_info_pred_info(ModuleInfo, PredId, PredInfo),
-		pred_info_get_marker_list(PredInfo, Markers),
-		list__member(request(obsolete), Markers),
+		pred_info_get_markers(PredInfo, Markers),
+		check_marker(Markers, obsolete),
 		%
 		% Don't warn about directly recursive calls.
 		% (That would cause spurious warnings, particularly
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.10
diff -u -r1.10 stratify.m
--- stratify.m	1997/09/01 14:04:49	1.10
+++ stratify.m	1997/11/23 07:26:18
@@ -296,16 +296,15 @@
 	{ PredProcId = proc(PredId, ProcId) },
 	{ module_info_pred_info(Module0, PredId, PredInfo) },
 	globals__io_lookup_bool_option(warn_non_stratification, Warn),
-	{ pred_info_get_marker_list(PredInfo, Markers) },
+	{ pred_info_get_markers(PredInfo, Markers) },
 	( 	
-		{ list__member(request(memo), Markers) }
+		{ check_marker(Markers, memo) }
 	->
 		{ Error = yes }
 	;
 		{ Error = no }
 	),
-	(	( { Error = yes 
-		; Warn = yes } ),
+	(	( { Error = yes ; Warn = yes } ),
 		{ map__search(HOInfo, PredProcId, HigherOrderInfo) }
 	->
 		{ HigherOrderInfo = info(HOCalls, _) },
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.2
diff -u -r1.2 term_util.m
--- term_util.m	1997/10/09 09:39:20	1.2
+++ term_util.m	1997/11/23 07:27:29
@@ -429,7 +429,7 @@
 		{ pred_info_set_procedures(PredInfo0, ProcTable, PredInfo) },
 		{ map__det_update(PredTable0, PredId, PredInfo, PredTable) },
 		{ module_info_set_preds(Module0, PredTable, Module1) },
-		{ pred_info_get_marker_list(PredInfo, MarkerList) },
+		{ pred_info_get_markers(PredInfo, Markers) },
 		globals__io_lookup_bool_option(check_termination,
 			NormalErrors),
 		globals__io_lookup_bool_option(verbose_check_termination,
@@ -443,14 +443,15 @@
 		% then the error is printed out for each of them.
 		( 
 			{ \+ pred_info_is_imported(PredInfo) },
-			{ list__member(request(check_termination), MarkerList) }
+			{ check_marker(Markers, check_termination) }
 		->
 			term_errors__output(PredId, ProcId, Module1,
 				Success),
 			% Success is only no if there was no error
 			% defined for this predicate.  As we just set the
 			% error, term_errors__output should succeed.
-			{ require(unify(Success, yes), "term_util.m: Unexpected value in do_ppid_check_terminates") },
+			{ require(unify(Success, yes),
+		"term_util.m: Unexpected value in do_ppid_check_terminates") },
 			io__set_exit_status(1),
 			{ module_info_incr_errors(Module1, Module2) }
 		; % else if
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.4
diff -u -r1.4 termination.m
--- termination.m	1997/10/16 15:09:48	1.4
+++ termination.m	1997/11/23 07:28:35
@@ -238,7 +238,7 @@
 	pred_info_import_status(PredInfo0, ImportStatus),
 	pred_info_context(PredInfo0, Context),
 	pred_info_procedures(PredInfo0, ProcTable0),
-	pred_info_get_marker_list(PredInfo0, Markers),
+	pred_info_get_markers(PredInfo0, Markers),
 	map__keys(ProcTable0, ProcIds),
 	( 
 		% It is possible for compiler generated/mercury builtin
@@ -254,7 +254,7 @@
 		; ImportStatus = pseudo_exported
 		)
 	->
-		( list__member(request(terminates), Markers) ->
+		( check_marker(Markers, terminates) ->
 			MaybeFind = no,
 			ReplaceTerminate = yes,
 			MaybeError = no,
@@ -280,10 +280,10 @@
 		% source file is compiled, so it cannot be depended upon. 
 		(
 		    (
-			list__member(request(terminates), Markers)
+			check_marker(Markers, terminates)
 		    ; 
 			MakeOptInt = no,
-			list__member(request(check_termination), Markers)
+			check_marker(Markers, check_termination)
 		    )
 		->
 			change_procs_terminate(ProcIds, no, yes, no, 
@@ -311,7 +311,7 @@
 		% here, and these import_status' refer to abstract types.
 		error("termination__check_preds: Unexpected import status of a predicate")
 	),
-	( list__member(request(does_not_terminate), Markers) ->
+	( check_marker(Markers, does_not_terminate) ->
 		MaybeFind1 = no,
 		ReplaceTerminate1 = dont_know,
 		MaybeError1 = yes(Context - does_not_term_pragma(PredId)),
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.218
diff -u -r1.218 typecheck.m
--- typecheck.m	1997/11/13 06:27:30	1.218
+++ typecheck.m	1997/11/23 07:29:28
@@ -426,8 +426,8 @@
 	        MaybePredInfo = no,
 		Changed = no
 	    ;
-		pred_info_get_marker_list(PredInfo0, Markers),
-		( list__member(request(infer_type), Markers) ->
+		pred_info_get_markers(PredInfo0, Markers),
+		( check_marker(Markers, infer_type) ->
 			% For a predicate whose type is inferred,
 			% the predicate is allowed to bind the type
 			% variables in the head of the predicate's
@@ -2874,9 +2874,9 @@
 write_inference_messages([], _) --> [].
 write_inference_messages([PredId | PredIds], ModuleInfo) -->
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-	{ pred_info_get_marker_list(PredInfo, Markers) },
+	{ pred_info_get_markers(PredInfo, Markers) },
 	(
-		{ list__member(request(infer_type), Markers) },
+		{ check_marker(Markers, infer_type) },
 		{ module_info_predids(ModuleInfo, ValidPredIds) },
 		{ list__member(PredId, ValidPredIds) }
 	->
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.35
diff -u -r1.35 unused_args.m
--- unused_args.m	1997/09/01 14:05:44	1.35
+++ unused_args.m	1997/11/23 07:50:42
@@ -883,12 +883,12 @@
 	remove_listof_elements(ArgTypes0, 1, UnusedArgs, ArgTypes),
 	pred_info_context(PredInfo0, Context),
 	pred_info_clauses_info(PredInfo0, ClausesInfo),
-	pred_info_get_marker_list(PredInfo0, MarkerList),
+	pred_info_get_markers(PredInfo0, Markers),
 	pred_info_get_goal_type(PredInfo0, GoalType),
 		% *** This will need to be fixed when the condition
 		%	field of the pred_info becomes used.
 	pred_info_init(PredModule, qualified(PredModule, Name), Arity, Tvars,
-		ArgTypes, true, Context, ClausesInfo, Status, MarkerList,
+		ArgTypes, true, Context, ClausesInfo, Status, Markers,
 		GoalType, PredOrFunc, PredInfo1),
 	pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo).
 

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.



More information about the developers mailing list