mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 06:14:59 +00:00
94535ec121
configure.ac: browser/*.m: compiler/*.m: deep_profiler/*.m: library/*.m: ssdb/*.m: runtime/mercury_conf.h.in: runtime/*.[ch]: scripts/Mmake.vars.in: trace/*.[ch]: util/*.c: Fix spelling and doubled-up words. Delete trailing whitespace. Convert tabs into spaces (where appropriate).
392 lines
15 KiB
Mathematica
392 lines
15 KiB
Mathematica
%-----------------------------------------------------------------------------e
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------e
|
|
% Copyright (C) 2008-2009, 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_type_defn.m.
|
|
%
|
|
% This module parses inst and mode definitions.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.prog_io_mode_defn.
|
|
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.maybe_error.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_io_iom.
|
|
|
|
:- import_module list.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
% Parse a `:- inst <InstDefn>.' declaration.
|
|
%
|
|
:- pred parse_inst_defn_item(module_name::in, varset::in, list(term)::in,
|
|
prog_context::in, int::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
% Parse a `:- mode <ModeDefn>.' declaration.
|
|
%
|
|
:- pred parse_mode_defn(module_name::in, varset::in, term::in, term::in,
|
|
prog_context::in, int::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
:- import_module parse_tree.prog_io_sym_name.
|
|
:- import_module parse_tree.prog_io_util.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module bag.
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module maybe.
|
|
:- import_module set.
|
|
|
|
parse_inst_defn_item(ModuleName, VarSet, ArgTerms, Context, SeqNum,
|
|
MaybeIOM) :-
|
|
( if ArgTerms = [InstDefnTerm] then
|
|
% XXX Some of the tests here could be factored out.
|
|
( if
|
|
InstDefnTerm =
|
|
term.functor(term.atom("=="), [HeadTerm, BodyTerm], _)
|
|
then
|
|
parse_inst_defn_eqv(ModuleName, VarSet, HeadTerm, BodyTerm,
|
|
Context, SeqNum, MaybeIOM)
|
|
else if
|
|
InstDefnTerm =
|
|
term.functor(term.atom("--->"), [HeadTerm, BodyTerm], _)
|
|
then
|
|
BoundBodyTerm =
|
|
term.functor(term.atom("bound"), [BodyTerm], Context),
|
|
parse_inst_defn_eqv(ModuleName, VarSet, HeadTerm, BoundBodyTerm,
|
|
Context, SeqNum, MaybeIOM)
|
|
else if
|
|
% XXX This is for `abstract inst' declarations,
|
|
% which are not really supported.
|
|
InstDefnTerm = term.functor(term.atom("is"), Args, _),
|
|
Args = [HeadTerm, term.functor(term.atom("private"), [], _)]
|
|
then
|
|
parse_abstract_inst_defn(ModuleName, VarSet, HeadTerm,
|
|
Context, SeqNum, MaybeIOM)
|
|
else
|
|
Pieces = [words("Error:"), quote("=="), words("expected in"),
|
|
decl("inst"), words("definition."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(InstDefnTerm),
|
|
[always(Pieces)])]),
|
|
MaybeIOM = error1([Spec])
|
|
)
|
|
else
|
|
Pieces = [words("Error: an"), decl("inst"), words("declaration"),
|
|
words("should have just one argument,"),
|
|
words("which should be the definition of an inst."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(Context, [always(Pieces)])]),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_inst_defn_eqv(module_name::in, varset::in, term::in, term::in,
|
|
prog_context::in, int::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
parse_inst_defn_eqv(ModuleName, VarSet, HeadTerm, BodyTerm, Context, SeqNum,
|
|
MaybeIOM) :-
|
|
ContextPieces = cord.singleton(words("In inst definition:")),
|
|
( if
|
|
HeadTerm = term.functor(term.atom("for"),
|
|
[NameTermPrime, ForTypeTerm], _)
|
|
then
|
|
NameTerm = NameTermPrime,
|
|
( if
|
|
parse_name_and_arity_unqualified(ForTypeTerm,
|
|
TypeSymName, TypeArity)
|
|
then
|
|
MaybeForType = yes(type_ctor(TypeSymName, TypeArity)),
|
|
ForTypeSpecs = []
|
|
else
|
|
MaybeForType = no,
|
|
ForTypeTermStr = describe_error_term(VarSet, ForTypeTerm),
|
|
ForTypePieces = [words("Error: expected"),
|
|
words("type constructor name/arity, not"),
|
|
quote(ForTypeTermStr), suffix("."), nl],
|
|
ForTypeSpec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(ForTypeTerm),
|
|
[always(ForTypePieces)])]),
|
|
ForTypeSpecs = [ForTypeSpec]
|
|
)
|
|
else
|
|
NameTerm = HeadTerm,
|
|
MaybeForType = no,
|
|
ForTypeSpecs = []
|
|
),
|
|
parse_implicitly_qualified_sym_name_and_args(ModuleName, NameTerm,
|
|
VarSet, ContextPieces, MaybeSymNameAndArgs),
|
|
(
|
|
MaybeSymNameAndArgs = error2(SymNameAndArgSpecs),
|
|
Specs = SymNameAndArgSpecs ++ ForTypeSpecs,
|
|
MaybeIOM = error1(Specs)
|
|
;
|
|
MaybeSymNameAndArgs = ok2(SymName, ArgTerms),
|
|
|
|
HeadTermContext = get_term_context(HeadTerm),
|
|
check_user_inst_name(SymName, HeadTermContext, NameSpecs),
|
|
check_inst_mode_defn_args("inst definition", VarSet, HeadTermContext,
|
|
ArgTerms, yes(BodyTerm), MaybeInstArgVars),
|
|
|
|
( if convert_inst(no_allow_constrained_inst_var, BodyTerm, Inst0) then
|
|
MaybeInst = ok1(Inst0)
|
|
else
|
|
% XXX Should make the error message here more precise.
|
|
BodyTermStr = describe_error_term(VarSet, BodyTerm),
|
|
BodyPieces = [words("Error: syntax error in inst body at"),
|
|
words(BodyTermStr), suffix("."), nl],
|
|
BodySpec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(BodyTerm),
|
|
[always(BodyPieces)])]),
|
|
MaybeInst = error1([BodySpec])
|
|
),
|
|
|
|
( if
|
|
NameSpecs = [],
|
|
ForTypeSpecs = [],
|
|
MaybeInstArgVars = ok1(InstArgVars),
|
|
MaybeInst = ok1(Inst)
|
|
then
|
|
varset.coerce(VarSet, InstVarSet),
|
|
InstDefn = eqv_inst(Inst),
|
|
ItemInstDefn = item_inst_defn_info(SymName, InstArgVars,
|
|
MaybeForType, InstDefn, InstVarSet, Context, SeqNum),
|
|
Item = item_inst_defn(ItemInstDefn),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = NameSpecs ++
|
|
get_any_errors1(MaybeInstArgVars) ++
|
|
get_any_errors1(MaybeInst),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
).
|
|
|
|
:- pred parse_abstract_inst_defn(module_name::in, varset::in, term::in,
|
|
prog_context::in, int::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
parse_abstract_inst_defn(ModuleName, VarSet, HeadTerm, Context, SeqNum,
|
|
MaybeIOM) :-
|
|
ContextPieces = cord.singleton(words("In inst definition:")),
|
|
parse_implicitly_qualified_sym_name_and_args(ModuleName, HeadTerm,
|
|
VarSet, ContextPieces, MaybeNameAndArgs),
|
|
(
|
|
MaybeNameAndArgs = error2(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
;
|
|
MaybeNameAndArgs = ok2(SymName, ArgTerms),
|
|
|
|
HeadTermContext = get_term_context(HeadTerm),
|
|
check_user_inst_name(SymName, HeadTermContext, NameSpecs),
|
|
check_inst_mode_defn_args("inst definition", VarSet, HeadTermContext,
|
|
ArgTerms, no, MaybeInstArgVars),
|
|
|
|
( if
|
|
NameSpecs = [],
|
|
MaybeInstArgVars = ok1(InstArgVars)
|
|
then
|
|
varset.coerce(VarSet, InstVarSet),
|
|
MaybeForType = no,
|
|
InstDefn = abstract_inst,
|
|
ItemInstDefn = item_inst_defn_info(SymName, InstArgVars,
|
|
MaybeForType, InstDefn, InstVarSet, Context, SeqNum),
|
|
Item = item_inst_defn(ItemInstDefn),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = NameSpecs ++ get_any_errors1(MaybeInstArgVars),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type processed_mode_body
|
|
---> processed_mode_body(
|
|
sym_name,
|
|
list(inst_var),
|
|
mode_defn
|
|
).
|
|
|
|
parse_mode_defn(ModuleName, VarSet, HeadTerm, BodyTerm, Context, SeqNum,
|
|
MaybeIOM) :-
|
|
ContextPieces = cord.singleton(words("In mode definition:")),
|
|
parse_implicitly_qualified_sym_name_and_args(ModuleName, HeadTerm,
|
|
VarSet, ContextPieces, MaybeSymNameAndArgs),
|
|
(
|
|
MaybeSymNameAndArgs = error2(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
;
|
|
MaybeSymNameAndArgs = ok2(SymName, ArgTerms),
|
|
|
|
HeadTermContext = get_term_context(HeadTerm),
|
|
check_user_mode_name(SymName, HeadTermContext, NameSpecs),
|
|
check_inst_mode_defn_args("mode definition", VarSet, HeadTermContext,
|
|
ArgTerms, yes(BodyTerm), MaybeInstArgVars),
|
|
|
|
( if convert_mode(no_allow_constrained_inst_var, BodyTerm, Mode0) then
|
|
MaybeMode = ok1(Mode0)
|
|
else
|
|
% XXX We should make the error message here more precise.
|
|
BodyPieces = [words("Error: syntax error"),
|
|
words("in mode definition body."), nl],
|
|
BodySpec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(BodyTerm),
|
|
[always(BodyPieces)])]),
|
|
MaybeMode = error1([BodySpec])
|
|
),
|
|
|
|
( if
|
|
NameSpecs = [],
|
|
MaybeInstArgVars = ok1(InstArgVars),
|
|
MaybeMode = ok1(Mode)
|
|
then
|
|
varset.coerce(VarSet, InstVarSet),
|
|
ModeDefn = eqv_mode(Mode),
|
|
ItemModeDefn = item_mode_defn_info(SymName, InstArgVars,
|
|
ModeDefn, InstVarSet, Context, SeqNum),
|
|
Item = item_mode_defn(ItemModeDefn),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = NameSpecs ++
|
|
get_any_errors1(MaybeInstArgVars) ++
|
|
get_any_errors1(MaybeMode),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
% Check that the inst name is available to users.
|
|
%
|
|
:- pred check_user_inst_name(sym_name::in, term.context::in,
|
|
list(error_spec)::out) is det.
|
|
|
|
check_user_inst_name(SymName, Context, NameSpecs) :-
|
|
Name = unqualify_name(SymName),
|
|
( if is_known_inst_name(Name) then
|
|
NamePieces = [words("Error: the inst name"), quote(Name),
|
|
words("is reserved for the Mercury implementation."), nl],
|
|
NameSpec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(Context, [always(NamePieces)])]),
|
|
NameSpecs = [NameSpec]
|
|
else
|
|
NameSpecs = []
|
|
).
|
|
|
|
% Check that the mode name is available to users.
|
|
%
|
|
:- pred check_user_mode_name(sym_name::in, term.context::in,
|
|
list(error_spec)::out) is det.
|
|
|
|
check_user_mode_name(SymName, Context, NameSpecs) :-
|
|
% Check that the mode name is available to users.
|
|
Name = unqualify_name(SymName),
|
|
( if is_known_mode_name(Name) then
|
|
NamePieces = [words("Error: the mode name"), quote(Name),
|
|
words("is reserved for the Mercury implementation."), nl],
|
|
NameSpec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(Context, [always(NamePieces)])]),
|
|
NameSpecs = [NameSpec]
|
|
else
|
|
NameSpecs = []
|
|
).
|
|
|
|
:- pred check_inst_mode_defn_args(string::in, varset::in, term.context::in,
|
|
list(term)::in, maybe(term)::in, maybe1(list(inst_var))::out) is det.
|
|
|
|
check_inst_mode_defn_args(DefnKind, VarSet, HeadTermContext,
|
|
ArgTerms, MaybeBodyTerm, MaybeArgVars) :-
|
|
% Check that all the head arguments are variables.
|
|
( if term.term_list_to_var_list(ArgTerms, ArgVars) then
|
|
some [!Specs] (
|
|
!:Specs = [],
|
|
|
|
% Check that all the head variables are distinct.
|
|
% The common cases are zero variable and one variable;
|
|
% fail fast in those cases.
|
|
( if
|
|
ArgVars = [_, _ | _], % Optimize the common case.
|
|
bag.from_list(ArgVars, ArgVarsBag),
|
|
bag.to_list_only_duplicates(ArgVarsBag, DupArgVars),
|
|
DupArgVars = [_ | _]
|
|
then
|
|
ParamWord = choose_number(DupArgVars,
|
|
"parameter", "parameters"),
|
|
IsAreWord = choose_number(DupArgVars,
|
|
"is", "are"),
|
|
DupVarNames =
|
|
list.map(mercury_var_to_name_only(VarSet), DupArgVars),
|
|
RepeatPieces = [words("Error: inst"), words(ParamWord)] ++
|
|
list_to_pieces(DupVarNames) ++
|
|
[words(IsAreWord), words("in LHS of"), words(DefnKind),
|
|
suffix("."), nl],
|
|
RepeatSpec = error_spec(severity_error,
|
|
phase_term_to_parse_tree,
|
|
[simple_msg(HeadTermContext, [always(RepeatPieces)])]),
|
|
!:Specs = [RepeatSpec | !.Specs]
|
|
else
|
|
true
|
|
),
|
|
|
|
% Check that all the variables in the body occur in the head.
|
|
% The common case is BodyVars = []; fail fast in that case.
|
|
( if
|
|
MaybeBodyTerm = yes(BodyTerm),
|
|
term.vars(BodyTerm, BodyVars),
|
|
BodyVars = [_ | _],
|
|
set.list_to_set(BodyVars, BodyVarsSet),
|
|
set.list_to_set(ArgVars, ArgVarsSet),
|
|
set.difference(BodyVarsSet, ArgVarsSet, FreeVarsSet),
|
|
set.to_sorted_list(FreeVarsSet, FreeVars),
|
|
FreeVars = [_ | _]
|
|
then
|
|
FreeVarNames =
|
|
list.map(mercury_var_to_name_only(VarSet), FreeVars),
|
|
FreePieces = [words("Error: free inst"),
|
|
words(choose_number(FreeVars,
|
|
"parameter", "parameters"))] ++
|
|
list_to_pieces(FreeVarNames) ++
|
|
[words("in RHS of"), words(DefnKind), suffix("."), nl],
|
|
FreeSpec = error_spec(severity_error,
|
|
phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(BodyTerm),
|
|
[always(FreePieces)])]),
|
|
!:Specs = [FreeSpec | !.Specs]
|
|
else
|
|
true
|
|
),
|
|
|
|
(
|
|
!.Specs = [],
|
|
list.map(term.coerce_var, ArgVars, InstArgVars),
|
|
MaybeArgVars = ok1(InstArgVars)
|
|
;
|
|
!.Specs = [_ | _],
|
|
MaybeArgVars = error1(!.Specs)
|
|
)
|
|
)
|
|
else
|
|
% XXX If term_list_to_var_list returned the non-var's term
|
|
% or context, we could use it here.
|
|
VarPieces = [words("Error: inst parameters must be variables."), nl],
|
|
VarSpec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(HeadTermContext, [always(VarPieces)])]),
|
|
MaybeArgVars = error1([VarSpec])
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
:- end_module parse_tree.prog_io_mode_defn.
|
|
%-----------------------------------------------------------------------------e
|