mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 18:33:58 +00:00
b6178ef723
compiler/parse_tree_out_cons_id.m:
Move the predicates and functions in prog_out.m that deal with cons_ids
to this module.
compiler/parse_tree_out_sym_name.m:
Move the predicates and functions in prog_out.m that deal with sym_names
and similar entities to this module.
compiler/parse_tree_out_type.m:
Move the predicates and functions in prog_out.m that deal with types
to this module.
compiler/parse_tree_out_misc.m:
Move the predicates and functions in prog_out.m that deal with simple
types to this module.
Delete mercury_output_det and mercury_format_det, replacing all their
uses with calls to mercury_det_to_string.
compiler/prog_out.m:
Delete this module.
compiler/parse_tree.m:
Delete prog_out from the parse_tree package.
compiler/Mercury.options:
compiler/notes/compiler_design.html:
Delete references to prog_out.m.
compiler/*.m:
Update imports and any explicit module qualifications to account
for the moved code.
tools/filter_sort_imports:
Automatically filter out any repeated imports. This can help with
changes like this that redistribute the contents of one module to other
modules. In this case, after a global replacement of prog_out's import
with the import of parse_tree_out_misc, this updated script could
remove this changed import from modules that already imported
parse_tree_out_misc.
604 lines
24 KiB
Mathematica
604 lines
24 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.m.
|
|
%
|
|
% This module parses tabling pragmas.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.parse_pragma_tabling.
|
|
:- 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 parse_tree.prog_data_pragma.
|
|
|
|
:- import_module list.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Parse a tabling pragma.
|
|
%
|
|
:- pred parse_tabling_pragma(module_name::in, varset::in, term::in,
|
|
string::in, list(term)::in, prog_context::in, item_seq_num::in,
|
|
tabled_eval_method::in, maybe1(item_or_marker)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.parse_tree_out_misc.
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
:- import_module parse_tree.parse_util.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_tabling_pragma(ModuleName, VarSet, ErrorTerm, PragmaName, PragmaTerms,
|
|
Context, SeqNum, TabledMethod0, MaybeIOM) :-
|
|
(
|
|
(
|
|
PragmaTerms = [PredOrProcSpecTerm0],
|
|
MaybeAttrs = no
|
|
;
|
|
PragmaTerms = [PredOrProcSpecTerm0, AttrListTerm0],
|
|
MaybeAttrs = yes(AttrListTerm0)
|
|
),
|
|
ContextPieces = cord.from_list([words("In the first argument of"),
|
|
pragma_decl(PragmaName), words("declaration:"), nl]),
|
|
parse_pred_pfu_name_arity_maybe_modes(ModuleName, ContextPieces,
|
|
VarSet, PredOrProcSpecTerm0, MaybePredOrProcSpec),
|
|
(
|
|
MaybePredOrProcSpec = ok1(PredOrProcSpec),
|
|
(
|
|
MaybeAttrs = no,
|
|
TabledInfo =
|
|
pragma_info_tabled(TabledMethod0, PredOrProcSpec, no),
|
|
Pragma = impl_pragma_tabled(TabledInfo),
|
|
ItemPragma = item_pragma_info(Pragma, Context, SeqNum),
|
|
Item = item_impl_pragma(ItemPragma),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
;
|
|
MaybeAttrs = yes(AttrsListTerm),
|
|
AttrContextPieces = cord.from_list(
|
|
[words("In the second argument of"),
|
|
pragma_decl(PragmaName), words("declaration:"), nl]),
|
|
parse_list_elements("tabling attributes",
|
|
parse_tabling_attribute(AttrContextPieces, TabledMethod0),
|
|
VarSet, AttrsListTerm, MaybeAttributeList),
|
|
(
|
|
MaybeAttributeList = ok1(AttributeList),
|
|
update_tabling_attributes(AttributeList,
|
|
default_memo_table_attributes, Attributes,
|
|
[], DuplicateSpecs),
|
|
(
|
|
DuplicateSpecs = [],
|
|
DisableWarning =
|
|
Attributes ^ table_attr_backend_warning,
|
|
(
|
|
DisableWarning = table_attr_ignore_with_warning,
|
|
TabledMethod = TabledMethod0
|
|
;
|
|
DisableWarning = table_attr_ignore_without_warning,
|
|
(
|
|
TabledMethod0 = tabled_memo(_),
|
|
TabledMethod = tabled_memo(
|
|
table_attr_ignore_without_warning)
|
|
;
|
|
( TabledMethod0 = tabled_loop_check
|
|
; TabledMethod0 = tabled_minimal(_)
|
|
),
|
|
TabledMethod = TabledMethod0
|
|
;
|
|
TabledMethod0 = tabled_io(_, _),
|
|
unexpected($pred, "non-pragma eval method")
|
|
)
|
|
),
|
|
TabledInfo = pragma_info_tabled(TabledMethod,
|
|
PredOrProcSpec, yes(Attributes)),
|
|
Pragma = impl_pragma_tabled(TabledInfo),
|
|
ItemPragma = item_pragma_info(Pragma, Context, SeqNum),
|
|
Item = item_impl_pragma(ItemPragma),
|
|
MaybeIOM = ok1(iom_item(Item))
|
|
;
|
|
DuplicateSpecs = [_ | _],
|
|
MaybeIOM = error1(DuplicateSpecs)
|
|
)
|
|
;
|
|
MaybeAttributeList = error1(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
)
|
|
;
|
|
MaybePredOrProcSpec = error1(Specs),
|
|
MaybeIOM = error1(Specs)
|
|
)
|
|
;
|
|
( PragmaTerms = []
|
|
; PragmaTerms = [_, _, _ | _]
|
|
),
|
|
Pieces = [words("Error: a"), pragma_decl(PragmaName),
|
|
words("declaration must have one or two arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(ErrorTerm), Pieces),
|
|
MaybeIOM = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred parse_tabling_attribute(cord(format_piece)::in,
|
|
tabled_eval_method::in, varset::in, term::in,
|
|
maybe1(pair(term.context, single_tabling_attribute))::out) is det.
|
|
|
|
parse_tabling_attribute(ContextPieces, TabledMethod, VarSet, Term,
|
|
MaybeContextAttribute) :-
|
|
( if
|
|
Term = term.functor(term.atom(Functor), ArgTerms, Context),
|
|
( Functor = "fast_loose"
|
|
; Functor = "specified"
|
|
; Functor = "size_limit"
|
|
; Functor = "statistics"
|
|
; Functor = "allow_reset"
|
|
; Functor = "disable_warning_if_ignored"
|
|
)
|
|
then
|
|
(
|
|
Functor = "fast_loose",
|
|
parse_tabling_attr_fast_loose(ContextPieces, TabledMethod,
|
|
VarSet, Context, ArgTerms, MaybeContextAttribute)
|
|
;
|
|
Functor = "specified",
|
|
parse_tabling_attr_specified(ContextPieces, TabledMethod,
|
|
VarSet, Context, ArgTerms, MaybeContextAttribute)
|
|
;
|
|
Functor = "size_limit",
|
|
parse_tabling_attr_size_limit(ContextPieces, TabledMethod,
|
|
VarSet, Context, ArgTerms, MaybeContextAttribute)
|
|
;
|
|
Functor = "statistics",
|
|
parse_tabling_attr_statistics(ContextPieces, TabledMethod,
|
|
VarSet, Context, ArgTerms, MaybeContextAttribute)
|
|
;
|
|
Functor = "allow_reset",
|
|
parse_tabling_attr_allow_reset(ContextPieces, TabledMethod,
|
|
VarSet, Context, ArgTerms, MaybeContextAttribute)
|
|
;
|
|
Functor = "disable_warning_if_ignored",
|
|
parse_tabling_attr_backend_warning(ContextPieces, TabledMethod,
|
|
VarSet, Context, ArgTerms, MaybeContextAttribute)
|
|
)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: expected one of"),
|
|
quote("fast_loose"), suffix(","),
|
|
quote("specified(...)"), suffix(","),
|
|
quote("size_limit(...)"), suffix(","),
|
|
quote("statistics"), suffix(","),
|
|
quote("allow_reset"), suffix(","), words("and"),
|
|
quote("disable_warning_if_ignored"), suffix(","),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(Term), Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred parse_tabling_attr_fast_loose(cord(format_piece)::in,
|
|
tabled_eval_method::in, varset::in, term.context::in, list(term)::in,
|
|
maybe1(pair(term.context, single_tabling_attribute))::out) is det.
|
|
|
|
parse_tabling_attr_fast_loose(ContextPieces, TabledMethod, _VarSet,
|
|
Context, ArgTerms, MaybeContextAttribute) :-
|
|
(
|
|
ArgTerms = [],
|
|
require_tabling_fast_loose(ContextPieces, TabledMethod, Context,
|
|
FastLooseSpecs),
|
|
(
|
|
FastLooseSpecs = [],
|
|
Attribute = attr_strictness(cts_all_fast_loose),
|
|
MaybeContextAttribute = ok1(Context - Attribute)
|
|
;
|
|
FastLooseSpecs = [_ | _],
|
|
MaybeContextAttribute = error1(FastLooseSpecs)
|
|
)
|
|
;
|
|
ArgTerms = [_ | _],
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: fast_loose"),
|
|
words("must have no arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
Context, Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred parse_tabling_attr_specified(cord(format_piece)::in,
|
|
tabled_eval_method::in, varset::in, term.context::in, list(term)::in,
|
|
maybe1(pair(term.context, single_tabling_attribute))::out) is det.
|
|
|
|
parse_tabling_attr_specified(ContextPieces, TabledMethod, VarSet,
|
|
Context, ArgTerms, MaybeContextAttribute) :-
|
|
(
|
|
(
|
|
ArgTerms = [MethodsTerm],
|
|
MaybeHiddenArg = ok1(table_hidden_arg_value)
|
|
;
|
|
ArgTerms = [MethodsTerm, HiddenArgTerm],
|
|
( if
|
|
HiddenArgTerm = term.functor(
|
|
term.atom("hidden_arg_value"), [], _)
|
|
then
|
|
MaybeHiddenArg = ok1(table_hidden_arg_value)
|
|
else if
|
|
HiddenArgTerm = term.functor(
|
|
term.atom("hidden_arg_addr"), [], _)
|
|
then
|
|
MaybeHiddenArg = ok1(table_hidden_arg_addr)
|
|
else
|
|
HiddenArgTermStr = describe_error_term(VarSet, HiddenArgTerm),
|
|
HiddenArgPieces = cord.list(ContextPieces) ++
|
|
[lower_case_next_if_not_first,
|
|
words("In the second argument of specified:"), nl,
|
|
words("error: expected either"),
|
|
quote("hidden_arg_value"), words("or"),
|
|
quote("hidden_arg_addr"), suffix(","),
|
|
words("got"), quote(HiddenArgTermStr), suffix("."), nl],
|
|
HiddenArgSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
get_term_context(HiddenArgTerm), HiddenArgPieces),
|
|
MaybeHiddenArg = error1([HiddenArgSpec])
|
|
)
|
|
),
|
|
MethodsContextPieces = ContextPieces ++
|
|
cord.from_list([lower_case_next_if_not_first,
|
|
words("In the first argument of specified:"), nl]),
|
|
parse_list_elements("argument tabling methods",
|
|
parse_arg_tabling_method(MethodsContextPieces),
|
|
VarSet, MethodsTerm, MaybeMaybeArgMethods),
|
|
require_tabling_fast_loose(ContextPieces, TabledMethod, Context,
|
|
FastLooseSpecs),
|
|
( if
|
|
MaybeMaybeArgMethods = ok1(MaybeArgMethods),
|
|
MaybeHiddenArg = ok1(HiddenArg),
|
|
FastLooseSpecs = []
|
|
then
|
|
Attribute = attr_strictness(
|
|
cts_specified(MaybeArgMethods, HiddenArg)),
|
|
MaybeContextAttribute = ok1(Context - Attribute)
|
|
else
|
|
Specs = get_any_errors1(MaybeMaybeArgMethods) ++
|
|
get_any_errors1(MaybeHiddenArg) ++
|
|
FastLooseSpecs,
|
|
MaybeContextAttribute = error1(Specs)
|
|
)
|
|
;
|
|
( ArgTerms = []
|
|
; ArgTerms = [_, _, _ | _]
|
|
),
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: specified must have one or two arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
Context, Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
).
|
|
|
|
:- pred parse_arg_tabling_method(cord(format_piece)::in,
|
|
varset::in, term::in, maybe1(maybe(arg_tabling_method))::out) is det.
|
|
|
|
parse_arg_tabling_method(ContextPieces, VarSet, Term,
|
|
MaybeMaybeArgTablingMethod) :-
|
|
( if
|
|
Term = term.functor(term.atom(Functor), [], _),
|
|
(
|
|
Functor = "value",
|
|
MaybeArgTablingMethod = yes(arg_value)
|
|
;
|
|
Functor = "addr",
|
|
MaybeArgTablingMethod = yes(arg_addr)
|
|
;
|
|
Functor = "promise_implied",
|
|
MaybeArgTablingMethod = yes(arg_promise_implied)
|
|
;
|
|
Functor = "output",
|
|
MaybeArgTablingMethod = no
|
|
)
|
|
then
|
|
MaybeMaybeArgTablingMethod = ok1(MaybeArgTablingMethod)
|
|
else
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: expected one of"),
|
|
quote("value"), suffix(","),
|
|
quote("addr"), suffix(","),
|
|
quote("promise_implied"), suffix(","), words("and"),
|
|
quote("output"), suffix(","),
|
|
words("got"), quote(TermStr), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
get_term_context(Term), Pieces),
|
|
MaybeMaybeArgTablingMethod = error1([Spec])
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred parse_tabling_attr_size_limit(cord(format_piece)::in,
|
|
tabled_eval_method::in, varset::in, term.context::in, list(term)::in,
|
|
maybe1(pair(term.context, single_tabling_attribute))::out) is det.
|
|
|
|
parse_tabling_attr_size_limit(ContextPieces, TabledMethod, VarSet,
|
|
Context, ArgTerms, MaybeContextAttribute) :-
|
|
(
|
|
ArgTerms = [LimitTerm],
|
|
LimitContextPieces = ContextPieces ++ cord.from_list(
|
|
[lower_case_next_if_not_first,
|
|
words("In the first argument of size_limit:"), nl]),
|
|
parse_decimal_int(LimitContextPieces, VarSet, LimitTerm, MaybeLimit),
|
|
AllowsSizeLimit = eval_method_allows_size_limit(TabledMethod),
|
|
(
|
|
AllowsSizeLimit = yes,
|
|
AllowSpecs = []
|
|
;
|
|
AllowsSizeLimit = no,
|
|
AllowPieces = cord.list(ContextPieces) ++
|
|
[lower_case_next_if_not_first,
|
|
words("Error: evaluation method"),
|
|
fixed(tabled_eval_method_to_string(TabledMethod)),
|
|
words("does not allow size limits."), nl],
|
|
AllowSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, AllowPieces),
|
|
AllowSpecs = [AllowSpec]
|
|
),
|
|
( if
|
|
MaybeLimit = ok1(Limit),
|
|
AllowSpecs = []
|
|
then
|
|
Attribute = attr_size_limit(Limit),
|
|
MaybeContextAttribute = ok1(Context - Attribute)
|
|
else
|
|
Specs = get_any_errors1(MaybeLimit) ++ AllowSpecs,
|
|
MaybeContextAttribute = error1(Specs)
|
|
)
|
|
;
|
|
( ArgTerms = []
|
|
; ArgTerms = [_, _ | _]
|
|
),
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: size_limit must have one argument."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
Context, Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred parse_tabling_attr_statistics(cord(format_piece)::in,
|
|
tabled_eval_method::in, varset::in, term.context::in, list(term)::in,
|
|
maybe1(pair(term.context, single_tabling_attribute))::out) is det.
|
|
|
|
parse_tabling_attr_statistics(ContextPieces, _TabledMethod, _VarSet,
|
|
Context, ArgTerms, MaybeContextAttribute) :-
|
|
(
|
|
ArgTerms = [],
|
|
Attribute = attr_statistics,
|
|
MaybeContextAttribute = ok1(Context - Attribute)
|
|
;
|
|
ArgTerms = [_ | _],
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: statistics must have no arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
Context, Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred parse_tabling_attr_allow_reset(cord(format_piece)::in,
|
|
tabled_eval_method::in, varset::in, term.context::in, list(term)::in,
|
|
maybe1(pair(term.context, single_tabling_attribute))::out) is det.
|
|
|
|
parse_tabling_attr_allow_reset(ContextPieces, _TabledMethod, _VarSet,
|
|
Context, ArgTerms, MaybeContextAttribute) :-
|
|
(
|
|
ArgTerms = [],
|
|
Attribute = attr_allow_reset,
|
|
MaybeContextAttribute = ok1(Context - Attribute)
|
|
;
|
|
ArgTerms = [_ | _],
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: allow_reset must have no arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
Context, Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred parse_tabling_attr_backend_warning(cord(format_piece)::in,
|
|
tabled_eval_method::in, varset::in, term.context::in, list(term)::in,
|
|
maybe1(pair(term.context, single_tabling_attribute))::out) is det.
|
|
|
|
parse_tabling_attr_backend_warning(ContextPieces, TabledMethod, _VarSet,
|
|
Context, ArgTerms, MaybeContextAttribute) :-
|
|
(
|
|
ArgTerms = [],
|
|
AllowsDisableWarning =
|
|
eval_method_allows_disable_warning_if_ignored(TabledMethod),
|
|
(
|
|
AllowsDisableWarning = yes,
|
|
Attribute = attr_ignore_without_warning,
|
|
MaybeContextAttribute = ok1(Context - Attribute)
|
|
;
|
|
AllowsDisableWarning = no,
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: evaluation method"),
|
|
fixed(tabled_eval_method_to_string(TabledMethod)),
|
|
words("does not allow disable_warning_if_ignored."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
)
|
|
;
|
|
ArgTerms = [_ | _],
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: allow_reset must have no arguments."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
|
|
Context, Pieces),
|
|
MaybeContextAttribute = error1([Spec])
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred require_tabling_fast_loose(cord(format_piece)::in,
|
|
tabled_eval_method::in, term.context::in, list(error_spec)::out) is det.
|
|
|
|
require_tabling_fast_loose(ContextPieces, TabledMethod, Context, Specs) :-
|
|
AllowsFastLoose = eval_method_allows_fast_loose(TabledMethod),
|
|
(
|
|
AllowsFastLoose = yes,
|
|
Specs = []
|
|
;
|
|
AllowsFastLoose = no,
|
|
Pieces = cord.list(ContextPieces) ++ [lower_case_next_if_not_first,
|
|
words("Error: evaluation method"),
|
|
fixed(tabled_eval_method_to_string(TabledMethod)),
|
|
words("does not allow fast_loose tabling."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
Specs = [Spec]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func eval_method_allows_fast_loose(tabled_eval_method) = bool.
|
|
|
|
eval_method_allows_fast_loose(tabled_loop_check) = yes.
|
|
eval_method_allows_fast_loose(tabled_memo(_)) = yes.
|
|
eval_method_allows_fast_loose(tabled_io(_, _)) = no.
|
|
eval_method_allows_fast_loose(tabled_minimal(_)) = no.
|
|
|
|
:- func eval_method_allows_size_limit(tabled_eval_method) = bool.
|
|
|
|
eval_method_allows_size_limit(tabled_loop_check) = yes.
|
|
eval_method_allows_size_limit(tabled_memo(_)) = yes.
|
|
eval_method_allows_size_limit(tabled_io(_, _)) = no.
|
|
eval_method_allows_size_limit(tabled_minimal(_)) = no.
|
|
|
|
:- func eval_method_allows_disable_warning_if_ignored(tabled_eval_method)
|
|
= bool.
|
|
|
|
eval_method_allows_disable_warning_if_ignored(tabled_loop_check) = no.
|
|
eval_method_allows_disable_warning_if_ignored(tabled_memo(_)) = yes.
|
|
eval_method_allows_disable_warning_if_ignored(tabled_io(_, _)) = no.
|
|
eval_method_allows_disable_warning_if_ignored(tabled_minimal(_)) = no.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type single_tabling_attribute
|
|
---> attr_strictness(call_table_strictness)
|
|
; attr_size_limit(int)
|
|
; attr_statistics
|
|
; attr_allow_reset
|
|
; attr_ignore_without_warning.
|
|
|
|
:- pred update_tabling_attributes(
|
|
assoc_list(term.context, single_tabling_attribute)::in,
|
|
table_attributes::in, table_attributes::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
update_tabling_attributes([], !Attributes, !Specs).
|
|
update_tabling_attributes([Context - Attr | ContextAttrs],
|
|
!Attributes, !Specs) :-
|
|
(
|
|
Attr = attr_strictness(Strictness),
|
|
( if !.Attributes ^ table_attr_strictness = cts_all_strict then
|
|
!Attributes ^ table_attr_strictness := Strictness
|
|
else
|
|
Pieces = [words("Error: duplicate argument tabling methods"),
|
|
words("attribute in"), pragma_decl("memo"),
|
|
words("declaration."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
;
|
|
Attr = attr_size_limit(Limit),
|
|
( if !.Attributes ^ table_attr_size_limit = no then
|
|
!Attributes ^ table_attr_size_limit := yes(Limit)
|
|
else
|
|
Pieces = [words("Error: duplicate size limits attribute in"),
|
|
pragma_decl("memo"), words("declaration."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
;
|
|
Attr = attr_statistics,
|
|
( if
|
|
!.Attributes ^ table_attr_statistics = table_dont_gather_statistics
|
|
then
|
|
!Attributes ^ table_attr_statistics := table_gather_statistics
|
|
else
|
|
Pieces = [words("Error: duplicate statistics attribute in"),
|
|
pragma_decl("memo"), words("declaration."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
;
|
|
Attr = attr_allow_reset,
|
|
( if
|
|
!.Attributes ^ table_attr_allow_reset = table_dont_allow_reset
|
|
then
|
|
!Attributes ^ table_attr_allow_reset := table_allow_reset
|
|
else
|
|
Pieces = [words("Error: duplicate allow_reset attribute in"),
|
|
pragma_decl("memo"), words("declaration."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
;
|
|
Attr = attr_ignore_without_warning,
|
|
( if
|
|
!.Attributes ^ table_attr_backend_warning =
|
|
table_attr_ignore_with_warning
|
|
then
|
|
!Attributes ^ table_attr_backend_warning :=
|
|
table_attr_ignore_without_warning
|
|
else
|
|
Pieces = [words("Error: duplicate disable_warning_if_ignored"),
|
|
words("attribute in"),
|
|
pragma_decl("memo"), words("declaration."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
),
|
|
update_tabling_attributes(ContextAttrs, !Attributes, !Specs).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module parse_tree.parse_pragma_tabling.
|
|
%---------------------------------------------------------------------------%
|