mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-12 12:26:29 +00:00
bcf7dbf9f8
Estimated hours taken: 250 Add support for tabling. This change allows for model_det, model_semidet and model_non memoing, minimal model and loop detection tabling. compiler/base_type_layout.m: Update comments to reflect new runtime naming standard. compiler/det_analysis.m: Allow tabling to change the result of det analysis. This is necessary in the case of minimal model tabling which can turn a det procedure into a semidet one. compiler/det_report.m: compiler/hlds_data.m: Add code to report error messages for various non compatible tabling methods and determinism. compiler/hlds_out.m: compiler/modules.m: Remove reference to the old memo marker. compiler/hlds_pred.m: Create new type (eval_method) to define which of the available evaluation methods should be used each procedure. Add new field to the proc_info structure. Add several new predicates relating to the new eval_method type. compiler/inlining.m: compiler/intermod.m: Make sure only procedures with normal evaluation are inlined. compiler/make_hlds.m: Add code to process new tabling pragmas. compiler/mercury_compile.m: Call the tabling transformation code. compiler/modes.m: Make sure that all procedures with non normal evaluation have no unique/partially instantiated modes. Produce error messages if they do. Support for partially instantiated modes is currently missing as it represents a large amount of work for a case that is currently not used. compiler/module_qual.m: compile/prog_data.m: compiler/prog_io_pragma.m: Add three new pragma types: `memo' `loop_check' `minimal_model' and code to support them. compiler/simplify.m: Don't report infinite recursion warning if a procedure has minimal model evaluation. compiler/stratify.m: Change the stratification analyser so that it reports cases of definite non-stratification. Rather than reporting warnings for any code that is not definitely stratified. Remove reference to the old memo marker. compiler/switch_detection.m: Fix a small bug where goal were being placed in reverse order. Call list__reverse on the list of goals. compiler/table_gen.m: New module to do the actual tabling transformation. compiler/notes/compiler_design.html: Document addition of new tabling pass to the compiler. doc/reference_manual.texi: Fix mistake in example. library/mercury_builtin.m: Add many new predicates for support of tabling. library/std_util.m: library/store.m: Move the functions : ML_compare_type_info ML_collapse_equivalences ML_create_type_info to the runtime. runtime/mercury_deep_copy.c: runtime/mercury_type_info.h: runtime/mercury_type_info.c: Move the make_type_info function into the mercury_type_info module and make it public. runtime/Mmakefile: runtime/mercury_imp.h: Add references to new files added for tabling support. runtime/mercury_string.h: Change hash macro so it does not cause a name clash with any variable called "hash". runtime/mercury_type_info.c: runtime/mercury_type_info.h: Add three new functions taken from the library : MR_compare_type_info MR_collapse_equivalences MR_create_type_info. runtime/mercury_table_any.c: runtime/mercury_table_any.h: runtime/mercury_table_enum.c: runtime/mercury_table_enum.h: runtime/mercury_table_int_float_string.c: runtime/mercury_table_int_float_string.h: runtime/mercury_table_type_info.c: runtime/mercury_table_type_info.h: runtime/mercury_tabling.h: New modules for the support of tabling.
928 lines
29 KiB
Mathematica
928 lines
29 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-1998 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: prog_io_pragma.m.
|
|
% Main authors: fjh, dgj.
|
|
%
|
|
% This module handles the parsing of pragma directives.
|
|
|
|
:- module prog_io_pragma.
|
|
|
|
:- interface.
|
|
|
|
:- import_module prog_data, prog_io_util.
|
|
:- import_module list, varset, term.
|
|
|
|
% parse the pragma declaration.
|
|
:- pred parse_pragma(module_name, varset, list(term), maybe1(item)).
|
|
:- mode parse_pragma(in, in, in, out) is semidet.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module prog_io, prog_io_goal, hlds_pred, term_util, term_errors.
|
|
:- import_module int, string, std_util, bool, require.
|
|
|
|
parse_pragma(ModuleName, VarSet, PragmaTerms, Result) :-
|
|
(
|
|
% new syntax: `:- pragma foo(...).'
|
|
PragmaTerms = [SinglePragmaTerm],
|
|
SinglePragmaTerm = term__functor(term__atom(PragmaType),
|
|
PragmaArgs, _),
|
|
parse_pragma_type(ModuleName, PragmaType, PragmaArgs,
|
|
SinglePragmaTerm, VarSet, Result0)
|
|
->
|
|
Result = Result0
|
|
;
|
|
% old syntax: `:- pragma(foo, ...).'
|
|
% XXX we should issue a warning; this syntax is deprecated.
|
|
PragmaTerms = [PragmaTypeTerm | PragmaArgs2],
|
|
PragmaTypeTerm = term__functor(term__atom(PragmaType), [], _),
|
|
parse_pragma_type(ModuleName, PragmaType, PragmaArgs2,
|
|
PragmaTypeTerm, VarSet, Result1)
|
|
->
|
|
Result = Result1
|
|
;
|
|
fail
|
|
).
|
|
|
|
:- pred parse_pragma_type(module_name, string, list(term), term,
|
|
varset, maybe1(item)).
|
|
:- mode parse_pragma_type(in, in, in, in, in, out) is semidet.
|
|
|
|
parse_pragma_type(_, "source_file", PragmaTerms, ErrorTerm, _VarSet, Result) :-
|
|
( PragmaTerms = [SourceFileTerm] ->
|
|
(
|
|
SourceFileTerm = term__functor(term__string(SourceFile), [], _)
|
|
->
|
|
Result = ok(pragma(source_file(SourceFile)))
|
|
;
|
|
Result = error(
|
|
"string expected in `pragma source_file' declaration",
|
|
SourceFileTerm)
|
|
)
|
|
;
|
|
Result = error(
|
|
"wrong number of arguments in `pragma source_file' declaration",
|
|
ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(_, "c_header_code", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [HeaderTerm]
|
|
->
|
|
(
|
|
HeaderTerm = term__functor(term__string(HeaderCode), [], _)
|
|
->
|
|
Result = ok(pragma(c_header_code(HeaderCode)))
|
|
;
|
|
Result = error("expected string for C header code", HeaderTerm)
|
|
)
|
|
;
|
|
Result = error(
|
|
"wrong number of arguments in `pragma c_header_code(...) declaration",
|
|
ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(ModuleName, "c_code", PragmaTerms,
|
|
ErrorTerm, VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [Just_C_Code_Term]
|
|
->
|
|
(
|
|
Just_C_Code_Term = term__functor(term__string(Just_C_Code), [],
|
|
_)
|
|
->
|
|
Result = ok(pragma(c_code(Just_C_Code)))
|
|
;
|
|
Result = error("expected string for C code", Just_C_Code_Term)
|
|
)
|
|
;
|
|
PragmaTerms = [PredAndVarsTerm, C_CodeTerm]
|
|
->
|
|
% XXX we should issue a warning; this syntax is deprecated.
|
|
% Result = error("pragma c_code doesn't say whether it can call mercury", PredAndVarsTerm)
|
|
MayCallMercury = will_not_call_mercury,
|
|
(
|
|
C_CodeTerm = term__functor(term__string(C_Code), [], Context)
|
|
->
|
|
parse_pragma_c_code(ModuleName, MayCallMercury, PredAndVarsTerm,
|
|
ordinary(C_Code, yes(Context)), VarSet, Result)
|
|
;
|
|
Result = error("invalid `:- pragma c_code' declaration -- expecting either `may_call_mercury' or `will_not_call_mercury', and a string for C code",
|
|
C_CodeTerm)
|
|
)
|
|
;
|
|
PragmaTerms = [PredAndVarsTerm, MayCallMercuryTerm, C_CodeTerm]
|
|
->
|
|
(
|
|
C_CodeTerm = term__functor(term__string(C_Code), [], Context)
|
|
->
|
|
( parse_may_call_mercury(MayCallMercuryTerm, MayCallMercury) ->
|
|
parse_pragma_c_code(ModuleName, MayCallMercury,
|
|
PredAndVarsTerm, ordinary(C_Code, yes(Context)),
|
|
VarSet, Result)
|
|
; parse_may_call_mercury(PredAndVarsTerm, MayCallMercury) ->
|
|
% XXX we should issue a warning; this syntax is deprecated
|
|
parse_pragma_c_code(ModuleName, MayCallMercury,
|
|
MayCallMercuryTerm, ordinary(C_Code, yes(Context)),
|
|
VarSet, Result)
|
|
;
|
|
Result = error("invalid second argument in `:- pragma c_code' declaration -- expecting either `may_call_mercury' or `will_not_call_mercury'",
|
|
MayCallMercuryTerm)
|
|
)
|
|
;
|
|
Result = error("invalid third argument in `:- pragma c_code' declaration -- expecting string for C code",
|
|
C_CodeTerm)
|
|
)
|
|
;
|
|
(
|
|
PragmaTerms = [PredAndVarsTerm, MayCallMercuryTerm,
|
|
FieldsTerm, FirstTerm, LaterTerm],
|
|
term__context_init(DummyContext),
|
|
SharedTerm = term__functor(term__atom("common_code"),
|
|
[term__functor(term__string(""), [], DummyContext)],
|
|
DummyContext)
|
|
;
|
|
PragmaTerms = [PredAndVarsTerm, MayCallMercuryTerm,
|
|
FieldsTerm, FirstTerm, LaterTerm, SharedTerm]
|
|
)
|
|
->
|
|
( parse_may_call_mercury(MayCallMercuryTerm, MayCallMercury) ->
|
|
( parse_pragma_keyword("local_vars", FieldsTerm, Fields, FieldsContext) ->
|
|
( parse_pragma_keyword("first_code", FirstTerm, First, FirstContext) ->
|
|
( parse_pragma_keyword("retry_code", LaterTerm, Later, LaterContext) ->
|
|
( parse_pragma_keyword("shared_code", SharedTerm, Shared, SharedContext) ->
|
|
parse_pragma_c_code(ModuleName, MayCallMercury,
|
|
PredAndVarsTerm,
|
|
nondet(Fields, yes(FieldsContext),
|
|
First, yes(FirstContext),
|
|
Later, yes(LaterContext),
|
|
share, Shared, yes(SharedContext)),
|
|
VarSet, Result)
|
|
; parse_pragma_keyword("duplicated_code", SharedTerm, Shared, SharedContext) ->
|
|
parse_pragma_c_code(ModuleName, MayCallMercury,
|
|
PredAndVarsTerm,
|
|
nondet(Fields, yes(FieldsContext),
|
|
First, yes(FirstContext),
|
|
Later, yes(LaterContext),
|
|
duplicate, Shared, yes(SharedContext)),
|
|
VarSet, Result)
|
|
; parse_pragma_keyword("common_code", SharedTerm, Shared, SharedContext) ->
|
|
parse_pragma_c_code(ModuleName, MayCallMercury,
|
|
PredAndVarsTerm,
|
|
nondet(Fields, yes(FieldsContext),
|
|
First, yes(FirstContext),
|
|
Later, yes(LaterContext),
|
|
automatic, Shared, yes(SharedContext)),
|
|
VarSet, Result)
|
|
;
|
|
Result = error("invalid sixth argument in `:- pragma c_code' declaration -- expecting `shared_code(<code>')",
|
|
LaterTerm)
|
|
)
|
|
;
|
|
Result = error("invalid fifth argument in `:- pragma c_code' declaration -- expecting `later_code(<code>')",
|
|
LaterTerm)
|
|
)
|
|
;
|
|
Result = error("invalid fourth argument in `:- pragma c_code' declaration -- expecting `first_code(<code>')",
|
|
FirstTerm)
|
|
)
|
|
;
|
|
Result = error("invalid third argument in `:- pragma c_code' declaration -- expecting `local_vars(<fields>)'",
|
|
FieldsTerm)
|
|
)
|
|
;
|
|
Result = error("invalid second argument in `:- pragma c_code' declaration -- expecting either `may_call_mercury' or `will_not_call_mercury'",
|
|
MayCallMercuryTerm)
|
|
)
|
|
;
|
|
Result = error(
|
|
"wrong number of arguments in `:- pragma c_code' declaration",
|
|
ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(ModuleName, "import", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [PredAndModesTerm, MayCallMercuryTerm,
|
|
C_FunctionTerm]
|
|
->
|
|
(
|
|
PredAndModesTerm = term__functor(_, _, _),
|
|
C_FunctionTerm = term__functor(term__string(C_Function), [], _)
|
|
->
|
|
(
|
|
PredAndModesTerm = term__functor(term__atom("="),
|
|
[FuncAndArgModesTerm, RetModeTerm], _)
|
|
->
|
|
parse_implicitly_qualified_term(ModuleName,
|
|
FuncAndArgModesTerm, PredAndModesTerm,
|
|
"pragma import declaration", FuncAndArgModesResult),
|
|
(
|
|
FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
|
|
(
|
|
convert_mode_list(ArgModeTerms, ArgModes),
|
|
convert_mode(RetModeTerm, RetMode)
|
|
->
|
|
list__append(ArgModes, [RetMode], Modes),
|
|
(
|
|
parse_may_call_mercury(MayCallMercuryTerm,
|
|
MayCallMercury)
|
|
->
|
|
Result = ok(pragma(import(FuncName, function,
|
|
Modes, MayCallMercury, C_Function)))
|
|
;
|
|
Result = error("invalid second argument in `:- pragma import/3' declaration -- expecting either `may_call_mercury' or `will_not_call_mercury'",
|
|
MayCallMercuryTerm)
|
|
)
|
|
;
|
|
Result = error(
|
|
"expected pragma import(FuncName(ModeList) = Mode, MayCallMercury, C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
FuncAndArgModesResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
;
|
|
parse_implicitly_qualified_term(ModuleName,
|
|
PredAndModesTerm, ErrorTerm,
|
|
"pragma import declaration", PredAndModesResult),
|
|
(
|
|
PredAndModesResult = ok(PredName, ModeTerms),
|
|
(
|
|
convert_mode_list(ModeTerms, Modes)
|
|
->
|
|
(
|
|
parse_may_call_mercury(MayCallMercuryTerm,
|
|
MayCallMercury)
|
|
->
|
|
Result = ok(pragma(import(PredName, predicate,
|
|
Modes, MayCallMercury, C_Function)))
|
|
;
|
|
Result = error("invalid second argument in `:- pragma import/3' declaration -- expecting either `may_call_mercury' or `will_not_call_mercury'",
|
|
MayCallMercuryTerm)
|
|
)
|
|
;
|
|
Result = error(
|
|
"expected pragma import(PredName(ModeList), MayCallMercury, C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
PredAndModesResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
)
|
|
;
|
|
Result = error(
|
|
"expected pragma import(PredName(ModeList), MayCallMercury, C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
PragmaTerms = [PredAndModesTerm, C_FunctionTerm]
|
|
->
|
|
MayCallMercury = may_call_mercury,
|
|
(
|
|
PredAndModesTerm = term__functor(_, _, _),
|
|
C_FunctionTerm = term__functor(term__string(C_Function), [], _)
|
|
->
|
|
(
|
|
PredAndModesTerm = term__functor(term__atom("="),
|
|
[FuncAndArgModesTerm, RetModeTerm], _)
|
|
->
|
|
parse_implicitly_qualified_term(ModuleName,
|
|
FuncAndArgModesTerm, PredAndModesTerm,
|
|
"pragma import declaration", FuncAndArgModesResult),
|
|
(
|
|
FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
|
|
(
|
|
convert_mode_list(ArgModeTerms, ArgModes),
|
|
convert_mode(RetModeTerm, RetMode)
|
|
->
|
|
list__append(ArgModes, [RetMode], Modes),
|
|
Result = ok(pragma(import(FuncName, function,
|
|
Modes, MayCallMercury, C_Function)))
|
|
;
|
|
Result = error(
|
|
"expected pragma import(FuncName(ModeList) = Mode, C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
FuncAndArgModesResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
;
|
|
parse_implicitly_qualified_term(ModuleName,
|
|
PredAndModesTerm, ErrorTerm,
|
|
"pragma import declaration", PredAndModesResult),
|
|
(
|
|
PredAndModesResult = ok(PredName, ModeTerms),
|
|
(
|
|
convert_mode_list(ModeTerms, Modes)
|
|
->
|
|
Result = ok(pragma(import(PredName, predicate,
|
|
Modes, MayCallMercury, C_Function)))
|
|
;
|
|
Result = error(
|
|
"expected pragma import(PredName(ModeList), C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
PredAndModesResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
)
|
|
;
|
|
Result = error(
|
|
"expected pragma import(PredName(ModeList), C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
Result =
|
|
error(
|
|
"wrong number of arguments in `pragma import(...)' declaration",
|
|
ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(_ModuleName, "export", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [PredAndModesTerm, C_FunctionTerm]
|
|
->
|
|
(
|
|
PredAndModesTerm = term__functor(_, _, _),
|
|
C_FunctionTerm = term__functor(term__string(C_Function), [], _)
|
|
->
|
|
(
|
|
PredAndModesTerm = term__functor(term__atom("="),
|
|
[FuncAndArgModesTerm, RetModeTerm], _)
|
|
->
|
|
parse_qualified_term(FuncAndArgModesTerm, PredAndModesTerm,
|
|
"pragma export declaration", FuncAndArgModesResult),
|
|
(
|
|
FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
|
|
(
|
|
convert_mode_list(ArgModeTerms, ArgModes),
|
|
convert_mode(RetModeTerm, RetMode)
|
|
->
|
|
list__append(ArgModes, [RetMode], Modes),
|
|
Result =
|
|
ok(pragma(export(FuncName, function,
|
|
Modes, C_Function)))
|
|
;
|
|
Result = error(
|
|
"expected pragma export(FuncName(ModeList) = Mode, C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
FuncAndArgModesResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
;
|
|
parse_qualified_term(PredAndModesTerm, ErrorTerm,
|
|
"pragma export declaration", PredAndModesResult),
|
|
(
|
|
PredAndModesResult = ok(PredName, ModeTerms),
|
|
(
|
|
convert_mode_list(ModeTerms, Modes)
|
|
->
|
|
Result =
|
|
ok(pragma(export(PredName, predicate, Modes,
|
|
C_Function)))
|
|
;
|
|
Result = error(
|
|
"expected pragma export(PredName(ModeList), C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
PredAndModesResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
)
|
|
;
|
|
Result = error(
|
|
"expected pragma export(PredName(ModeList), C_Function)",
|
|
PredAndModesTerm)
|
|
)
|
|
;
|
|
Result =
|
|
error(
|
|
"wrong number of arguments in `pragma export(...)' declaration",
|
|
ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(ModuleName, "inline", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_simple_pragma(ModuleName, "inline",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = inline(Name, Arity)),
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
parse_pragma_type(ModuleName, "no_inline", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_simple_pragma(ModuleName, "no_inline",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = no_inline(Name, Arity)),
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
parse_pragma_type(ModuleName, "memo", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_tabling_pragma(ModuleName, "memo", eval_memo,
|
|
PragmaTerms, ErrorTerm, Result).
|
|
parse_pragma_type(ModuleName, "loop_check", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check,
|
|
PragmaTerms, ErrorTerm, Result).
|
|
parse_pragma_type(ModuleName, "minimal_model", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_tabling_pragma(ModuleName, "minimal_model", eval_minimal,
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
parse_pragma_type(ModuleName, "obsolete", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_simple_pragma(ModuleName, "obsolete",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = obsolete(Name, Arity)),
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
% pragma unused_args should never appear in user programs,
|
|
% only in .opt files.
|
|
parse_pragma_type(_ModuleName, "unused_args", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [
|
|
PredOrFuncTerm,
|
|
PredNameTerm,
|
|
term__functor(term__integer(Arity), [], _),
|
|
term__functor(term__integer(ProcInt), [], _),
|
|
UnusedArgsTerm
|
|
],
|
|
proc_id_to_int(ProcId, ProcInt),
|
|
(
|
|
PredOrFuncTerm = term__functor(
|
|
term__atom("predicate"), [], _),
|
|
PredOrFunc = predicate
|
|
;
|
|
PredOrFuncTerm = term__functor(
|
|
term__atom("function"), [], _),
|
|
PredOrFunc = function
|
|
),
|
|
parse_qualified_term(PredNameTerm, ErrorTerm,
|
|
"predicate name", PredNameResult),
|
|
PredNameResult = ok(PredName, []),
|
|
convert_int_list(UnusedArgsTerm, UnusedArgsResult),
|
|
UnusedArgsResult = ok(UnusedArgs)
|
|
->
|
|
Result = ok(pragma(unused_args(PredOrFunc, PredName,
|
|
Arity, ProcId, UnusedArgs)))
|
|
;
|
|
Result = error("error in pragma unused_args", ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(ModuleName, "fact_table", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [PredAndArityTerm, FileNameTerm]
|
|
->
|
|
(
|
|
PredAndArityTerm = term__functor(term__atom("/"),
|
|
[PredNameTerm, ArityTerm], _)
|
|
->
|
|
(
|
|
parse_implicitly_qualified_term(ModuleName, PredNameTerm,
|
|
PredAndArityTerm, "pragma fact_table declaration",
|
|
ok(PredName, [])),
|
|
ArityTerm = term__functor(term__integer(Arity), [], _)
|
|
->
|
|
(
|
|
FileNameTerm =
|
|
term__functor(term__string(FileName), [], _)
|
|
->
|
|
Result = ok(pragma(fact_table(PredName, Arity,
|
|
FileName)))
|
|
;
|
|
Result = error(
|
|
"expected string for fact table filename",
|
|
FileNameTerm)
|
|
)
|
|
;
|
|
Result = error(
|
|
"expected predname/arity for `pragma fact_table(..., ...)'",
|
|
PredAndArityTerm)
|
|
)
|
|
;
|
|
Result = error(
|
|
"expected predname/arity for `pragma fact_table(..., ...)'",
|
|
PredAndArityTerm)
|
|
)
|
|
;
|
|
Result =
|
|
error(
|
|
"wrong number of arguments in pragma fact_table(..., ...) declaration",
|
|
ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(ModuleName, "promise_pure", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_simple_pragma(ModuleName, "promise_pure",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = promise_pure(Name, Arity)),
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
parse_pragma_type(ModuleName, "termination_info", PragmaTerms, ErrorTerm,
|
|
_VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [
|
|
PredAndModesTerm0,
|
|
ArgSizeTerm,
|
|
TerminationTerm
|
|
],
|
|
(
|
|
PredAndModesTerm0 = term__functor(Const, Terms0, _)
|
|
->
|
|
(
|
|
Const = term__atom("="),
|
|
Terms0 = [FuncAndModesTerm, FuncResultTerm0]
|
|
->
|
|
% function
|
|
PredOrFunc = function,
|
|
PredAndModesTerm = FuncAndModesTerm,
|
|
FuncResultTerm = [FuncResultTerm0]
|
|
;
|
|
% predicate
|
|
PredOrFunc = predicate,
|
|
PredAndModesTerm = PredAndModesTerm0,
|
|
FuncResultTerm = []
|
|
),
|
|
parse_implicitly_qualified_term(ModuleName,
|
|
PredAndModesTerm, ErrorTerm,
|
|
"`pragma termination_info' declaration", PredNameResult),
|
|
PredNameResult = ok(PredName, ModeListTerm0),
|
|
(
|
|
PredOrFunc = predicate,
|
|
ModeListTerm = ModeListTerm0
|
|
;
|
|
PredOrFunc = function,
|
|
list__append(ModeListTerm0, FuncResultTerm, ModeListTerm)
|
|
),
|
|
convert_mode_list(ModeListTerm, ModeList),
|
|
(
|
|
ArgSizeTerm = term__functor(term__atom("not_set"), [], _),
|
|
MaybeArgSizeInfo = no
|
|
;
|
|
ArgSizeTerm = term__functor(term__atom("infinite"), [],
|
|
ArgSizeContext),
|
|
MaybeArgSizeInfo = yes(infinite(
|
|
[ArgSizeContext - imported_pred]))
|
|
;
|
|
ArgSizeTerm = term__functor(term__atom("finite"),
|
|
[IntTerm, UsedArgsTerm], _),
|
|
IntTerm = term__functor(term__integer(Int), [], _),
|
|
convert_bool_list(UsedArgsTerm, UsedArgs),
|
|
MaybeArgSizeInfo = yes(finite(Int, UsedArgs))
|
|
),
|
|
(
|
|
TerminationTerm = term__functor(term__atom("not_set"), [], _),
|
|
MaybeTerminationInfo = no
|
|
;
|
|
TerminationTerm = term__functor(term__atom("can_loop"),
|
|
[], TermContext),
|
|
MaybeTerminationInfo = yes(can_loop(
|
|
[TermContext - imported_pred]))
|
|
;
|
|
TerminationTerm = term__functor(term__atom("cannot_loop"),
|
|
[], _),
|
|
MaybeTerminationInfo = yes(cannot_loop)
|
|
),
|
|
Result0 = ok(pragma(termination_info(PredOrFunc, PredName,
|
|
ModeList, MaybeArgSizeInfo, MaybeTerminationInfo)))
|
|
;
|
|
Result0 = error("unexpected variable in pragma termination_info",
|
|
ErrorTerm)
|
|
)
|
|
->
|
|
Result = Result0
|
|
;
|
|
Result = error("syntax error in `pragma termination_info'", ErrorTerm)
|
|
).
|
|
|
|
parse_pragma_type(ModuleName, "terminates", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_simple_pragma(ModuleName, "terminates",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = terminates(Name, Arity)),
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
parse_pragma_type(ModuleName, "does_not_terminate", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_simple_pragma(ModuleName, "does_not_terminate",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = does_not_terminate(Name, Arity)),
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
parse_pragma_type(ModuleName, "check_termination", PragmaTerms,
|
|
ErrorTerm, _VarSet, Result) :-
|
|
parse_simple_pragma(ModuleName, "check_termination",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = check_termination(Name, Arity)),
|
|
PragmaTerms, ErrorTerm, Result).
|
|
|
|
:- pred parse_simple_pragma(module_name, string,
|
|
pred(sym_name, int, pragma_type),
|
|
list(term), term, maybe1(item)).
|
|
:- mode parse_simple_pragma(in, in, pred(in, in, out) is det,
|
|
in, in, out) is det.
|
|
|
|
parse_simple_pragma(ModuleName, PragmaType, MakePragma,
|
|
PragmaTerms, ErrorTerm, Result) :-
|
|
(
|
|
PragmaTerms = [PredAndArityTerm]
|
|
->
|
|
(
|
|
PredAndArityTerm = term__functor(term__atom("/"),
|
|
[PredNameTerm, ArityTerm], _)
|
|
->
|
|
(
|
|
parse_implicitly_qualified_term(ModuleName,
|
|
PredNameTerm, ErrorTerm, "", ok(PredName, [])),
|
|
ArityTerm = term__functor(term__integer(Arity), [], _)
|
|
->
|
|
call(MakePragma, PredName, Arity, Pragma),
|
|
Result = ok(pragma(Pragma))
|
|
;
|
|
string__append_list(
|
|
["expected predname/arity for `pragma ",
|
|
PragmaType, "(...)' declaration"], ErrorMsg),
|
|
Result = error(ErrorMsg, PredAndArityTerm)
|
|
)
|
|
;
|
|
string__append_list(["expected predname/arity for `pragma ",
|
|
PragmaType, "(...)' declaration"], ErrorMsg),
|
|
Result = error(ErrorMsg, PredAndArityTerm)
|
|
)
|
|
;
|
|
string__append_list(["wrong number of arguments in `pragma ",
|
|
PragmaType, "(...)' declaration"], ErrorMsg),
|
|
Result = error(ErrorMsg, ErrorTerm)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred parse_pragma_keyword(string, term, string, term__context).
|
|
:- mode parse_pragma_keyword(in, in, out, out) is semidet.
|
|
|
|
parse_pragma_keyword(ExpectedKeyword, Term, StringArg, StartContext) :-
|
|
Term = term__functor(term__atom(ExpectedKeyword), [Arg], _),
|
|
Arg = term__functor(term__string(StringArg), [], StartContext).
|
|
|
|
:- pred parse_may_call_mercury(term, may_call_mercury).
|
|
:- mode parse_may_call_mercury(in, out) is semidet.
|
|
|
|
parse_may_call_mercury(term__functor(term__atom("recursive"), [], _),
|
|
may_call_mercury).
|
|
parse_may_call_mercury(term__functor(term__atom("non_recursive"), [], _),
|
|
will_not_call_mercury).
|
|
parse_may_call_mercury(term__functor(term__atom("may_call_mercury"), [], _),
|
|
may_call_mercury).
|
|
parse_may_call_mercury(term__functor(term__atom("will_not_call_mercury"), [],
|
|
_), will_not_call_mercury).
|
|
|
|
% parse a pragma c_code declaration
|
|
|
|
:- pred parse_pragma_c_code(module_name, may_call_mercury, term,
|
|
pragma_c_code_impl, varset, maybe1(item)).
|
|
:- mode parse_pragma_c_code(in, in, in, in, in, out) is det.
|
|
|
|
parse_pragma_c_code(ModuleName, MayCallMercury, PredAndVarsTerm0, PragmaImpl,
|
|
VarSet, Result) :-
|
|
(
|
|
PredAndVarsTerm0 = term__functor(Const, Terms0, _)
|
|
->
|
|
(
|
|
% is this a function or a predicate?
|
|
Const = term__atom("="),
|
|
Terms0 = [FuncAndVarsTerm, FuncResultTerm0]
|
|
->
|
|
% function
|
|
PredOrFunc = function,
|
|
PredAndVarsTerm = FuncAndVarsTerm,
|
|
FuncResultTerms = [FuncResultTerm0]
|
|
;
|
|
% predicate
|
|
PredOrFunc = predicate,
|
|
PredAndVarsTerm = PredAndVarsTerm0,
|
|
FuncResultTerms = []
|
|
),
|
|
parse_implicitly_qualified_term(ModuleName,
|
|
PredAndVarsTerm, PredAndVarsTerm0,
|
|
"pragma c_code declaration", PredNameResult),
|
|
(
|
|
PredNameResult = ok(PredName, VarList0),
|
|
(
|
|
PredOrFunc = predicate,
|
|
VarList = VarList0
|
|
;
|
|
PredOrFunc = function,
|
|
list__append(VarList0, FuncResultTerms, VarList)
|
|
),
|
|
parse_pragma_c_code_varlist(VarSet, VarList, PragmaVars, Error),
|
|
(
|
|
Error = no,
|
|
Result = ok(pragma(c_code(MayCallMercury, PredName,
|
|
PredOrFunc, PragmaVars, VarSet, PragmaImpl)))
|
|
;
|
|
Error = yes(ErrorMessage),
|
|
Result = error(ErrorMessage, PredAndVarsTerm)
|
|
)
|
|
;
|
|
PredNameResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
;
|
|
Result = error("unexpected variable in `pragma c_code' declaration",
|
|
PredAndVarsTerm0)
|
|
).
|
|
|
|
% parse the variable list in the pragma c code declaration.
|
|
% The final argument is 'no' for no error, or 'yes(ErrorMessage)'.
|
|
:- pred parse_pragma_c_code_varlist(varset, list(term), list(pragma_var),
|
|
maybe(string)).
|
|
:- mode parse_pragma_c_code_varlist(in, in, out, out) is det.
|
|
|
|
parse_pragma_c_code_varlist(_, [], [], no).
|
|
parse_pragma_c_code_varlist(VarSet, [V|Vars], PragmaVars, Error):-
|
|
(
|
|
V = term__functor(term__atom("::"), [VarTerm, ModeTerm], _),
|
|
VarTerm = term__variable(Var)
|
|
->
|
|
(
|
|
varset__search_name(VarSet, Var, VarName)
|
|
->
|
|
(
|
|
convert_mode(ModeTerm, Mode)
|
|
->
|
|
P = (pragma_var(Var, VarName, Mode)),
|
|
parse_pragma_c_code_varlist(VarSet,
|
|
Vars, PragmaVars0, Error),
|
|
PragmaVars = [P|PragmaVars0]
|
|
;
|
|
PragmaVars = [],
|
|
Error = yes("unknown mode in pragma c_code")
|
|
)
|
|
;
|
|
% if the variable wasn't in the varset it must be an
|
|
% underscore variable.
|
|
PragmaVars = [], % return any old junk for that.
|
|
Error = yes(
|
|
"sorry, not implemented: anonymous `_' variable in pragma c_code")
|
|
)
|
|
;
|
|
PragmaVars = [], % return any old junk in PragmaVars
|
|
Error = yes("arguments not in form 'Var :: mode'")
|
|
).
|
|
|
|
|
|
:- pred parse_tabling_pragma(module_name, string, eval_method, list(term),
|
|
term, maybe1(item)).
|
|
:- mode parse_tabling_pragma(in, in, in, in, in, out) is det.
|
|
|
|
parse_tabling_pragma(ModuleName, PragmaName, TablingType, PragmaTerms,
|
|
ErrorTerm, Result) :-
|
|
(
|
|
PragmaTerms = [PredAndModesTerm0]
|
|
->
|
|
(
|
|
% Is this a simple pred/arity pragma
|
|
PredAndModesTerm0 = term__functor(term__atom("/"),
|
|
[PredNameTerm, ArityTerm], _)
|
|
->
|
|
(
|
|
parse_implicitly_qualified_term(ModuleName, PredNameTerm,
|
|
PredAndModesTerm0, "", ok(PredName, [])),
|
|
ArityTerm = term__functor(term__integer(Arity), [], _)
|
|
->
|
|
Result = ok(pragma(tabled(TablingType, PredName, Arity,
|
|
no, no)))
|
|
;
|
|
string__append_list(
|
|
["expected predname/arity for `pragma ",
|
|
PragmaName, "(...)' declaration"], ErrorMsg),
|
|
Result = error(ErrorMsg, PredAndModesTerm0)
|
|
)
|
|
;
|
|
% Is this a specific mode pragma
|
|
PredAndModesTerm0 = term__functor(Const, Terms0, _)
|
|
->
|
|
(
|
|
% is this a function or a predicate?
|
|
Const = term__atom("="),
|
|
Terms0 = [FuncAndModesTerm, FuncResultTerm0]
|
|
->
|
|
% function
|
|
PredOrFunc = function,
|
|
PredAndModesTerm = FuncAndModesTerm,
|
|
FuncResultTerms = [ FuncResultTerm0 ]
|
|
;
|
|
% predicate
|
|
PredOrFunc = predicate,
|
|
PredAndModesTerm = PredAndModesTerm0,
|
|
FuncResultTerms = []
|
|
),
|
|
string__append_list(["`pragma ", PragmaName, "(...)' declaration"],
|
|
ParseMsg),
|
|
parse_qualified_term(PredAndModesTerm, PredAndModesTerm0,
|
|
ParseMsg, PredNameResult),
|
|
(
|
|
PredNameResult = ok(PredName, ModeList0),
|
|
(
|
|
PredOrFunc = predicate,
|
|
ModeList = ModeList0
|
|
;
|
|
PredOrFunc = function,
|
|
list__append(ModeList0, FuncResultTerms, ModeList)
|
|
),
|
|
(
|
|
convert_mode_list(ModeList, Modes)
|
|
->
|
|
list__length(Modes, Arity0),
|
|
(
|
|
PredOrFunc = function
|
|
->
|
|
Arity is Arity0 - 1
|
|
;
|
|
Arity = Arity0
|
|
),
|
|
Result = ok(pragma(tabled(TablingType, PredName, Arity,
|
|
yes(PredOrFunc), yes(Modes))))
|
|
;
|
|
string__append_list(["syntax error in pragma '",
|
|
PragmaName, "(...)' declaration"],ErrorMessage),
|
|
Result = error(ErrorMessage, PredAndModesTerm)
|
|
)
|
|
;
|
|
PredNameResult = error(Msg, Term),
|
|
Result = error(Msg, Term)
|
|
)
|
|
;
|
|
string__append_list(["unexpected variable in `pragma ", PragmaName,
|
|
"'"], ErrorMessage),
|
|
Result = error(ErrorMessage, PredAndModesTerm0)
|
|
)
|
|
;
|
|
string__append_list(["wrong number of arguments in `pragma ",
|
|
PragmaName, "(...)' declaration"], ErrorMessage),
|
|
Result = error(ErrorMessage, ErrorTerm)
|
|
).
|
|
|
|
:- pred convert_int_list(term::in, maybe1(list(int))::out) is det.
|
|
|
|
convert_int_list(term__variable(V),
|
|
error("variable in int list", term__variable(V))).
|
|
convert_int_list(term__functor(Functor, Args, Context), Result) :-
|
|
(
|
|
Functor = term__atom("."),
|
|
Args = [term__functor(term__integer(Int), [], _), RestTerm]
|
|
->
|
|
convert_int_list(RestTerm, RestResult),
|
|
(
|
|
RestResult = ok(List0),
|
|
Result = ok([Int | List0])
|
|
;
|
|
RestResult = error(_, _),
|
|
Result = RestResult
|
|
)
|
|
;
|
|
Functor = term__atom("[]"),
|
|
Args = []
|
|
->
|
|
Result = ok([])
|
|
;
|
|
Result = error("error in int list",
|
|
term__functor(Functor, Args, Context))
|
|
).
|
|
|
|
:- pred convert_bool_list(term::in, list(bool)::out) is semidet.
|
|
|
|
convert_bool_list(term__functor(Functor, Args, _), Bools) :-
|
|
(
|
|
Functor = term__atom("."),
|
|
Args = [term__functor(AtomTerm, [], _), RestTerm],
|
|
(
|
|
AtomTerm = term__atom("yes"),
|
|
Bool = yes
|
|
;
|
|
AtomTerm = term__atom("no"),
|
|
Bool = no
|
|
),
|
|
convert_bool_list(RestTerm, RestList),
|
|
Bools = [ Bool | RestList ]
|
|
;
|
|
Functor = term__atom("[]"),
|
|
Args = [],
|
|
Bools = []
|
|
).
|