mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-12 12:26:29 +00:00
5eae909f78
compiler/hlds_cons.m:
compiler/hlds_data.m:
Move the parts of hlds_data.m dealing with the cons table
(representing the function symbols visible in the current module)
and with the fields within those function symbols to the new module
hlds_cons.m. This code was a large fraction of hlds_data.m, yet it is
needed by relatively few modules.
compiler/hlds.m:
compiler/notes/compiler_design.html:
Add and document the new module.
compiler/*.m:
Import the new module as well as, or instead of, hlds_data.m.
831 lines
36 KiB
Mathematica
831 lines
36 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2012,2014 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.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.make_hlds.add_clause.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.make_hlds.qual_info.
|
|
:- import_module hlds.quantification.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.maybe_error.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred module_add_clause(prog_varset::in, pred_or_func::in, sym_name::in,
|
|
list(prog_term)::in, maybe1(goal)::in, pred_status::in, prog_context::in,
|
|
maybe(int)::in, goal_type::in, module_info::in, module_info::out,
|
|
qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
:- pred clauses_info_add_clause(clause_applicable_modes::in, list(proc_id)::in,
|
|
prog_varset::in, tvarset::in, list(prog_term)::in, goal::in,
|
|
prog_context::in, maybe(int)::in, pred_status::in, pred_or_func::in,
|
|
arity::in, goal_type::in, hlds_goal::out, prog_varset::out, tvarset::out,
|
|
list(quant_warning)::out, clauses_info::in, clauses_info::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_errors.
|
|
:- import_module hlds.add_pred.
|
|
:- import_module hlds.default_func_mode.
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.hlds_args.
|
|
:- import_module hlds.hlds_code_util.
|
|
:- import_module hlds.hlds_error_util.
|
|
:- import_module hlds.hlds_out.
|
|
:- import_module hlds.hlds_out.hlds_out_goal.
|
|
:- import_module hlds.hlds_out.hlds_out_util.
|
|
:- import_module hlds.hlds_rtti.
|
|
:- import_module hlds.make_goal.
|
|
:- import_module hlds.make_hlds.goal_expr_to_goal.
|
|
:- import_module hlds.make_hlds.make_hlds_warn.
|
|
:- import_module hlds.make_hlds.state_var.
|
|
:- import_module hlds.make_hlds.superhomogeneous.
|
|
:- import_module hlds.pre_quantification.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module parse_tree.module_qual.
|
|
:- import_module parse_tree.parse_inst_mode_name.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.parse_tree_out_pred_decl.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_rename.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module int.
|
|
:- import_module io.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
module_add_clause(ClauseVarSet, PredOrFunc, PredName, ArgTerms0, MaybeBodyGoal,
|
|
Status, Context, MaybeSeqNum, GoalType,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
( if
|
|
illegal_state_var_func_result(PredOrFunc, ArgTerms0, SVar, SVarCtxt)
|
|
then
|
|
IllegalSVarResult = yes({SVar, SVarCtxt})
|
|
else
|
|
IllegalSVarResult = no
|
|
),
|
|
ArityAdjustment = ( if IllegalSVarResult = yes(_) then -1 else 0 ),
|
|
expand_bang_state_pairs_in_terms(ArgTerms0, ArgTerms),
|
|
|
|
% Lookup the pred declaration in the predicate table.
|
|
% (If it's not there, call maybe_undefined_pred_error and insert
|
|
% an implicit declaration for the predicate.)
|
|
module_info_get_name(!.ModuleInfo, ModuleName),
|
|
list.length(ArgTerms, Arity0),
|
|
Arity = Arity0 + ArityAdjustment,
|
|
some [!PredInfo] (
|
|
module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
|
|
predicate_table_lookup_pf_sym_arity(PredicateTable,
|
|
is_fully_qualified, PredOrFunc, PredName, Arity, PredIds),
|
|
( if PredIds = [PredIdPrime] then
|
|
MaybePredId = yes(PredIdPrime),
|
|
( if GoalType = goal_type_promise(_) then
|
|
NameString = sym_name_to_string(PredName),
|
|
string.format("%s %s %s (%s).\n",
|
|
[s("Attempted to introduce a predicate"),
|
|
s("for a promise with an identical"),
|
|
s("name to an existing predicate"),
|
|
s(NameString)], UnexpectedMsg),
|
|
unexpected($module, $pred, UnexpectedMsg)
|
|
else
|
|
true
|
|
)
|
|
else if unqualify_name(PredName) = ",", Arity = 2 then
|
|
MaybePredId = no,
|
|
Pieces = [words("Attempt to define a clause for"),
|
|
unqual_sym_name_and_arity(sym_name_arity(unqualified(","), 2)),
|
|
suffix("."),
|
|
words("This is usually caused by"),
|
|
words("inadvertently writing a period instead of a comma"),
|
|
words("at the end of the preceding line."), nl],
|
|
Msg = simple_msg(Context, [always(Pieces)]),
|
|
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
% A promise will not have a corresponding pred declaration.
|
|
( if GoalType = goal_type_promise(_) then
|
|
HeadVars = term.term_list_to_var_list(ArgTerms),
|
|
preds_add_implicit_for_assertion(!ModuleInfo, ModuleName,
|
|
PredName, Arity, PredOrFunc, HeadVars, Status, Context,
|
|
NewPredId)
|
|
else
|
|
preds_add_implicit_report_error(!ModuleInfo, ModuleName,
|
|
PredName, Arity, PredOrFunc, Status, is_not_a_class_method,
|
|
Context, origin_user(PredName), [words("clause")],
|
|
NewPredId, !Specs)
|
|
),
|
|
MaybePredId = yes(NewPredId)
|
|
),
|
|
(
|
|
MaybePredId = yes(PredId),
|
|
module_add_clause_2(ClauseVarSet, PredOrFunc, PredName, PredId,
|
|
ArgTerms, Arity, ArityAdjustment, MaybeBodyGoal,
|
|
Status, Context, MaybeSeqNum, GoalType, IllegalSVarResult,
|
|
!ModuleInfo, !QualInfo, !Specs)
|
|
;
|
|
MaybePredId = no
|
|
)
|
|
).
|
|
|
|
:- pred module_add_clause_2(prog_varset::in, pred_or_func::in, sym_name::in,
|
|
pred_id::in, list(prog_term)::in, int::in, int::in, maybe1(goal)::in,
|
|
pred_status::in, prog_context::in, maybe(int)::in, goal_type::in,
|
|
maybe({prog_var, prog_context})::in, module_info::in, module_info::out,
|
|
qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
module_add_clause_2(ClauseVarSet, PredOrFunc, PredName, PredId,
|
|
MaybeAnnotatedArgTerms, Arity, ArityAdjustment, MaybeBodyGoal,
|
|
PredStatus, Context, MaybeSeqNum, GoalType, IllegalSVarResult,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
some [!PredInfo, !PredicateTable, !PredSpecs] (
|
|
% Lookup the pred_info for this pred, add the clause to the
|
|
% clauses_info in the pred_info, if there are no modes add an
|
|
% `infer_modes' marker, and then save the pred_info.
|
|
module_info_get_predicate_table(!.ModuleInfo, !:PredicateTable),
|
|
predicate_table_get_preds(!.PredicateTable, PredMap0),
|
|
map.lookup(PredMap0, PredId, !:PredInfo),
|
|
|
|
trace [io(!IO)] (
|
|
some [Globals] (
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
|
|
(
|
|
VeryVerbose = yes,
|
|
pred_info_get_clauses_info(!.PredInfo, MsgClauses),
|
|
NumClauses = num_clauses_in_clauses_rep(
|
|
MsgClauses ^ cli_rep),
|
|
io.format("%% Processing clause %d for ",
|
|
[i(NumClauses + 1)], !IO),
|
|
write_pred_or_func(PredOrFunc, !IO),
|
|
io.write_string(" `", !IO),
|
|
list.length(MaybeAnnotatedArgTerms, PredArity0),
|
|
PredArity = PredArity0 + ArityAdjustment,
|
|
adjust_func_arity(PredOrFunc, OrigArity, PredArity),
|
|
prog_out.write_sym_name_and_arity(
|
|
sym_name_arity(PredName, OrigArity), !IO),
|
|
io.write_string("'...\n", !IO)
|
|
;
|
|
VeryVerbose = no
|
|
)
|
|
)
|
|
),
|
|
|
|
% Opt_imported preds are initially tagged as imported, and are tagged
|
|
% as opt_imported only if/when we see a clause for them.
|
|
( if PredStatus = pred_status(status_opt_imported) then
|
|
pred_info_set_status(pred_status(status_opt_imported), !PredInfo),
|
|
pred_info_get_markers(!.PredInfo, InitMarkers0),
|
|
add_marker(marker_calls_are_fully_qualified,
|
|
InitMarkers0, InitMarkers),
|
|
pred_info_set_markers(InitMarkers, !PredInfo)
|
|
else
|
|
true
|
|
),
|
|
|
|
!:PredSpecs = [],
|
|
(
|
|
IllegalSVarResult = yes({StateVar, StateVarContext}),
|
|
report_illegal_func_svar_result(StateVarContext, ClauseVarSet,
|
|
StateVar, !PredSpecs)
|
|
;
|
|
IllegalSVarResult = no
|
|
),
|
|
|
|
( if
|
|
% User-supplied clauses for field access functions are not
|
|
% allowed -- the clauses are always generated by the compiler.
|
|
PredOrFunc = pf_function,
|
|
adjust_func_arity(pf_function, FuncArity, Arity),
|
|
is_field_access_function_name(!.ModuleInfo, PredName,
|
|
FuncArity, _, _),
|
|
|
|
% Don't report errors for clauses for field access function clauses
|
|
% in `.opt' files.
|
|
PredStatus \= pred_status(status_opt_imported)
|
|
then
|
|
CallId = simple_call_id(PredOrFunc, PredName, Arity),
|
|
FieldAccessMainPieces =
|
|
[words("Error: clause for automatically generated"),
|
|
words("field access"), simple_call(CallId), suffix("."), nl],
|
|
FieldAccessVerbosePieces =
|
|
[words("Clauses for field access functions"),
|
|
words("are automatically generated by the compiler."),
|
|
words("To supply your own definition for a field access"),
|
|
words("function, for example to check the input"),
|
|
words("to a field update, give the field"),
|
|
words("of the constructor a different name.")],
|
|
FieldAccessMsg = simple_msg(Context,
|
|
[always(FieldAccessMainPieces),
|
|
verbose_only(verbose_always, FieldAccessVerbosePieces)]),
|
|
FieldAccessSpec = error_spec(severity_error,
|
|
phase_parse_tree_to_hlds, [FieldAccessMsg]),
|
|
!:PredSpecs = [FieldAccessSpec | !.PredSpecs]
|
|
else
|
|
true
|
|
),
|
|
|
|
( if pred_info_is_builtin(!.PredInfo) then
|
|
% When bootstrapping a change that defines a builtin using
|
|
% normal Mercury code, we need to disable the generation
|
|
% of the error message, and just ignore the definition.
|
|
some [Globals] (
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, allow_defn_of_builtins,
|
|
AllowDefnOfBuiltin)
|
|
),
|
|
(
|
|
AllowDefnOfBuiltin = no,
|
|
BuiltinMsg = simple_msg(Context,
|
|
[always([words("Error: clause for builtin.")])]),
|
|
BuiltinSpec = error_spec(severity_error,
|
|
phase_parse_tree_to_hlds, [BuiltinMsg]),
|
|
!:PredSpecs = [BuiltinSpec | !.PredSpecs]
|
|
;
|
|
AllowDefnOfBuiltin = yes
|
|
)
|
|
else
|
|
true
|
|
),
|
|
|
|
maybe_add_default_func_mode(!PredInfo, _),
|
|
(
|
|
!.PredSpecs = [_ | _ ],
|
|
!:Specs = !.PredSpecs ++ get_any_errors1(MaybeBodyGoal) ++ !.Specs
|
|
;
|
|
!.PredSpecs = [],
|
|
(
|
|
MaybeBodyGoal = error1(BodyGoalSpecs),
|
|
!:Specs = BodyGoalSpecs ++ !.Specs,
|
|
pred_info_get_clauses_info(!.PredInfo, Clauses0),
|
|
Clauses = Clauses0 ^ cli_had_syntax_errors :=
|
|
some_clause_syntax_errors,
|
|
pred_info_set_clauses_info(Clauses, !PredInfo)
|
|
;
|
|
MaybeBodyGoal = ok1(BodyGoal),
|
|
pred_info_get_clauses_info(!.PredInfo, Clauses0),
|
|
pred_info_get_typevarset(!.PredInfo, TVarSet0),
|
|
select_applicable_modes(MaybeAnnotatedArgTerms, ClauseVarSet,
|
|
PredStatus, Context, PredId, !.PredInfo, ArgTerms,
|
|
ProcIdsForThisClause, AllProcIds,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
clauses_info_add_clause(ProcIdsForThisClause, AllProcIds,
|
|
ClauseVarSet, TVarSet0, ArgTerms, BodyGoal,
|
|
Context, MaybeSeqNum, PredStatus, PredOrFunc, Arity,
|
|
GoalType, Goal, VarSet, TVarSet, Warnings,
|
|
Clauses0, Clauses, !ModuleInfo, !QualInfo, !Specs),
|
|
pred_info_set_clauses_info(Clauses, !PredInfo),
|
|
( if GoalType = goal_type_promise(PromiseType) then
|
|
pred_info_set_goal_type(goal_type_promise(PromiseType),
|
|
!PredInfo)
|
|
else
|
|
pred_info_update_goal_type(goal_type_clause, !PredInfo)
|
|
),
|
|
pred_info_set_typevarset(TVarSet, !PredInfo),
|
|
pred_info_get_arg_types(!.PredInfo, _ArgTVarSet, ExistQVars,
|
|
ArgTypes),
|
|
pred_info_set_arg_types(TVarSet, ExistQVars, ArgTypes,
|
|
!PredInfo),
|
|
|
|
% Check if there are still no modes for the predicate, and
|
|
% if so, set the `infer_modes' marker for that predicate.
|
|
% Predicates representing promises do not need mode inference.
|
|
|
|
ProcIds = pred_info_all_procids(!.PredInfo),
|
|
( if
|
|
ProcIds = [],
|
|
GoalType \= goal_type_promise(_)
|
|
then
|
|
pred_info_get_markers(!.PredInfo, EndMarkers0),
|
|
add_marker(marker_infer_modes, EndMarkers0, EndMarkers),
|
|
pred_info_set_markers(EndMarkers, !PredInfo)
|
|
else
|
|
true
|
|
),
|
|
( if
|
|
(
|
|
% Any singleton warnings should be generated
|
|
% for the original code, not for the copy
|
|
% in a .opt or .trans_opt file.
|
|
PredStatus = pred_status(status_opt_imported)
|
|
;
|
|
% Part of the parser's recovery from syntax errors
|
|
% (e.g. when they occur in lambda expressions' clause
|
|
% heads) may have included not translating parts
|
|
% of the original term into the parsed clause body,
|
|
% so any singleton warnings we generate for such
|
|
% "truncated" clauses could be misleading.
|
|
%
|
|
% We could try to record the set of variables
|
|
% in the parts of the original goal term that we don't
|
|
% include in the clause, but (a) this is not trivial
|
|
% to do, and (b) the payoff is questionable, because
|
|
% some of those variables could have been the result
|
|
% of typos affecting a word that the programmer meant
|
|
% to be something else.
|
|
Clauses ^ cli_had_syntax_errors =
|
|
some_clause_syntax_errors
|
|
)
|
|
then
|
|
true
|
|
else
|
|
% Warn about singleton variables.
|
|
SimpleCallId = simple_call_id(PredOrFunc, PredName, Arity),
|
|
warn_singletons(!.ModuleInfo, SimpleCallId, VarSet, Goal,
|
|
!Specs),
|
|
% Warn about variables with overlapping scopes.
|
|
add_quant_warnings(SimpleCallId, VarSet, Warnings, !Specs)
|
|
)
|
|
),
|
|
map.det_update(PredId, !.PredInfo, PredMap0, PredMap),
|
|
predicate_table_set_preds(PredMap, !PredicateTable),
|
|
module_info_set_predicate_table(!.PredicateTable, !ModuleInfo)
|
|
)
|
|
).
|
|
|
|
% Extract the mode annotations (if any) from the clause arguments,
|
|
% and determine which mode(s) this clause should apply to.
|
|
%
|
|
:- pred select_applicable_modes(list(prog_term)::in, prog_varset::in,
|
|
pred_status::in, prog_context::in, pred_id::in, pred_info::in,
|
|
list(prog_term)::out, clause_applicable_modes::out, list(proc_id)::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
select_applicable_modes(MaybeAnnotatedArgTerms, VarSet, PredStatus, Context,
|
|
PredId, PredInfo, ArgTerms, ApplProcIds, AllProcIds,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
AllProcIds = pred_info_all_procids(PredInfo),
|
|
PredIdStr = pred_id_to_string(!.ModuleInfo, PredId),
|
|
ContextPieces = cord.from_list([words("In the head of a clause for"),
|
|
fixed(PredIdStr), suffix(":"), nl]),
|
|
get_mode_annotations(VarSet, ContextPieces, MaybeAnnotatedArgTerms, 1,
|
|
ArgTerms, ma_empty, ModeAnnotations, [], ModeAnnotationSpecs),
|
|
(
|
|
ModeAnnotationSpecs = [_ | _],
|
|
!:Specs = ModeAnnotationSpecs ++ !.Specs,
|
|
% Apply the clause to all modes.
|
|
% XXX Would it be better to apply it to none?
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
;
|
|
ModeAnnotationSpecs = [],
|
|
(
|
|
ModeAnnotations = ma_modes(ModeList0),
|
|
|
|
% The user specified some mode annotations on this clause.
|
|
% First module-qualify the mode annotations. The annotations on
|
|
% clauses from `.opt' files will already be fully module qualified.
|
|
|
|
( if PredStatus = pred_status(status_opt_imported) then
|
|
ModeList = ModeList0
|
|
else
|
|
Exported =
|
|
pred_status_is_exported_to_non_submodules(PredStatus),
|
|
(
|
|
Exported = yes,
|
|
InInt = mq_used_in_interface
|
|
;
|
|
Exported = no,
|
|
InInt = mq_not_used_in_interface
|
|
),
|
|
qual_info_get_mq_info(!.QualInfo, MQInfo0),
|
|
qualify_clause_mode_list(InInt, Context,
|
|
ModeList0, ModeList, MQInfo0, MQInfo, !Specs),
|
|
qual_info_set_mq_info(MQInfo, !QualInfo)
|
|
),
|
|
|
|
% Now find the procedure which matches these mode annotations.
|
|
pred_info_get_proc_table(PredInfo, Procs),
|
|
map.to_assoc_list(Procs, ExistingProcs),
|
|
( if
|
|
get_procedure_matching_declmodes_with_renaming(ExistingProcs,
|
|
ModeList, !.ModuleInfo, ProcId)
|
|
then
|
|
ApplProcIds = selected_modes([ProcId])
|
|
else
|
|
undeclared_mode_error(ModeList, VarSet, PredId, PredInfo,
|
|
!.ModuleInfo, Context, !Specs),
|
|
% Apply the clause to all modes.
|
|
% XXX Would it be better to apply it to none?
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
)
|
|
;
|
|
( ModeAnnotations = ma_empty
|
|
; ModeAnnotations = ma_none
|
|
),
|
|
( if pred_info_pragma_goal_type(PredInfo) then
|
|
% We are only allowed to mix foreign procs and
|
|
% mode specific clauses, so make this clause
|
|
% mode specific but apply to all modes.
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
else
|
|
ApplProcIds = all_modes
|
|
)
|
|
;
|
|
ModeAnnotations = ma_mixed,
|
|
Pieces = [words("In the head of a clause for"),
|
|
fixed(PredIdStr), suffix(":"), nl,
|
|
words("syntax error: some but not all arguments"),
|
|
words("have mode annotations."), nl],
|
|
Msg = simple_msg(Context, [always(Pieces)]),
|
|
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
|
|
!:Specs = [Spec | !.Specs],
|
|
|
|
% Apply the clause to all modes.
|
|
% XXX Would it be better to apply it to none?
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
)
|
|
).
|
|
|
|
:- pred undeclared_mode_error(list(mer_mode)::in, prog_varset::in,
|
|
pred_id::in, pred_info::in, module_info::in, prog_context::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
undeclared_mode_error(ModeList, VarSet, PredId, PredInfo, ModuleInfo, Context,
|
|
!Specs) :-
|
|
PredIdPieces = describe_one_pred_name(ModuleInfo,
|
|
should_not_module_qualify, PredId),
|
|
strip_builtin_qualifiers_from_mode_list(ModeList, StrippedModeList),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
Name = pred_info_name(PredInfo),
|
|
MaybeDet = no,
|
|
SubDeclStr = mercury_mode_subdecl_to_string(output_debug, PredOrFunc,
|
|
varset.coerce(VarSet), unqualified(Name), StrippedModeList, MaybeDet),
|
|
|
|
MainPieces = [words("In clause for")] ++ PredIdPieces ++ [suffix(":"), nl,
|
|
words("error: mode annotation specifies undeclared mode"),
|
|
quote(SubDeclStr), suffix("."), nl],
|
|
ProcIds = pred_info_all_procids(PredInfo),
|
|
(
|
|
ProcIds = [],
|
|
VerbosePieces = [words("(There are no declared modes for this"),
|
|
p_or_f(PredOrFunc), suffix(".)"), nl]
|
|
;
|
|
ProcIds = [ProcIdsHead | ProcIdsTail],
|
|
(
|
|
ProcIdsTail = [],
|
|
VerbosePieces = [words("The declared mode for this"),
|
|
p_or_f(PredOrFunc), words("is:"),
|
|
nl_indent_delta(1)] ++
|
|
mode_decl_for_pred_info_to_pieces(PredInfo, ProcIdsHead) ++
|
|
[nl_indent_delta(-1)]
|
|
;
|
|
ProcIdsTail = [_ | _],
|
|
VerbosePieces = [words("The declared modes for this"),
|
|
p_or_f(PredOrFunc), words("are the following:"),
|
|
nl_indent_delta(1)] ++
|
|
component_list_to_line_pieces(
|
|
list.map(mode_decl_for_pred_info_to_pieces(PredInfo),
|
|
ProcIds),
|
|
[]) ++
|
|
[nl_indent_delta(-1)]
|
|
)
|
|
),
|
|
Msg = simple_msg(Context,
|
|
[always(MainPieces), verbose_only(verbose_always, VerbosePieces)]),
|
|
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
|
|
!:Specs = [Spec | !.Specs].
|
|
|
|
:- func mode_decl_for_pred_info_to_pieces(pred_info, proc_id)
|
|
= list(format_component).
|
|
|
|
mode_decl_for_pred_info_to_pieces(PredInfo, ProcId) =
|
|
[words(":- mode"), words(mode_decl_to_string(ProcId, PredInfo)),
|
|
suffix(".")].
|
|
|
|
% Clauses can have mode annotations on them, to indicate that the
|
|
% clause should only be used for particular modes of a predicate.
|
|
% This type specifies the mode annotations on a clause.
|
|
:- type mode_annotations
|
|
---> ma_empty
|
|
% No arguments.
|
|
|
|
; ma_none
|
|
% One or more arguments, each without any mode annotations.
|
|
|
|
; ma_modes(list(mer_mode))
|
|
% One or more arguments, each with a mode annotation.
|
|
|
|
; ma_mixed.
|
|
% Two or more arguments, including some with mode annotations
|
|
% and some without. (This is not allowed.)
|
|
|
|
% Extract the mode annotations (if any) from a list of arguments.
|
|
%
|
|
:- pred get_mode_annotations(prog_varset::in, cord(format_component)::in,
|
|
list(prog_term)::in, int::in, list(prog_term)::out,
|
|
mode_annotations::in, mode_annotations::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
get_mode_annotations(_, _, [], _, [], !Annotations, !Specs).
|
|
get_mode_annotations(VarSet, ContextPieces,
|
|
[MAArgTerm | MAArgTerms], ArgNum, [ArgTerm | ArgTerms],
|
|
!Annotations, !Specs) :-
|
|
ArgContextPieces = ContextPieces ++
|
|
cord.from_list([words("in the"), nth_fixed(ArgNum),
|
|
words("argument:"), nl]),
|
|
get_mode_annotation(VarSet, ArgContextPieces, MAArgTerm, ArgTerm,
|
|
MaybeMaybeMode),
|
|
(
|
|
MaybeMaybeMode = ok1(MaybeMode),
|
|
add_annotation(MaybeMode, !Annotations)
|
|
;
|
|
MaybeMaybeMode = error1(MaybeModeSpecs),
|
|
!:Specs = !.Specs ++ MaybeModeSpecs
|
|
),
|
|
get_mode_annotations(VarSet, ContextPieces,
|
|
MAArgTerms, ArgNum + 1, ArgTerms, !Annotations, !Specs).
|
|
|
|
:- pred add_annotation(maybe(mer_mode)::in,
|
|
mode_annotations::in, mode_annotations::out) is det.
|
|
|
|
add_annotation(no, ma_empty, ma_none).
|
|
add_annotation(yes(Mode), ma_empty, ma_modes([Mode])).
|
|
add_annotation(no, ma_modes(_ : list(mer_mode)), ma_mixed).
|
|
add_annotation(yes(Mode), ma_modes(Modes), ma_modes(Modes ++ [Mode])).
|
|
add_annotation(no, ma_none, ma_none).
|
|
add_annotation(yes(_), ma_none, ma_mixed).
|
|
add_annotation(_, ma_mixed, ma_mixed).
|
|
|
|
% Extract the mode annotations (if any) from a single argument.
|
|
%
|
|
:- pred get_mode_annotation(prog_varset::in, cord(format_component)::in,
|
|
prog_term::in, prog_term::out, maybe1(maybe(mer_mode))::out) is det.
|
|
|
|
get_mode_annotation(VarSet, ContextPieces, MaybeAnnotatedArgTerm, ArgTerm,
|
|
MaybeMaybeAnnotation) :-
|
|
( if
|
|
MaybeAnnotatedArgTerm = term.functor(term.atom("::"),
|
|
[ArgTermPrime, ModeTerm], _)
|
|
then
|
|
ArgTerm = ArgTermPrime,
|
|
|
|
varset.coerce(VarSet, GenVarSet),
|
|
term.coerce(ModeTerm, GenModeTerm),
|
|
parse_mode(allow_constrained_inst_var, GenVarSet, ContextPieces,
|
|
GenModeTerm, MaybeMode),
|
|
(
|
|
MaybeMode = ok1(Mode),
|
|
MaybeMaybeAnnotation = ok1(yes(Mode))
|
|
;
|
|
MaybeMode = error1(Specs),
|
|
MaybeMaybeAnnotation = error1(Specs)
|
|
)
|
|
else
|
|
ArgTerm = MaybeAnnotatedArgTerm,
|
|
MaybeMaybeAnnotation = ok1(no)
|
|
).
|
|
|
|
clauses_info_add_clause(ApplModeIds0, AllModeIds, CVarSet, TVarSet0, ArgTerms,
|
|
BodyGoal, Context, MaybeSeqNum, PredStatus, PredOrFunc, Arity,
|
|
GoalType, Goal, VarSet, TVarSet, QuantWarnings,
|
|
!ClausesInfo, !ModuleInfo, !QualInfo, !Specs) :-
|
|
!.ClausesInfo = clauses_info(VarSet0, TVarNameMap0,
|
|
ExplicitVarTypes0, InferredVarTypes, HeadVars,
|
|
ClausesRep0, ItemNumbers0, RttiVarMaps,
|
|
HasForeignClauses, HadSyntaxError0),
|
|
IsEmpty = clause_list_is_empty(ClausesRep0),
|
|
(
|
|
IsEmpty = yes,
|
|
% Create the mapping from type variable name, used to rename
|
|
% type variables occurring in explicit type qualifications.
|
|
% The version of this mapping stored in the clauses_info should
|
|
% only contain type variables which occur in the argument types
|
|
% of the predicate. Type variables which only occur in explicit type
|
|
% qualifications are local to the clause in which they appear.
|
|
varset.create_name_var_map(TVarSet0, TVarNameMap)
|
|
;
|
|
IsEmpty = no,
|
|
TVarNameMap = TVarNameMap0
|
|
),
|
|
( if PredStatus = pred_status(status_opt_imported) then
|
|
MaybeOptImported = is_opt_imported
|
|
else
|
|
MaybeOptImported = is_not_opt_imported
|
|
),
|
|
update_qual_info(TVarNameMap, TVarSet0, ExplicitVarTypes0,
|
|
MaybeOptImported, !QualInfo),
|
|
varset.merge_renaming(VarSet0, CVarSet, VarSet1, Renaming),
|
|
add_clause_transform(Renaming, HeadVars, ArgTerms, BodyGoal, Context,
|
|
PredOrFunc, Arity, GoalType, Goal0, VarSet1, VarSet,
|
|
QuantWarnings, StateVarWarnings, StateVarErrors,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
qual_info_get_tvarset(!.QualInfo, TVarSet),
|
|
qual_info_get_found_syntax_error(!.QualInfo, FoundError),
|
|
qual_info_set_found_syntax_error(no, !QualInfo),
|
|
( if
|
|
( FoundError = yes
|
|
; StateVarErrors = [_ | _]
|
|
)
|
|
then
|
|
% Don't insert clauses containing syntax errors into the
|
|
% clauses_info, because doing that would cause typecheck.m
|
|
% to report spurious type errors. Don't report singleton variable
|
|
% warnings if there were syntax errors.
|
|
!:Specs = StateVarErrors ++ !.Specs,
|
|
Goal = true_goal,
|
|
!ClausesInfo ^ cli_had_syntax_errors := some_clause_syntax_errors
|
|
else
|
|
Goal = Goal0,
|
|
% If we have foreign clauses, we should only add this clause
|
|
% for modes *not* covered by the foreign clauses.
|
|
(
|
|
HasForeignClauses = some_foreign_lang_clauses,
|
|
get_clause_list(Clauses0, ClausesRep0, ClausesRep1),
|
|
ForeignModeIds = list.condense(list.filter_map(
|
|
( func(C) = ProcIds is semidet :-
|
|
C ^ clause_lang = impl_lang_foreign(_),
|
|
ApplProcIds = C ^ clause_applicable_procs,
|
|
(
|
|
ApplProcIds = all_modes,
|
|
unexpected($module, $pred, "all_modes foreign_proc")
|
|
;
|
|
ApplProcIds = selected_modes(ProcIds)
|
|
;
|
|
( ApplProcIds = unify_in_in_modes
|
|
; ApplProcIds = unify_non_in_in_modes
|
|
),
|
|
unexpected($pred, "unify modes for foreign_proc")
|
|
)
|
|
),
|
|
Clauses0)),
|
|
(
|
|
ApplModeIds0 = all_modes,
|
|
ModeIds0 = AllModeIds
|
|
;
|
|
ApplModeIds0 = selected_modes(ModeIds0)
|
|
;
|
|
( ApplModeIds0 = unify_in_in_modes
|
|
; ApplModeIds0 = unify_non_in_in_modes
|
|
),
|
|
unexpected($pred, "unify modes for user defined predicate")
|
|
),
|
|
ModeIds = list.delete_elems(ModeIds0, ForeignModeIds),
|
|
(
|
|
ModeIds = [],
|
|
ClausesRep = ClausesRep1
|
|
;
|
|
ModeIds = [_ | _],
|
|
ApplicableModeIds = selected_modes(ModeIds),
|
|
Clause = clause(ApplicableModeIds, Goal, impl_lang_mercury,
|
|
Context, StateVarWarnings),
|
|
add_clause(Clause, ClausesRep1, ClausesRep)
|
|
)
|
|
;
|
|
HasForeignClauses = no_foreign_lang_clauses,
|
|
Clause = clause(ApplModeIds0, Goal, impl_lang_mercury, Context,
|
|
StateVarWarnings),
|
|
add_clause(Clause, ClausesRep0, ClausesRep)
|
|
),
|
|
qual_info_get_var_types(!.QualInfo, ExplicitVarTypes),
|
|
add_clause_item_number(MaybeSeqNum, Context, item_is_clause,
|
|
ItemNumbers0, ItemNumbers),
|
|
!:ClausesInfo = clauses_info(VarSet, TVarNameMap,
|
|
ExplicitVarTypes, InferredVarTypes, HeadVars,
|
|
ClausesRep, ItemNumbers, RttiVarMaps,
|
|
HasForeignClauses, HadSyntaxError0)
|
|
).
|
|
|
|
% ArgTerms0 has already had !S arguments replaced by
|
|
% !.S, !:S argument pairs.
|
|
%
|
|
:- pred add_clause_transform(prog_var_renaming::in,
|
|
proc_arg_vector(prog_var)::in, list(prog_term)::in, goal::in,
|
|
prog_context::in, pred_or_func::in, arity::in, goal_type::in,
|
|
hlds_goal::out, prog_varset::in, prog_varset::out,
|
|
list(quant_warning)::out, list(error_spec)::out, list(error_spec)::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
add_clause_transform(Renaming, HeadVars, ArgTerms0, ParseTreeBodyGoal, Context,
|
|
PredOrFunc, Arity, GoalType, Goal, !VarSet,
|
|
QuantWarnings, StateVarWarnings, StateVarErrors,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
some [!SInfo, !SVarState, !SVarStore] (
|
|
HeadVarList = proc_arg_vector_to_list(HeadVars),
|
|
rename_vars_in_term_list(need_not_rename, Renaming,
|
|
ArgTerms0, ArgTerms1),
|
|
svar_prepare_for_clause_head(ArgTerms1, ArgTerms, !VarSet,
|
|
FinalSVarMap, !:SVarState, !:SVarStore, !Specs),
|
|
InitialSVarState = !.SVarState,
|
|
( if GoalType = goal_type_promise(_) then
|
|
HeadGoal = true_goal
|
|
else
|
|
ArgContext = ac_head(PredOrFunc, Arity),
|
|
HeadGoal0 = true_goal,
|
|
insert_arg_unifications(HeadVarList, ArgTerms, Context, ArgContext,
|
|
HeadGoal0, HeadGoal1, !SVarState, !SVarStore, !VarSet,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
% The only pass that pays attention to the from_head feature,
|
|
% switch_detection, only does so on kinds of hlds_goal_exprs
|
|
% that do not occur in from_ground_term scopes, which we have
|
|
% just marked as from_ground_term_initial. Those scopes will be
|
|
% converted to one of from_ground_term_{construct,deconstruct,
|
|
% other} by mode analysis, if type analysis hasn't done it first.
|
|
% Type analysis will do this if it finds that some of the
|
|
% "unifications" inside these scopes are actually calls.
|
|
% Switch detection *does* care about from_head features on calls,
|
|
% and it looks inside all scopes except those of the
|
|
% from_ground_term_construct kind. Therefore any code that can be
|
|
% executed between now and switch detection that converts a
|
|
% from_ground_term_initial or from_ground_term_construct scope
|
|
% to another kind of scope should attach any from_head feature
|
|
% present on the scope to all its subgoals.
|
|
attach_features_to_all_goals([feature_from_head],
|
|
do_not_attach_in_from_ground_term, HeadGoal1, HeadGoal)
|
|
),
|
|
transform_parse_tree_goal_to_hlds(loc_whole_goal, ParseTreeBodyGoal,
|
|
Renaming, BodyGoal, !SVarState, !SVarStore, !VarSet,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
|
|
trace [compiletime(flag("debug-statevar-lambda")), io(!IO)] (
|
|
io.write_string("\nCLAUSE HEAD\n", !IO),
|
|
io.write_string("arg terms before:\n", !IO),
|
|
io.write_list(ArgTerms0, "\n", io.write, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("arg terms renamed:\n", !IO),
|
|
io.write_list(ArgTerms1, "\n", io.write, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("arg terms after:\n", !IO),
|
|
io.write_list(ArgTerms, "\n", io.write, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("head vars:\n", !IO),
|
|
io.write(HeadVarList, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("arg unifies:\n", !IO),
|
|
dump_goal(!.ModuleInfo, !.VarSet, HeadGoal, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("clause body:\n", !IO),
|
|
dump_goal(!.ModuleInfo, !.VarSet, BodyGoal, !IO),
|
|
io.nl(!IO),
|
|
some [FinalSVarList] (
|
|
map.to_assoc_list(FinalSVarMap, FinalSVarList),
|
|
io.write_string("FinalSVarMap:\n", !IO),
|
|
io.write(FinalSVarList, !IO),
|
|
io.nl(!IO)
|
|
)
|
|
),
|
|
|
|
FinalSVarState = !.SVarState,
|
|
svar_finish_clause_body(Context, FinalSVarMap,
|
|
HeadGoal, BodyGoal, Goal0, InitialSVarState, FinalSVarState,
|
|
!.SVarStore, StateVarWarnings, StateVarErrors),
|
|
|
|
qual_info_get_found_trace_goal(!.QualInfo, FoundTraceGoal),
|
|
(
|
|
FoundTraceGoal = no,
|
|
Goal1 = Goal0
|
|
;
|
|
FoundTraceGoal = yes,
|
|
separate_trace_goal_only_locals(Goal0, Goal1)
|
|
),
|
|
qual_info_get_var_types(!.QualInfo, VarTypes0),
|
|
% The RTTI varmaps here are just a dummy value, because the real ones
|
|
% are not introduced until polymorphism.
|
|
rtti_varmaps_init(EmptyRttiVarmaps),
|
|
% XXX It should be possible to exploit the fact that lambda expressions
|
|
% are not yet recognized as such inside from_ground_term scopes.
|
|
implicitly_quantify_clause_body_general(
|
|
ordinary_nonlocals_maybe_lambda,
|
|
HeadVarList, QuantWarnings, Goal1, Goal,
|
|
!VarSet, VarTypes0, VarTypes, EmptyRttiVarmaps, _),
|
|
qual_info_set_var_types(VarTypes, !QualInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.make_hlds.add_clause.
|
|
%-----------------------------------------------------------------------------%
|