mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
7dab0cac8c
The only three places we still refer to Erlang are the places where such
references are needed to explain the reason why the current code is
what it is.
compiler/builtin_ops.m:
Delete the builltin ops that compare whole terms, which was only ever
used by the Erlang backend.
library/private_builtin.m:
Stop declaring the deleted builtin ops.
compiler/compute_grade.m:
compiler/parse_pragma_foreign.m:
Stop adding "Support for Erlang has been discontinued" to error messages
for code that still refers to Erlang.
compiler/add_mutable_aux_preds.m:
compiler/add_pred.m:
compiler/code_util.m:
compiler/generate_mmakefile_fragments.m:
compiler/globals.m:
compiler/llds.m:
compiler/llds_out_data.m:
compiler/mercury_compile_middle_passes.m:
compiler/ml_global_data.m:
compiler/mlds_dump.m:
compiler/mlds_to_c_data.m:
compiler/mlds_to_cs_data.m:
compiler/mlds_to_java_data.m:
compiler/opt_debug.m:
compiler/parse_mutable.m:
compiler/prog_foreign.m:
compiler/simplify_goal_call.m:
compiler/simplify_goal_unify.m:
compiler/term_constr_initial.m:
Conform to the changes above, and/or delete other references to Erlang.
tests/invalid_make_int/bad_foreign_type_int.int_err_exp:
tests/invalid_nodepend/bad_foreign_code.err_exp:
tests/invalid_nodepend/bad_foreign_decl.err_exp:
tests/invalid_nodepend/bad_foreign_enum.err_exp:
tests/invalid_nodepend/bad_foreign_export.err_exp:
tests/invalid_nodepend/bad_foreign_export_enum.err_exp:
tests/invalid_nodepend/bad_foreign_import_module.err_exp:
tests/invalid_nodepend/bad_foreign_proc.err_exp:
Don't expect the message about "support has been discontinued".
649 lines
26 KiB
Mathematica
649 lines
26 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2008, 2011 The University of Melbourne.
|
|
% Copyright (C) 2016-2017, 2019-2022, 2024 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: parse_mutable.m.
|
|
%
|
|
% This module defines predicates for parsing the parts of Mercury programs
|
|
% relating to initialise, finalise and mutable declarations.
|
|
|
|
:- module parse_tree.parse_mutable.
|
|
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.maybe_error.
|
|
:- import_module parse_tree.parse_types.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module list.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
:- pred parse_initialise_item(module_name::in, varset::in, list(term)::in,
|
|
prog_context::in, item_seq_num::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_finalise_item(module_name::in, varset::in, list(term)::in,
|
|
prog_context::in, item_seq_num::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_mutable_item(module_name::in, varset::in, list(term)::in,
|
|
prog_context::in, item_seq_num::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
:- type mutable_locn
|
|
---> mutable_locn_item
|
|
% The mutable is an item of its own.
|
|
; mutable_locn_in_solver_type.
|
|
% The mutable is part of an item that defines a solver type.
|
|
|
|
:- pred parse_mutable_decl_info(module_name::in, varset::in, list(term)::in,
|
|
prog_context::in, item_seq_num::in, mutable_locn::in,
|
|
maybe1(item_mutable_info)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.parse_inst_mode_name.
|
|
:- import_module parse_tree.parse_pragma_foreign.
|
|
:- import_module parse_tree.parse_sym_name.
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
:- import_module parse_tree.parse_type_name.
|
|
:- import_module parse_tree.parse_util.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module cord.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module string.
|
|
:- import_module term_vars.
|
|
:- import_module unit.
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
parse_initialise_item(_ModuleName, VarSet, ArgTerms, Context, SeqNum,
|
|
MaybeIOM) :-
|
|
( if ArgTerms = [Term] then
|
|
parse_sym_name_maybe_arity(VarSet, Term, MaybeSymNameMaybeArity),
|
|
(
|
|
MaybeSymNameMaybeArity = error1(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
;
|
|
MaybeSymNameMaybeArity = ok1(SymNameMaybeArity),
|
|
(
|
|
SymNameMaybeArity = sym_name_only(_),
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error in"), decl("initialise"),
|
|
words("declaration:"), words("expected")] ++
|
|
color_as_correct([quote("predname/arity"), suffix(",")]) ++
|
|
[words("got")] ++
|
|
color_as_incorrect([quote(TermStr), suffix(".")]) ++ [nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(Term), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
;
|
|
SymNameMaybeArity = sym_name_with_arity(SymName, UserArity),
|
|
UserArity = user_arity(UserArityInt),
|
|
( if ( UserArityInt = 0 ; UserArityInt = 2 ) then
|
|
ItemInitialise = item_initialise_info(SymName,
|
|
UserArity, item_origin_user, Context, SeqNum),
|
|
Item = item_initialise(ItemInitialise),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error:"), decl("initialise"),
|
|
words("declaration specifies a predicate,")] ++
|
|
color_as_subject([quote(TermStr), suffix(",")]) ++
|
|
color_as_incorrect(
|
|
[words("whose arity is not zero or two.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(Term), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
)
|
|
)
|
|
)
|
|
else
|
|
Pieces = [words("Error: an"), decl("initialise"),
|
|
words("declaration")] ++
|
|
color_as_incorrect([words("should have the form")]) ++
|
|
color_as_correct([quote(":- initialise pred_name/pred_arity.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt, Context, Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_finalise_item(_ModuleName, VarSet, ArgTerms, Context, SeqNum,
|
|
MaybeIOM) :-
|
|
( if ArgTerms = [Term] then
|
|
parse_sym_name_maybe_arity(VarSet, Term, MaybeSymNameMaybeArity),
|
|
(
|
|
MaybeSymNameMaybeArity = error1(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
;
|
|
MaybeSymNameMaybeArity = ok1(SymNameMaybeArity),
|
|
(
|
|
SymNameMaybeArity = sym_name_only(_),
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error in"), decl("finalise"),
|
|
words("declaration:"), words("expected")] ++
|
|
color_as_correct([quote("predname/arity"), suffix(",")]) ++
|
|
[words("got")] ++
|
|
color_as_incorrect([quote(TermStr), suffix(".")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(Term), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
;
|
|
SymNameMaybeArity = sym_name_with_arity(SymName, UserArity),
|
|
UserArity = user_arity(UserArityInt),
|
|
( if ( UserArityInt = 0 ; UserArityInt = 2 ) then
|
|
ItemFinalise = item_finalise_info(SymName, UserArity,
|
|
item_origin_user, Context, SeqNum),
|
|
Item = item_finalise(ItemFinalise),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error:"), decl("finalise"),
|
|
words("declaration specifies a predicate,")] ++
|
|
color_as_subject([quote(TermStr), suffix(",")]) ++
|
|
color_as_incorrect(
|
|
[words("whose arity is not zero or two.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(Term), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
)
|
|
)
|
|
)
|
|
else
|
|
Pieces = [words("Error: a"), decl("finalise"), words("declaration")] ++
|
|
color_as_incorrect([words("should have the form")]) ++
|
|
color_as_correct([quote(":- finalise pred_name/pred_arity.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt, Context, Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_mutable_item(ModuleName, VarSet, ArgTerms, Context, SeqNum, MaybeIOM) :-
|
|
parse_mutable_decl_info(ModuleName, VarSet, ArgTerms, Context, SeqNum,
|
|
mutable_locn_item, MaybeItemMutableInfo),
|
|
(
|
|
MaybeItemMutableInfo = ok1(ItemMutableInfo),
|
|
MaybeIOM = ok1(iom_item(item_mutable(ItemMutableInfo)))
|
|
;
|
|
MaybeItemMutableInfo = error1(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_mutable_decl_info(_ModuleName, VarSet, ArgTerms, Context, SeqNum,
|
|
MutableLocn, MaybeItemMutableInfo) :-
|
|
( if
|
|
ArgTerms = [NameTerm, TypeTerm, ValueTerm, InstTerm | OptMutAttrsTerm],
|
|
% The list of attributes is optional.
|
|
(
|
|
OptMutAttrsTerm = [],
|
|
MaybeAttrsTerm = no
|
|
;
|
|
OptMutAttrsTerm = [MutAttrsTerm0],
|
|
MaybeAttrsTerm = yes(MutAttrsTerm0)
|
|
)
|
|
then
|
|
parse_mutable_name(VarSet, NameTerm, MaybeName),
|
|
parse_mutable_type(VarSet, TypeTerm, MaybeType),
|
|
term.coerce(ValueTerm, Value),
|
|
varset.coerce(VarSet, ProgVarSet),
|
|
parse_mutable_inst(VarSet, InstTerm, MaybeInst),
|
|
|
|
(
|
|
MaybeAttrsTerm = no,
|
|
MaybeMutAttrs = ok1(default_mutable_attributes)
|
|
;
|
|
MaybeAttrsTerm = yes(MutAttrsTerm),
|
|
parse_mutable_attrs(VarSet, MutAttrsTerm, MaybeMutAttrs)
|
|
),
|
|
( if
|
|
MaybeName = ok1(Name),
|
|
MaybeType = ok1(Type),
|
|
MaybeInst = ok1(Inst),
|
|
MaybeMutAttrs = ok1(MutAttrs)
|
|
then
|
|
% We *must* attach the varset to the mutable item because if the
|
|
% initial value is non-ground, then the initial value will be a
|
|
% variable and the mutable initialisation predicate will contain
|
|
% references to it. Ignoring the varset may lead to later compiler
|
|
% passes attempting to reuse this variable when fresh variables are
|
|
% allocated.
|
|
ItemMutableInfo = item_mutable_info(Name, Type, Type, Inst, Inst,
|
|
Value, ProgVarSet, MutAttrs, Context, SeqNum),
|
|
MaybeItemMutableInfo = ok1(ItemMutableInfo)
|
|
else
|
|
Specs = get_any_errors1(MaybeName) ++ get_any_errors1(MaybeType) ++
|
|
get_any_errors1(MaybeInst) ++ get_any_errors1(MaybeMutAttrs),
|
|
MaybeItemMutableInfo = error1(Specs)
|
|
)
|
|
else
|
|
Form1 = "mutable(name, type, init_value, inst)",
|
|
Form2 = "mutable(name, type, init_value, inst, [attr1, ...])",
|
|
(
|
|
MutableLocn = mutable_locn_item,
|
|
WhatPieces = [words("a"), decl("mutable"), words("declaration")],
|
|
Prefix = ":- ",
|
|
Suffix1 = "."
|
|
;
|
|
MutableLocn = mutable_locn_in_solver_type,
|
|
WhatPieces = [words("a"), decl("mutable"),
|
|
words("representing part of the constraint store")],
|
|
Prefix = "",
|
|
Suffix1 = ""
|
|
),
|
|
Pieces = [words("Error:") | WhatPieces] ++
|
|
color_as_incorrect([words("should have the form")]) ++
|
|
[nl_indent_delta(1)] ++
|
|
color_as_correct([quote(Prefix ++ Form1 ++ Suffix1)]) ++
|
|
[nl_indent_delta(-11),
|
|
words("or the form"),
|
|
nl_indent_delta(1)] ++
|
|
color_as_correct([quote(Prefix ++ Form2 ++ ".")]) ++
|
|
[nl_indent_delta(-1)],
|
|
Spec = spec($pred, severity_error, phase_t2pt, Context, Pieces),
|
|
MaybeItemMutableInfo = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_mutable_name(varset::in, term::in, maybe1(string)::out) is det.
|
|
|
|
parse_mutable_name(VarSet, NameTerm, MaybeName) :-
|
|
( if NameTerm = term.functor(atom(Name), [], _) then
|
|
MaybeName = ok1(Name)
|
|
else
|
|
NameTermStr = describe_error_term(VarSet, NameTerm),
|
|
Pieces = [words("Error: expected a")] ++
|
|
color_as_correct([words("mutable name.")]) ++
|
|
[words("got")] ++
|
|
color_as_incorrect([quote(NameTermStr), suffix(".")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(NameTerm), Pieces),
|
|
MaybeName = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_mutable_type(varset::in, term::in, maybe1(mer_type)::out) is det.
|
|
|
|
parse_mutable_type(VarSet, TypeTerm, MaybeType) :-
|
|
( if term_vars.term_contains_var(TypeTerm, _) then
|
|
TypeTermStr = describe_error_term(VarSet, TypeTerm),
|
|
Pieces = [words("Error: the type in a"), decl("mutable"),
|
|
words("declaration may not contain variables, but")] ++
|
|
color_as_subject([quote(TypeTermStr)]) ++
|
|
color_as_incorrect([words("does.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(TypeTerm), Pieces),
|
|
MaybeType = error1([Spec])
|
|
else
|
|
ContextPieces = cord.init,
|
|
parse_type(allow_ho_inst_info, VarSet, ContextPieces,
|
|
TypeTerm, MaybeType)
|
|
).
|
|
|
|
:- pred parse_mutable_inst(varset::in, term::in, maybe1(mer_inst)::out) is det.
|
|
|
|
parse_mutable_inst(VarSet, InstTerm, MaybeInst) :-
|
|
% XXX We should check whether the *inst* contains variables, not whether
|
|
% the *term* does, but (a) inst_contains_inst_var is in inst_match.m,
|
|
% not in inst_util.m, and (b) it is not exported.
|
|
( if term_vars.term_contains_var(InstTerm, _) then
|
|
InstTermStr = describe_error_term(VarSet, InstTerm),
|
|
Pieces = [words("Error: the inst in a"), decl("mutable"),
|
|
words("declaration cannot contain variables, but")] ++
|
|
color_as_subject([quote(InstTermStr)]) ++
|
|
color_as_incorrect([words("does.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(InstTerm), Pieces),
|
|
MaybeInst = error1([Spec])
|
|
else
|
|
ContextPieces = cord.from_list([words("In a"), decl("mutable"),
|
|
words("declaration:")]),
|
|
parse_inst(no_allow_constrained_inst_var(wnciv_mutable_inst),
|
|
VarSet, ContextPieces, InstTerm, MaybeInst)
|
|
).
|
|
|
|
:- type collected_mutable_attribute
|
|
---> mutable_attr_trailed(mutable_trailed)
|
|
; mutable_attr_foreign_name(foreign_name)
|
|
; mutable_attr_attach_to_io_state % mutable_attach_to_io_state
|
|
; mutable_attr_constant % mutable_constant
|
|
; mutable_attr_thread_local. % mutable_thread_local.
|
|
|
|
% Has the user specified a name for us to use on the target code side
|
|
% of the FLI?
|
|
%
|
|
:- type foreign_name
|
|
---> foreign_name(
|
|
foreign_name_lang :: foreign_language,
|
|
foreign_name_name :: string
|
|
).
|
|
|
|
:- pred parse_mutable_attrs(varset::in, term::in,
|
|
maybe1(mutable_var_attributes)::out) is det.
|
|
|
|
parse_mutable_attrs(VarSet, MutAttrsTerm, MaybeMutAttrs) :-
|
|
( if list_term_to_term_list(MutAttrsTerm, MutAttrTerms) then
|
|
map_parser(parse_mutable_attr(VarSet), MutAttrTerms, MaybeAttrList),
|
|
(
|
|
MaybeAttrList = ok1(CollectedMutAttrPairs),
|
|
record_mutable_attributes(VarSet, CollectedMutAttrPairs,
|
|
map.init, LangMap,
|
|
maybe.no, MaybeTrailed, maybe.no, MaybeConstant,
|
|
maybe.no, MaybeIO, maybe.no, MaybeLocal, [], RecordSpecs),
|
|
(
|
|
RecordSpecs = [_ | _],
|
|
MaybeMutAttrs = error1(RecordSpecs)
|
|
;
|
|
RecordSpecs = [],
|
|
OnlyLangMap =
|
|
map.map_values_only((func(_ - Name) = Name), LangMap),
|
|
check_attribute_fit(VarSet, OnlyLangMap,
|
|
MaybeTrailed, MaybeConstant, MaybeIO, MaybeLocal,
|
|
MaybeMutAttrs)
|
|
)
|
|
;
|
|
MaybeAttrList = error1(Specs),
|
|
MaybeMutAttrs = error1(Specs)
|
|
)
|
|
else
|
|
MutAttrsStr = mercury_term_to_string_vs(VarSet, print_name_only,
|
|
MutAttrsTerm),
|
|
Pieces = [words("In fifth argument of"),
|
|
decl("mutable"), words("declaration:"),
|
|
words("error: expected a")] ++
|
|
color_as_correct([words("list of attributes,")]) ++
|
|
[words("got")] ++
|
|
color_as_incorrect([quote(MutAttrsStr), suffix(".")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(MutAttrsTerm), Pieces),
|
|
MaybeMutAttrs = error1([Spec])
|
|
).
|
|
|
|
:- pred record_mutable_attributes(varset::in,
|
|
assoc_list(term, collected_mutable_attribute)::in,
|
|
map(foreign_language, pair(term, string))::in,
|
|
map(foreign_language, pair(term, string))::out,
|
|
maybe(pair(term, mutable_trailed))::in,
|
|
maybe(pair(term, mutable_trailed))::out,
|
|
maybe(pair(term, unit))::in,
|
|
maybe(pair(term, unit))::out,
|
|
maybe(pair(term, unit))::in,
|
|
maybe(pair(term, unit))::out,
|
|
maybe(pair(term, unit))::in,
|
|
maybe(pair(term, unit))::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
record_mutable_attributes(_VarSet, [], !LangMap,
|
|
!MaybeTrailed, !MaybeConstant, !MaybeIO, !MaybeLocal, !Specs).
|
|
record_mutable_attributes(VarSet, [Term - Attr | TermAttrs], !LangMap,
|
|
!MaybeTrailed, !MaybeConstant, !MaybeIO, !MaybeLocal, !Specs) :-
|
|
(
|
|
Attr = mutable_attr_foreign_name(ForeignName),
|
|
ForeignName = foreign_name(Lang, Name),
|
|
( if map.search(!.LangMap, Lang, Term0 - _Name0) then
|
|
report_conflicting_attributes(VarSet, Term0, Term, !Specs)
|
|
else
|
|
map.det_insert(Lang, Term - Name, !LangMap)
|
|
)
|
|
;
|
|
Attr = mutable_attr_trailed(Trailed),
|
|
(
|
|
!.MaybeTrailed = no,
|
|
!:MaybeTrailed = yes(Term - Trailed)
|
|
;
|
|
!.MaybeTrailed = yes(Term0 - Trailed0),
|
|
report_repeated_or_conflicting_attributes(VarSet,
|
|
Term0, Trailed0, Term, Trailed, !Specs)
|
|
)
|
|
;
|
|
Attr = mutable_attr_constant,
|
|
(
|
|
!.MaybeConstant = no,
|
|
!:MaybeConstant = yes(Term - unit)
|
|
;
|
|
!.MaybeConstant = yes(Term0 - _),
|
|
report_repeated_or_conflicting_attributes(VarSet,
|
|
Term0, unit, Term, unit, !Specs)
|
|
)
|
|
;
|
|
Attr = mutable_attr_attach_to_io_state,
|
|
(
|
|
!.MaybeIO = no,
|
|
!:MaybeIO = yes(Term - unit)
|
|
;
|
|
!.MaybeIO = yes(Term0 - _),
|
|
report_repeated_or_conflicting_attributes(VarSet,
|
|
Term0, unit, Term, unit, !Specs)
|
|
)
|
|
;
|
|
Attr = mutable_attr_thread_local,
|
|
(
|
|
!.MaybeLocal = no,
|
|
!:MaybeLocal = yes(Term - unit)
|
|
;
|
|
!.MaybeLocal = yes(Term0 - _),
|
|
report_repeated_or_conflicting_attributes(VarSet,
|
|
Term0, unit, Term, unit, !Specs)
|
|
)
|
|
),
|
|
record_mutable_attributes(VarSet, TermAttrs, !LangMap,
|
|
!MaybeTrailed, !MaybeConstant, !MaybeIO, !MaybeLocal, !Specs).
|
|
|
|
:- pred check_attribute_fit(varset::in,
|
|
map(foreign_language, string)::in,
|
|
maybe(pair(term, mutable_trailed))::in,
|
|
maybe(pair(term, unit))::in,
|
|
maybe(pair(term, unit))::in,
|
|
maybe(pair(term, unit))::in,
|
|
maybe1(mutable_var_attributes)::out) is det.
|
|
|
|
check_attribute_fit(VarSet, OnlyLangMap, MaybeTrailed, MaybeConst, MaybeIO,
|
|
MaybeLocal, MaybeMutAttrs) :-
|
|
some [!Specs] (
|
|
!:Specs = [],
|
|
(
|
|
MaybeConst = no,
|
|
(
|
|
MaybeIO = no,
|
|
IO = mutable_do_not_attach_to_io_state
|
|
;
|
|
MaybeIO = yes(_ - unit),
|
|
IO = mutable_attach_to_io_state
|
|
),
|
|
(
|
|
MaybeLocal = yes(LocalTerm - unit),
|
|
Local = mutable_is_thread_local, % implicitly mutable_untrailed
|
|
(
|
|
MaybeTrailed = yes(_TrailTerm - mutable_untrailed)
|
|
;
|
|
MaybeTrailed = yes(TrailTerm - mutable_trailed),
|
|
% Local is wrong, but will not be used due to !:Specs.
|
|
report_conflicting_attributes(VarSet, LocalTerm, TrailTerm,
|
|
!Specs)
|
|
;
|
|
MaybeTrailed = no,
|
|
% Local is wrong, but will not be used due to !:Specs.
|
|
LocalTermStr = mercury_term_to_string_vs(VarSet,
|
|
print_name_only, LocalTerm),
|
|
Pieces = [words("Error: attribute")] ++
|
|
color_as_subject([quote(LocalTermStr)]) ++
|
|
color_as_incorrect(
|
|
[words("conflicts with the default,")]) ++
|
|
[words("which is that updates are trailed."),
|
|
words("You need to specify the")] ++
|
|
color_as_hint([quote("untrailed")]) ++
|
|
[words("attribute explicitly."), nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(LocalTerm), Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
;
|
|
MaybeLocal = no,
|
|
(
|
|
MaybeTrailed = yes(_TrailTerm - Trail)
|
|
;
|
|
MaybeTrailed = no,
|
|
Trail = mutable_trailed % The default.
|
|
),
|
|
Local = mutable_is_not_thread_local(Trail)
|
|
),
|
|
Const = mutable_is_not_constant(IO, Local)
|
|
;
|
|
MaybeConst = yes(ConstTerm - unit),
|
|
(
|
|
MaybeIO = no
|
|
;
|
|
MaybeIO = yes(IOTerm - unit),
|
|
report_conflicting_attributes(VarSet, ConstTerm, IOTerm,
|
|
!Specs)
|
|
),
|
|
(
|
|
MaybeTrailed = no
|
|
;
|
|
MaybeTrailed = yes(_TrailTerm - mutable_untrailed)
|
|
;
|
|
MaybeTrailed = yes(TrailTerm - mutable_trailed),
|
|
report_conflicting_attributes(VarSet, ConstTerm, TrailTerm,
|
|
!Specs)
|
|
),
|
|
(
|
|
MaybeLocal = no
|
|
;
|
|
MaybeLocal = yes(LocalTerm - unit),
|
|
report_conflicting_attributes(VarSet, ConstTerm, LocalTerm,
|
|
!Specs)
|
|
),
|
|
Const = mutable_is_constant
|
|
),
|
|
(
|
|
!.Specs = [],
|
|
MutAttrs = mutable_var_attributes(OnlyLangMap, Const),
|
|
MaybeMutAttrs = ok1(MutAttrs)
|
|
;
|
|
!.Specs = [_ | _],
|
|
MaybeMutAttrs = error1(!.Specs)
|
|
)
|
|
).
|
|
|
|
:- func default_mutable_attributes = mutable_var_attributes.
|
|
|
|
default_mutable_attributes =
|
|
mutable_var_attributes(
|
|
map.init,
|
|
mutable_is_not_constant(
|
|
mutable_do_not_attach_to_io_state,
|
|
mutable_is_not_thread_local(mutable_trailed)
|
|
)
|
|
).
|
|
|
|
:- pred report_repeated_or_conflicting_attributes(varset::in, term::in, T::in,
|
|
term::in, T::in, list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
report_repeated_or_conflicting_attributes(VarSet, Term0, Attr0, Term, Attr,
|
|
!Specs) :-
|
|
( if Attr0 = Attr then
|
|
TermStr = mercury_term_to_string_vs(VarSet, print_name_only, Term),
|
|
Pieces = [words("Error: attribute")] ++
|
|
color_as_subject([quote(TermStr)]) ++
|
|
[words("is")] ++
|
|
color_as_incorrect([words("repeated.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(Term), Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
report_conflicting_attributes(VarSet, Term0, Term, !Specs)
|
|
).
|
|
|
|
:- pred report_conflicting_attributes(varset::in, term::in, term::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
report_conflicting_attributes(VarSet, Term0, Term, !Specs) :-
|
|
TermStr0 = mercury_term_to_string_vs(VarSet, print_name_only, Term0),
|
|
TermStr = mercury_term_to_string_vs(VarSet, print_name_only, Term),
|
|
Pieces = [words("Error: attributes")] ++
|
|
color_as_inconsistent([quote(TermStr0)]) ++
|
|
[words("and")] ++
|
|
color_as_inconsistent([quote(TermStr)]) ++
|
|
color_as_incorrect([words("conflict.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(Term), Pieces),
|
|
!:Specs = [Spec | !.Specs].
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% NOTE: We return maybe1() wrapped around a pair instead using maybe2
|
|
% because map_parser works only with maybe1.
|
|
%
|
|
:- pred parse_mutable_attr(varset::in, term::in,
|
|
maybe1(pair(term, collected_mutable_attribute))::out) is det.
|
|
|
|
parse_mutable_attr(VarSet, MutAttrTerm, MutAttrResult) :-
|
|
( if
|
|
MutAttrTerm = term.functor(term.atom(String), [], _),
|
|
(
|
|
String = "untrailed",
|
|
MutAttr = mutable_attr_trailed(mutable_untrailed)
|
|
;
|
|
String = "trailed",
|
|
MutAttr = mutable_attr_trailed(mutable_trailed)
|
|
;
|
|
String = "attach_to_io_state",
|
|
MutAttr = mutable_attr_attach_to_io_state
|
|
;
|
|
String = "constant",
|
|
MutAttr = mutable_attr_constant
|
|
;
|
|
String = "thread_local",
|
|
MutAttr = mutable_attr_thread_local
|
|
)
|
|
then
|
|
MutAttrResult = ok1(MutAttrTerm - MutAttr)
|
|
else if
|
|
MutAttrTerm = term.functor(term.atom("foreign_name"), Args, _),
|
|
Args = [LangTerm, ForeignNameTerm],
|
|
term_to_foreign_language(LangTerm, Lang),
|
|
ForeignNameTerm = term.functor(term.string(ForeignName), [], _)
|
|
then
|
|
MutAttr = mutable_attr_foreign_name(foreign_name(Lang, ForeignName)),
|
|
MutAttrResult = ok1(MutAttrTerm - MutAttr)
|
|
else
|
|
MutAttrStr = describe_error_term(VarSet, MutAttrTerm),
|
|
Pieces =
|
|
[words("Error in"), decl("mutable"), words("declaration:"), nl] ++
|
|
color_as_incorrect([words("unrecognised attribute")]) ++
|
|
color_as_subject([quote(MutAttrStr), suffix(".")]) ++ [nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(MutAttrTerm), Pieces),
|
|
MutAttrResult = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module parse_tree.parse_mutable.
|
|
%---------------------------------------------------------------------------%
|