mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 10:23:46 +00:00
9d38b252bf
compiler/prog_item.m:
Previously, both decl and impl pragmas contained some pragma kinds
that contained only the specification of a predicate or function.
These served only to specify a marker to be applied to the named
predicate or function.
This diff separates out those kinds of pragmas from the types of
both the decl pragmas and the impl pragmas (the difference is that
decl pragmas may appear in module interfaces, while impl pragmas may not),
and gives them two new representations: decl markers and impl markers.
While in the old representation, each kind of marker had its own wrapper
around the predicate/function specification, in the new representation,
they are side-by-side, which allows simpler construction techniques
and smaller code.
Update the definition of parse_tree_module_src, parse_tree_plain_opt,
parse_tree_int0 and parse_tree_int1 to include markers alongside
pragmas of each kind. Use subtypes to restrict the kinds of markers
that can appear in parse_tree_plain_opts to the set that we actually
can put into them. (Source files of course can contain any markers,
and .intN files either get put into them either all of the markers
that occur in the source file in a given section, or none of them.)
Delete the item_pragma_info type, which was a wrapper around
the specific info of each pragma, and stored a context and an item
sequence number alongside it. Move the context and the item sequence
number into the representation of each pragma. This should reduce
visual clutter in the source code at places that construct or deconstruct
pragmas, and at runtime (with direct args) it should reduce both
the number of memory cells we need to allocate, and the number
of pointers we need to follow.
Include decl vs impl in the names of some function symbols.
Partly to counteract that, shorten some names to avoid excessive
line lengths.
compiler/add_pragma.m:
Add predicates to add decl and impl markers.
Move the predicates looping over lists of pragma next to the
predicates handling those pragmas.
compiler/make_hlds_passes.m:
Add both decl and impl markers before adding foreign_procs.
The ability to do this was the original motivation for this diff.
Update the comments both about this issue, and about why we delay
adding tabling pragmas to the HLDS.
compiler/check_module_interface.m:
Conform to the changes above.
Add an XXX about something fishy.
compiler/item_util.m:
Delete aux functions that are no longer needed.
compiler/add_mutable_aux_preds.m:
compiler/add_pragma_tabling.m:
compiler/add_pragma_type_spec.m:
compiler/comp_unit_interface.m:
compiler/convert_parse_tree.m:
compiler/equiv_type.m:
compiler/get_dependencies.m:
compiler/grab_modules.m:
compiler/hlds_module.m:
compiler/intermod.m:
compiler/intermod_analysis.m:
compiler/make_hlds_separate_items.m:
compiler/mercury_compile_middle_passes.m:
compiler/module_qual.collect_mq_info.m:
compiler/module_qual.qual_errors.m:
compiler/module_qual.qualify_items.m:
compiler/parse_pragma.m:
compiler/parse_pragma_analysis.m:
compiler/parse_pragma_foreign.m:
compiler/parse_pragma_tabling.m:
compiler/parse_tree_out.m:
compiler/parse_tree_out_pragma.m:
compiler/prog_item_stats.m:
compiler/prog_mutable.m:
compiler/recompilation.check.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/unused_args.m:
Conform to the changes above.
982 lines
42 KiB
Mathematica
982 lines
42 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 expandtab
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-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_pragma_analysis.m.
|
|
%
|
|
% This parses pragmas that record the results of some program analysis,
|
|
% though some of them may also be written by hand.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.parse_pragma_analysis.
|
|
:- 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 list.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred parse_pragma_unused_args(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_pragma_termination_info(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_pragma_termination2_info(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_pragma_structure_sharing(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_pragma_structure_reuse(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_pragma_exceptions(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_pragma_trailing_info(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
:- pred parse_pragma_mm_tabling_info(module_name::in, varset::in, term::in,
|
|
list(term)::in, prog_context::in, item_seq_num::in,
|
|
maybe1(item_or_marker)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.
|
|
:- import_module libs.rat.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.error_spec.
|
|
:- 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 parse_tree.prog_ctgc.
|
|
:- import_module parse_tree.prog_data_pragma.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module maybe.
|
|
:- import_module term_int.
|
|
:- import_module term_vars.
|
|
:- import_module unit.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_unused_args(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
% pragma unused_args should never appear in user programs,
|
|
% only in .opt files.
|
|
(
|
|
PragmaTerms = [PredOrFuncTerm, PredNameTerm, ArityTerm, ModeNumTerm,
|
|
UnusedArgsTerm],
|
|
PredNameContextPieces = cord.from_list(
|
|
[words("In the second argument of"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_predicate_or_function(VarSet, PredOrFuncTerm, MaybePredOrFunc),
|
|
parse_implicitly_qualified_sym_name_and_no_args(ModuleName,
|
|
VarSet, PredNameContextPieces, PredNameTerm, MaybePredName),
|
|
ArityContextPieces = cord.from_list(
|
|
[words("In the third argument of"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_decimal_int(ArityContextPieces, VarSet, ArityTerm, MaybeArity),
|
|
ModeNumContextPieces = cord.from_list(
|
|
[words("In the fourth argument of"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_decimal_int(ModeNumContextPieces, VarSet, ModeNumTerm,
|
|
MaybeModeNum),
|
|
UnusedArgsContextPieces = cord.from_list(
|
|
[words("In the fifth argument of"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_list_elements("a list of integers",
|
|
parse_decimal_int(UnusedArgsContextPieces),
|
|
VarSet, UnusedArgsTerm, MaybeUnusedArgs),
|
|
( if
|
|
MaybePredOrFunc = ok1(PredOrFunc),
|
|
MaybePredName = ok1(PredName),
|
|
MaybeArity = ok1(Arity),
|
|
MaybeModeNum = ok1(ModeNum),
|
|
MaybeUnusedArgs = ok1(UnusedArgs)
|
|
then
|
|
PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc,
|
|
PredName, user_arity(Arity), ModeNum),
|
|
Pragma = gen_pragma_unused_args_info(PredNameArityPFMn,
|
|
UnusedArgs, Context, SeqNum),
|
|
Item = item_generated_pragma( gen_pragma_unused_args(Pragma)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs =
|
|
get_any_errors1(MaybePredOrFunc) ++
|
|
get_any_errors1(MaybePredName) ++
|
|
get_any_errors1(MaybeArity) ++
|
|
get_any_errors1(MaybeModeNum) ++
|
|
get_any_errors1(MaybeUnusedArgs),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
;
|
|
( PragmaTerms = []
|
|
; PragmaTerms = [_]
|
|
; PragmaTerms = [_, _]
|
|
; PragmaTerms = [_, _, _]
|
|
; PragmaTerms = [_, _, _, _]
|
|
; PragmaTerms = [_, _, _, _, _, _ | _]
|
|
),
|
|
Pieces = [words("Error: an"), pragma_decl("unused_args"),
|
|
words("declaration must have five arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_termination_info(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
(
|
|
PragmaTerms = [PredAndModesTerm0, ArgSizeTerm, TerminationTerm],
|
|
PAMContextPieces = cord.from_list([words("In the first argument of"),
|
|
pragma_decl("termination_info"), words("declaration:"), nl]),
|
|
parse_pred_or_func_and_arg_modes(yes(ModuleName), PAMContextPieces,
|
|
VarSet, PredAndModesTerm0, MaybeNameAndModes),
|
|
( if
|
|
ArgSizeTerm = term.functor(term.atom(ArgSizeFunctor),
|
|
ArgSizeArgTerms, _),
|
|
( ArgSizeFunctor = "not_set"
|
|
; ArgSizeFunctor = "infinite"
|
|
; ArgSizeFunctor = "finite"
|
|
)
|
|
then
|
|
ArgSizeContextPieces = cord.from_list(
|
|
[words("In the second argument of"),
|
|
pragma_decl("termination_info"), words("declaration:"), nl]),
|
|
(
|
|
ArgSizeFunctor = "not_set",
|
|
(
|
|
ArgSizeArgTerms = [],
|
|
MaybeArgSizeInfo0 = no,
|
|
MaybeMaybeArgSizeInfo = ok1(MaybeArgSizeInfo0)
|
|
;
|
|
ArgSizeArgTerms = [_ | _],
|
|
NotSetPieces = cord.list(ArgSizeContextPieces) ++
|
|
[words("error:"), quote("not_set"),
|
|
words("must have no arguments."), nl],
|
|
NotSetSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(ArgSizeTerm), NotSetPieces),
|
|
MaybeMaybeArgSizeInfo = error1([NotSetSpec])
|
|
)
|
|
;
|
|
ArgSizeFunctor = "infinite",
|
|
(
|
|
ArgSizeArgTerms = [],
|
|
MaybeArgSizeInfo0 = yes(infinite(unit)),
|
|
MaybeMaybeArgSizeInfo = ok1(MaybeArgSizeInfo0)
|
|
;
|
|
ArgSizeArgTerms = [_ | _],
|
|
InfinitePieces = cord.list(ArgSizeContextPieces) ++
|
|
[words("error:"), quote("infinite"),
|
|
words("must have no arguments."), nl],
|
|
InfiniteSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(ArgSizeTerm), InfinitePieces),
|
|
MaybeMaybeArgSizeInfo = error1([InfiniteSpec])
|
|
)
|
|
;
|
|
ArgSizeFunctor = "finite",
|
|
(
|
|
ArgSizeArgTerms = [IntTerm, UsedArgsTerm],
|
|
IntContextPieces = ArgSizeContextPieces ++
|
|
cord.from_list([words("in the first argument:"), nl]),
|
|
parse_decimal_int(IntContextPieces, VarSet, IntTerm,
|
|
MaybeInt),
|
|
BoolContextPieces = ArgSizeContextPieces ++
|
|
cord.from_list([words("in the second argument:"), nl]),
|
|
parse_list_elements("a list of booleans",
|
|
parse_bool(BoolContextPieces),
|
|
VarSet, UsedArgsTerm, MaybeUsedArgs),
|
|
( if
|
|
MaybeInt = ok1(Int),
|
|
MaybeUsedArgs = ok1(UsedArgs)
|
|
then
|
|
MaybeArgSizeInfo0 = yes(finite(Int, UsedArgs)),
|
|
MaybeMaybeArgSizeInfo = ok1(MaybeArgSizeInfo0)
|
|
else
|
|
FiniteSpecs = get_any_errors1(MaybeInt) ++
|
|
get_any_errors1(MaybeUsedArgs),
|
|
MaybeMaybeArgSizeInfo = error1(FiniteSpecs)
|
|
)
|
|
;
|
|
( ArgSizeArgTerms = []
|
|
; ArgSizeArgTerms = [_]
|
|
; ArgSizeArgTerms = [_, _, _ | _]
|
|
),
|
|
FinitePieces =
|
|
[words("Error: in the second argument of"),
|
|
pragma_decl("termination_info"),
|
|
words("declaration:"), nl,
|
|
quote("finite"),
|
|
words("must have two arguments."), nl],
|
|
FiniteSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(ArgSizeTerm), FinitePieces),
|
|
MaybeMaybeArgSizeInfo = error1([FiniteSpec])
|
|
)
|
|
)
|
|
else
|
|
ArgSizeTermStr = describe_error_term(VarSet, ArgSizeTerm),
|
|
ArgSizePieces = [words("In the second argument of"),
|
|
pragma_decl("termination_info"), words("declaration:"), nl,
|
|
words("error: expected one of"),
|
|
quote("not_set"), suffix(","),
|
|
quote("infinite"), suffix(","), words("and"),
|
|
quote("finite(N, <used_args>)"), suffix(","),
|
|
words("got"), quote(ArgSizeTermStr), suffix("."), nl],
|
|
ArgSizeSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(ArgSizeTerm),
|
|
ArgSizePieces),
|
|
MaybeMaybeArgSizeInfo = error1([ArgSizeSpec])
|
|
),
|
|
TIContextPieces = [words("In the third argument of"),
|
|
pragma_decl("termination_info"), words("declaration:"), nl],
|
|
parse_termination_info(TIContextPieces, VarSet, TerminationTerm,
|
|
MaybeMaybeTerminationInfo),
|
|
( if
|
|
MaybeNameAndModes = ok3(PredName, PredOrFunc, Modes),
|
|
MaybeMaybeArgSizeInfo = ok1(MaybeArgSizeInfo),
|
|
MaybeMaybeTerminationInfo = ok1(MaybeTerminationInfo)
|
|
then
|
|
PredNameModesPF = proc_pf_name_modes(PredOrFunc, PredName, Modes),
|
|
Term = decl_pragma_termination_info(PredNameModesPF,
|
|
MaybeArgSizeInfo, MaybeTerminationInfo, Context, SeqNum),
|
|
Item = item_decl_pragma(decl_pragma_termination(Term)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = get_any_errors3(MaybeNameAndModes) ++
|
|
get_any_errors1(MaybeMaybeArgSizeInfo) ++
|
|
get_any_errors1(MaybeMaybeTerminationInfo),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
;
|
|
( PragmaTerms = []
|
|
; PragmaTerms = [_]
|
|
; PragmaTerms = [_, _]
|
|
; PragmaTerms = [_, _, _, _ | _]
|
|
),
|
|
Pieces = [words("Error: a"), pragma_decl("termination_info"),
|
|
words("declaration must have three arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_bool(cord(format_piece)::in, varset::in, term::in,
|
|
maybe1(bool)::out) is det.
|
|
|
|
parse_bool(ContextPieces, VarSet, Term, MaybeBool) :-
|
|
( if
|
|
Term = term.functor(term.atom(Name), [], _),
|
|
( Name = "yes", Bool = yes
|
|
; Name = "no", Bool = no
|
|
)
|
|
then
|
|
MaybeBool = ok1(Bool)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: expected a boolean (yes or no),"),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(Term), Pieces),
|
|
MaybeBool = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_termination2_info(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
(
|
|
PragmaTerms = [PredAndModesTerm0, SuccessArgSizeTerm,
|
|
FailureArgSizeTerm, TerminationTerm],
|
|
PAMContextPieces = cord.from_list([words("In the first argument of"),
|
|
pragma_decl("termination2_info"), words("declaration:"), nl]),
|
|
parse_pred_or_func_and_arg_modes(yes(ModuleName), PAMContextPieces,
|
|
VarSet, PredAndModesTerm0, MaybeNameAndModes),
|
|
parse_arg_size_constraints(VarSet, SuccessArgSizeTerm,
|
|
MaybeSuccessArgSize),
|
|
parse_arg_size_constraints(VarSet, FailureArgSizeTerm,
|
|
MaybeFailureArgSize),
|
|
TIContextPieces = [words("In the fourth argument of"),
|
|
pragma_decl("termination2_info"), words("declaration:"), nl],
|
|
parse_termination_info(TIContextPieces, VarSet, TerminationTerm,
|
|
MaybeMaybeTerminationInfo),
|
|
( if
|
|
MaybeNameAndModes = ok3(PredName, PredOrFunc, Modes),
|
|
MaybeSuccessArgSize = ok1(SuccessArgSizeInfo),
|
|
MaybeFailureArgSize = ok1(FailureArgSizeInfo),
|
|
MaybeMaybeTerminationInfo = ok1(MaybeTerminationInfo)
|
|
then
|
|
PredNameModesPF = proc_pf_name_modes(PredOrFunc, PredName, Modes),
|
|
Term2 = decl_pragma_termination2_info(PredNameModesPF,
|
|
SuccessArgSizeInfo, FailureArgSizeInfo, MaybeTerminationInfo,
|
|
Context, SeqNum),
|
|
Item = item_decl_pragma(decl_pragma_termination2(Term2)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = get_any_errors3(MaybeNameAndModes) ++
|
|
get_any_errors1(MaybeSuccessArgSize) ++
|
|
get_any_errors1(MaybeFailureArgSize) ++
|
|
get_any_errors1(MaybeMaybeTerminationInfo),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
;
|
|
( PragmaTerms = []
|
|
; PragmaTerms = [_]
|
|
; PragmaTerms = [_, _]
|
|
; PragmaTerms = [_, _, _]
|
|
; PragmaTerms = [_, _, _, _, _ | _]
|
|
),
|
|
Pieces = [words("Error: a"), pragma_decl("termination2_info"),
|
|
words("declaration must have four arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_termination_info(list(format_piece)::in, varset::in,
|
|
term::in, maybe1(maybe(pragma_termination_info))::out) is det.
|
|
|
|
parse_termination_info(ContextPieces, VarSet, Term,
|
|
MaybeMaybeTerminationInfo) :-
|
|
( if
|
|
Term = term.functor(term.atom(Functor), [], _),
|
|
(
|
|
Functor = "not_set",
|
|
MaybeTerminationInfo = no
|
|
;
|
|
Functor = "can_loop",
|
|
MaybeTerminationInfo = yes(can_loop(unit))
|
|
;
|
|
Functor = "cannot_loop",
|
|
MaybeTerminationInfo = yes(cannot_loop(unit))
|
|
)
|
|
then
|
|
MaybeMaybeTerminationInfo = ok1(MaybeTerminationInfo)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = ContextPieces ++
|
|
[lower_case_next_if_not_first, words("Error: expected one of"),
|
|
quote("not_set"), suffix(","),
|
|
quote("can_loop"), suffix(","), words("and"),
|
|
quote("cannot_loop"), suffix(","),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(Term), Pieces),
|
|
MaybeMaybeTerminationInfo = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_arg_size_constraints(varset::in, term::in,
|
|
maybe1(maybe(list(arg_size_constr)))::out) is det.
|
|
|
|
parse_arg_size_constraints(VarSet, Term, MaybeMaybeArgSizeConstraints) :-
|
|
( if
|
|
Term = term.functor(term.atom("not_set"), [], _)
|
|
then
|
|
MaybeMaybeArgSizeConstraints = ok1(no)
|
|
else if
|
|
Term = term.functor(term.atom("constraints"), [ConstraintsTerm], _)
|
|
then
|
|
parse_list_elements("list of argument size constraints",
|
|
parse_arg_size_constraint, VarSet, ConstraintsTerm,
|
|
MaybeConstraints),
|
|
(
|
|
MaybeConstraints = ok1(Constraints),
|
|
MaybeMaybeArgSizeConstraints = ok1(yes(Constraints))
|
|
;
|
|
MaybeConstraints = error1(Specs),
|
|
MaybeMaybeArgSizeConstraints = error1(Specs)
|
|
)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error: expected a description of"),
|
|
words("argument size constraints,"),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(Term), Pieces),
|
|
MaybeMaybeArgSizeConstraints = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_arg_size_constraint(varset::in, term::in,
|
|
maybe1(arg_size_constr)::out) is det.
|
|
|
|
parse_arg_size_constraint(VarSet, Term, MaybeConstr) :-
|
|
( if
|
|
Term = term.functor(term.atom(Functor), [Terms, ConstantTerm], _),
|
|
( Functor = "le"
|
|
; Functor = "eq"
|
|
)
|
|
then
|
|
parse_list_elements("a list of linear terms", parse_lp_term,
|
|
VarSet, Terms, LPTermsResult),
|
|
parse_rational(VarSet, ConstantTerm, ConstantResult),
|
|
( if
|
|
LPTermsResult = ok1(LPTerms),
|
|
ConstantResult = ok1(Constant)
|
|
then
|
|
(
|
|
Functor = "le",
|
|
Constr = le(LPTerms, Constant)
|
|
;
|
|
Functor = "eq",
|
|
Constr = eq(LPTerms, Constant)
|
|
),
|
|
MaybeConstr = ok1(Constr)
|
|
else
|
|
Specs = get_any_errors1(LPTermsResult) ++
|
|
get_any_errors1(ConstantResult),
|
|
MaybeConstr = error1(Specs)
|
|
)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error: expected an argument size constraint,"),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(Term), Pieces),
|
|
MaybeConstr = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_lp_term(varset::in, term::in, maybe1(arg_size_term)::out) is det.
|
|
|
|
parse_lp_term(VarSet, Term, MaybeLpTerm) :-
|
|
( if
|
|
Term = term.functor(term.atom("term"), [VarIdTerm, CoeffTerm], _)
|
|
then
|
|
( if term_int.decimal_term_to_int(VarIdTerm, VarId0) then
|
|
MaybeVarId = ok1(VarId0)
|
|
else
|
|
VarIdTermStr = describe_error_term(VarSet, VarIdTerm),
|
|
Pieces = [words("Error: expected an integer,"),
|
|
words("got"), quote(VarIdTermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(VarIdTerm), Pieces),
|
|
MaybeVarId = error1([Spec])
|
|
),
|
|
parse_rational(VarSet, CoeffTerm, MaybeCoeff),
|
|
( if
|
|
MaybeVarId = ok1(VarId),
|
|
MaybeCoeff = ok1(Coeff)
|
|
then
|
|
LpTerm = arg_size_term(VarId, Coeff),
|
|
MaybeLpTerm = ok1(LpTerm)
|
|
else
|
|
Specs = get_any_errors1(MaybeVarId) ++
|
|
get_any_errors1(MaybeCoeff),
|
|
MaybeLpTerm = error1(Specs)
|
|
)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error: expected a linear term of the form"),
|
|
quote("term(<varnum>, <rational_coeff>)"), suffix(","),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(Term), Pieces),
|
|
MaybeLpTerm = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_rational(varset::in, term::in, maybe1(rat)::out) is det.
|
|
|
|
parse_rational(VarSet, Term, MaybeRational) :-
|
|
( if
|
|
Term = term.functor(term.atom("r"), [NumerTerm, DenomTerm], _),
|
|
term_int.decimal_term_to_int(NumerTerm, Numer),
|
|
term_int.decimal_term_to_int(DenomTerm, Denom)
|
|
then
|
|
Rational = rat.rat(Numer, Denom),
|
|
MaybeRational = ok1(Rational)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error: expected a rational number of the form"),
|
|
quote("r(N, M)"), suffix(","),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(Term), Pieces),
|
|
MaybeRational = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_structure_sharing(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
( if
|
|
PragmaTerms = [PredAndModesTerm0, HeadVarsTerm,
|
|
HeadVarTypesTerm, SharingInformationTerm],
|
|
ModesContextPieces = cord.from_list([words("In"),
|
|
pragma_decl("structure_sharing"), words("declaration:"), nl]),
|
|
parse_pred_or_func_and_arg_modes(yes(ModuleName), ModesContextPieces,
|
|
VarSet, PredAndModesTerm0, MaybeNameAndModes),
|
|
MaybeNameAndModes = ok3(PredName, PredOrFunc, Modes),
|
|
|
|
% Parse the head variables:
|
|
HeadVarsTerm = term.functor(term.atom("vars"), ListHVTerms, _),
|
|
term_vars.vars_in_terms(ListHVTerms, HeadVarsGeneric),
|
|
list.map(term.coerce_var, HeadVarsGeneric, HeadVars),
|
|
|
|
% Parse the types:
|
|
HeadVarTypesTerm = term.functor(term.atom("types"), ListTypeTerms, _),
|
|
maybe_parse_types(no_allow_ho_inst_info(wnhii_pragma_struct_sharing),
|
|
ListTypeTerms, Types),
|
|
|
|
% Parse the actual structure sharing information.
|
|
|
|
SharingInformationTerm = term.functor(term.atom(SharingFunctor),
|
|
SharingArgTerms, _),
|
|
(
|
|
SharingFunctor = "not_available",
|
|
% XXX Why don't we test SharingArgTerms?
|
|
MaybeSharingAs = no
|
|
;
|
|
SharingFunctor = "yes",
|
|
SharingArgTerms = [SharingAsTerm],
|
|
MaybeSharingAs = yes(parse_structure_sharing_domain(SharingAsTerm))
|
|
)
|
|
then
|
|
PredNameModesPF = proc_pf_name_modes(PredOrFunc, PredName, Modes),
|
|
varset.coerce(VarSet, ProgVarSet),
|
|
varset.coerce(VarSet, TVarSet),
|
|
Sharing = decl_pragma_struct_sharing_info(PredNameModesPF, HeadVars,
|
|
Types, ProgVarSet, TVarSet, MaybeSharingAs, Context, SeqNum),
|
|
Item = item_decl_pragma(decl_pragma_struct_sharing(Sharing)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Pieces = [words("Syntax error in"),
|
|
pragma_decl("structure_sharing"), words("declaration."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_structure_reuse(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
( if
|
|
PragmaTerms = [PredAndModesTerm0, HeadVarsTerm,
|
|
HeadVarTypesTerm, MaybeStructureReuseTerm],
|
|
ReuseContextPieces = cord.from_list([words("In"),
|
|
pragma_decl("structure_reuse"), words("declaration:"), nl]),
|
|
parse_pred_or_func_and_arg_modes(yes(ModuleName), ReuseContextPieces,
|
|
VarSet, PredAndModesTerm0, MaybeNameAndModes),
|
|
MaybeNameAndModes = ok3(PredName, PredOrFunc, Modes),
|
|
|
|
% Parse the head variables:
|
|
HeadVarsTerm = term.functor(term.atom("vars"), ListHVTerms, _),
|
|
term_vars.vars_in_terms(ListHVTerms, HeadVarsGeneric),
|
|
list.map(term.coerce_var, HeadVarsGeneric, HeadVars),
|
|
|
|
% Parse the types:
|
|
HeadVarTypesTerm = term.functor(term.atom("types"), ListTypeTerms, _),
|
|
maybe_parse_types(no_allow_ho_inst_info(wnhii_pragma_struct_reuse),
|
|
ListTypeTerms, Types),
|
|
|
|
% Parse the actual structure reuse information.
|
|
MaybeStructureReuseTerm = term.functor(term.atom(ReuseFunctor),
|
|
ReuseArgTerms, _),
|
|
(
|
|
ReuseFunctor = "not_available",
|
|
% XXX Why don't we test ReuseArgTerms?
|
|
MaybeStructureReuse = no
|
|
;
|
|
ReuseFunctor = "yes",
|
|
ReuseArgTerms = [StructureReuseTerm],
|
|
StructureReuse = parse_structure_reuse_domain(StructureReuseTerm),
|
|
MaybeStructureReuse = yes(StructureReuse)
|
|
)
|
|
then
|
|
PredNameModesPF = proc_pf_name_modes(PredOrFunc, PredName, Modes),
|
|
varset.coerce(VarSet, ProgVarSet),
|
|
varset.coerce(VarSet, TVarSet),
|
|
Reuse = decl_pragma_struct_reuse_info(PredNameModesPF, HeadVars, Types,
|
|
ProgVarSet, TVarSet, MaybeStructureReuse, Context, SeqNum),
|
|
Item = item_decl_pragma(decl_pragma_struct_reuse(Reuse)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Pieces = [words("Syntax error in"),
|
|
pragma_decl("structure_reuse"), words("declaration."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_exceptions(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
(
|
|
PragmaTerms = [PredOrFuncTerm, PredNameTerm, ArityTerm, ModeNumTerm,
|
|
ThrowStatusTerm],
|
|
parse_predicate_or_function(VarSet, PredOrFuncTerm, MaybePredOrFunc),
|
|
PNContextPieces = cord.from_list(
|
|
[words("In the second argument of"), pragma_decl("exceptions"),
|
|
words("declaration:"), nl]),
|
|
parse_implicitly_qualified_sym_name_and_no_args(ModuleName,
|
|
VarSet, PNContextPieces, PredNameTerm, MaybePredName),
|
|
ArityContextPieces = cord.from_list(
|
|
[words("In the third argument of an"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_decimal_int(ArityContextPieces, VarSet, ArityTerm, MaybeArity),
|
|
ModeNumContextPieces = cord.from_list(
|
|
[words("In the fourth argument of an"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_decimal_int(ModeNumContextPieces, VarSet, ModeNumTerm,
|
|
MaybeModeNum),
|
|
( if
|
|
ThrowStatusTerm = term.functor(term.atom(ThrowStatusFunctor),
|
|
ThrowStatusArgTerms, _),
|
|
( ThrowStatusFunctor = "will_not_throw"
|
|
; ThrowStatusFunctor = "may_throw"
|
|
; ThrowStatusFunctor = "conditional"
|
|
)
|
|
then
|
|
(
|
|
ThrowStatusFunctor = "will_not_throw",
|
|
(
|
|
ThrowStatusArgTerms = [],
|
|
MaybeThrowStatus = ok1(will_not_throw)
|
|
;
|
|
ThrowStatusArgTerms = [_ | _],
|
|
WillNotThrowPieces =
|
|
[words("In the fifth argument of"),
|
|
pragma_decl("exceptions"), words("declaration:"), nl,
|
|
words("error:"), quote("will_not_throw"),
|
|
words("must have no arguments."), nl],
|
|
WillNotThrowSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(ThrowStatusTerm), WillNotThrowPieces),
|
|
MaybeThrowStatus = error1([WillNotThrowSpec])
|
|
)
|
|
;
|
|
ThrowStatusFunctor = "may_throw",
|
|
( if
|
|
ThrowStatusArgTerms = [ExceptionTypeTerm],
|
|
ExceptionTypeTerm = term.functor(
|
|
term.atom(ExceptionFunctor), [], _),
|
|
(
|
|
ExceptionFunctor = "user_exception",
|
|
ExceptionType = user_exception
|
|
;
|
|
ExceptionFunctor = "type_exception",
|
|
ExceptionType = type_exception
|
|
)
|
|
then
|
|
MaybeThrowStatus = ok1(may_throw(ExceptionType))
|
|
else
|
|
MayThrowPieces =
|
|
[words("In the fifth argument of"),
|
|
pragma_decl("exceptions"), words("declaration:"), nl,
|
|
words("error:"), quote("may_throw"),
|
|
words("must have one argument,"),
|
|
words("which must be either"),
|
|
quote("user_exception"), words("or"),
|
|
quote("type_exception"), suffix("."), nl],
|
|
MayThrowSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(ThrowStatusTerm), MayThrowPieces),
|
|
MaybeThrowStatus = error1([MayThrowSpec])
|
|
)
|
|
;
|
|
ThrowStatusFunctor = "conditional",
|
|
(
|
|
ThrowStatusArgTerms = [],
|
|
MaybeThrowStatus = ok1(throw_conditional)
|
|
;
|
|
ThrowStatusArgTerms = [_ | _],
|
|
ConditionalPieces =
|
|
[words("In the fifth argument of"),
|
|
pragma_decl("exceptions"), words("declaration:"), nl,
|
|
words("error:"), quote("conditional"),
|
|
words("must have no arguments."), nl],
|
|
ConditionalSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(ThrowStatusTerm), ConditionalPieces),
|
|
MaybeThrowStatus = error1([ConditionalSpec])
|
|
)
|
|
)
|
|
else
|
|
ThrowStatusTermStr = describe_error_term(VarSet, ThrowStatusTerm),
|
|
ThrowStatusPieces = [words("In the fifth argument of"),
|
|
pragma_decl("exceptions"), words("declaration:"), nl,
|
|
words("error: expected one of"),
|
|
quote("will_not_throw"), suffix(","),
|
|
quote("may_throw"), suffix(","), words("and"),
|
|
quote("conditional"), suffix(","),
|
|
words("got"), quote(ThrowStatusTermStr), suffix("."), nl],
|
|
ThrowStatusSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(ThrowStatusTerm),
|
|
ThrowStatusPieces),
|
|
MaybeThrowStatus = error1([ThrowStatusSpec])
|
|
),
|
|
( if
|
|
MaybePredOrFunc = ok1(PredOrFunc),
|
|
MaybePredName = ok1(PredName),
|
|
MaybeArity = ok1(Arity),
|
|
MaybeModeNum = ok1(ModeNum),
|
|
MaybeThrowStatus = ok1(ThrowStatus)
|
|
then
|
|
PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc,
|
|
PredName, user_arity(Arity), ModeNum),
|
|
Exceptions = gen_pragma_exceptions_info(PredNameArityPFMn,
|
|
ThrowStatus, Context, SeqNum),
|
|
Item = item_generated_pragma(gen_pragma_exceptions(Exceptions)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = get_any_errors1(MaybePredOrFunc) ++
|
|
get_any_errors1(MaybePredName) ++
|
|
get_any_errors1(MaybeArity) ++
|
|
get_any_errors1(MaybeModeNum) ++
|
|
get_any_errors1(MaybeThrowStatus),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
;
|
|
( PragmaTerms = []
|
|
; PragmaTerms = [_]
|
|
; PragmaTerms = [_, _]
|
|
; PragmaTerms = [_, _, _]
|
|
; PragmaTerms = [_, _, _, _]
|
|
; PragmaTerms = [_, _, _, _, _, _ | _]
|
|
),
|
|
Pieces = [words("Error: an"), pragma_decl("exceptions"),
|
|
words("declaration must have five arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_trailing_info(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
(
|
|
PragmaTerms = [PredOrFuncTerm, PredNameTerm, ArityTerm, ModeNumTerm,
|
|
TrailingStatusTerm],
|
|
parse_predicate_or_function(VarSet, PredOrFuncTerm, MaybePredOrFunc),
|
|
PNContextPieces = cord.from_list(
|
|
[words("In the second argument of"), pragma_decl("traling_info"),
|
|
words("declaration:"), nl]),
|
|
parse_implicitly_qualified_sym_name_and_no_args(ModuleName,
|
|
VarSet, PNContextPieces, PredNameTerm, MaybePredName),
|
|
ArityContextPieces = cord.from_list(
|
|
[words("In the third argument of an"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_decimal_int(ArityContextPieces, VarSet, ArityTerm, MaybeArity),
|
|
ModeNumContextPieces = cord.from_list(
|
|
[words("In the fourth argument of an"),
|
|
pragma_decl("unused_args"), words("declaration:"), nl]),
|
|
parse_decimal_int(ModeNumContextPieces, VarSet, ModeNumTerm,
|
|
MaybeModeNum),
|
|
( if
|
|
TrailingStatusTerm = term.functor(term.atom(TrailingStatusFunctor),
|
|
[], _),
|
|
(
|
|
TrailingStatusFunctor = "will_not_modify_trail",
|
|
TrailingStatus0 = trail_will_not_modify
|
|
;
|
|
TrailingStatusFunctor = "may_modify_trail",
|
|
TrailingStatus0 = trail_may_modify
|
|
;
|
|
TrailingStatusFunctor = "conditional",
|
|
TrailingStatus0 = trail_conditional
|
|
)
|
|
then
|
|
MaybeTrailingStatus = ok1(TrailingStatus0)
|
|
else
|
|
TrailingStatusTermStr =
|
|
describe_error_term(VarSet, TrailingStatusTerm),
|
|
TrailingStatusPieces = [words("In the fifth argument of"),
|
|
pragma_decl("trailing_info"), words("declaration:"), nl,
|
|
words("error: expected one of"),
|
|
quote("will_not_modify_trail"), suffix(","),
|
|
quote("may_modify_trail"), suffix(","), words("and"),
|
|
quote("conditional"), suffix(","),
|
|
words("got"), quote(TrailingStatusTermStr), suffix("."), nl],
|
|
TrailingStatusSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(TrailingStatusTerm),
|
|
TrailingStatusPieces),
|
|
MaybeTrailingStatus = error1([TrailingStatusSpec])
|
|
),
|
|
( if
|
|
MaybePredOrFunc = ok1(PredOrFunc),
|
|
MaybePredName = ok1(PredName),
|
|
MaybeArity = ok1(Arity),
|
|
MaybeModeNum = ok1(ModeNum),
|
|
MaybeTrailingStatus = ok1(TrailingStatus)
|
|
then
|
|
PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc,
|
|
PredName, user_arity(Arity), ModeNum),
|
|
Trailing = gen_pragma_trailing_info(PredNameArityPFMn,
|
|
TrailingStatus, Context, SeqNum),
|
|
Item = item_generated_pragma(gen_pragma_trailing(Trailing)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = get_any_errors1(MaybePredOrFunc) ++
|
|
get_any_errors1(MaybePredName) ++
|
|
get_any_errors1(MaybeArity) ++
|
|
get_any_errors1(MaybeModeNum) ++
|
|
get_any_errors1(MaybeTrailingStatus),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
;
|
|
( PragmaTerms = []
|
|
; PragmaTerms = [_]
|
|
; PragmaTerms = [_, _]
|
|
; PragmaTerms = [_, _, _]
|
|
; PragmaTerms = [_, _, _, _]
|
|
; PragmaTerms = [_, _, _, _, _, _ | _]
|
|
),
|
|
Pieces = [words("Error:"), pragma_decl("trailing_info"),
|
|
words("declaration must have five arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_pragma_mm_tabling_info(ModuleName, VarSet, ErrorTerm, PragmaTerms,
|
|
Context, SeqNum, MaybeIOM) :-
|
|
(
|
|
PragmaTerms = [PredOrFuncTerm, PredNameTerm, ArityTerm, ModeNumTerm,
|
|
MMTablingStatusTerm],
|
|
parse_predicate_or_function(VarSet, PredOrFuncTerm, MaybePredOrFunc),
|
|
PNContextPieces = cord.from_list(
|
|
[words("In the second argument of"),
|
|
pragma_decl("mm_tabling_info"), words("declaration:"), nl]),
|
|
parse_implicitly_qualified_sym_name_and_no_args(ModuleName,
|
|
VarSet, PNContextPieces, PredNameTerm, MaybePredName),
|
|
ArityContextPieces = cord.from_list(
|
|
[words("In the third argument of an"),
|
|
pragma_decl("mm_tabling_info"), words("declaration:"), nl]),
|
|
parse_decimal_int(ArityContextPieces, VarSet, ArityTerm, MaybeArity),
|
|
ModeNumContextPieces = cord.from_list(
|
|
[words("In the fourth argument of an"),
|
|
pragma_decl("mm_tabling_info"), words("declaration:"), nl]),
|
|
parse_decimal_int(ModeNumContextPieces, VarSet, ModeNumTerm,
|
|
MaybeModeNum),
|
|
( if
|
|
MMTablingStatusTerm = term.functor(
|
|
term.atom(MMTablingStatusFunctor), [], _),
|
|
(
|
|
MMTablingStatusFunctor = "mm_tabled_will_not_call",
|
|
MMTablingStatus0 = mm_tabled_will_not_call
|
|
;
|
|
MMTablingStatusFunctor = "mm_tabled_may_call",
|
|
MMTablingStatus0 = mm_tabled_may_call
|
|
;
|
|
MMTablingStatusFunctor = "mm_tabled_conditional",
|
|
MMTablingStatus0 = mm_tabled_conditional
|
|
)
|
|
then
|
|
MaybeMMTablingStatus = ok1(MMTablingStatus0)
|
|
else
|
|
MMTablingStatusTermStr =
|
|
describe_error_term(VarSet, MMTablingStatusTerm),
|
|
MMTablingStatusPieces = [words("In the fifth argument of"),
|
|
pragma_decl("mm_tabling_info"), words("declaration:"), nl,
|
|
words("error: expected one of"),
|
|
quote("will_not_modify_trail"), suffix(","),
|
|
quote("may_modify_trail"), suffix(","), words("and"),
|
|
quote("conditional"), suffix(","),
|
|
words("got"), quote(MMTablingStatusTermStr), suffix("."), nl],
|
|
MMTablingStatusSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(MMTablingStatusTerm), MMTablingStatusPieces),
|
|
MaybeMMTablingStatus = error1([MMTablingStatusSpec])
|
|
),
|
|
( if
|
|
MaybePredOrFunc = ok1(PredOrFunc),
|
|
MaybePredName = ok1(PredName),
|
|
MaybeArity = ok1(Arity),
|
|
MaybeModeNum = ok1(ModeNum),
|
|
MaybeMMTablingStatus = ok1(MMTablingStatus)
|
|
then
|
|
PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc,
|
|
PredName, user_arity(Arity), ModeNum),
|
|
Tabling = gen_pragma_mm_tabling_info(PredNameArityPFMn,
|
|
MMTablingStatus, Context, SeqNum),
|
|
Item = item_generated_pragma(gen_pragma_mm_tabling(Tabling)),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
else
|
|
Specs = get_any_errors1(MaybePredOrFunc) ++
|
|
get_any_errors1(MaybePredName) ++
|
|
get_any_errors1(MaybeArity) ++
|
|
get_any_errors1(MaybeModeNum) ++
|
|
get_any_errors1(MaybeMMTablingStatus),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
;
|
|
( PragmaTerms = []
|
|
; PragmaTerms = [_]
|
|
; PragmaTerms = [_, _]
|
|
; PragmaTerms = [_, _, _]
|
|
; PragmaTerms = [_, _, _, _]
|
|
; PragmaTerms = [_, _, _, _, _, _ | _]
|
|
),
|
|
Pieces = [words("Error: an"), pragma_decl("mm_tabling_info"),
|
|
words("declaration must have five arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred parse_predicate_or_function(varset::in, term::in,
|
|
maybe1(pred_or_func)::out) is det.
|
|
|
|
parse_predicate_or_function(VarSet, Term, MaybePredOrFunc) :-
|
|
( if
|
|
Term = term.functor(term.atom(Functor), [], _),
|
|
(
|
|
Functor = "predicate",
|
|
PredOrFunc = pf_predicate
|
|
;
|
|
Functor = "function",
|
|
PredOrFunc = pf_function
|
|
)
|
|
then
|
|
MaybePredOrFunc = ok1(PredOrFunc)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = [words("Error: expected either"),
|
|
quote("predicate"), words("or"), quote("function"), suffix(","),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, get_term_context(Term), Pieces),
|
|
MaybePredOrFunc = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module parse_tree.parse_pragma_analysis.
|
|
%---------------------------------------------------------------------------%
|