mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-21 00:39:37 +00:00
2f1ec6b91c
compiler/polymorphism.m:
When it sees a curried predicate call, polymorphism converts it to an
explicit lambda expression in order to add the unifications that
construct the type_infos and/or typeclass_infos the call needs.
For this, it needs to know the call's determinism. If the predicate had
no declared determinism, we used to abort the compiler, which is
too drastic a response to a simple programmer error.
Change this so that in this situation, we simply report an error,
and record that it is not safe to continue the compilation process.
In reality, it is not safe to continue the compilation only of the
predicate that the lambda expression occurs in, but in the vast, vast
majority of cases, this should be more than good enough.
I did try to code this change so that we continued the compilation
of other predicates when this error occurs, but it turned out to be
a bit too complicated for the very small potential benefit. Nevertheless,
some of the changes below are the results of this attempt; I kept them
because they are useful in their own right.
Change the code for traversing the procedures of a predicate
to be more direct.
Put the access predicates in the poly_info type in the same order
as the fields they operate on.
compiler/error_util.m:
Allow recording that an error is discovered during the polymorphism pass.
compiler/mercury_compile_front_end.m:
If polymorphism finds errors, print their messages, and then stop;
don't continue to the later passes.
compiler/maybe_error.m:
New module, containing the maybeN types (taken from prog_io_utio.m)
and the safe_to_continue type (taken from modes.m). These are now
needed by polymorphism.m as well.
compiler/parse_tree.m:
compiler/notes/compiler_design.html:
Mention the new module.
compiler/options.m:
doc/user_guide.texi:
Delete the (undocumented, developer-only) --no-polymorphism option,
since its use cannot lead to anything other than a compiler abort,
and this won't change in the future.
compiler/hlds_pred.m:
Rename the "marker" type to "pred_marker", to clarify its purpose.
Rename the "attribute" type to "pred_attribute", for the same reason.
Make the pred_markers and attributes types true sets, not lists
masquerading as sets.
Add a predicate to add more than one marker at a time to a set of markers.
Delete an unused predicate.
Rename the functors of the can_process type to clarify its purpose.
(I tried to use it to record the presence of errors discovered by
polymorphism.m, and this did not work; these renames should spare
others a similar experience.)
Make the code that construct pred_infos build its components from first
field to last field, not in random order.
compiler/det_analysis.m:
Specialize an exported predicate to its actual uses.
compiler/hlds_out_pred.m:
Dump the cannot_process_yet flag for procedures that have them.
compiler/add_pragma.m:
compiler/add_pred.m:
compiler/complexity.m:
compiler/deforest.m:
compiler/equiv_type_hlds.m:
compiler/field_access.m:
compiler/goal_expr_to_goal.m:
compiler/higher_order.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/lambda.m:
compiler/ml_accurate_gc.m:
compiler/modecheck_goal.m:
compiler/modecheck_unify.m:
compiler/modecheck_util.m:
compiler/modes.m:
compiler/prog_io.m:
compiler/prog_io_dcg.m:
compiler/prog_io_goal.m:
compiler/prog_io_item.m:
compiler/prog_io_mode_defn.m:
compiler/prog_io_mutable.m:
compiler/prog_io_pragma.m:
compiler/prog_io_sym_name.m:
compiler/prog_io_type_defn.m:
compiler/prog_io_typeclass.m:
compiler/prog_io_util.m:
compiler/recompilation.check.m:
compiler/recompilation.version.m:
compiler/simplify_goal_unify.m:
compiler/ssdebug.m:
compiler/stm_expand.m:
compiler/superhomogeneous.m:
compiler/table_gen.m:
compiler/try_expand.m:
compiler/unify_proc.m:
Conform to the changes above.
tests/invalid/higher_order_no_detism.{m,err_exp}:
A new test case to test that the compiler does not abort, but generates
an error message when it sees a curried predicate call to a predicate with
no declared determinism.
tests/invalid/Mmakefile:
Enable the new test case.
357 lines
15 KiB
Mathematica
357 lines
15 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: prog_io_mutable.m.
|
|
%
|
|
% This module defines predicates for parsing the parts of Mercury programs
|
|
% relating to initialise, finalise and mutable declarations.
|
|
|
|
:- module parse_tree.prog_io_mutable.
|
|
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.maybe_error.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module list.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
:- pred parse_initialise_decl(module_name::in, varset::in, term::in,
|
|
prog_context::in, int::in, maybe1(item)::out) is det.
|
|
|
|
:- pred parse_finalise_decl(module_name::in, varset::in, term::in,
|
|
prog_context::in, int::in, maybe1(item)::out) is det.
|
|
|
|
:- pred parse_mutable_decl(module_name::in, varset::in, list(term)::in,
|
|
prog_context::in, int::in, maybe1(item)::out) is semidet.
|
|
|
|
:- pred parse_mutable_decl_info(module_name::in, varset::in, list(term)::in,
|
|
prog_context::in, int::in, maybe1(item_mutable_info)::out) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
:- import_module parse_tree.prog_io_pragma.
|
|
:- import_module parse_tree.prog_io_sym_name.
|
|
:- import_module parse_tree.prog_io_util.
|
|
|
|
:- import_module pair.
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
parse_initialise_decl(_ModuleName, VarSet, Term, Context, SeqNum, MaybeItem) :-
|
|
parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
|
|
(
|
|
MaybeSymNameSpecifier = error1(Specs),
|
|
MaybeItem = error1(Specs)
|
|
;
|
|
MaybeSymNameSpecifier = ok1(SymNameSpecifier),
|
|
(
|
|
SymNameSpecifier = name(_),
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error:"), decl("initialise"),
|
|
words("declaration"), words("requires arity, found"),
|
|
words(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(Term), [always(Pieces)])]),
|
|
MaybeItem = error1([Spec])
|
|
;
|
|
SymNameSpecifier = name_arity(SymName, Arity),
|
|
( if ( Arity = 0 ; Arity = 2 ) then
|
|
ItemInitialise = item_initialise_info(SymName, Arity,
|
|
item_origin_user, Context, SeqNum),
|
|
Item = item_initialise(ItemInitialise),
|
|
MaybeItem = ok1(Item)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error:"), decl("initialise"),
|
|
words("declaration specifies a predicate"),
|
|
words("whose arity is not zero or two:"),
|
|
fixed(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(Term), [always(Pieces)])]),
|
|
MaybeItem = error1([Spec])
|
|
)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_finalise_decl(_ModuleName, VarSet, Term, Context, SeqNum, MaybeItem) :-
|
|
parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
|
|
(
|
|
MaybeSymNameSpecifier = error1(Specs),
|
|
MaybeItem = error1(Specs)
|
|
;
|
|
MaybeSymNameSpecifier = ok1(SymNameSpecifier),
|
|
(
|
|
SymNameSpecifier = name(_),
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error:"), decl("finalise"),
|
|
words("declaration"), words("requires arity, found"),
|
|
fixed(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(Term), [always(Pieces)])]),
|
|
MaybeItem = error1([Spec])
|
|
;
|
|
SymNameSpecifier = name_arity(SymName, Arity),
|
|
( if ( Arity = 0 ; Arity = 2 ) then
|
|
ItemFinalise = item_finalise_info(SymName, Arity,
|
|
item_origin_user, Context, SeqNum),
|
|
Item = item_finalise(ItemFinalise),
|
|
MaybeItem = ok1(Item)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error:"), decl("finalise"),
|
|
words("declaration specifies a predicate"),
|
|
words("whose arity is not zero or two:"),
|
|
words(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(Term), [always(Pieces)])]),
|
|
MaybeItem = error1([Spec])
|
|
)
|
|
)
|
|
).
|
|
|
|
parse_mutable_decl(ModuleName, VarSet, Terms, Context, SeqNum, MaybeItem) :-
|
|
parse_mutable_decl_info(ModuleName, VarSet, Terms, Context, SeqNum,
|
|
MaybeMutableInfo),
|
|
(
|
|
MaybeMutableInfo = ok1(MutableInfo),
|
|
MaybeItem = ok1(item_mutable(MutableInfo))
|
|
;
|
|
MaybeMutableInfo = error1(Specs),
|
|
MaybeItem = error1(Specs)
|
|
).
|
|
|
|
parse_mutable_decl_info(_ModuleName, VarSet, Terms, Context, SeqNum,
|
|
MaybeMutableInfo) :-
|
|
Terms = [NameTerm, TypeTerm, ValueTerm, InstTerm | OptMutAttrsTerm],
|
|
parse_mutable_name(NameTerm, MaybeName),
|
|
parse_mutable_type(VarSet, TypeTerm, MaybeType),
|
|
term.coerce(ValueTerm, Value),
|
|
varset.coerce(VarSet, ProgVarSet),
|
|
parse_mutable_inst(VarSet, InstTerm, MaybeInst),
|
|
|
|
% The list of attributes is optional.
|
|
(
|
|
OptMutAttrsTerm = [],
|
|
MaybeMutAttrs = ok1(default_mutable_attributes)
|
|
;
|
|
OptMutAttrsTerm = [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.
|
|
MutableInfo = item_mutable_info(Name, Type, Value, Inst, MutAttrs,
|
|
ProgVarSet, Context, SeqNum),
|
|
MaybeMutableInfo = ok1(MutableInfo)
|
|
else
|
|
Specs = get_any_errors1(MaybeName) ++ get_any_errors1(MaybeType) ++
|
|
get_any_errors1(MaybeInst) ++ get_any_errors1(MaybeMutAttrs),
|
|
MaybeMutableInfo = error1(Specs)
|
|
).
|
|
|
|
:- pred parse_mutable_name(term::in, maybe1(string)::out) is det.
|
|
|
|
parse_mutable_name(NameTerm, MaybeName) :-
|
|
( if NameTerm = term.functor(atom(Name), [], _) then
|
|
MaybeName = ok1(Name)
|
|
else
|
|
Pieces = [words("Error: invalid mutable name."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(NameTerm), [always(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.contains_var(TypeTerm, _) then
|
|
TypeTermStr = describe_error_term(VarSet, TypeTerm),
|
|
Pieces = [words("Error: the type in a"), decl("mutable"),
|
|
words("declaration cannot contain variables:"),
|
|
words(TypeTermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(TypeTerm), [always(Pieces)])]),
|
|
MaybeType = error1([Spec])
|
|
else
|
|
ContextPieces = [],
|
|
parse_type(TypeTerm, VarSet, ContextPieces, MaybeType)
|
|
).
|
|
|
|
:- pred parse_mutable_inst(varset::in, term::in, maybe1(mer_inst)::out) is det.
|
|
|
|
parse_mutable_inst(VarSet, InstTerm, MaybeInst) :-
|
|
( if 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:"),
|
|
words(InstTermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(InstTerm), [always(Pieces)])]),
|
|
MaybeInst = error1([Spec])
|
|
else if convert_inst(no_allow_constrained_inst_var, InstTerm, Inst) then
|
|
MaybeInst = ok1(Inst)
|
|
else
|
|
Pieces = [words("Error: invalid inst in"), decl("mutable"),
|
|
words("declaration."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(InstTerm), [always(Pieces)])]),
|
|
MaybeInst = error1([Spec])
|
|
).
|
|
|
|
:- 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).
|
|
|
|
:- pred parse_mutable_attrs(varset::in, term::in,
|
|
maybe1(mutable_var_attributes)::out) is det.
|
|
|
|
parse_mutable_attrs(VarSet, MutAttrsTerm, MaybeMutAttrs) :-
|
|
Attributes0 = default_mutable_attributes,
|
|
ConflictingAttributes = [
|
|
mutable_attr_trailed(mutable_trailed) -
|
|
mutable_attr_trailed(mutable_untrailed),
|
|
mutable_attr_trailed(mutable_trailed) -
|
|
mutable_attr_thread_local(mutable_thread_local),
|
|
mutable_attr_constant(mutable_constant) -
|
|
mutable_attr_trailed(mutable_trailed),
|
|
mutable_attr_constant(mutable_constant) -
|
|
mutable_attr_attach_to_io_state(mutable_attach_to_io_state),
|
|
mutable_attr_constant(mutable_constant) -
|
|
mutable_attr_thread_local(mutable_thread_local)
|
|
],
|
|
( if
|
|
list_term_to_term_list(MutAttrsTerm, MutAttrTerms),
|
|
map_parser(parse_mutable_attr, MutAttrTerms, MaybeAttrList),
|
|
MaybeAttrList = ok1(CollectedMutAttrs)
|
|
then
|
|
% We check for trailed/untrailed, constant/trailed,
|
|
% trailed/thread_local, constant/attach_to_io_state,
|
|
% constant/thread_local conflicts here and deal with conflicting
|
|
% foreign_name attributes in make_hlds_passes.m.
|
|
( if
|
|
list.member(Conflict1 - Conflict2, ConflictingAttributes),
|
|
list.member(Conflict1, CollectedMutAttrs),
|
|
list.member(Conflict2, CollectedMutAttrs)
|
|
then
|
|
% XXX Should generate more specific error message.
|
|
MutAttrsStr = mercury_term_to_string(VarSet, print_name_only,
|
|
MutAttrsTerm),
|
|
Pieces = [words("Error: conflicting attributes"),
|
|
words("in attribute list:"), nl,
|
|
words(MutAttrsStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(MutAttrsTerm),
|
|
[always(Pieces)])]),
|
|
MaybeMutAttrs = error1([Spec])
|
|
else
|
|
list.foldl(process_mutable_attribute, CollectedMutAttrs,
|
|
Attributes0, Attributes),
|
|
MaybeMutAttrs = ok1(Attributes)
|
|
)
|
|
else
|
|
MutAttrsStr = mercury_term_to_string(VarSet, print_name_only,
|
|
MutAttrsTerm),
|
|
Pieces = [words("Error: malformed attribute list"),
|
|
words("in"), decl("mutable"), words("declaration:"),
|
|
words(MutAttrsStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(MutAttrsTerm), [always(Pieces)])]),
|
|
MaybeMutAttrs = error1([Spec])
|
|
).
|
|
|
|
:- pred process_mutable_attribute(collected_mutable_attribute::in,
|
|
mutable_var_attributes::in, mutable_var_attributes::out) is det.
|
|
|
|
process_mutable_attribute(mutable_attr_trailed(Trailed), !Attributes) :-
|
|
set_mutable_var_trailed(Trailed, !Attributes).
|
|
process_mutable_attribute(mutable_attr_foreign_name(ForeignName),
|
|
!Attributes) :-
|
|
set_mutable_add_foreign_name(ForeignName, !Attributes).
|
|
process_mutable_attribute(mutable_attr_attach_to_io_state(AttachToIOState),
|
|
!Attributes) :-
|
|
set_mutable_var_attach_to_io_state(AttachToIOState, !Attributes).
|
|
process_mutable_attribute(mutable_attr_constant(Constant), !Attributes) :-
|
|
set_mutable_var_constant(Constant, !Attributes),
|
|
(
|
|
Constant = mutable_constant,
|
|
set_mutable_var_trailed(mutable_untrailed, !Attributes),
|
|
set_mutable_var_attach_to_io_state(mutable_dont_attach_to_io_state,
|
|
!Attributes)
|
|
;
|
|
Constant = mutable_not_constant
|
|
).
|
|
process_mutable_attribute(mutable_attr_thread_local(ThrLocal), !Attributes) :-
|
|
set_mutable_var_thread_local(ThrLocal, !Attributes).
|
|
|
|
:- pred parse_mutable_attr(term::in,
|
|
maybe1(collected_mutable_attribute)::out) is det.
|
|
|
|
parse_mutable_attr(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(
|
|
mutable_attach_to_io_state)
|
|
;
|
|
String = "constant",
|
|
MutAttr = mutable_attr_constant(mutable_constant)
|
|
;
|
|
String = "thread_local",
|
|
MutAttr = mutable_attr_thread_local(mutable_thread_local)
|
|
)
|
|
then
|
|
MutAttrResult = ok1(MutAttr)
|
|
else if
|
|
MutAttrTerm = term.functor(term.atom("foreign_name"), Args, _),
|
|
Args = [LangTerm, ForeignNameTerm],
|
|
parse_foreign_language(LangTerm, Lang),
|
|
ForeignNameTerm = term.functor(term.string(ForeignName), [], _)
|
|
then
|
|
MutAttr = mutable_attr_foreign_name(foreign_name(Lang, ForeignName)),
|
|
MutAttrResult = ok1(MutAttr)
|
|
else
|
|
Pieces = [words("Error: unrecognised attribute"),
|
|
words("in"), decl("mutable"), words("declaration."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(MutAttrTerm), [always(Pieces)])]),
|
|
MutAttrResult = error1([Spec])
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module parse_tree.prog_io_mutable.
|
|
%-----------------------------------------------------------------------------%
|