mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-19 03:13:40 +00:00
35a4f3a2dd
compiler/parse_pragma.m:
Improve error handling in several respects.
First, for several kinds of pragmas the only error message we printed
was some form of "something went wrong". Fix this by generating messages
that say what part of the pragma has a problem, and what that problem is.
Second, specify the "where" part more precisely, as a nested context
(in construct A: in construct B: etc).
Third, make the text of error messages more consistent, using patterns
such as "expected abc, got def", and "In the Nth argument of xyz:".
Fourth, don't stop looking for errors after finding one; keep looking
for others.
Also, replace a bunch of if-then-elses with switches, and break up
a too-large predicate.
compiler/parse_sym_name.m:
Add parse_sym_name_and_no_args, a version of the existing predicate
try_parse_sym_name_and_no_args that generates an error message if it
does not find what it is asked to look for.
Use the same consistent error message phraseology as above (which we
also use elsewhere in the compiler).
compiler/parse_item.m:
Put a newline at the end of context pieces such as "In clause head:",
so that the "error:" that follows is not buried in the middle of a line.
tests/invalid/bad_pragma.{m,err_exp}:
Add a news test case for some of the updated error messages.
tests/invalid/Mmakefile:
Enable the new test case.
tests/invalid/bad_foreign_enum.m:
Add another bad foreign_enum to this test.
tests/invalid/bad_detism_category.err_exp:
tests/invalid/bad_foreign_code.err_exp:
tests/invalid/bad_foreign_enum.err_exp:
tests/invalid/bad_foreign_export.err_exp:
tests/invalid/bad_foreign_export_enum.err_exp:
tests/invalid/bad_foreign_import_module.err_exp:
tests/invalid/bad_foreign_proc.err_exp:
tests/invalid/bad_foreign_type.err_exp:
tests/invalid/bad_with_inst.err_exp:
tests/invalid/impl_def_literal_syntax.err_exp:
tests/invalid/invalid_float_literal.err_exp:
tests/invalid/null_char.err_exp:
tests/invalid/predmode.err_exp:
tests/invalid/require_tailrec_invalid.err_exp:
tests/invalid/some.err_exp:
tests/invalid/specified.err_exp:
tests/invalid/vars_in_wrong_places.err_exp:
Expect the updated error messages.
573 lines
23 KiB
Mathematica
573 lines
23 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_util.
|
|
:- 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_component 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_component)::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_component)::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(ModuleName, Term,
|
|
% VarSet, ContextPieces, 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 ModuleName, and if it isn't qualified, then we qualify it with
|
|
% ModuleName (unless ModuleName is root_module_name). 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,
|
|
term(T)::in, varset::in, cord(format_component)::in,
|
|
maybe_functor(T)::out) is det.
|
|
:- pred parse_implicitly_qualified_sym_name_and_no_args(module_name::in,
|
|
term(T)::in, varset::in, cord(format_component)::in,
|
|
maybe1(sym_name)::out) is det.
|
|
:- pred try_parse_implicitly_qualified_sym_name_and_args(module_name::in,
|
|
term(T)::in, sym_name::out, list(term(T))::out) is semidet.
|
|
:- pred try_parse_implicitly_qualified_sym_name_and_no_args(module_name::in,
|
|
term(T)::in, sym_name::out) is semidet.
|
|
|
|
% These predicates do just the "implicitly qualifying" part of the
|
|
% job of the predicates above.
|
|
%
|
|
:- 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.
|
|
:- 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.
|
|
|
|
% 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.
|
|
|
|
:- pred parse_implicitly_qualified_symbol_name_specifier(module_name::in,
|
|
varset::in, term::in, maybe1(sym_name_specifier)::out) is det.
|
|
|
|
% We use the empty module name ('') as the "root" module name; when adding
|
|
% default module qualifiers in parse_implicitly_qualified_*,
|
|
% if the default module is the root module then we don't add any qualifier.
|
|
%
|
|
:- func root_module_name = module_name.
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
|
|
:- import_module 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: 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),
|
|
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: identifier expected 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(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
|
|
NameArgsTerm = term.functor(term.atom(Name), Args, _),
|
|
try_parse_symbol_name(ModuleTerm, Module),
|
|
SymName = qualified(Module, Name)
|
|
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_component)::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, Term,
|
|
VarSet, ContextPieces, 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, Term,
|
|
VarSet, ContextPieces, 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)
|
|
).
|
|
|
|
try_parse_implicitly_qualified_sym_name_and_args(DefaultModuleName, Term,
|
|
SymName, Args) :-
|
|
try_parse_sym_name_and_args(Term, SymName0, Args),
|
|
try_to_implicitly_qualify_sym_name(DefaultModuleName, SymName0, SymName).
|
|
|
|
try_parse_implicitly_qualified_sym_name_and_no_args(DefaultModuleName, Term,
|
|
SymName) :-
|
|
try_parse_sym_name_and_no_args(Term, SymName0),
|
|
try_to_implicitly_qualify_sym_name(DefaultModuleName, SymName0, SymName).
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
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: module qualifier in definition"),
|
|
words("does not match 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: module qualifier in definition"),
|
|
words("does not match 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) :-
|
|
( if DefaultModuleName = root_module_name then
|
|
SymName = SymName0
|
|
else
|
|
( if
|
|
SymName0 = qualified(ModuleName, _),
|
|
not partial_sym_name_matches_full(ModuleName, DefaultModuleName)
|
|
then
|
|
fail
|
|
else
|
|
UnqualName = unqualify_name(SymName0),
|
|
SymName = qualified(DefaultModuleName, UnqualName)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
parse_symbol_name(VarSet, Term, MaybeSymName) :-
|
|
( if
|
|
Term = term.functor(term.atom(FunctorName), [ModuleTerm, NameTerm],
|
|
TermContext),
|
|
( FunctorName = ":"
|
|
; 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(FunctorName), [ModuleTerm, NameTerm],
|
|
_TermContext),
|
|
( FunctorName = ":"
|
|
; FunctorName = "."
|
|
)
|
|
then
|
|
NameTerm = term.functor(term.atom(Name), [], _),
|
|
try_parse_symbol_name(ModuleTerm, Module),
|
|
SymName = qualified(Module, Name)
|
|
else
|
|
Term = term.functor(term.atom(Name), [], _),
|
|
SymName = string_to_sym_name_sep(Name, "__")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
parse_implicitly_qualified_symbol_name(DefaultModuleName, VarSet, Term,
|
|
MaybeSymName) :-
|
|
parse_symbol_name(VarSet, Term, MaybeSymName0),
|
|
(
|
|
MaybeSymName0 = ok1(SymName),
|
|
( if
|
|
DefaultModuleName = root_module_name
|
|
then
|
|
MaybeSymName = MaybeSymName0
|
|
else if
|
|
SymName = qualified(ModuleName, _),
|
|
not partial_sym_name_matches_full(ModuleName, DefaultModuleName)
|
|
then
|
|
Pieces = [words("Error: module qualifier in definition"),
|
|
words("does not match 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])
|
|
else
|
|
UnqualName = unqualify_name(SymName),
|
|
MaybeSymName = ok1(qualified(DefaultModuleName, UnqualName))
|
|
)
|
|
;
|
|
MaybeSymName0 = error1(_),
|
|
MaybeSymName = MaybeSymName0
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier) :-
|
|
parse_implicitly_qualified_symbol_name_specifier(root_module_name, VarSet,
|
|
Term, MaybeSymNameSpecifier).
|
|
|
|
parse_implicitly_qualified_symbol_name_specifier(DefaultModule, VarSet, Term,
|
|
MaybeSymNameSpecifier) :-
|
|
( if Term = term.functor(term.atom("/"), [NameTerm, ArityTerm], _) then
|
|
( if decimal_term_to_int(ArityTerm, Arity) then
|
|
( if Arity >= 0 then
|
|
parse_implicitly_qualified_symbol_name(DefaultModule, VarSet,
|
|
NameTerm, MaybeName),
|
|
(
|
|
MaybeName = error1(Specs),
|
|
MaybeSymNameSpecifier = error1(Specs)
|
|
;
|
|
MaybeName = ok1(Name),
|
|
MaybeSymNameSpecifier =
|
|
ok1(sym_name_specifier_name_arity(Name, Arity))
|
|
)
|
|
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_implicitly_qualified_symbol_name(DefaultModule, VarSet, Term,
|
|
MaybeSymbolName),
|
|
(
|
|
MaybeSymbolName = error1(Specs),
|
|
MaybeSymNameSpecifier = error1(Specs)
|
|
;
|
|
MaybeSymbolName = ok1(SymbolName),
|
|
MaybeSymNameSpecifier = ok1(sym_name_specifier_name(SymbolName))
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
|
|
root_module_name = unqualified("").
|
|
|
|
%-----------------------------------------------------------------------------e
|
|
:- end_module parse_tree.parse_sym_name.
|
|
%-----------------------------------------------------------------------------e
|