mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 14:25:56 +00:00
Code Issues Projects Releases Wiki Activity
Files
684ecfbd553c9a7999861d5aca10e12dfec4cd28
mercury/compiler/mode_errors.m
Ralph Becket 684ecfbd55 Undo my recent changes to purity error checking in the context of inst any 
Estimated hours taken: 16
Branches: main

Undo my recent changes to purity error checking in the context of inst any
non-locals in negated contexts.

Implement a better way of handling the problem, as discussed on the mailing
list.  The new solution is to require that any goals featuring inst any
non-locals in a negated context must appear in a
promise_{pure,semipure,impure} context.  This is something of a compromise:
on the one hand it does require that the condition be explicitly recognised
by the programmer; on the other, it does not require that the "offending" goals
be individually identified (this is partly for pragmatic reasons: the earlier
approach required a plethora of awkward impurity declarations on goals that
would otherwise be considered completely pure).

compiler/mode_errors.m:
	Remove purity_error_should_be_impure and purity_error_wrongly_impure
	data constructors; add purity_error_should_be_in_promise_purity_scope.

compiler/mode_info.m:
	Replace the in_negated_context field with the in_promise_purity_scope
	field.

compiler/modecheck_call.m:
compiler/modecheck_unify.m:
	Back out my previous change.

compiler/modes.m:
	Record a purity error if a non-local inst any variable appears
	in a negation or the condition of an if-then-else goal.

compiler/purity.m:
compiler/unique_modes.m:
	Back out my previous change.

doc/reference_manual.texi:
	Document the new purity rules for inst any non-locals in negated
	contexts.

tests/debugger/solver_test.m:
tests/hard_coded/any_free_unify.m:
tests/invalid/any_passed_as_ground.m:
tests/invalid/any_to_ground_in_ite_cond.m:
tests/invalid/anys_in_negated_contexts.err_exp:
tests/invalid/anys_in_negated_contexts.m:
tests/invalid/purity/impure_func_t7.err_exp:
tests/invalid/purity/impure_func_t7.m:
	Fix up error cases to use the new syntax.
2005-12-14 05:14:17 +00:00

1445 lines
59 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2005 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: mode_errors.m.
% Main author: fjh.
% This module contains all the error-reporting routines for the mode-checker.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module check_hlds__mode_errors.
:- interface.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_goal.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module check_hlds.mode_info.
:- import_module bool.
:- import_module io.
:- import_module list.
:- import_module set.
:- import_module std_util.
%-----------------------------------------------------------------------------%
:- type merge_context
---> disj
; if_then_else.
:- type merge_error == pair(prog_var, list(mer_inst)).
:- type merge_errors == list(merge_error).
:- type delayed_goal
---> delayed_goal(
set(prog_var), % The vars it's waiting on.
mode_error_info, % The reason it can't be scheduled.
hlds_goal % The goal itself.
).
:- type mode_error
---> mode_error_disj(merge_context, merge_errors)
% Different arms of a disjunction result in different insts
% for some non-local variables.
; mode_error_par_conj(merge_errors)
% Different arms of a parallel conj result in mutually exclusive
% bindings - ie the process of unifying the instmaps from the end
% of each branch failed.
; mode_error_higher_order_pred_var(pred_or_func, prog_var, mer_inst,
arity)
% The predicate variable in a higher-order predicate or function
% call didn't have a higher-order predicate or function inst
% of the appropriate arity.
; mode_error_poly_unify(prog_var, mer_inst)
% A variable in a polymorphic unification with unknown
% type has inst other than `ground' or `any'.
; mode_error_var_is_live(prog_var)
% Call to a predicate which will clobber its argument,
% but the argument is still live.
; mode_error_var_has_inst(prog_var, mer_inst, mer_inst)
% Call to a predicate with an insufficiently
% instantiated variable (for preds with one mode).
; mode_error_unify_pred(prog_var, mode_error_unify_rhs, mer_type,
pred_or_func)
% An attempt was made to unify two higher-order
% predicate or function variables.
; mode_error_implied_mode(prog_var, mer_inst, mer_inst)
% A call to a predicate with an overly instantiated variable
% would use an implied mode of the predicate, but we can't
% introduce a simple unification after calling the predicate in a
% principal mode because the relevant variable has complex inst
% (such as any).
; mode_error_no_mode_decl
% A call to a predicate for which there are no mode declarations
% (and mode inference is not enabled).
; mode_error_no_matching_mode(list(prog_var), list(mer_inst))
% Call to a predicate with an insufficiently instantiated variable
% (for preds with >1 mode).
; mode_error_in_callee(list(prog_var), list(mer_inst),
pred_id, proc_id, list(mode_error_info))
% Call to a predicate with initial argument insts for which mode
% inference gave a mode error in the callee.
; mode_error_bind_var(var_lock_reason, prog_var, mer_inst, mer_inst)
% Attempt to bind a non-local variable inside a negated context,
% or attempt to re-bind a variable in a parallel conjunct.
; mode_error_non_local_lambda_var(prog_var, mer_inst)
% Attempt to pass a live non-ground var as a non-local variable
% to a lambda goal.
; mode_error_unify_var_var(prog_var, prog_var, mer_inst, mer_inst)
% Attempt to unify two free variables.
; mode_error_unify_var_functor(prog_var, cons_id, list(prog_var),
mer_inst, list(mer_inst))
% Attempt to unify a free var with a functor containing
% free arguments.
; mode_error_unify_var_lambda(prog_var, mer_inst, mer_inst)
% Some sort of error in attempt to unify a variable with lambda
% expression.
; mode_error_conj(list(delayed_goal), schedule_culprit)
% A conjunction contains one or more unscheduleable goals;
% schedule_culprit gives the reason why they couldn't be scheduled.
; mode_error_final_inst(int, prog_var, mer_inst, mer_inst,
final_inst_error)
% One of the head variables did not have the expected final inst
% on exit from the proc.
; purity_error_should_be_in_promise_purity_scope(
negated_context_desc, prog_var)
% The condition of an if-then-else or the body of a negation
% contained an inst any non-local, but was not inside a
% promise_purity scope.
; purity_error_lambda_should_be_impure(list(prog_var)).
% A lambda term containing inst any non-locals should have been
% declared impure, but hasn't been (executing such a lambda may
% further constrain the inst any variables, thereby violating
% referential transparency).
:- type negated_context_desc
---> if_then_else
; negation.
:- type schedule_culprit
---> goal_itself_was_impure
; goals_followed_by_impure_goal(hlds_goal)
; conj_floundered. % We've reached the end of a conjunction
% and there were still delayed goals.
:- type final_inst_error
---> too_instantiated
; not_instantiated_enough
; wrongly_instantiated. % A catchall for anything that doesn't
% fit into the above two categories.
:- type mode_error_unify_rhs
---> error_at_var(prog_var)
; error_at_functor(cons_id, list(prog_var))
; error_at_lambda(list(prog_var), list(mer_mode)).
:- type mode_error_info
---> mode_error_info(
set(prog_var), % The variables which caused the error
% (we will attempt to reschedule the goal
% if the one of these variables becomes
% more instantiated).
mode_error, % The nature of the error.
prog_context, % Where the error occurred.
mode_context % Where the error occurred.
).
:- type mode_warning
---> cannot_succeed_var_var(prog_var, prog_var, mer_inst, mer_inst)
; cannot_succeed_var_functor(prog_var, mer_inst, cons_id).
:- type mode_warning_info
---> mode_warning_info(
mode_warning, % The nature of the error.
prog_context, % Where the error occurred.
mode_context % Where the error occurred.
).
%-----------------------------------------------------------------------------%
% If there were any errors recorded in the mode_info,
% report them to the user now.
%
:- pred report_mode_errors(mode_info::in, mode_info::out,
io::di, io::uo) is det.
% Print an error message describing a mode error.
%
:- pred report_mode_error(mode_error::in, mode_info::in,
io::di, io::uo) is det.
% Report an error for a predicate with no mode declarations
% unless mode inference is enabled and the predicate is local.
%
:- pred maybe_report_error_no_modes(pred_id::in, pred_info::in,
module_info::in, io::di, io::uo) is det.
% If there were any warnings recorded in the mode_info,
% report them to the user now.
%
:- pred report_mode_warnings(mode_info::in, mode_info::out,
io::di, io::uo) is det.
% Print a warning message.
%
:- pred report_mode_warning(mode_info::in, mode_warning_info::in,
io::di, io::uo) is det.
% Initialize the mode_context.
%
:- pred mode_context_init(mode_context::out) is det.
% Write out the inferred `mode' declarations for a list of pred_ids.
% The bool indicates whether or not to write out determinism
% annotations on the modes (it should only be set to `yes' _after_
% determinism analysis).
%
:- pred write_mode_inference_messages(list(pred_id)::in, bool::in,
module_info::in, io::di, io::uo) is det.
% Report an error for the case when two mode declarations
% declare indistinguishable modes.
%
:- pred report_indistinguishable_modes_error(proc_id::in, proc_id::in,
pred_id::in, pred_info::in, module_info::in, io::di, io::uo) is det.
:- pred output_mode_decl(proc_id::in, pred_info::in, io::di, io::uo) is det.
:- func mode_decl_to_string(proc_id, pred_info) = string.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.mode_info.
:- import_module check_hlds.mode_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_out.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
:- import_module int.
:- import_module map.
:- import_module string.
:- import_module term.
:- import_module term_io.
:- import_module varset.
%-----------------------------------------------------------------------------%
report_mode_error(ModeError, ModeInfo, !IO) :-
Specs = mode_error_to_specs(ModeError, ModeInfo),
% XXX This module needs some rearrangement for the global extra erro info
% flag to be respected properly. In the meantime we just set it to yes
% because that was the original behaviour for this module was.
globals.io_set_extra_error_info(yes, !IO),
write_error_specs(Specs, !IO).
report_mode_warning(ModeInfo, Warning, !IO) :-
Specs = mode_warning_to_specs(ModeInfo, Warning),
write_error_specs(Specs, !IO),
record_warning(!IO).
:- func mode_error_to_specs(mode_error::in, mode_info::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_to_specs(ModeError, ModeInfo) = Specs :-
(
ModeError = mode_error_disj(MergeContext, ErrorList),
Specs = mode_error_disj_to_specs(ModeInfo, MergeContext, ErrorList)
;
ModeError = mode_error_par_conj(ErrorList),
Specs = mode_error_par_conj_to_specs(ModeInfo, ErrorList)
;
ModeError = mode_error_higher_order_pred_var(PredOrFunc, Var, Inst,
Arity),
Specs = mode_error_higher_order_pred_var_to_specs(ModeInfo, PredOrFunc,
Var, Inst, Arity)
;
ModeError = mode_error_poly_unify(Var, Inst),
Specs = mode_error_poly_unify_to_specs(ModeInfo, Var, Inst)
;
ModeError = mode_error_var_is_live(Var),
Specs = mode_error_var_is_live_to_specs(ModeInfo, Var)
;
ModeError = mode_error_var_has_inst(Var, InstA, InstB),
Specs = mode_error_var_has_inst_to_specs(ModeInfo, Var, InstA, InstB)
;
ModeError = mode_error_unify_pred(Var, RHS, Type, PredOrFunc),
Specs = mode_error_unify_pred_to_specs(ModeInfo, Var, RHS, Type,
PredOrFunc)
;
ModeError = mode_error_implied_mode(Var, InstA, InstB),
Specs = mode_error_implied_mode_to_specs(ModeInfo, Var, InstA, InstB)
;
ModeError = mode_error_no_mode_decl,
Specs = mode_error_no_mode_decl_to_specs(ModeInfo)
;
ModeError = mode_error_bind_var(Reason, Var, InstA, InstB),
Specs = mode_error_bind_var_to_specs(ModeInfo, Reason, Var,
InstA, InstB)
;
ModeError = mode_error_non_local_lambda_var(Var, Inst),
Specs = mode_error_non_local_lambda_var_to_specs(ModeInfo, Var, Inst)
;
ModeError = mode_error_unify_var_var(VarA, VarB, InstA, InstB),
Specs = mode_error_unify_var_var_to_specs(ModeInfo, VarA, VarB,
InstA, InstB)
;
ModeError = mode_error_unify_var_lambda(VarA, InstA, InstB),
Specs = mode_error_unify_var_lambda_to_specs(ModeInfo, VarA,
InstA, InstB)
;
ModeError = mode_error_unify_var_functor(Var, Name, Args, Inst,
ArgInsts),
Specs = mode_error_unify_var_functor_to_specs(ModeInfo, Var, Name,
Args, Inst, ArgInsts)
;
ModeError = mode_error_conj(Errors, Culprit),
Specs = mode_error_conj_to_specs(ModeInfo, Errors, Culprit)
;
ModeError = mode_error_no_matching_mode(Vars, Insts),
Specs = mode_error_no_matching_mode_to_specs(ModeInfo, Vars, Insts)
;
ModeError = mode_error_in_callee(Vars, Insts,
CalleePredId, CalleeProcId, CalleeErrors),
Specs = mode_error_in_callee_to_specs(ModeInfo, Vars, Insts,
CalleePredId, CalleeProcId, CalleeErrors)
;
ModeError = mode_error_final_inst(ArgNum, Var, VarInst, Inst, Reason),
Specs = mode_error_final_inst_to_specs(ModeInfo, ArgNum, Var, VarInst,
Inst, Reason)
;
ModeError = purity_error_should_be_in_promise_purity_scope(NegCtxt,
Var),
Specs = purity_error_should_be_in_promise_purity_scope_to_specs(
NegCtxt, ModeInfo, Var)
;
ModeError = purity_error_lambda_should_be_impure(Vars),
Specs = purity_error_lambda_should_be_impure_to_specs(ModeInfo, Vars)
).
:- func mode_warning_to_specs(mode_info::in, mode_warning_info::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_warning_to_specs(!.ModeInfo, Warning) = Specs :-
Warning = mode_warning_info(ModeWarning, Context, ModeContext),
mode_info_set_context(Context, !ModeInfo),
mode_info_set_mode_context(ModeContext, !ModeInfo),
(
ModeWarning = cannot_succeed_var_var(VarA, VarB, InstA, InstB),
Specs = mode_warning_cannot_succeed_var_var(!.ModeInfo, VarA, VarB,
InstA, InstB)
;
ModeWarning = cannot_succeed_var_functor(Var, Inst, ConsId),
Specs = mode_warning_cannot_succeed_var_functor(!.ModeInfo,
Var, Inst, ConsId)
).
%-----------------------------------------------------------------------------%
:- func mode_error_conj_to_specs(mode_info::in, list(delayed_goal)::in,
schedule_culprit::in) = (list(error_msg_spec)::out(error_msg_specs))
is det.
mode_error_conj_to_specs(ModeInfo, Errors, Culprit) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
list__filter(is_error_important, Errors, ImportantErrors, OtherErrors),
% If there's more than one error, and we have verbose-errors enabled,
% report them all.
mode_info_get_module_info(ModeInfo, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, verbose_errors, VerboseErrors),
(
VerboseErrors = yes,
Errors = [_, _ | _]
->
PiecesA = [words("mode error in conjunction. The next"),
fixed(int_to_string(list__length(Errors))),
words("error messages indicate possible causes of this error.")],
Specs1Start = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, PiecesA)],
Specs1Rest = list__map(
mode_error_conjunct_to_specs(VarSet, Context, ModeInfo),
ImportantErrors ++ OtherErrors),
Specs1 = Specs1Start ++ list__condense(Specs1Rest)
;
% In the normal case, only report the first error.
ImportantErrors = [FirstImportantError | _]
->
Specs1 = mode_error_conjunct_to_specs(VarSet, Context, ModeInfo,
FirstImportantError)
;
OtherErrors = [FirstOtherError | _]
->
Specs1 = mode_error_conjunct_to_specs(VarSet, Context, ModeInfo,
FirstOtherError)
;
% There wasn't any error to report! This can't happen.
unexpected(this_file, "report_mode_error_conj")
),
% If the goal(s) couldn't be scheduled because we couldn't reorder things
% past an impure goal, then report that.
(
Culprit = conj_floundered,
% We've already reported everything we can.
Specs2 = []
;
Culprit = goal_itself_was_impure,
Pieces = [words("The goal could not be reordered,"),
words("because it was impure.")],
Specs2 = [error_msg_spec(no, Context, 0, Pieces)]
;
Culprit = goals_followed_by_impure_goal(ImpureGoal),
ImpureGoal = _ - ImpureGoalInfo,
goal_info_get_context(ImpureGoalInfo, ImpureGoalContext),
Pieces1 = [words("The goal could not be reordered,"),
words("becaise it was followed by an impure goal.")],
Pieces2 = [words("This is the location of the impure goal.")],
Specs2 = [error_msg_spec(no, Context, 0, Pieces1),
error_msg_spec(no, ImpureGoalContext, 0, Pieces2)]
),
Specs = Specs1 ++ Specs2.
:- pred is_error_important(delayed_goal::in) is semidet.
is_error_important(Error) :-
Error = delayed_goal(_, mode_error_info(_, ModeError, _, ModeContext), _),
(
% An error is important unless it is a non-explicit unification,
% i.e. a head unification or a call argument unification.
ModeContext = unify(unify_context(UnifyContext, _), _),
UnifyContext \= explicit,
% Except that errors in lambda goals are important even if the
% unification that creates the lambda goal is an implicit one.
ModeError \= mode_error_non_local_lambda_var(_, _)
->
fail
;
true
).
:- func mode_error_conjunct_to_specs(prog_varset::in, prog_context::in,
mode_info::in, delayed_goal::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_conjunct_to_specs(VarSet, Context, !.ModeInfo, DelayedGoal)
= Specs :-
DelayedGoal = delayed_goal(Vars, Error, Goal),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, debug_modes, Debug),
(
Debug = yes,
set__to_sorted_list(Vars, VarList),
Pieces1 = [words("Floundered goal, waiting on { "),
words(mercury_vars_to_string(VarList, VarSet, no)),
words(" } :"), nl],
Specs1 = [error_msg_spec(no, Context, 0, Pieces1)]
;
Debug = no,
Specs1 = []
),
globals__lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = yes,
Specs2 = [anything(write_indented_goal(Goal, ModuleInfo, VarSet))]
;
VeryVerbose = no,
Specs2 = []
),
Error = mode_error_info(_, ModeError, ErrorContext, ModeContext),
mode_info_set_context(ErrorContext, !ModeInfo),
mode_info_set_mode_context(ModeContext, !ModeInfo),
Specs = Specs1 ++ Specs2 ++ mode_error_to_specs(ModeError, !.ModeInfo).
:- pred write_indented_goal(hlds_goal::in, module_info::in, prog_varset::in,
io::di, io::uo) is det.
write_indented_goal(Goal, ModuleInfo, VarSet, !IO) :-
io__write_string("\t\t", !IO),
hlds_out__write_goal(Goal, ModuleInfo, VarSet, no, 2, ".\n", !IO).
%-----------------------------------------------------------------------------%
:- func mode_error_disj_to_specs(mode_info::in, merge_context::in,
merge_errors::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_disj_to_specs(ModeInfo, MergeContext, ErrorList) = Specs :-
mode_info_get_context(ModeInfo, Context),
Pieces = [words("mode mismatch in "),
words(merge_context_to_string(MergeContext)), suffix(".")],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces) |
list__map(merge_error_to_spec(ModeInfo), ErrorList)].
:- func mode_error_par_conj_to_specs(mode_info::in, merge_errors::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_par_conj_to_specs(ModeInfo, ErrorList) = Specs :-
mode_info_get_context(ModeInfo, Context),
Pieces = [words("mode error: mutually exclusive bindings"),
words("in parallel conjunction."),
words("(The current implementation does not permit"),
words("parallel conjunctions to fail.)"), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces) |
list__map(merge_error_to_spec(ModeInfo), ErrorList)].
:- func merge_error_to_spec(mode_info::in, merge_error::in)
= (error_msg_spec::out(error_msg_spec)) is det.
merge_error_to_spec(ModeInfo, Var - Insts) = Spec :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words(add_quotes(mercury_var_to_string(Var, VarSet, no))),
fixed("::"),
words(inst_list_to_string(ModeInfo, Insts)), suffix("."), nl],
Spec = error_msg_spec(no, Context, 0, Pieces).
:- func merge_context_to_string(merge_context) = string.
merge_context_to_string(disj) = "disjunction".
merge_context_to_string(if_then_else) = "if-then-else".
%-----------------------------------------------------------------------------%
:- func mode_error_bind_var_to_specs(mode_info::in, var_lock_reason::in,
prog_var::in, mer_inst::in, mer_inst::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_bind_var_to_specs(ModeInfo, Reason, Var, VarInst, Inst) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
(
Reason = negation,
ReasonStr = "attempt to bind a variable inside a negation."
;
Reason = if_then_else,
ReasonStr = "attempt to bind a non-local variable" ++
" inside the condition of an if-then-else."
;
Reason = lambda(PredOrFunc),
PredOrFuncS = prog_out__pred_or_func_to_str(PredOrFunc),
ReasonStr = "attempt to bind a non-local variable inside" ++
" a " ++ PredOrFuncS ++ " lambda goal."
;
Reason = par_conj,
ReasonStr = "attempt to bind a non-local variable" ++
"inside more than one parallel conjunct."
),
Pieces1 = [words("scope error:"), words(ReasonStr), nl,
words("Variable"),
words(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, VarInst))), suffix(","), nl,
words("expected instantiatedness was"),
words(add_quotes(inst_to_string(ModeInfo, Inst))), suffix("."), nl],
mode_info_get_module_info(ModeInfo, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, verbose_errors, VerboseErrors),
(
VerboseErrors = yes,
(
Reason = negation,
Pieces2 = [words("A negation is only allowed to bind variables"),
words("which are local to the negation, i.e. those which are"),
words("implicitly existentially quantified"),
words("inside the scope of the negation."), nl]
;
Reason = if_then_else,
Pieces2 = [words("The condition of an if-then-else is only"),
words("allowed to bind variables which are local to the"),
words("condition or which occur only in the condition"),
words("and the `then' part."), nl]
;
Reason = lambda(_),
Pieces2 = [words("A lambda goal is only allowed to bind"),
words("its arguments and variables local to the "),
words("lambda expression."), nl]
;
Reason = par_conj,
Pieces2 = [words("A nonlocal variable of a parallel conjunction"),
words("may be bound in at most one conjunct."), nl]
)
;
VerboseErrors = no,
% XXX We need to set the extra error flag here.
Pieces2 = []
),
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2)].
%-----------------------------------------------------------------------------%
:- func mode_error_non_local_lambda_var_to_specs(mode_info::in, prog_var::in,
mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_non_local_lambda_var_to_specs(ModeInfo, Var, VarInst) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("mode error: variable"),
fixed(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, VarInst))),
suffix(","), nl,
words("expected instantiatedness for non-local variables"),
words("of lambda goals is `ground'."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
%-----------------------------------------------------------------------------%
:- func mode_error_in_callee_to_specs(mode_info::in, list(prog_var)::in,
list(mer_inst)::in, pred_id::in, proc_id::in, list(mode_error_info)::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_in_callee_to_specs(!.ModeInfo, Vars, Insts,
CalleePredId, CalleeProcId, CalleeModeErrors) = Specs :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_info_get_context(!.ModeInfo, Context),
mode_info_get_varset(!.ModeInfo, VarSet),
Pieces1 = [words("mode error: arguments"),
words(add_quotes(mercury_vars_to_string(Vars, VarSet, no))),
words("have the following insts:"), nl_indent_delta(1)] ++
inst_list_to_sep_lines(!.ModeInfo, Insts) ++
[words("which does not match any of the valid modes for")],
module_info_get_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, verbose_errors, VerboseErrors),
(
VerboseErrors = yes,
Pieces2 = [words("the callee"), prefix("(")] ++
describe_one_pred_name(ModuleInfo, should_module_qualify,
CalleePredId) ++ [suffix(")"), nl,
words("because of the following error."), nl]
;
VerboseErrors = no,
Pieces2 = [words("the callee, because of the following error."), nl]
),
InitSpecs = [mode_info_context_to_spec(!.ModeInfo),
error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2)],
(
CalleeModeErrors = [First | _],
First = mode_error_info(_, CalleeModeError,
CalleeContext, CalleeModeContext),
mode_info_set_predid(CalleePredId, !ModeInfo),
mode_info_set_procid(CalleeProcId, !ModeInfo),
mode_info_set_context(CalleeContext, !ModeInfo),
mode_info_set_mode_context(CalleeModeContext, !ModeInfo),
LaterSpecs0 = mode_error_to_specs(CalleeModeError, !.ModeInfo),
(
LaterSpecs0 = [],
LaterSpecs = []
;
LaterSpecs0 = [LaterSpecsHead0 | LaterSpecsTail],
(
LaterSpecsHead0 = error_msg_spec(_, _, _, _),
LaterSpecsHead = LaterSpecsHead0 ^ spec_treat_as_first := yes
;
LaterSpecsHead0 = anything(_),
LaterSpecsHead = LaterSpecsHead0
),
LaterSpecs = [LaterSpecsHead | LaterSpecsTail]
),
Specs = InitSpecs ++ LaterSpecs
;
CalleeModeErrors = [],
unexpected(this_file, "report_mode_error_in_callee: no error")
).
:- func mode_error_no_matching_mode_to_specs(mode_info::in, list(prog_var)::in,
list(mer_inst)::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_no_matching_mode_to_specs(ModeInfo, Vars, Insts) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
mode_info_get_mode_context(ModeInfo, ModeContext),
( ModeContext = call(CallId, _) ->
CallIdStr = hlds_out__call_id_to_string(CallId)
;
unexpected(this_file,
"report_mode_error_no_matching_mode: invalid context")
),
Pieces = [words("mode error: arguments"),
fixed(add_quotes(mercury_vars_to_string(Vars, VarSet, no))),
words("have the following insts:"), nl_indent_delta(1)] ++
inst_list_to_sep_lines(ModeInfo, Insts) ++
[words("which does not match any of the modes for"),
words(CallIdStr), suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
:- func mode_error_higher_order_pred_var_to_specs(mode_info::in,
pred_or_func::in, prog_var::in, mer_inst::in, arity::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_higher_order_pred_var_to_specs(ModeInfo, PredOrFunc, Var, VarInst,
Arity) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
(
PredOrFunc = predicate,
Expecting = "expecting higher-order pred inst (of arity " ++
int_to_string(Arity) ++ ")."
;
PredOrFunc = function,
Expecting = "expecting higher-order func inst (of arity " ++
int_to_string(Arity - 1) ++ ")."
),
Pieces = [words("mode error: variable"),
fixed(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, VarInst))),
suffix(","), nl,
words(Expecting), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
:- func mode_error_poly_unify_to_specs(mode_info::in, prog_var::in,
mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_poly_unify_to_specs(ModeInfo, Var, VarInst) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces1 = [words("in polymorphically-typed unification:"), nl,
words("mode error: variable"),
words(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, VarInst))), suffix(","), nl,
words("expected instantiatedness was `ground' or `any'."), nl],
mode_info_get_module_info(ModeInfo, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, verbose_errors, VerboseErrors),
(
VerboseErrors = yes,
Pieces2 = [words("When unifying two variables whose type"),
words("will not be known until runtime, the variables must both"),
words("be ground (or have inst `any'). Unifications of"),
words("polymorphically-typed variables with partially"),
words("instantiated modes are not allowed.")]
;
VerboseErrors = no,
Pieces2 = []
),
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2)].
:- func mode_error_var_is_live_to_specs(mode_info::in, prog_var::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_var_is_live_to_specs(ModeInfo, Var) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("unique-mode error: the called procedure"),
words("would clobber its argument, but variable"),
words(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("is still live."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
:- func mode_error_var_has_inst_to_specs(mode_info::in, prog_var::in,
mer_inst::in, mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs))
is det.
mode_error_var_has_inst_to_specs(ModeInfo, Var, VarInst, Inst) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("mode error: variable"),
words(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, VarInst))), suffix(","), nl,
words("expected instantiatedness was"),
words(add_quotes(inst_to_string(ModeInfo, Inst))), suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
:- func mode_error_implied_mode_to_specs(mode_info::in, prog_var::in,
mer_inst::in, mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs))
is det.
mode_error_implied_mode_to_specs(ModeInfo, Var, VarInst, Inst) = Specs :-
% This "error" message is really a "sorry, not implemented" message.
% We only print the message if we will actually generating code.
mode_info_get_module_info(ModeInfo, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, errorcheck_only, ErrorcheckOnly),
(
ErrorcheckOnly = no,
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("sorry, implied modes not implemented."), nl,
words("Variable"),
words(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, VarInst))),
suffix(","), nl,
words("expected instantiatedness was"),
words(add_quotes(inst_to_string(ModeInfo, Inst))),
suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)]
;
ErrorcheckOnly = yes,
Specs = []
).
:- func mode_error_no_mode_decl_to_specs(mode_info::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_no_mode_decl_to_specs(ModeInfo) = Specs :-
mode_info_get_context(ModeInfo, Context),
Pieces = [words("no mode declaration for called predicate."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
:- func mode_error_unify_pred_to_specs(mode_info::in, prog_var::in,
mode_error_unify_rhs::in, mer_type::in, pred_or_func::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_unify_pred_to_specs(ModeInfo, X, RHS, Type, PredOrFunc) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
mode_info_get_instvarset(ModeInfo, InstVarSet),
mode_info_get_module_info(ModeInfo, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
(
RHS = error_at_var(Y),
RHSStr = mercury_var_to_string(Y, VarSet, no)
;
RHS = error_at_functor(ConsId, ArgVars),
RHSStr = hlds_out__functor_cons_id_to_string(ConsId, ArgVars, VarSet,
ModuleInfo, no)
;
RHS = error_at_lambda(ArgVars, ArgModes),
RHSStr = "lambda(["
++ hlds_out__var_modes_to_string(ArgVars, ArgModes, VarSet,
InstVarSet, no)
++ "] ... )"
),
varset__init(TypeVarSet),
Pieces1 = [words("In unification of"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("with"), words(add_quotes(RHSStr)), suffix(":"), nl,
words("mode error: attempt at higher-order unification."), nl,
words("Cannot unify two terms of type"),
words(add_quotes(mercury_type_to_string(TypeVarSet, no, Type))),
suffix("."), nl],
globals__lookup_bool_option(Globals, verbose_errors, VerboseErrors),
(
VerboseErrors = yes,
Pieces2 = [words("Your code is trying to test whether two "),
words(prog_out__pred_or_func_to_full_str(PredOrFunc) ++ "s"),
words("are equal, by unifying them."),
words("In the general case, testing equivalence of"),
words(prog_out__pred_or_func_to_full_str(PredOrFunc) ++ "s"),
words("is an undecidable problem,"),
words("and so this is not allowed by the Mercury mode system."),
words("In some cases, you can achieve the same effect by"),
words("writing an explicit universal quantification, e.g."),
fixed("`all [X] call(P, X) <=> call(Q, X)',"),
words("instead of"),
fixed("`P = Q'.")]
;
VerboseErrors = no,
Pieces2 = []
),
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2)].
%-----------------------------------------------------------------------------%
:- func mode_error_unify_var_var_to_specs(mode_info::in, prog_var::in,
prog_var::in, mer_inst::in, mer_inst::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_unify_var_var_to_specs(ModeInfo, X, Y, InstX, InstY) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("mode error in unification of"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("and"),
words(add_quotes(mercury_var_to_string(Y, VarSet, no))),
suffix("."), nl,
words("Variable"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix(","), nl,
words("variable"),
words(add_quotes(mercury_var_to_string(Y, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstY))), suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
%-----------------------------------------------------------------------------%
:- func mode_error_unify_var_lambda_to_specs(mode_info::in, prog_var::in,
mer_inst::in, mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs))
is det.
mode_error_unify_var_lambda_to_specs(ModeInfo, X, InstX, InstY) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("mode error in unification of"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("and lambda expression."), nl,
words("Variable"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix(","), nl,
words("lambda expression has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstY))), suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
%-----------------------------------------------------------------------------%
:- func mode_error_unify_var_functor_to_specs(mode_info::in, prog_var::in,
cons_id::in, list(prog_var)::in, mer_inst::in, list(mer_inst)::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_unify_var_functor_to_specs(ModeInfo, X, ConsId, Args,
InstX, ArgInsts) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
mode_info_get_module_info(ModeInfo, ModuleInfo),
Pieces1 = [words("mode error in unification of"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("and"),
words(add_quotes(hlds_out__functor_cons_id_to_string(ConsId, Args,
VarSet, ModuleInfo, no))), suffix("."), nl,
words("Variable"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix(","), nl,
words("term"),
words(add_quotes(hlds_out__functor_cons_id_to_string(ConsId, Args,
VarSet, ModuleInfo, no)))],
(
Args = [_ | _],
Pieces2 = [words("has instantiatedness"),
prefix("`"),
words(mercury_cons_id_to_string(ConsId, does_not_need_brackets)),
suffix("("), nl_indent_delta(1)] ++
inst_list_to_sep_lines(ModeInfo, ArgInsts) ++
[fixed(")'.")]
;
Args = [],
Pieces2 = [words("has instantiatedness"),
words(add_quotes(mercury_cons_id_to_string(ConsId,
does_not_need_brackets))), suffix("."), nl]
),
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2)].
%-----------------------------------------------------------------------------%
:- func mode_warning_cannot_succeed_var_var(mode_info::in,
prog_var::in, prog_var::in, mer_inst::in, mer_inst::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_warning_cannot_succeed_var_var(ModeInfo, X, Y, InstX, InstY) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("warning: unification of"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("and"),
words(add_quotes(mercury_var_to_string(Y, VarSet, no))),
words("cannot succeed"), nl,
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix(","), nl,
words(add_quotes(mercury_var_to_string(Y, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstY))), suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
:- func mode_warning_cannot_succeed_var_functor(mode_info::in,
prog_var::in, mer_inst::in, cons_id::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_warning_cannot_succeed_var_functor(ModeInfo, X, InstX, ConsId) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words("warning: unification of"),
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("and"),
words(mercury_cons_id_to_string(ConsId, does_not_need_brackets)),
words("cannot succeed"), nl,
words(add_quotes(mercury_var_to_string(X, VarSet, no))),
words("has instantiatedness"),
words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
%-----------------------------------------------------------------------------%
:- func mode_info_context_to_spec(mode_info::in)
= (error_msg_spec::out(error_msg_spec)) is det.
mode_info_context_to_spec(ModeInfo) = Spec :-
mode_info_get_module_info(ModeInfo, ModuleInfo),
mode_info_get_context(ModeInfo, Context),
mode_info_get_predid(ModeInfo, PredId),
mode_info_get_procid(ModeInfo, ProcId),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
pred_info_get_markers(PredInfo, PredMarkers),
proc_info_declared_argmodes(ProcInfo, Modes0),
strip_builtin_qualifiers_from_mode_list(Modes0, Modes),
Name0 = pred_info_name(PredInfo),
Name = unqualified(Name0),
mode_info_get_instvarset(ModeInfo, InstVarSet),
MaybeDet = no,
ModeSubDeclStr = mercury_mode_subdecl_to_string(PredOrFunc, InstVarSet,
Name, Modes, MaybeDet, Context),
Pieces1 = [words("In clause for"),
words(add_quotes(ModeSubDeclStr)), suffix(":"), nl],
mode_info_get_mode_context(ModeInfo, ModeContext),
Pieces2 = mode_context_to_pieces(ModeContext, PredMarkers),
Spec = error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2).
%-----------------------------------------------------------------------------%
% XXX some parts of the mode context never get set up
:- func mode_context_to_pieces(mode_context, pred_markers)
= list(format_component).
mode_context_to_pieces(uninitialized, _Markers) = [].
mode_context_to_pieces(call(CallId, ArgNum), Markers) =
[words("in"),
words(hlds_out__call_arg_id_to_string(CallId, ArgNum, Markers)),
suffix(":"), nl].
mode_context_to_pieces(unify(UnifyContext, _Side), _Markers) = Pieces :-
hlds_out__unify_context_to_pieces(no, _, UnifyContext, [], Pieces).
%-----------------------------------------------------------------------------%
mode_context_init(uninitialized).
%-----------------------------------------------------------------------------%
:- func mode_error_final_inst_to_specs(mode_info::in, int::in, prog_var::in,
mer_inst::in, mer_inst::in, final_inst_error::in)
= (list(error_msg_spec)::out(error_msg_specs)) is det.
mode_error_final_inst_to_specs(ModeInfo, ArgNum, Var, VarInst, Inst, Reason)
= Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
( Reason = too_instantiated ->
Problem = " became too instantiated."
; Reason = not_instantiated_enough ->
Problem = "did not get sufficiently instantiated."
;
% I don't think this can happen. But just in case...
Problem = "had the wrong instantiatedness."
),
Pieces = [words("mode error: argument"), fixed(int_to_string(ArgNum)),
words(Problem), nl,
words("Final instantiatedness of"),
words(add_quotes(mercury_var_to_string(Var, VarSet, no))),
words("was"), words(add_quotes(inst_to_string(ModeInfo, VarInst))),
suffix(","), nl,
words("expected final instantiatedness was"),
words(add_quotes(inst_to_string(ModeInfo, Inst))),
suffix("."), nl],
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
%-----------------------------------------------------------------------------%
:- func purity_error_should_be_in_promise_purity_scope_to_specs(
negated_context_desc::in, mode_info::in, prog_var::in) =
(list(error_msg_spec)::out(error_msg_specs)) is det.
purity_error_should_be_in_promise_purity_scope_to_specs(NegCtxtDesc,
ModeInfo, Var) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
(
NegCtxtDesc = if_then_else,
Pieces = [
words("purity error: if-then-else"),
words("should be inside a promise_purity"),
words("scope because non-local variable"),
words(mercury_var_to_string(Var, VarSet, no)),
words("has inst any and appears in the condition.")
]
;
NegCtxtDesc = negation,
Pieces = [
words("purity error: negation"),
words("should be inside a promise_purity"),
words("scope because non-local variable"),
words(mercury_var_to_string(Var, VarSet, no)),
words("has inst any and appears in the body.")
]
),
Specs = [
mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)
].
%-----------------------------------------------------------------------------%
:- func purity_error_lambda_should_be_impure_to_specs(mode_info::in,
list(prog_var)::in) = (list(error_msg_spec)::out(error_msg_specs))
is det.
purity_error_lambda_should_be_impure_to_specs(ModeInfo, Vars) = Specs :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [
words("purity error: lambda should be impure because it"),
words("contains the following non-local variables"),
words("whose insts contain `any':"),
words(mercury_vars_to_string(Vars, VarSet, no)),
suffix("."), nl
],
Specs = [
mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)
].
%-----------------------------------------------------------------------------%
maybe_report_error_no_modes(PredId, PredInfo, ModuleInfo, !IO) :-
pred_info_import_status(PredInfo, ImportStatus),
( ImportStatus = local ->
globals__io_lookup_bool_option(infer_modes, InferModesOpt, !IO),
(
InferModesOpt = yes
;
InferModesOpt = no,
io__set_exit_status(1, !IO),
pred_info_context(PredInfo, Context),
Pieces1 = [words("Error: no mode declaration for")] ++
describe_one_pred_name(ModuleInfo, should_module_qualify,
PredId) ++ [suffix("."), nl],
globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
(
VerboseErrors = yes,
Pieces2 = [words("(Use `--infer-modes'"),
words("to enable mode inference.)"), nl]
;
VerboseErrors = no,
Pieces2 = []
),
write_error_pieces(Context, 0, Pieces1 ++ Pieces2, !IO)
)
;
io__set_exit_status(1, !IO),
pred_info_context(PredInfo, Context),
Pieces = [words("Error: no mode declaration for exported")] ++
describe_one_pred_name(ModuleInfo, should_module_qualify, PredId)
++ [suffix("."), nl],
write_error_pieces(Context, 0, Pieces, !IO)
).
%-----------------------------------------------------------------------------%
% Write out the inferred `mode' declarations for a list of pred_ids.
%
write_mode_inference_messages([], _, _, !IO).
write_mode_inference_messages([PredId | PredIds], OutputDetism, ModuleInfo,
!IO) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
( check_marker(Markers, infer_modes) ->
ProcIds = pred_info_all_procids(PredInfo),
pred_info_procedures(PredInfo, Procs),
write_mode_inference_messages_2(ProcIds, Procs, PredInfo,
OutputDetism, ModuleInfo, !IO)
;
true
),
write_mode_inference_messages(PredIds, OutputDetism, ModuleInfo, !IO).
% Write out the inferred `mode' declarations for a list of proc_ids.
%
:- pred write_mode_inference_messages_2(list(proc_id)::in, proc_table::in,
pred_info::in, bool::in, module_info::in, io::di, io::uo) is det.
write_mode_inference_messages_2([], _, _, _, _, !IO).
write_mode_inference_messages_2([ProcId | ProcIds], Procs, PredInfo,
OutputDetism, ModuleInfo, !IO) :-
globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
map__lookup(Procs, ProcId, ProcInfo),
(
(
% We always output `Inferred :- mode ...'
proc_info_is_valid_mode(ProcInfo)
;
% We only output `REJECTED :- mode ...'
% if --verbose-errors is enabled
VerboseErrors = yes
)
->
write_mode_inference_message(PredInfo, ProcInfo, OutputDetism,
ModuleInfo, !IO)
;
true
),
write_mode_inference_messages_2(ProcIds, Procs, PredInfo, OutputDetism,
ModuleInfo, !IO).
% Write out the inferred `mode' declaration for a single function
% or predicate..
%
:- pred write_mode_inference_message(pred_info::in, proc_info::in, bool::in,
module_info::in, io::di, io::uo) is det.
write_mode_inference_message(PredInfo, ProcInfo, OutputDetism, ModuleInfo,
!IO) :-
PredName = pred_info_name(PredInfo),
Name = unqualified(PredName),
pred_info_context(PredInfo, Context),
PredArity = pred_info_orig_arity(PredInfo),
some [!ArgModes, !MaybeDet] (
proc_info_argmodes(ProcInfo, !:ArgModes),
% We need to strip off the extra type_info arguments inserted at the
% front by polymorphism.m - we only want the last `PredArity' of them.
%
list__length(!.ArgModes, NumArgModes),
NumToDrop = NumArgModes - PredArity,
( list__drop(NumToDrop, !ArgModes) ->
true
;
unexpected(this_file, "report_pred_proc_id: list__drop failed")
),
varset__init(VarSet),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
(
OutputDetism = yes,
proc_info_inferred_determinism(ProcInfo, Detism),
!:MaybeDet = yes(Detism)
;
OutputDetism = no,
!:MaybeDet = no
),
( proc_info_is_valid_mode(ProcInfo) ->
Msg = "Inferred"
;
Msg = "REJECTED",
% Replace the final insts with dummy insts '...',
% since they won't be valid anyway -- they are just
% the results of whatever partial inference we did
% before detecting the error.
mode_list_get_initial_insts(ModuleInfo, !.ArgModes, InitialInsts),
DummyInst = defined_inst(user_inst(unqualified("..."), [])),
list__duplicate(PredArity, DummyInst, FinalInsts),
!:ArgModes = list__map(func(I - F) = (I -> F),
assoc_list.from_corresponding_lists(InitialInsts, FinalInsts)),
% Likewise delete the determinism.
!:MaybeDet = no
),
strip_builtin_qualifiers_from_mode_list(!ArgModes),
(
PredOrFunc = predicate,
Detail = mercury_pred_mode_decl_to_string(VarSet, Name,
!.ArgModes, !.MaybeDet, Context)
;
PredOrFunc = function,
pred_args_to_func_args(!.ArgModes, FuncArgModes, RetMode),
Detail = mercury_func_mode_decl_to_string(VarSet, Name,
FuncArgModes, RetMode, !.MaybeDet, Context)
),
Pieces = [words(Msg), words(Detail), nl],
write_error_pieces(Context, 0, Pieces, !IO)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
report_mode_errors(!ModeInfo, !IO) :-
mode_info_get_errors(!.ModeInfo, Errors),
(
Errors = [FirstError | _],
% XXX Document exactly why we only report the first.
FirstError = mode_error_info(_, ModeError, Context, ModeContext),
mode_info_set_context(Context, !ModeInfo),
mode_info_set_mode_context(ModeContext, !ModeInfo),
report_mode_error(ModeError, !.ModeInfo, !IO)
;
Errors = []
).
report_mode_warnings(!ModeInfo, !IO) :-
mode_info_get_warnings(!.ModeInfo, Warnings),
list__foldl(report_mode_warning(!.ModeInfo), Warnings, !IO).
%-----------------------------------------------------------------------------%
report_indistinguishable_modes_error(OldProcId, NewProcId, PredId, PredInfo,
ModuleInfo, !IO) :-
io__set_exit_status(1, !IO),
pred_info_procedures(PredInfo, Procs),
map__lookup(Procs, OldProcId, OldProcInfo),
map__lookup(Procs, NewProcId, NewProcInfo),
proc_info_context(OldProcInfo, OldContext),
proc_info_context(NewProcInfo, NewContext),
Pieces1 = [words("In mode declarations for ")] ++
describe_one_pred_name(ModuleInfo, should_module_qualify, PredId)
++ [suffix(":"), nl, words("error: duplicate mode declaration."), nl],
Specs1 = [error_msg_spec(no, NewContext, 0, Pieces1)],
globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
(
VerboseErrors = yes,
Pieces2 = [words("Modes"),
fixed(add_quotes(mode_decl_to_string(OldProcId, PredInfo))),
words("and"),
fixed(add_quotes(mode_decl_to_string(NewProcId, PredInfo))),
words("are indistinguishable.")],
Specs2 = [error_msg_spec(no, NewContext, 0, Pieces2)]
;
VerboseErrors = no,
Specs2 = []
),
Pieces3 = [words("Here is the conflicting mode declaration.")],
Specs3 = [error_msg_spec(no, OldContext, 0, Pieces3)],
write_error_specs(Specs1 `do_append` Specs2 `do_append` Specs3, !IO).
:- func do_append(list(T)::in(list_skel(I =< ground)),
list(T)::in(list_skel(I =< ground))) =
(list(T)::out(list_skel(I =< ground))) is det.
do_append([], L) = L.
do_append([H | T], L) = [H | NT] :-
do_append(T, L) = NT.
%-----------------------------------------------------------------------------%
output_mode_decl(ProcId, PredInfo, !IO) :-
io__write_string(mode_decl_to_string(ProcId, PredInfo), !IO).
mode_decl_to_string(ProcId, PredInfo) = String :-
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Name0 = pred_info_name(PredInfo),
Name = unqualified(Name0),
pred_info_procedures(PredInfo, Procs),
map__lookup(Procs, ProcId, ProcInfo),
proc_info_declared_argmodes(ProcInfo, Modes0),
proc_info_declared_determinism(ProcInfo, MaybeDet),
proc_info_context(ProcInfo, Context),
varset__init(InstVarSet),
strip_builtin_qualifiers_from_mode_list(Modes0, Modes),
String = mercury_mode_subdecl_to_string(PredOrFunc, InstVarSet, Name,
Modes, MaybeDet, Context).
:- pred output_inst(mer_inst::in, mode_info::in, io::di, io::uo) is det.
output_inst(Inst0, ModeInfo, !IO) :-
io__write_string(inst_to_string(ModeInfo, Inst0), !IO).
:- func inst_to_string(mode_info, mer_inst) = string.
inst_to_string(ModeInfo, Inst0) = Str :-
strip_builtin_qualifiers_from_inst(Inst0, Inst),
mode_info_get_instvarset(ModeInfo, InstVarSet),
mode_info_get_module_info(ModeInfo, ModuleInfo),
Str = mercury_expanded_inst_to_string(Inst, InstVarSet, ModuleInfo).
:- pred output_inst_list(list(mer_inst)::in, mode_info::in, io::di, io::uo)
is det.
output_inst_list(Insts, ModeInfo, !IO) :-
io__write_string(inst_list_to_string(ModeInfo, Insts), !IO).
:- func inst_list_to_string(mode_info, list(mer_inst)) = string.
inst_list_to_string(ModeInfo, Insts) =
string__join_list(", ", list__map(inst_to_string(ModeInfo), Insts)).
:- pred output_inst_list_sep_lines(prog_context::in, list(mer_inst)::in,
mode_info::in, io::di, io::uo) is det.
output_inst_list_sep_lines(_Context, [], _, !IO).
output_inst_list_sep_lines(Context, [Inst | Insts], ModeInfo, !IO) :-
prog_out__write_context(Context, !IO),
io__write_string(" ", !IO),
output_inst(Inst, ModeInfo, !IO),
(
Insts = []
;
Insts = [_ | _],
io__write_string(",", !IO)
),
io__nl(!IO),
output_inst_list_sep_lines(Context, Insts, ModeInfo, !IO).
:- func inst_list_to_sep_lines(mode_info, list(mer_inst))
= list(format_component).
inst_list_to_sep_lines(_ModeInfo, []) = [].
inst_list_to_sep_lines(ModeInfo, [Inst | Insts]) = Pieces ++ MorePieces :-
(
Insts = [],
Comma = [],
Newline = nl_indent_delta(-1)
;
Insts = [_ | _],
Comma = [suffix(",")],
Newline = nl
),
Pieces = [words(inst_to_string(ModeInfo, Inst))] ++ Comma ++ [Newline],
MorePieces = inst_list_to_sep_lines(ModeInfo, Insts).
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "mode_errors.m".
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink