Files
mercury/compiler/parse_sym_name.m
Zoltan Somogyi 427f67ffda Allow module qualification using mixed operators ...
... such as a__b.c__d.

compiler/parse_sym_name.m:
    Allow the operands of terms module qualified with "." to contain
    terms module qualified with "__".

    Stop allowing ":" as a module qualifier.

compiler/parse_dcg_goal.m:
compiler/parse_goal.m:
    Make the code parsing DCG and non-DCG goals as similar as possible.

tests/invalid/qual_basic_test2.err_exp:
    Expect "io.io__write_string" to be parsed as "io.io.write_string".

tests/invalid_make_int/test_nested_helper_1.test_nested_helper_3.m:
tests/invalid_make_int/test_nested_helper_1.test_nested_helper_4.m:
tests/invalid_make_int/test_nested_helper_2.test_nested_helper_6.m:
tests/invalid_submodules/nested_impl_in_int.m:
    Stop using ":" as module qualifier.
2023-09-26 01:59:33 +10:00

545 lines
22 KiB
Mathematica

%-----------------------------------------------------------------------------e
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------e
% Copyright (C) 2008-2009, 2011-2012 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.
%---------------------------------------------------------------------------%
%
% Many of the predicates below exist in two or three forms.
%
% - The first form, whose name is of the form parse_<something>, always
% succeeds; if it doesn't find the thing it is looking for, it returns
% an error message.
% - The second form, whose name is of the form try_parse_<something>, exists
% because building this error message is a waste of time if not finding
% <something> is not in fact an error, which happens often. This second form
% simply fails when it does not find <something>.
% - The third form exists in cases where our caller imposes further
% restrictions on the form of the thing being looked for, such as a list
% of arguments being empty.
%
%-----------------------------------------------------------------------------e
:- module parse_tree.parse_sym_name.
:- interface.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.prog_data.
:- import_module cord.
:- import_module list.
:- import_module term.
:- import_module varset.
:- type maybe_functor == maybe_functor(generic).
:- type maybe_functor(T) == maybe2(sym_name, list(term(T))).
% A SymNameAndArgs is one of
% Name(Args)
% Module.Name(Args)
% (or if Args is empty, one of
% Name
% Module.Name)
% where Module is a SymName. For backwards compatibility, we allow `__'
% as an alternative to `.'.
% parse_sym_name_and_args(VarSet, ContextPieces, Term, Result):
%
% Parse Term into a sym_name that is its top function symbol and a
% list of its argument terms, and if successful return them in Result.
% However, in case it does not succeed, parse_sym_name_and_args
% also takes as input Varset (from which the variables in Term are taken),
% and a format_piece list describing the context from which it was
% called, e.g. "In clause head:".
%
% Note: parse_sym_name_and_args is intended for places where a symbol
% is _used_, where no default module name exists for the sym_name.
% For places where a symbol is _defined_, use the related predicate
% parse_implicitly_qualified_sym_name_and_args.
%
:- pred parse_sym_name_and_args(varset::in, cord(format_piece)::in,
term(T)::in, maybe_functor(T)::out) is det.
:- pred try_parse_sym_name_and_args(term(T)::in,
sym_name::out, list(term(T))::out) is semidet.
% When given the first two arguments Functor and FunctorArgs,
% try_parse_sym_name_and_args_from_f_args will do exactly the same as
% what try_parse_sym_name_and_args would do when given the term
% term.functor(Functor, FunctorArgs, _), but it does so without
% requiring its caller to construct that term.
%
:- pred try_parse_sym_name_and_args_from_f_args(const::in, list(term(T))::in,
sym_name::out, list(term(T))::out) is semidet.
% Versions of parse_sym_name_and_args and try_parse_sym_name_and_args
% that require the given term to have no arguments.
%
:- pred parse_sym_name_and_no_args(varset::in, cord(format_piece)::in,
term(T)::in, maybe1(sym_name)::out) is det.
:- pred try_parse_sym_name_and_no_args(term(T)::in, sym_name::out) is semidet.
% parse_implicitly_qualified_sym_name_and_args(DefaultModuleName,
% VarSet, ContextPieces, Term, Result):
%
% Parse Term into a sym_name that is its top function symbol and a
% list of its argument terms, and if successful return them in Result.
% This predicate thus does almost the same job as the predicate
% parse_sym_name_and_args above, the difference being that
% if the sym_name is qualified, then we check whether it is qualified
% with (possibly a part of) DefaultModuleName, and if it isn't qualified,
% then we qualify it with DefaultModuleName . This is the right thing
% to do for clause heads, which is the intended job of
% parse_implicitly_qualified_sym_name_and_args.
%
:- pred parse_implicitly_qualified_sym_name_and_args(module_name::in,
varset::in, cord(format_piece)::in, term(T)::in,
maybe_functor(T)::out) is det.
:- pred parse_implicitly_qualified_sym_name_and_no_args(module_name::in,
varset::in, cord(format_piece)::in, term(T)::in,
maybe1(sym_name)::out) is det.
% These predicates do just the "implicitly qualifying" part of the
% job of the predicates above.
%
:- pred implicitly_qualify_sym_name(module_name::in, term(T)::in,
sym_name::in, maybe1(sym_name)::out) is det.
:- pred try_to_implicitly_qualify_sym_name(module_name::in,
sym_name::in, sym_name::out) is semidet.
% A SymbolName is one of
% Name
% Matches symbols with the specified name in the
% current namespace.
% Module.Name
% Matches symbols with the specified name exported
% by the specified module (where Module is itself a SymbolName).
%
% We also allow the syntax `Module__Name' as an alternative
% for `Module.Name'.
%
:- pred parse_symbol_name(varset(T)::in, term(T)::in, maybe1(sym_name)::out)
is det.
:- pred try_parse_symbol_name(term(T)::in, sym_name::out) is semidet.
:- pred parse_implicitly_qualified_symbol_name(module_name::in, varset::in,
term::in, maybe1(sym_name)::out) is det.
:- type sym_name_specifier
---> sym_name_specifier_name(sym_name)
; sym_name_specifier_name_arity(sym_name, user_arity).
% A SymbolNameSpecifier is one of
% SymbolName
% SymbolName/Arity
% Matches only symbols of the specified arity.
%
:- pred parse_symbol_name_specifier(varset::in, term::in,
maybe1(sym_name_specifier)::out) is det.
%-----------------------------------------------------------------------------e
:- implementation.
:- import_module parse_tree.parse_tree_out_term.
:- import_module int.
:- import_module term_int.
parse_sym_name_and_args(VarSet, ContextPieces, Term, MaybeSymNameAndArgs) :-
( if
Term = term.functor(Functor, FunctorArgs, TermContext),
Functor = term.atom("."),
FunctorArgs = [ModuleTerm, NameArgsTerm]
then
( if NameArgsTerm = term.functor(term.atom(Name), Args, _) then
varset.coerce(VarSet, GenericVarSet),
parse_symbol_name(GenericVarSet, ModuleTerm, MaybeModule),
(
MaybeModule = ok1(Module),
MaybeSymNameAndArgs = ok2(qualified(Module, Name), Args)
;
MaybeModule = error1(_),
ModuleTermStr = describe_error_term(GenericVarSet, ModuleTerm),
Pieces = cord.list(ContextPieces) ++
[lower_case_next_if_not_first,
words("Error: expected module name before '.'"),
words("in qualified symbol name, got"),
words(ModuleTermStr), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, TermContext, Pieces),
MaybeSymNameAndArgs = error2([Spec])
)
else
varset.coerce(VarSet, GenericVarSet),
TermStr = describe_error_term(GenericVarSet, Term),
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
words("Error: expected identifier after '.'"),
words("in qualified symbol name, got"),
words(TermStr), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, TermContext, Pieces),
MaybeSymNameAndArgs = error2([Spec])
)
else
varset.coerce(VarSet, GenericVarSet),
( if Term = term.functor(term.atom(Name), Args, _) then
SymName = string_to_sym_name_sep(Name, "__"),
MaybeSymNameAndArgs = ok2(SymName, Args)
else
TermStr = describe_error_term(GenericVarSet, Term),
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
words("Error: expected a symbol name, got"),
quote(TermStr), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, get_term_context(Term), Pieces),
MaybeSymNameAndArgs = error2([Spec])
)
).
try_parse_sym_name_and_args(Term, SymName, Args) :-
Term = term.functor(Functor, FunctorArgs, _TermContext),
try_parse_sym_name_and_args_from_f_args(Functor, FunctorArgs,
SymName, Args).
:- pragma inline(pred(try_parse_sym_name_and_args_from_f_args/4)).
try_parse_sym_name_and_args_from_f_args(Functor, FunctorArgs, SymName, Args) :-
Functor = term.atom(FunctorName),
( if
FunctorName = ".",
FunctorArgs = [ModuleTerm, NameArgsTerm]
then
try_parse_symbol_name(ModuleTerm, ModuleSymName),
try_parse_sym_name_and_args(NameArgsTerm, SubSymName, Args),
SymName = glue_sym_names(ModuleSymName, SubSymName)
else
SymName = string_to_sym_name_sep(FunctorName, "__"),
Args = FunctorArgs
).
parse_sym_name_and_no_args(VarSet, ContextPieces, Term, MaybeSymName) :-
( if
Term = term.functor(Functor, FunctorArgs, TermContext),
Functor = term.atom("."),
FunctorArgs = [ModuleTerm, NameArgsTerm]
then
( if NameArgsTerm = term.functor(term.atom(Name), Args, _) then
varset.coerce(VarSet, GenericVarSet),
parse_symbol_name(GenericVarSet, ModuleTerm, MaybeModule),
(
MaybeModule = ok1(Module),
SymName = qualified(Module, Name),
insist_on_no_args(ContextPieces, NameArgsTerm, SymName,
Args, MaybeSymName)
;
MaybeModule = error1(_),
ModuleTermStr = describe_error_term(GenericVarSet, ModuleTerm),
Pieces = cord.list(ContextPieces) ++
[lower_case_next_if_not_first,
words("Error: expected module name expected before '.'"),
words("in qualified symbol name, got"),
words(ModuleTermStr), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, TermContext, Pieces),
MaybeSymName = error1([Spec])
)
else
varset.coerce(VarSet, GenericVarSet),
TermStr = describe_error_term(GenericVarSet, Term),
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
words("Error: expected identifier after '.'"),
words("in qualified symbol name, got"),
words(TermStr), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, TermContext, Pieces),
MaybeSymName = error1([Spec])
)
else
varset.coerce(VarSet, GenericVarSet),
( if Term = term.functor(term.atom(Name), Args, _) then
SymName = string_to_sym_name_sep(Name, "__"),
insist_on_no_args(ContextPieces, Term, SymName, Args, MaybeSymName)
else
TermStr = describe_error_term(GenericVarSet, Term),
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
words("Error: atom expected at"),
words(TermStr), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, get_term_context(Term), Pieces),
MaybeSymName = error1([Spec])
)
).
:- pred insist_on_no_args(cord(format_piece)::in, term(T)::in,
sym_name::in, list(term(T))::in, maybe1(sym_name)::out) is det.
insist_on_no_args(ContextPieces, Term, SymName, Args, MaybeSymName) :-
(
Args = [],
MaybeSymName = ok1(SymName)
;
Args = [_ | _],
Name = sym_name_to_string(SymName),
Pieces = cord.list(ContextPieces) ++
[lower_case_next_if_not_first,
words("Error:"), quote(Name), words("has arguments,"),
words("expected none."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, get_term_context(Term), Pieces),
MaybeSymName = error1([Spec])
).
try_parse_sym_name_and_no_args(Term, SymName) :-
Term = term.functor(Functor, FunctorArgs, _TermContext),
Functor = term.atom(FunctorName),
( if
FunctorName = ".",
FunctorArgs = [ModuleTerm, NameArgsTerm]
then
NameArgsTerm = term.functor(term.atom(Name), [], _),
try_parse_symbol_name(ModuleTerm, Module),
SymName = qualified(Module, Name)
else
FunctorArgs = [],
SymName = string_to_sym_name_sep(FunctorName, "__")
).
%-----------------------------------------------------------------------------e
parse_implicitly_qualified_sym_name_and_args(DefaultModuleName, VarSet,
ContextPieces, Term, MaybeSymNameAndArgs) :-
parse_sym_name_and_args(VarSet, ContextPieces, Term, MaybeSymNameAndArgs0),
(
MaybeSymNameAndArgs0 = ok2(SymName0, Args),
implicitly_qualify_sym_name_and_args(DefaultModuleName, Term,
SymName0, Args, MaybeSymNameAndArgs)
;
MaybeSymNameAndArgs0 = error2(_),
MaybeSymNameAndArgs = MaybeSymNameAndArgs0
).
parse_implicitly_qualified_sym_name_and_no_args(DefaultModuleName, VarSet,
ContextPieces, Term, MaybeSymName) :-
parse_sym_name_and_args(VarSet, ContextPieces, Term, MaybeSymNameAndArgs0),
(
MaybeSymNameAndArgs0 = ok2(SymName0, Args0),
implicitly_qualify_sym_name(DefaultModuleName, Term,
SymName0, MaybeSymName1),
(
Args0 = [],
ArgSpecs = []
;
Args0 = [_ | _],
ArgPieces = [words("Error: did not expect"),
qual_sym_name(SymName0), words("to have any arguments."), nl],
ArgSpec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, get_term_context(Term), ArgPieces),
ArgSpecs = [ArgSpec]
),
( if
MaybeSymName1 = ok1(SymName),
ArgSpecs = []
then
MaybeSymName = ok1(SymName)
else
Specs = get_any_errors1(MaybeSymName1) ++ ArgSpecs,
MaybeSymName = error1(Specs)
)
;
MaybeSymNameAndArgs0 = error2(Specs),
MaybeSymName = error1(Specs)
).
%-----------------------------------------------------------------------------e
:- pred implicitly_qualify_sym_name_and_args(module_name::in, term(T)::in,
sym_name::in, list(term(T))::in, maybe2(sym_name, list(term(T)))::out)
is det.
implicitly_qualify_sym_name_and_args(DefaultModuleName, Term, SymName0, Args,
MaybeSymNameAndArgs) :-
( if
try_to_implicitly_qualify_sym_name(DefaultModuleName, SymName0,
SymName)
then
MaybeSymNameAndArgs = ok2(SymName, Args)
else
Pieces = [words("Error: the module qualifier in"),
qual_sym_name(SymName0), words("does not match"),
words("the preceding"), decl("module"), words("declaration."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
get_term_context(Term), Pieces),
MaybeSymNameAndArgs = error2([Spec])
).
implicitly_qualify_sym_name(DefaultModuleName, Term, SymName0, MaybeSymName) :-
( if
try_to_implicitly_qualify_sym_name(DefaultModuleName, SymName0,
SymName)
then
MaybeSymName = ok1(SymName)
else
Pieces = [words("Error: the module qualifier in"),
qual_sym_name(SymName0), words("does not match"),
words("the preceding"), decl("module"), words("declaration."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
get_term_context(Term), Pieces),
MaybeSymName = error1([Spec])
).
try_to_implicitly_qualify_sym_name(DefaultModuleName, SymName0, SymName) :-
(
SymName0 = qualified(ModuleName0, Name0),
( if partial_sym_name_matches_full(ModuleName0, DefaultModuleName) then
SymName = qualified(DefaultModuleName, Name0)
else
fail
)
;
SymName0 = unqualified(Name0),
SymName = qualified(DefaultModuleName, Name0)
).
%-----------------------------------------------------------------------------e
parse_symbol_name(VarSet, Term, MaybeSymName) :-
( if
Term = term.functor(term.atom(FunctorName), [ModuleTerm, NameTerm],
TermContext),
FunctorName = "."
then
( if NameTerm = term.functor(term.atom(Name), [], _) then
parse_symbol_name(VarSet, ModuleTerm, MaybeModule),
(
MaybeModule = ok1(Module),
MaybeSymName = ok1(qualified(Module, Name))
;
MaybeModule = error1(_ModuleResultSpecs),
% XXX We should say "module name" OR "identifier", not both.
Pieces = [words("Error: module name identifier"),
words("expected before"), quote(FunctorName),
words("in qualified symbol name."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, TermContext, Pieces),
% XXX Should we include _ModuleResultSpecs?
MaybeSymName = error1([Spec])
)
else
Pieces = [words("Error: identifier expected after"),
quote(FunctorName), words("in qualified symbol name."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, TermContext, Pieces),
MaybeSymName = error1([Spec])
)
else
( if Term = term.functor(term.atom(Name), [], _) then
SymName = string_to_sym_name_sep(Name, "__"),
MaybeSymName = ok1(SymName)
else
TermStr = describe_error_term(VarSet, Term),
Pieces = [words("Error: symbol name expected at"),
words(TermStr), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, get_term_context(Term), Pieces),
MaybeSymName = error1([Spec])
)
).
try_parse_symbol_name(Term, SymName) :-
( if Term = term.functor(term.atom("."), [ModuleTerm, NameTerm], _) then
try_parse_symbol_name(ModuleTerm, ModuleSymName),
try_parse_symbol_name(NameTerm, SubSymName),
SymName = glue_sym_names(ModuleSymName, SubSymName)
else
Term = term.functor(term.atom(Name), [], _),
SymName = string_to_sym_name_sep(Name, "__")
).
% Given two terms T1 and T2, that came from that appeared in
% This function is used to help implement a rare form of
% module qualification which mixes the "." module qualifier,
% which shows up in the structures of terms, and the "__" module qualifier,
% which does not. A string such as "a__b.c__d" contains three qualifiers,
% but only one shows up as a function symbol. When its two args,
% "a__b" and "c__d" are parsed as function symbols, we need to glue
% the resulting qualifiers together. This function does that.
%
:- func glue_sym_names(module_name, sym_name) = sym_name.
glue_sym_names(ModuleSymName, SubSymName) = SymName :-
(
SubSymName = unqualified(BaseName),
% This is the overwhelmingly more likely path, so optimize it.
SymName = qualified(ModuleSymName, BaseName)
;
SubSymName = qualified(_, _),
ModuleNameList = sym_name_to_list(ModuleSymName),
sym_name_to_qualifier_list_and_name(SubSymName, SubModuleNameList,
BaseName),
det_list_to_sym_name(ModuleNameList ++ SubModuleNameList ++
[BaseName], SymName)
).
%-----------------------------------------------------------------------------e
parse_implicitly_qualified_symbol_name(DefaultModuleName, VarSet, Term,
MaybeSymName) :-
parse_symbol_name(VarSet, Term, MaybeSymName0),
(
MaybeSymName0 = ok1(SymName0),
implicitly_qualify_sym_name(DefaultModuleName, Term,
SymName0, MaybeSymName)
;
MaybeSymName0 = error1(_),
MaybeSymName = MaybeSymName0
).
%-----------------------------------------------------------------------------e
parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier) :-
( if Term = term.functor(term.atom("/"), [NameTerm, ArityTerm], _) then
( if term_int.decimal_term_to_int(ArityTerm, Arity) then
( if Arity >= 0 then
parse_symbol_name(VarSet, NameTerm, MaybeName),
(
MaybeName = error1(Specs),
MaybeSymNameSpecifier = error1(Specs)
;
MaybeName = ok1(Name),
UserArity = user_arity(Arity),
MaybeSymNameSpecifier =
ok1(sym_name_specifier_name_arity(Name, UserArity))
)
else
Pieces = [words("Error: arity in symbol name specifier"),
words("must be a non-negative integer."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, get_term_context(Term), Pieces),
MaybeSymNameSpecifier = error1([Spec])
)
else
Pieces = [words("Error: arity in symbol name specifier"),
words("must be an integer."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, get_term_context(Term), Pieces),
MaybeSymNameSpecifier = error1([Spec])
)
else
parse_symbol_name(VarSet, Term, MaybeSymbolName),
(
MaybeSymbolName = error1(Specs),
MaybeSymNameSpecifier = error1(Specs)
;
MaybeSymbolName = ok1(SymbolName),
MaybeSymNameSpecifier = ok1(sym_name_specifier_name(SymbolName))
)
).
%-----------------------------------------------------------------------------e
:- end_module parse_tree.parse_sym_name.
%-----------------------------------------------------------------------------e