mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-22 04:43:53 +00:00
b2ba2dd917
The motivation for this diff is something I saw when I fixed the bug in
equiv_type_hlds.m on aug 13. During the bootcheck to verify the bug fix,
I enabled the end-of-front-end HLDS dump, and I saw that one module,
deep_profiler/display_report.m, had some references to MISSING_INSTs
in its HLDS dump. Since these could be signs of a bug in mode analysis,
I tracked them down. It turns out that the cause was an incompatibility
between the code that existed in error_msg_inst.m before that fix,
and the new code there added by that fix. But ironically, to find that
incompatibility, I first had to extend error_msg_inst.m's functionality
still further, specifically to make it possible to use it to write out insts
in HLDS dumps.
The reason for this need is that that the old code for dumping out insts
left a lot to be desired. It ignored (as in, it never wrote out) some parts
of specific kinds insts, such as the types in typed insts, without which
some parts of HLDS dumps did not make sense. For example, the ground inst
table in the HLDS dump of display_report.m contained several keys whose
printed versions were identical, seemingly indicating a bug in the code
that added new entries to that table (since it is supposed to add a new entry
to the table if the relevant key does not yet exist in the table). It turns
out that there was no bug; the keys differed, but only in the types.
compiler/error_msg_inst.m:
Fix the incompatibility, and document both it, and its solution.
Besides error_msg_inst, export a new function error_msg_inst_name,
which does the same thing for inst_names as error_msg_inst does for insts.
Add a flag to both functions that specifies whether the intended use
of the return value is in an error message (whose audience is usually
an ordinary Mercury user) or a HLDS dump (whose audience is always
a Mercury developer). Include details such as the types in typed insts,
and the structure of the compiler-generated inst names generally,
which involve concepts that users do not know about, in the output
only if the flag says the audience is Mercury developers.
When printing out type or inst variables, use their actual names
if these are available. To make this possible, require the callers
of error_msg_{inst,inst_name} to provide tvarsets and inst_varsets,
instead of always using empty varsets. The caller may still pass
empty varsets if cannot do better than that, but most callers can,
and now do pass valid varsets.
compiler/hlds_out_goal.m:
Since we now want to pass a valid tvarset to error_msg_inst.m
when printing the insts in goals' instmap_deltas, we need to pass around
the tvarset, as well as the inst_varset, of the procedure that the goal
was taken from. Instead of adding yet another parameter to all the affected
predicates, replace all the existing parameters that have the same role
(of which there were already about half a dozen) with a parameter
of a new type named hlds_out_info_goal, which contains the values of
all these old parameters, and the new one.
compiler/hlds_out_inst_table.m:
Use the same setting to govern whether we use error_msg_inst.m's
facilities for writing out insts and inst names in both the keys
and the values of the various inst tables.
compiler/simplify_info.m:
Include tvarsets in simplify_infos, since dumping out goals during
simplification pass can now use this information.
compiler/add_clause.m:
compiler/add_mutable_aux_preds.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/direct_arg_in_out.m:
compiler/format_call.m:
compiler/goal_expr_to_goal.m:
compiler/hlds_out_pred.m:
compiler/inst_abstract_unify.m:
compiler/inst_lookup.m:
compiler/intermod.m:
compiler/lco.m:
compiler/liveness.m:
compiler/make_hlds_warn.m:
compiler/mode_errors.m:
compiler/pd_debug.m:
compiler/prog_mode.m:
compiler/push_goals_together.m:
compiler/saved_vars.m:
compiler/simplify_goal.m:
compiler/simplify_goal_conj.m:
compiler/simplify_proc.m:
compiler/stack_opt.m:
compiler/superhomogeneous.m:
compiler/unneeded_code.m:
Conform to the changes above.
982 lines
38 KiB
Mathematica
982 lines
38 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2012 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: make_hlds_warn.m.
|
|
%
|
|
% Generate whatever warnings the module being transformed to HLDS deserves.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module hlds.make_hlds.make_hlds_warn.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.quantification.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_foreign.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Warn about variables with overlapping scopes.
|
|
%
|
|
:- pred add_quant_warnings(pf_sym_name_arity::in, prog_varset::in,
|
|
list(quant_warning)::in, list(error_spec)::in, list(error_spec)::out)
|
|
is det.
|
|
|
|
% Have we seen a quantifier with a nonempty list of variables,
|
|
% either in the form of a "some [Vars]" scope, or an if-then-else
|
|
% with a similarly nonempty list of variables being quantified
|
|
% across the condition and then then-part?
|
|
:- type maybe_seen_quant
|
|
---> have_not_seen_quant
|
|
; have_seen_quant.
|
|
|
|
% Warn about variables which occur only once but don't start with
|
|
% an underscore, or about variables which do start with an underscore
|
|
% but occur more than once, or about variables that do not occur in
|
|
% target language code strings when they should.
|
|
%
|
|
:- pred warn_singletons(module_info::in, pf_sym_name_arity::in,
|
|
prog_varset::in, hlds_goal::in, maybe_seen_quant::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
% warn_singletons_in_pragma_foreign_proc checks to see if each variable
|
|
% is mentioned at least once in the foreign code fragments that ought to
|
|
% mention it. If not, it gives a warning.
|
|
%
|
|
% (Note that for some foreign languages it might not be appropriate
|
|
% to do this check, or you may need to add a transformation to map
|
|
% Mercury variable names into identifiers for that foreign language).
|
|
%
|
|
:- pred warn_singletons_in_pragma_foreign_proc(module_info::in,
|
|
pragma_foreign_proc_impl::in, foreign_language::in,
|
|
list(maybe(foreign_arg_name_mode))::in, prog_context::in,
|
|
pf_sym_name_arity::in, pred_id::in, proc_id::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
% This predicate performs the following checks on promise ex declarations
|
|
% (see notes/promise_ex.html).
|
|
%
|
|
% - check for universally quantified variables
|
|
% - check if universal quantification is placed in the wrong position
|
|
% (i.e. after the `promise_exclusive' rather than before it)
|
|
% - check that its goal is a disjunction and that each arm of the
|
|
% disjunction has at most one call, and otherwise has only unifications.
|
|
%
|
|
:- pred check_promise_ex_decl(prog_vars::in, promise_type::in, goal::in,
|
|
prog_context::in, list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
% Warn about suspicious things in the bodies of foreign_code pragmas.
|
|
% Currently, this just checks for the presence of the MR_ALLOC_ID macro
|
|
% inside the bodies of a foreign_code pragmas.
|
|
%
|
|
:- pred warn_suspicious_foreign_code(foreign_language::in,
|
|
foreign_literal_or_include::in, prog_context::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.hlds_out.
|
|
:- import_module hlds.hlds_out.hlds_out_goal.
|
|
:- import_module hlds.status.
|
|
:- import_module libs.options.
|
|
:- import_module parse_tree.parse_tree_out_misc.
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_db.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module char.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term_context.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
add_quant_warnings(PfSymNameArity, VarSet, Warnings, !Specs) :-
|
|
WarningSpecs =
|
|
list.map(quant_warning_to_spec(PfSymNameArity, VarSet), Warnings),
|
|
!:Specs = WarningSpecs ++ !.Specs.
|
|
|
|
:- func quant_warning_to_spec(pf_sym_name_arity, prog_varset, quant_warning)
|
|
= error_spec.
|
|
|
|
quant_warning_to_spec(PfSymNameArity, VarSet, Warning) = Spec :-
|
|
Warning = warn_overlap(Vars, Context),
|
|
Pieces1 = [words("In clause for"),
|
|
unqual_pf_sym_name_pred_form_arity(PfSymNameArity), suffix(":"), nl],
|
|
(
|
|
Vars = [],
|
|
unexpected($pred, "Vars = []")
|
|
;
|
|
Vars = [Var],
|
|
Pieces2 = [words("warning: variable"),
|
|
quote(mercury_var_to_name_only_vs(VarSet, Var)),
|
|
words("has overlapping scopes."), nl]
|
|
;
|
|
Vars = [_, _ | _],
|
|
Pieces2 = [words("warning: variables"),
|
|
quote(mercury_vars_to_name_only_vs(VarSet, Vars)),
|
|
words("each have overlapping scopes."), nl]
|
|
),
|
|
Spec = conditional_spec($pred, warn_overlapping_scopes, yes,
|
|
severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, Pieces1 ++ Pieces2)]).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
warn_singletons(ModuleInfo, PfSymNameArity, VarSet, BodyGoal, SeenQuant,
|
|
!Specs) :-
|
|
% We handle warnings about variables in the clause head specially.
|
|
% This is because the compiler transforms clause heads such as
|
|
%
|
|
% p(X, Y, Z) :- ...
|
|
%
|
|
% into
|
|
%
|
|
% p(HV1, HV2, HV3) :- HV1 = X, HV2 = Y, HV3 = Z, ...
|
|
%
|
|
% If more than one of the head variables is a singleton, programmers
|
|
% would expect a single warning naming them all, since to programmers,
|
|
% everything in the clause head is part of the same scope, but for the
|
|
% compiler, the singleton nature of e.g. Y is detected in its own scope,
|
|
% to wit, the HV2 = Y unification.
|
|
%
|
|
% Even though we discover the singleton nature of e.g. Y in that
|
|
% unification, we don't generate a warning for that scope. Instead,
|
|
% we gather all the singleton variables in the head, and generate a single
|
|
% message for them all here.
|
|
%
|
|
% We also do the same thing for variables whose names indicate they should
|
|
% be singletons, but aren't.
|
|
|
|
trace [compile_time(flag("warn_singletons")), io(!IO)] (
|
|
io.stderr_stream(StdErr, !IO),
|
|
io.write_string(StdErr,
|
|
"\nWARN_SINGLETONS on the following goal:\n", !IO),
|
|
varset.init(TVarSet),
|
|
varset.init(InstVarSet),
|
|
dump_goal(StdErr, ModuleInfo, vns_varset(VarSet), TVarSet, InstVarSet,
|
|
BodyGoal, !IO)
|
|
),
|
|
|
|
Info0 = warn_info(ModuleInfo, PfSymNameArity, VarSet,
|
|
[], set_of_var.init, set_of_var.init, dummy_context,
|
|
have_not_seen_quant),
|
|
QuantVars = set_of_var.init,
|
|
warn_singletons_in_goal(BodyGoal, QuantVars, Info0, Info),
|
|
Info = warn_info(_ModuleInfo, _PfSymNameArity, _VarSet,
|
|
NewSpecs, SingletonHeadVarsSet, MultiHeadVarsSet, HeadContext,
|
|
SeenQuant),
|
|
!:Specs = NewSpecs ++ !.Specs,
|
|
set_of_var.to_sorted_list(SingletonHeadVarsSet, SingletonHeadVars),
|
|
set_of_var.to_sorted_list(MultiHeadVarsSet, MultiHeadVars),
|
|
(
|
|
SingletonHeadVars = []
|
|
;
|
|
SingletonHeadVars = [HeadSHV | TailSHVs],
|
|
generate_variable_warning(sm_single, HeadContext, PfSymNameArity,
|
|
VarSet, HeadSHV, TailSHVs, SingleSpec),
|
|
!:Specs = [SingleSpec | !.Specs]
|
|
),
|
|
(
|
|
MultiHeadVars = []
|
|
;
|
|
MultiHeadVars = [HeadMHV | TailMHVs],
|
|
generate_variable_warning(sm_multi, HeadContext, PfSymNameArity,
|
|
VarSet, HeadMHV, TailMHVs, MultiSpec),
|
|
!:Specs = [MultiSpec | !.Specs]
|
|
).
|
|
|
|
:- type warn_info
|
|
---> warn_info(
|
|
% The first three fields are readonly after initialization.
|
|
|
|
% The current module.
|
|
wi_module_info :: module_info,
|
|
|
|
% The id and the varset of the procedure whose body
|
|
% we are checking.
|
|
wi_pf_sna :: pf_sym_name_arity,
|
|
wi_varset :: prog_varset,
|
|
|
|
% The remaining fields are writeable.
|
|
|
|
% The warnings we have generated while checking.
|
|
wi_specs :: list(error_spec),
|
|
|
|
% The set of variables that occur singleton in the clause head.
|
|
wi_singleton_headvars :: set_of_progvar,
|
|
|
|
% The set of variables that occur more than once in the clause
|
|
% head, even though their names say they SHOULD be singletons.
|
|
wi_multi_headvars :: set_of_progvar,
|
|
|
|
% The context of the clause head. Should be set to a meaningful
|
|
% value if either wi_singleton_headvars or wi_multi_headvars
|
|
% is not empty.
|
|
%
|
|
% It is possible for the clause head to occupy more than one
|
|
% line, and thus for different parts of it to have different
|
|
% contexts. Since we want to generate only a single error_spec,
|
|
% we arbitrarily pick the context of one of those variables.
|
|
wi_head_context :: prog_context,
|
|
|
|
% Have we seen a quantifier with at least one variable listed?
|
|
wi_seen_quant :: maybe_seen_quant
|
|
).
|
|
|
|
:- pred warn_singletons_in_goal(hlds_goal::in, set_of_progvar::in,
|
|
warn_info::in, warn_info::out) is det.
|
|
|
|
warn_singletons_in_goal(Goal, QuantVars, !Info) :-
|
|
Goal = hlds_goal(GoalExpr, GoalInfo),
|
|
(
|
|
GoalExpr = conj(_ConjType, Goals),
|
|
warn_singletons_in_goal_list(Goals, QuantVars, !Info)
|
|
;
|
|
GoalExpr = disj(Goals),
|
|
warn_singletons_in_goal_list(Goals, QuantVars, !Info)
|
|
;
|
|
GoalExpr = switch(_Var, _CanFail, Cases),
|
|
warn_singletons_in_cases(Cases, QuantVars, !Info)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
warn_singletons_in_goal(SubGoal, QuantVars, !Info)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
(
|
|
Reason = exist_quant(Vars, Creator),
|
|
(
|
|
Vars = [_ | _],
|
|
!Info ^ wi_seen_quant := have_seen_quant,
|
|
SubGoalVars = free_goal_vars(SubGoal),
|
|
set_of_var.init(EmptySet),
|
|
(
|
|
Creator = user_quant,
|
|
% Warn if any quantified variables occur only
|
|
% in the quantifier.
|
|
warn_singletons_goal_vars(Vars, GoalInfo, EmptySet,
|
|
SubGoalVars, !Info),
|
|
set_of_var.insert_list(Vars, QuantVars, SubQuantVars)
|
|
;
|
|
Creator = compiler_quant,
|
|
% If the exist_quant scope was created by the compiler,
|
|
% and not by the user, then there two implications.
|
|
%
|
|
% First, there is no point in generating any warnings
|
|
% about variables that occur nowhere else but in Reason,
|
|
% since if there some, (a) it is the fault of the compiler,
|
|
% and not the user, and (b) the user can do nothing
|
|
% to prevent the compiler's screwup. This is why we
|
|
% don't call warn_singletons_goal_vars here.
|
|
%
|
|
% Second, the occurrence of the variable in Reason
|
|
% does not occur in the source code. Therefore a variable
|
|
% that occurs in Reason and has exactly one occurrence
|
|
% elsewhere *should* get a singleton warning generated
|
|
% for it. This is why we don't add Vars to QuantVars.
|
|
SubQuantVars = QuantVars
|
|
)
|
|
;
|
|
Vars = [],
|
|
SubQuantVars = QuantVars
|
|
),
|
|
warn_singletons_in_goal(SubGoal, SubQuantVars, !Info)
|
|
;
|
|
Reason = promise_solutions(Vars, _),
|
|
(
|
|
Vars = [_ | _],
|
|
% Warn if any quantified variables occur only
|
|
% in the quantifier.
|
|
SubGoalVars = free_goal_vars(SubGoal),
|
|
set_of_var.init(EmptySet),
|
|
warn_singletons_goal_vars(Vars, GoalInfo, EmptySet,
|
|
SubGoalVars, !Info),
|
|
set_of_var.insert_list(Vars, QuantVars, SubQuantVars)
|
|
;
|
|
Vars = [],
|
|
SubQuantVars = QuantVars
|
|
),
|
|
warn_singletons_in_goal(SubGoal, SubQuantVars, !Info)
|
|
;
|
|
Reason = disable_warnings(HeadWarning, TailWarnings),
|
|
( if
|
|
( HeadWarning = goal_warning_singleton_vars
|
|
; list.member(goal_warning_singleton_vars, TailWarnings)
|
|
)
|
|
then
|
|
% Since we don't want to generate any singleton variable
|
|
% warnings inside this scope, there is no point in examining
|
|
% the goals inside this scope.
|
|
true
|
|
else
|
|
warn_singletons_in_goal(SubGoal, QuantVars, !Info)
|
|
)
|
|
;
|
|
( Reason = promise_purity(_)
|
|
; Reason = require_detism(_)
|
|
; Reason = require_complete_switch(_)
|
|
; Reason = require_switch_arms_detism(_, _)
|
|
; Reason = commit(_)
|
|
; Reason = barrier(_)
|
|
; Reason = trace_goal(_, _, _, _, _)
|
|
),
|
|
warn_singletons_in_goal(SubGoal, QuantVars, !Info)
|
|
;
|
|
Reason = from_ground_term(TermVar, _Kind),
|
|
% There can be no singleton variables inside the scopes by
|
|
% construction. The only variable involved in the scope that
|
|
% can possibly be singleton is the one representing the entire
|
|
% ground term.
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
warn_singletons_goal_vars([TermVar], GoalInfo, NonLocals,
|
|
QuantVars, !Info)
|
|
;
|
|
Reason = loop_control(_, _, _),
|
|
% These scopes are introduced only by compiler passes
|
|
% that execute after us.
|
|
sorry($pred, "loop_control")
|
|
)
|
|
;
|
|
GoalExpr = if_then_else(Vars, Cond, Then, Else),
|
|
|
|
% Warn if any quantified variables do not occur in the condition
|
|
% or the "then" part of the if-then-else.
|
|
(
|
|
Vars = [_ | _],
|
|
!Info ^ wi_seen_quant := have_seen_quant,
|
|
CondVars = free_goal_vars(Cond),
|
|
ThenVars = free_goal_vars(Then),
|
|
set_of_var.union(CondVars, ThenVars, CondThenVars),
|
|
set_of_var.init(EmptySet),
|
|
warn_singletons_goal_vars(Vars, GoalInfo, EmptySet, CondThenVars,
|
|
!Info)
|
|
;
|
|
Vars = []
|
|
),
|
|
set_of_var.insert_list(Vars, QuantVars, CondThenQuantVars),
|
|
warn_singletons_in_goal(Cond, CondThenQuantVars, !Info),
|
|
warn_singletons_in_goal(Then, CondThenQuantVars, !Info),
|
|
warn_singletons_in_goal(Else, QuantVars, !Info)
|
|
;
|
|
GoalExpr = plain_call(_, _, Args, _, _, _),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
warn_singletons_goal_vars(Args, GoalInfo, NonLocals, QuantVars, !Info)
|
|
;
|
|
GoalExpr = generic_call(GenericCall, Args0, _, _, _),
|
|
goal_util.generic_call_vars(GenericCall, Args1),
|
|
Args = Args0 ++ Args1,
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
warn_singletons_goal_vars(Args, GoalInfo, NonLocals, QuantVars, !Info)
|
|
;
|
|
GoalExpr = unify(Var, RHS, _, _, _),
|
|
warn_singletons_in_unify(Var, RHS, GoalInfo, QuantVars, !Info)
|
|
;
|
|
GoalExpr = call_foreign_proc(Attrs, PredId, ProcId, Args, _, _,
|
|
PragmaImpl),
|
|
Context = goal_info_get_context(GoalInfo),
|
|
Lang = get_foreign_language(Attrs),
|
|
NamesModes = list.map(foreign_arg_maybe_name_mode, Args),
|
|
warn_singletons_in_pragma_foreign_proc(!.Info ^ wi_module_info,
|
|
PragmaImpl, Lang, NamesModes, Context, !.Info ^ wi_pf_sna,
|
|
PredId, ProcId, [], PragmaSpecs),
|
|
list.foldl(add_warn_spec, PragmaSpecs, !Info)
|
|
;
|
|
GoalExpr = shorthand(ShortHand),
|
|
(
|
|
% XXX STM We need to look at how we should handle Outer, Inner and
|
|
% MaybeOutputVars.
|
|
ShortHand = atomic_goal(_GoalType, _Outer, Inner,
|
|
_MaybeOutputVars, MainGoal, OrElseGoals, _OrElseInners),
|
|
Inner = atomic_interface_vars(InnerDI, InnerUO),
|
|
set_of_var.insert_list([InnerDI, InnerUO],
|
|
QuantVars, InsideQuantVars),
|
|
warn_singletons_in_goal(MainGoal, InsideQuantVars, !Info),
|
|
warn_singletons_in_goal_list(OrElseGoals, InsideQuantVars, !Info)
|
|
;
|
|
ShortHand = try_goal(_, _, SubGoal),
|
|
warn_singletons_in_goal(SubGoal, QuantVars, !Info)
|
|
;
|
|
ShortHand = bi_implication(GoalA, GoalB),
|
|
warn_singletons_in_goal_list([GoalA, GoalB], QuantVars, !Info)
|
|
)
|
|
).
|
|
|
|
:- pred warn_singletons_in_goal_list(list(hlds_goal)::in, set_of_progvar::in,
|
|
warn_info::in, warn_info::out) is det.
|
|
|
|
warn_singletons_in_goal_list([], _, !Info).
|
|
warn_singletons_in_goal_list([Goal | Goals], QuantVars, !Info) :-
|
|
warn_singletons_in_goal(Goal, QuantVars, !Info),
|
|
warn_singletons_in_goal_list(Goals, QuantVars, !Info).
|
|
|
|
:- pred warn_singletons_in_cases(list(case)::in, set_of_progvar::in,
|
|
warn_info::in, warn_info::out) is det.
|
|
|
|
warn_singletons_in_cases([], _, !Info).
|
|
warn_singletons_in_cases([Case | Cases], QuantVars, !Info) :-
|
|
Case = case(_MainConsId, _OtherConsIds, Goal),
|
|
warn_singletons_in_goal(Goal, QuantVars, !Info),
|
|
warn_singletons_in_cases(Cases, QuantVars, !Info).
|
|
|
|
:- pred warn_singletons_in_unify(prog_var::in,
|
|
unify_rhs::in, hlds_goal_info::in, set_of_progvar::in,
|
|
warn_info::in, warn_info::out) is det.
|
|
|
|
warn_singletons_in_unify(X, RHS, GoalInfo, QuantVars, !Info) :-
|
|
(
|
|
RHS = rhs_var(Y),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
warn_singletons_goal_vars([X, Y], GoalInfo, NonLocals, QuantVars,
|
|
!Info)
|
|
;
|
|
RHS = rhs_functor(_ConsId, _, Ys),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
warn_singletons_goal_vars([X | Ys], GoalInfo, NonLocals, QuantVars,
|
|
!Info)
|
|
;
|
|
RHS = rhs_lambda_goal(_Purity, _Groundness, _PredOrFunc,
|
|
_Eval, _NonLocals, ArgVarsModes, _Det, LambdaGoal),
|
|
assoc_list.keys(ArgVarsModes, ArgVars),
|
|
% Warn if any lambda-quantified variables occur only in the quantifier.
|
|
LambdaGoal = hlds_goal(_, LambdaGoalInfo),
|
|
LambdaNonLocals = goal_info_get_nonlocals(LambdaGoalInfo),
|
|
warn_singletons_goal_vars(ArgVars, GoalInfo, LambdaNonLocals,
|
|
QuantVars, !Info),
|
|
|
|
% Warn if X (the variable we're unifying the lambda expression with)
|
|
% is singleton.
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
warn_singletons_goal_vars([X], GoalInfo, NonLocals, QuantVars, !Info),
|
|
|
|
% Warn if the lambda-goal contains singletons.
|
|
warn_singletons_in_goal(LambdaGoal, QuantVars, !Info)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% warn_singletons_goal_vars(Vars, GoalInfo, NonLocals, QuantVars, ...):
|
|
%
|
|
% Warn if any of the non-underscore variables in Vars don't occur in
|
|
% NonLocals and don't have the same name as any variable in QuantVars,
|
|
% or if any of the underscore variables in Vars do occur in NonLocals.
|
|
% Omit the warning if GoalInfo says we should.
|
|
%
|
|
:- pred warn_singletons_goal_vars(list(prog_var)::in,
|
|
hlds_goal_info::in, set_of_progvar::in, set_of_progvar::in,
|
|
warn_info::in, warn_info::out) is det.
|
|
|
|
warn_singletons_goal_vars(GoalVars, GoalInfo, NonLocals, QuantVars, !Info) :-
|
|
% Find all the variables in the goal that don't occur outside the goal
|
|
% (i.e. are singleton), have a variable name that doesn't start with "_"
|
|
% or "DCG_", and don't have the same name as any variable in QuantVars
|
|
% (i.e. weren't explicitly quantified).
|
|
|
|
VarSet = !.Info ^ wi_varset,
|
|
PfSymNameArity = !.Info ^ wi_pf_sna,
|
|
Context = goal_info_get_context(GoalInfo),
|
|
|
|
list.filter(is_singleton_var(NonLocals, QuantVars, VarSet), GoalVars,
|
|
SingleVars),
|
|
|
|
% If there were any such variables, issue a warning.
|
|
(
|
|
SingleVars = []
|
|
;
|
|
SingleVars = [HeadSV | TailSVs],
|
|
( if goal_info_has_feature(GoalInfo, feature_dont_warn_singleton) then
|
|
true
|
|
else
|
|
( if goal_info_has_feature(GoalInfo, feature_from_head) then
|
|
SingleHeadVars0 = !.Info ^ wi_singleton_headvars,
|
|
set_of_var.insert_list(SingleVars,
|
|
SingleHeadVars0, SingleHeadVars),
|
|
!Info ^ wi_singleton_headvars := SingleHeadVars,
|
|
!Info ^ wi_head_context := goal_info_get_context(GoalInfo)
|
|
else
|
|
generate_variable_warning(sm_single, Context, PfSymNameArity,
|
|
VarSet, HeadSV, TailSVs, SingleSpec),
|
|
add_warn_spec(SingleSpec, !Info)
|
|
)
|
|
)
|
|
),
|
|
|
|
% Find all the variables in the goal that do occur outside the goal
|
|
% (i.e. are not singleton) and have a variable name that starts
|
|
% with "_". If there were any such variables, issue a warning.
|
|
|
|
list.filter(is_multi_var(NonLocals, VarSet), GoalVars, MultiVars),
|
|
(
|
|
MultiVars = []
|
|
;
|
|
MultiVars = [HeadMV | TailMVs],
|
|
( if goal_info_has_feature(GoalInfo, feature_from_head) then
|
|
MultiHeadVars0 = !.Info ^ wi_multi_headvars,
|
|
set_of_var.insert_list(MultiVars, MultiHeadVars0, MultiHeadVars),
|
|
!Info ^ wi_multi_headvars := MultiHeadVars,
|
|
!Info ^ wi_head_context := goal_info_get_context(GoalInfo)
|
|
else
|
|
generate_variable_warning(sm_multi, Context, PfSymNameArity,
|
|
VarSet, HeadMV, TailMVs, MultiSpec),
|
|
add_warn_spec(MultiSpec, !Info)
|
|
)
|
|
).
|
|
|
|
:- type single_or_multi
|
|
---> sm_single
|
|
; sm_multi.
|
|
|
|
:- pred generate_variable_warning(single_or_multi::in, prog_context::in,
|
|
pf_sym_name_arity::in, prog_varset::in, prog_var::in, list(prog_var)::in,
|
|
error_spec::out) is det.
|
|
|
|
generate_variable_warning(SingleMulti, Context, PfSymNameArity, VarSet,
|
|
Var, Vars, Spec) :-
|
|
(
|
|
SingleMulti = sm_single,
|
|
Count = "only once"
|
|
;
|
|
SingleMulti = sm_multi,
|
|
Count = "more than once"
|
|
),
|
|
PreamblePieces = [words("In clause for"),
|
|
unqual_pf_sym_name_pred_form_arity(PfSymNameArity), suffix(":"), nl],
|
|
VarStrs0 = list.map(mercury_var_to_name_only_vs(VarSet), [Var | Vars]),
|
|
list.sort_and_remove_dups(VarStrs0, VarStrs),
|
|
VarsStr = "`" ++ string.join_list(", ", VarStrs) ++ "'",
|
|
% We want VarsPiece to be breakable into two or more lines
|
|
% in case VarsStr does not fit on one line.
|
|
VarsPiece = words(VarsStr),
|
|
(
|
|
VarStrs = [],
|
|
% Sorting a nonempty list must yield a nonempty list.
|
|
unexpected($pred, "VarStrs = []")
|
|
;
|
|
VarStrs = [_],
|
|
WarnPieces = [words("warning: variable"), VarsPiece,
|
|
words("occurs"), words(Count), words("in this scope."), nl]
|
|
;
|
|
VarStrs = [_, _ | _],
|
|
WarnPieces = [words("warning: variables"), VarsPiece,
|
|
words("occur"), words(Count), words("in this scope."), nl]
|
|
),
|
|
Spec = conditional_spec($pred, warn_singleton_vars, yes,
|
|
severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, PreamblePieces ++ WarnPieces)]).
|
|
|
|
:- pred add_warn_spec(error_spec::in, warn_info::in, warn_info::out) is det.
|
|
|
|
add_warn_spec(Spec, !Info) :-
|
|
Specs0 = !.Info ^ wi_specs,
|
|
Specs = [Spec | Specs0],
|
|
!Info ^ wi_specs := Specs.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
warn_singletons_in_pragma_foreign_proc(ModuleInfo, PragmaImpl, Lang,
|
|
Args, Context, PFSymNameArity, PredId, ProcId, !Specs) :-
|
|
LangStr = foreign_language_string(Lang),
|
|
PragmaImpl = fp_impl_ordinary(Code, _),
|
|
c_code_to_name_list(Code, C_CodeList),
|
|
list.filter_map(var_is_unmentioned(C_CodeList), Args, UnmentionedVars),
|
|
(
|
|
UnmentionedVars = []
|
|
;
|
|
UnmentionedVars = [_ | _],
|
|
Pieces = [words("In the"), words(LangStr), words("code for"),
|
|
unqual_pf_sym_name_pred_form_arity(PFSymNameArity),
|
|
suffix(":"), nl] ++
|
|
variable_warning_start(UnmentionedVars) ++
|
|
[words("not occur in the"), words(LangStr), words("code."), nl],
|
|
Spec = conditional_spec($pred, warn_singleton_vars, yes,
|
|
severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, Pieces)]),
|
|
!:Specs = [Spec | !.Specs]
|
|
),
|
|
pragma_foreign_proc_body_checks(ModuleInfo, Lang, Context, PFSymNameArity,
|
|
PredId, ProcId, C_CodeList, !Specs).
|
|
|
|
:- pred var_is_unmentioned(list(string)::in, maybe(foreign_arg_name_mode)::in,
|
|
string::out) is semidet.
|
|
|
|
var_is_unmentioned(NameList1, MaybeArg, Name) :-
|
|
MaybeArg = yes(foreign_arg_name_mode(Name, _Mode)),
|
|
not string.prefix(Name, "_"),
|
|
not list.member(Name, NameList1).
|
|
|
|
:- func variable_warning_start(list(string)) = list(format_piece).
|
|
|
|
variable_warning_start(UnmentionedVars) = Pieces :-
|
|
( if UnmentionedVars = [Var] then
|
|
Pieces = [words("warning: variable"), quote(Var), words("does")]
|
|
else
|
|
Pieces = [words("warning: variables"),
|
|
words(add_quotes(string.join_list(", ", UnmentionedVars))),
|
|
words("do")]
|
|
).
|
|
|
|
% c_code_to_name_list(Code, List) is true iff List is a list of the
|
|
% identifiers used in the C code in Code.
|
|
%
|
|
:- pred c_code_to_name_list(string::in, list(string)::out) is det.
|
|
|
|
c_code_to_name_list(Code, List) :-
|
|
string.to_char_list(Code, CharList),
|
|
c_code_to_name_list_2(CharList, List).
|
|
|
|
:- pred c_code_to_name_list_2(list(char)::in, list(string)::out) is det.
|
|
|
|
c_code_to_name_list_2(C_Code, List) :-
|
|
get_first_c_name(C_Code, NameCharList, TheRest),
|
|
(
|
|
NameCharList = [],
|
|
% no names left
|
|
List = []
|
|
;
|
|
NameCharList = [_ | _],
|
|
c_code_to_name_list_2(TheRest, Names),
|
|
string.from_char_list(NameCharList, Name),
|
|
List = [Name | Names]
|
|
).
|
|
|
|
:- pred get_first_c_name(list(char)::in, list(char)::out, list(char)::out)
|
|
is det.
|
|
|
|
get_first_c_name([], [], []).
|
|
get_first_c_name([C | CodeChars], NameCharList, TheRest) :-
|
|
( if char.is_alnum_or_underscore(C) then
|
|
get_first_c_name_in_word(CodeChars, NameCharList0, TheRest),
|
|
NameCharList = [C | NameCharList0]
|
|
else
|
|
% Strip off any characters in the C code which don't form part
|
|
% of an identifier.
|
|
get_first_c_name(CodeChars, NameCharList, TheRest)
|
|
).
|
|
|
|
:- pred get_first_c_name_in_word(list(char)::in, list(char)::out,
|
|
list(char)::out) is det.
|
|
|
|
get_first_c_name_in_word([], [], []).
|
|
get_first_c_name_in_word([C | CodeChars], NameCharList, TheRest) :-
|
|
( if char.is_alnum_or_underscore(C) then
|
|
% There are more characters in the word.
|
|
get_first_c_name_in_word(CodeChars, NameCharList0, TheRest),
|
|
NameCharList = [C|NameCharList0]
|
|
else
|
|
% The word is finished.
|
|
NameCharList = [],
|
|
TheRest = CodeChars
|
|
).
|
|
|
|
:- pred is_singleton_var(set_of_progvar::in,
|
|
set_of_progvar::in, prog_varset::in, prog_var::in) is semidet.
|
|
|
|
is_singleton_var(NonLocals, QuantVars, VarSet, Var) :-
|
|
not set_of_var.member(NonLocals, Var),
|
|
varset.search_name(VarSet, Var, Name),
|
|
not string.prefix(Name, "_"),
|
|
not string.prefix(Name, "DCG_"),
|
|
not (
|
|
set_of_var.member(QuantVars, QuantVar),
|
|
varset.search_name(VarSet, QuantVar, Name)
|
|
).
|
|
|
|
:- pred is_multi_var(set_of_progvar::in, prog_varset::in, prog_var::in)
|
|
is semidet.
|
|
|
|
is_multi_var(NonLocals, VarSet, Var) :-
|
|
set_of_var.member(NonLocals, Var),
|
|
varset.search_name(VarSet, Var, Name),
|
|
string.prefix(Name, "_").
|
|
|
|
:- pred pragma_foreign_proc_body_checks(module_info::in, foreign_language::in,
|
|
prog_context::in, pf_sym_name_arity::in, pred_id::in, proc_id::in,
|
|
list(string)::in, list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
pragma_foreign_proc_body_checks(ModuleInfo, Lang, Context, PFSymNameArity,
|
|
PredId, ProcId, BodyPieces, !Specs) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_status(PredInfo, PredStatus),
|
|
IsImported = pred_status_is_imported(PredStatus),
|
|
(
|
|
IsImported = yes
|
|
;
|
|
IsImported = no,
|
|
check_fp_body_for_success_indicator(ModuleInfo, Lang, Context,
|
|
PFSymNameArity, PredId, ProcId, BodyPieces, !Specs),
|
|
check_fp_body_for_return(Lang, Context, PFSymNameArity, BodyPieces,
|
|
!Specs)
|
|
).
|
|
|
|
:- pred check_fp_body_for_success_indicator(module_info::in,
|
|
foreign_language::in, prog_context::in, pf_sym_name_arity::in,
|
|
pred_id::in, proc_id::in, list(string)::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
check_fp_body_for_success_indicator(ModuleInfo, Lang, Context, PFSymNameArity,
|
|
PredId, ProcId, BodyPieces, !Specs) :-
|
|
module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
|
|
proc_info_get_declared_determinism(ProcInfo, MaybeDeclDetism),
|
|
(
|
|
MaybeDeclDetism = yes(Detism),
|
|
SuccIndStr = "SUCCESS_INDICATOR",
|
|
(
|
|
( Detism = detism_det
|
|
; Detism = detism_cc_multi
|
|
; Detism = detism_erroneous
|
|
),
|
|
( if list.member(SuccIndStr, BodyPieces) then
|
|
LangStr = foreign_language_string(Lang),
|
|
Pieces = [words("Warning: the"), fixed(LangStr),
|
|
words("code for"),
|
|
unqual_pf_sym_name_pred_form_arity(PFSymNameArity),
|
|
words("may set"), quote(SuccIndStr), suffix(","),
|
|
words("but it cannot fail.")],
|
|
Spec = conditional_spec($pred,
|
|
warn_suspicious_foreign_procs, yes,
|
|
severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, Pieces)]),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
true
|
|
)
|
|
;
|
|
( Detism = detism_semi
|
|
; Detism = detism_cc_non
|
|
),
|
|
( if list.member(SuccIndStr, BodyPieces) then
|
|
true
|
|
else
|
|
LangStr = foreign_language_string(Lang),
|
|
Pieces = [words("Warning: the"), fixed(LangStr),
|
|
words("code for"),
|
|
unqual_pf_sym_name_pred_form_arity(PFSymNameArity),
|
|
words("does not appear to set"),
|
|
quote(SuccIndStr), suffix(","),
|
|
words("but it can fail.")],
|
|
Spec = conditional_spec($pred,
|
|
warn_suspicious_foreign_procs, yes,
|
|
severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, Pieces)]),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
;
|
|
( Detism = detism_multi
|
|
; Detism = detism_non
|
|
; Detism = detism_failure
|
|
)
|
|
)
|
|
;
|
|
MaybeDeclDetism = no
|
|
).
|
|
|
|
% Check to see if a foreign_proc body contains a return statement
|
|
% (or whatever the foreign language equivalent is).
|
|
%
|
|
:- pred check_fp_body_for_return(foreign_language::in, prog_context::in,
|
|
pf_sym_name_arity::in, list(string)::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
check_fp_body_for_return(Lang, Context, PFSymNameArity, BodyPieces, !Specs) :-
|
|
( if list.member("return", BodyPieces) then
|
|
LangStr = foreign_language_string(Lang),
|
|
Pieces = [words("Warning: the"), fixed(LangStr),
|
|
words("code for"),
|
|
unqual_pf_sym_name_pred_form_arity(PFSymNameArity),
|
|
words("may contain a"), quote("return"),
|
|
words("statement."), nl],
|
|
Spec = conditional_spec($pred, warn_suspicious_foreign_procs, yes,
|
|
severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, Pieces)]),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Promise_ex error checking.
|
|
%
|
|
|
|
check_promise_ex_decl(UnivVars, PromiseType, Goal, Context, !Specs) :-
|
|
% Are universally quantified variables present?
|
|
(
|
|
UnivVars = [],
|
|
promise_ex_error(PromiseType, Context,
|
|
"declaration has no universally quantified variables", !Specs)
|
|
;
|
|
UnivVars = [_ | _]
|
|
),
|
|
check_promise_ex_goal(PromiseType, Goal, !Specs).
|
|
|
|
% Check for misplaced universal quantification, otherwise find the
|
|
% disjunction, flatten it out into list form and perform further checks.
|
|
%
|
|
:- pred check_promise_ex_goal(promise_type::in, goal::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
check_promise_ex_goal(PromiseType, Goal, !Specs) :-
|
|
( if
|
|
Goal = quant_expr(quant_some, quant_ordinary_vars, _, _, SubGoal)
|
|
then
|
|
check_promise_ex_goal(PromiseType, SubGoal, !Specs)
|
|
else if
|
|
Goal = disj_expr(_, Disjunct1, Disjunct2, Disjuncts3plus)
|
|
then
|
|
DisjList = [Disjunct1, Disjunct2 | Disjuncts3plus],
|
|
list.map(flatten_to_conj_list, DisjList, DisjConjList),
|
|
check_promise_ex_disjunction(PromiseType, DisjConjList, !Specs)
|
|
else if
|
|
Goal = quant_expr(quant_all, quant_ordinary_vars, Context, _UnivVars,
|
|
SubGoal)
|
|
then
|
|
promise_ex_error(PromiseType, Context,
|
|
"universal quantification should come before " ++
|
|
"the declaration name", !Specs),
|
|
check_promise_ex_goal(PromiseType, SubGoal, !Specs)
|
|
else
|
|
promise_ex_error(PromiseType, get_goal_context(Goal),
|
|
"goal in declaration is not a disjunction", !Specs)
|
|
).
|
|
|
|
% Takes a goal representing an arm of a disjunction and turns it into
|
|
% a list of conjunct goals.
|
|
%
|
|
:- pred flatten_to_conj_list(goal::in, list(goal)::out) is det.
|
|
|
|
flatten_to_conj_list(Goal, GoalList) :-
|
|
( if Goal = conj_expr(_, ConjunctA, ConjunctsB) then
|
|
list.map(flatten_to_conj_list, [ConjunctA | ConjunctsB],
|
|
ConjunctGoalLists),
|
|
list.condense(ConjunctGoalLists, GoalList)
|
|
else
|
|
GoalList = [Goal]
|
|
).
|
|
|
|
% Taking a list of arms of the disjunction, check each arm individually.
|
|
%
|
|
:- pred check_promise_ex_disjunction(promise_type::in, list(list(goal))::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
check_promise_ex_disjunction(PromiseType, DisjConjList, !Specs) :-
|
|
(
|
|
DisjConjList = []
|
|
;
|
|
DisjConjList = [ConjList | Rest],
|
|
check_promise_ex_disj_arm(PromiseType, ConjList, no, !Specs),
|
|
check_promise_ex_disjunction(PromiseType, Rest, !Specs)
|
|
).
|
|
|
|
% Only one goal in an arm is allowed to be a call, the rest must be
|
|
% unifications.
|
|
%
|
|
:- pred check_promise_ex_disj_arm(promise_type::in, list(goal)::in, bool::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
check_promise_ex_disj_arm(PromiseType, Goals, CallUsed, !Specs) :-
|
|
(
|
|
Goals = []
|
|
;
|
|
Goals = [HeadGoal | TailGoals],
|
|
( if
|
|
HeadGoal = unify_expr(_, _, _, _)
|
|
then
|
|
check_promise_ex_disj_arm(PromiseType, TailGoals,
|
|
CallUsed, !Specs)
|
|
else if
|
|
HeadGoal = quant_expr(quant_some, quant_ordinary_vars, _, _,
|
|
HeadSubGoal)
|
|
then
|
|
check_promise_ex_disj_arm(PromiseType, [HeadSubGoal | TailGoals],
|
|
CallUsed, !Specs)
|
|
else if
|
|
HeadGoal = call_expr(Context, _, _, _)
|
|
then
|
|
(
|
|
CallUsed = no
|
|
;
|
|
CallUsed = yes,
|
|
promise_ex_error(PromiseType, Context,
|
|
"disjunct contains more than one call", !Specs)
|
|
),
|
|
check_promise_ex_disj_arm(PromiseType, TailGoals, yes, !Specs)
|
|
else
|
|
promise_ex_error(PromiseType, get_goal_context(HeadGoal),
|
|
"disjunct is not a call or unification", !Specs),
|
|
check_promise_ex_disj_arm(PromiseType, TailGoals, CallUsed, !Specs)
|
|
)
|
|
).
|
|
|
|
% Called for any error in the above checks.
|
|
%
|
|
:- pred promise_ex_error(promise_type::in, prog_context::in, string::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
promise_ex_error(PromiseType, Context, Message, !Specs) :-
|
|
Pieces = [words("In"),
|
|
quote(parse_tree_out_misc.promise_to_string(PromiseType)),
|
|
words("declaration:"), nl,
|
|
words("error:"), words(Message), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds,
|
|
Context, Pieces),
|
|
!:Specs = [Spec | !.Specs].
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
warn_suspicious_foreign_code(Lang, BodyCode, Context, !Specs) :-
|
|
(
|
|
BodyCode = floi_include_file(_)
|
|
;
|
|
BodyCode = floi_literal(Code),
|
|
(
|
|
Lang = lang_c,
|
|
c_code_to_name_list(Code, C_CodeList),
|
|
( if list.member("MR_ALLOC_ID", C_CodeList) then
|
|
Pieces = [
|
|
words("Warning: the body of this"),
|
|
pragma_decl("foreign_code"),
|
|
words("declaration may refer to the"),
|
|
quote("MR_ALLOC_ID"), words("macro."),
|
|
words("That macro is only defined within the body of"),
|
|
pragma_decl("foreign_proc"), words("declarations.")
|
|
],
|
|
Spec = conditional_spec($pred, warn_suspicious_foreign_code,
|
|
yes, severity_warning, phase_parse_tree_to_hlds,
|
|
[simplest_msg(Context, Pieces)]),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
true
|
|
)
|
|
;
|
|
( Lang = lang_csharp
|
|
; Lang = lang_java
|
|
)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module hlds.make_hlds.make_hlds_warn.
|
|
%---------------------------------------------------------------------------%
|