mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-13 12:53:53 +00:00
fa8a94feaf
Estimated hours taken: 1 Improve the error messages for certain kinds of syntax errors, where variables occur in places that they shouldn't. compiler/prog_io_goal.m: Change parse_qualified_term to take an extra argument, the "containing" term, in case the term being parsed is a term__variable, which will not have a term__context. Use the new argument to give better error messages. compiler/make_hlds.m: compiler/prog_io.m: compiler/prog_io_dcg.m: compiler/prog_io_pragma.m: compiler/prog_io_util.m: Changed calls to parse_qualified_term to pass the new argument. tests/invalid/Mmakefile: tests/invalid/vars_in_wrong_places.m: tests/invalid/vars_in_wrong_places.err_exp: Test cases for the above change.
651 lines
19 KiB
Mathematica
651 lines
19 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-1997 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_goal, hlds_pred, term_util, term_errors.
|
|
:- import_module 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,
|
|
parse_pragma_c_code(ModuleName, MayCallMercury, PredAndVarsTerm,
|
|
no, C_CodeTerm, VarSet, Result)
|
|
;
|
|
PragmaTerms = [PredAndVarsTerm, MayCallMercuryTerm, C_CodeTerm]
|
|
->
|
|
( parse_may_call_mercury(MayCallMercuryTerm, MayCallMercury) ->
|
|
parse_pragma_c_code(ModuleName, MayCallMercury, PredAndVarsTerm,
|
|
no, C_CodeTerm, 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, no, C_CodeTerm, VarSet, Result)
|
|
;
|
|
Result = error("invalid second argument in `:- pragma c_code(..., ..., ...)' declaration -- expecting either `may_call_mercury' or `will_not_call_mercury'",
|
|
MayCallMercuryTerm)
|
|
)
|
|
;
|
|
PragmaTerms = [PredAndVarsTerm, MayCallMercuryTerm,
|
|
SavedVarsTerm, LabelNamesTerm, C_CodeTerm]
|
|
->
|
|
( parse_may_call_mercury(MayCallMercuryTerm, MayCallMercury) ->
|
|
( parse_ident_list(SavedVarsTerm, SavedVars) ->
|
|
( parse_ident_list(LabelNamesTerm, LabelNames) ->
|
|
parse_pragma_c_code(ModuleName, MayCallMercury,
|
|
PredAndVarsTerm, yes(SavedVars - LabelNames),
|
|
C_CodeTerm, VarSet, Result)
|
|
;
|
|
Result = error("invalid fourth argument in `:- pragma c_code/5' declaration -- expecting a list of C identifiers",
|
|
MayCallMercuryTerm)
|
|
)
|
|
;
|
|
Result = error("invalid third argument in `:- pragma c_code/5' declaration -- expecting a list of C identifiers",
|
|
MayCallMercuryTerm)
|
|
)
|
|
;
|
|
Result = error("invalid second argument in `:- pragma c_code/3' 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, "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_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, "termination_info", PragmaTerms, ErrorTerm,
|
|
_VarSet, Result) :-
|
|
(
|
|
PragmaTerms = [
|
|
PredAndModesTerm0,
|
|
ConstTerm,
|
|
TerminatesTerm,
|
|
MaybeUsedArgsTerm
|
|
],
|
|
(
|
|
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_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),
|
|
(
|
|
ConstTerm = term__functor(term__atom("not_set"), [], _),
|
|
TerminationConst = not_set
|
|
;
|
|
ConstTerm = term__functor(
|
|
term__atom("infinite"), [], ConstContext),
|
|
TerminationConst = inf(ConstContext - imported_pred)
|
|
;
|
|
ConstTerm = term__functor(term__atom("set"), [IntTerm], _),
|
|
IntTerm = term__functor(term__integer(Int), [], _),
|
|
TerminationConst = set(Int)
|
|
),
|
|
(
|
|
TerminatesTerm = term__functor(term__atom("not_set"), [], _),
|
|
Terminates = not_set,
|
|
MaybeError = no
|
|
;
|
|
TerminatesTerm = term__functor(
|
|
term__atom("dont_know"), [], TermContext),
|
|
Terminates = dont_know,
|
|
MaybeError = yes(TermContext - imported_pred)
|
|
;
|
|
TerminatesTerm = term__functor(term__atom("yes"), [], _),
|
|
Terminates = yes,
|
|
MaybeError = no
|
|
),
|
|
(
|
|
MaybeUsedArgsTerm = term__functor(
|
|
term__atom("yes"), [BoolListTerm], _),
|
|
convert_bool_list(BoolListTerm, BoolList),
|
|
MaybeUsedArgs = yes(BoolList)
|
|
;
|
|
MaybeUsedArgsTerm = term__functor(term__atom("no"), [], _),
|
|
MaybeUsedArgs = no
|
|
),
|
|
Termination = term(TerminationConst, Terminates,
|
|
MaybeUsedArgs, MaybeError),
|
|
Result0 = ok(pragma(termination_info(PredOrFunc, PredName,
|
|
ModeList, Termination)))
|
|
;
|
|
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_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_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).
|
|
|
|
:- pred parse_ident_list(term, list(string)).
|
|
:- mode parse_ident_list(in, out) is semidet.
|
|
|
|
parse_ident_list(term__functor(term__atom("[]"), [], _), []).
|
|
parse_ident_list(term__functor(term__atom("."), [Head, Tail], _),
|
|
[SavedVar | SavedVars]) :-
|
|
% XXX liberalize this
|
|
Head = term__functor(term__atom(SavedVar), [], _),
|
|
parse_ident_list(Tail, SavedVars).
|
|
|
|
% parse a pragma c_code declaration
|
|
|
|
:- pred parse_pragma_c_code(module_name, may_call_mercury, term,
|
|
maybe(pair(list(string))), term, varset, maybe1(item)).
|
|
:- mode parse_pragma_c_code(in, in, in, in, in, in, out) is det.
|
|
|
|
parse_pragma_c_code(ModuleName, MayCallMercury, PredAndVarsTerm0, ExtraInfo,
|
|
C_CodeTerm, 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_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)
|
|
),
|
|
(
|
|
C_CodeTerm = term__functor(term__string(C_Code), [], _)
|
|
->
|
|
parse_pragma_c_code_varlist(VarSet,
|
|
VarList, PragmaVars, Error),
|
|
(
|
|
Error = no,
|
|
(
|
|
ExtraInfo = no,
|
|
Result = ok(pragma(c_code(MayCallMercury, PredName,
|
|
PredOrFunc, PragmaVars, VarSet, C_Code)))
|
|
;
|
|
ExtraInfo = yes(SavedVars - LabelNames),
|
|
Result = ok(pragma(c_code(MayCallMercury, PredName,
|
|
PredOrFunc, PragmaVars, SavedVars, LabelNames,
|
|
VarSet, C_Code)))
|
|
)
|
|
;
|
|
Error = yes(ErrorMessage),
|
|
Result = error(ErrorMessage, PredAndVarsTerm)
|
|
)
|
|
;
|
|
Result = error("expected string for C code", C_CodeTerm)
|
|
)
|
|
;
|
|
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 = []
|
|
).
|