mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-24 13:53:54 +00:00
0927f2d41e
compiler/parse_mutable.m:
Add color to the diagnostics generated by this module.
In a few cases, improve the wording of the diagnostic.
tests/invalid_make_int/bad_finalise_decl_int.int_err_exp:
tests/invalid_make_int/bad_initialise_decl_int.int_err_exp:
tests/invalid_make_int/bad_mutable_int.int_err_exp:
Expect updated diagnostics.
659 lines
26 KiB
Mathematica
659 lines
26 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2008, 2011 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: 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_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
|
|
(
|
|
MaybeSymNameSpecifier = error1(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
;
|
|
MaybeSymNameSpecifier = ok1(SymNameSpecifier),
|
|
(
|
|
SymNameSpecifier = sym_name_specifier_name(_),
|
|
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])
|
|
;
|
|
SymNameSpecifier =
|
|
sym_name_specifier_name_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_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
|
|
(
|
|
MaybeSymNameSpecifier = error1(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
;
|
|
MaybeSymNameSpecifier = ok1(SymNameSpecifier),
|
|
(
|
|
SymNameSpecifier = sym_name_specifier_name(_),
|
|
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])
|
|
;
|
|
SymNameSpecifier =
|
|
sym_name_specifier_name_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(no_allow_ho_inst_info(wnhii_mutable_decl),
|
|
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_dont_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"), 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_dont_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_possible_cause([quote(TermStr0)]) ++
|
|
[words("and")] ++
|
|
color_as_possible_cause([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 if
|
|
MutAttrTerm = term.functor(term.atom("foreign_name"), Args, _),
|
|
Args = [LangTerm, _ForeignNameTerm],
|
|
term_to_foreign_language_erlang(LangTerm)
|
|
then
|
|
Pieces = [words("Error in"), decl("mutable"), words("declaration:"),
|
|
nl, words("support for Erlang has been discontinued."), nl],
|
|
Spec = spec($pred, severity_error, phase_t2pt,
|
|
get_term_context(MutAttrTerm), Pieces),
|
|
MutAttrResult = error1([Spec])
|
|
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.
|
|
%---------------------------------------------------------------------------%
|