mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-13 21:04:00 +00:00
11d8161692
Estimated hours taken: 50
Add support for nested modules.
- module names may themselves be module-qualified
- modules may contain `:- include_module' declarations
which name sub-modules
- a sub-module has access to all the declarations in the
parent module (including its implementation section).
This support is not yet complete; see the BUGS and LIMITATIONS below.
LIMITATIONS
- source file names must match module names
(just as they did previously)
- mmc doesn't allow path names on the command line any more
(e.g. `mmc --make-int ../library/foo.m').
- import_module declarations must use the fully-qualified module name
- module qualifiers must use the fully-qualified module name
- no support for root-qualified module names
(e.g. `:parent:child' instead of `parent:child').
- modules may not be physically nested (only logical nesting, via
`include_module').
BUGS
- doesn't check that the parent module is imported/used before allowing
import/use of its sub-modules.
- doesn't check that there is an include_module declaration in the
parent for each module claiming to be a child of that parent
- privacy of private modules is not enforced
-------------------
NEWS:
Mention that we support nested modules.
library/ops.m:
library/nc_builtin.nl:
library/sp_builtin.nl:
compiler/mercury_to_mercury.m:
Add `include_module' as a new prefix operator.
Change the associativity of `:' from xfy to yfx
(since this made parsing module qualifiers slightly easier).
compiler/prog_data.m:
Add new `include_module' declaration.
Change the `module_name' and `module_specifier' types
from strings to sym_names, so that module names can
themselves be module qualified.
compiler/modules.m:
Add predicates module_name_to_file_name/2 and
file_name_to_module_name/2.
Lots of changes to handle parent module dependencies,
to create parent interface (`.int0') files, to read them in,
to output correct dependencies information for them to the
`.d' and `.dep' files, etc.
Rewrite a lot of the code to improve the readability
(add comments, use subroutines, better variable names).
Also fix a couple of bugs:
- generate_dependencies was using the transitive implementation
dependencies rather than the transitive interface dependencies
to compute the `.int3' dependencies when writing `.d' files
(this bug was introduced during crs's changes to support
`.trans_opt' files)
- when creating the `.int' file, it was reading in the
interfaces for modules imported in the implementation section,
not just those in the interface section.
This meant that the compiler missed a lot of errors.
library/graph.m:
library/lexer.m:
library/term.m:
library/term_io.m:
library/varset.m:
compiler/*.m:
Add `:- import_module' declarations to the interface needed
by declarations in the interface. (The previous version
of the compiler did not detect these missing interface imports,
due to the above-mentioned bug in modules.m.)
compiler/mercury_compile.m:
compiler/intermod.m:
Change mercury_compile__maybe_grab_optfiles and
intermod__grab_optfiles so that they grab the opt files for
parent modules as well as the ones for imported modules.
compiler/mercury_compile.m:
Minor changes to handle parent module dependencies.
(Also improve the wording of the warning about trans-opt
dependencies.)
compiler/make_hlds.m:
compiler/module_qual.m:
Ignore `:- include_module' declarations.
compiler/module_qual.m:
A couple of small changes to handle nested module names.
compiler/prog_out.m:
compiler/prog_util.m:
Add new predicates string_to_sym_name/3 (prog_util.m) and
sym_name_to_string/{2,3} (prog_out.m).
compiler/*.m:
Replace many occurrences of `string' with `module_name'.
Change code that prints out module names or converts
them to strings or filenames to handle the fact that
module names are now sym_names intead of strings.
Also change a few places (e.g. in intermod.m, hlds_module.m)
where the code assumed that any qualified symbol was
fully-qualified.
compiler/prog_io.m:
compiler/prog_io_goal.m:
Move sym_name_and_args/3, parse_qualified_term/4 and
parse_qualified_term/5 preds from prog_io_goal.m to prog_io.m,
since they are very similar to the parse_symbol_name/2 predicate
already in prog_io.m. Rewrite these predicates, both
to improve maintainability, and to handle the newly
allowed syntax (module-qualified module names).
Rename parse_qualified_term/5 as `parse_implicit_qualified_term'.
compiler/prog_io.m:
Rewrite the handling of `:- module' and `:- end_module'
declarations, so that it can handle nested modules.
Add code to parse `include_module' declarations.
compiler/prog_util.m:
compiler/*.m:
Add new predicates mercury_public_builtin_module/1 and
mercury_private_builtin_module/1 in prog_util.m.
Change most of the hard-coded occurrences of "mercury_builtin"
to call mercury_private_builtin_module/1 or
mercury_public_builtin_module/1 or both.
compiler/llds_out.m:
Add llds_out__sym_name_mangle/2, for mangling module names.
compiler/special_pred.m:
compiler/mode_util.m:
compiler/clause_to_proc.m:
compiler/prog_io_goal.m:
compiler/lambda.m:
compiler/polymorphism.m:
Move the predicates in_mode/1, out_mode/1, and uo_mode/1
from special_pred.m to mode_util.m, and change various
hard-coded definitions to instead call these predicates.
compiler/polymorphism.m:
Ensure that the type names `type_info' and `typeclass_info' are
module-qualified in the generated code. This avoids a problem
where the code generated by polymorphism.m was not considered
type-correct, due to the type `type_info' not matching
`mercury_builtin:type_info'.
compiler/check_typeclass.m:
Simplify the code for check_instance_pred and
get_matching_instance_pred_ids.
compiler/mercury_compile.m:
compiler/modules.m:
Disallow directory names in command-line arguments.
compiler/options.m:
compiler/handle_options.m:
compiler/mercury_compile.m:
compiler/modules.m:
Add a `--make-private-interface' option.
The private interface file `<module>.int0' contains
all the declarations in the module; it is used for
compiling sub-modules.
scripts/Mmake.rules:
scripts/Mmake.vars.in:
Add support for creating `.int0' and `.date0' files
by invoking mmc with `--make-private-interface'.
doc/user_guide.texi:
Document `--make-private-interface' and the `.int0'
and `.date0' file extensions.
doc/reference_manual.texi:
Document nested modules.
util/mdemangle.c:
profiler/demangle.m:
Demangle names with multiple module qualifiers.
tests/general/Mmakefile:
tests/general/string_format_test.m:
tests/general/string_format_test.exp:
tests/general/string__format_test.m:
tests/general/string__format_test.exp:
tests/general/.cvsignore:
Change the `:- module string__format_test' declaration in
`string__format_test.m' to `:- module string_format_test',
because with the original declaration the `__' was taken
as a module qualifier, which lead to an error message.
Hence rename the file accordingly, to avoid the warning
about file name not matching module name.
tests/invalid/Mmakefile:
tests/invalid/missing_interface_import.m:
tests/invalid/missing_interface_import.err_exp:
Regression test to check that the compiler reports
errors for missing `import_module' in the interface section.
tests/invalid/*.err_exp:
tests/warnings/unused_args_test.exp:
tests/warnings/unused_import.exp:
Update the expected diagnostics output for the test cases to
reflect a few minor changes to the warning messages.
tests/hard_coded/Mmakefile:
tests/hard_coded/parent.m:
tests/hard_coded/parent.child.m:
tests/hard_coded/parent.exp:
tests/hard_coded/parent2.m:
tests/hard_coded/parent2.child.m:
tests/hard_coded/parent2.exp:
Two simple tests case for the use of nested modules with
separate compilation.
829 lines
25 KiB
Mathematica
829 lines
25 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_simple_pragma(ModuleName, "memo",
|
|
lambda([Name::in, Arity::in, Pragma::out] is det,
|
|
Pragma = memo(Name, Arity)),
|
|
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 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 = []
|
|
).
|