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