[m-dev.] for review: pragma foreign_code for MC++ (part 2/2)
Tyson Dowd
trd at cs.mu.OZ.AU
Fri Nov 10 19:49:44 AEDT 2000
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.181
diff -u -r1.181 mercury_compile.m
--- compiler/mercury_compile.m 2000/10/14 04:00:12 1.181
+++ compiler/mercury_compile.m 2000/11/10 04:08:01
@@ -43,7 +43,7 @@
% the LLDS back-end
:- import_module saved_vars, liveness.
:- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
-:- import_module code_gen, optimize, export.
+:- import_module code_gen, optimize, foreign, export.
:- import_module base_typeclass_info.
:- import_module llds_common, transform_llds, llds_out.
:- import_module continuation_info, stack_layout.
@@ -2180,25 +2180,32 @@
%-----------------------------------------------------------------------------%
%
-% Gather together the information from the HLDS that is
-% used for the C interface. This stuff mostly just gets
-% passed directly to the LLDS unchanged, but we do do
-% a bit of code generation -- for example, we call
-% export__get_c_export_{decls,defns} here, which do the
-% generation of C code for `pragma export' declarations.
+% Gather together the information from the HLDS, given the foreign
+% language we are going to use, that is used for the foreign language
+% interface.
+% This stuff mostly just gets passed directly to the LLDS unchanged, but
+% we do do a bit of code generation -- for example, we call
+% export__get_foreign_export_{decls,defns} here, which do the generation
+% of C code for `pragma export' declarations.
%
-:- pred get_c_interface_info(module_info, foreign_interface_info).
-:- mode get_c_interface_info(in, out) is det.
+:- pred get_c_interface_info(module_info, foreign_language,
+ foreign_interface_info).
+:- mode get_c_interface_info(in, in, out) is det.
-get_c_interface_info(HLDS, C_InterfaceInfo) :-
+get_c_interface_info(HLDS, UseForeignLanguage, Foreign_InterfaceInfo) :-
module_info_name(HLDS, ModuleName),
- module_info_get_foreign_header(HLDS, C_HeaderCode),
- module_info_get_foreign_body_code(HLDS, C_BodyCode),
- export__get_c_export_decls(HLDS, C_ExportDecls),
- export__get_c_export_defns(HLDS, C_ExportDefns),
- C_InterfaceInfo = foreign_interface_info(ModuleName,
- C_HeaderCode, C_BodyCode, C_ExportDecls, C_ExportDefns).
+ module_info_get_foreign_decl(HLDS, ForeignDecls),
+ module_info_get_foreign_body_code(HLDS, ForeignBodyCode),
+ foreign__filter_decls(UseForeignLanguage, ForeignDecls,
+ WantedForeignDecls, _OtherDecls),
+ foreign__filter_bodys(UseForeignLanguage, ForeignBodyCode,
+ WantedForeignBodys, _OtherBodys),
+ export__get_foreign_export_decls(HLDS, Foreign_ExportDecls),
+ export__get_foreign_export_defns(HLDS, Foreign_ExportDefns),
+ Foreign_InterfaceInfo = foreign_interface_info(ModuleName,
+ WantedForeignDecls, WantedForeignBodys,
+ Foreign_ExportDecls, Foreign_ExportDefns).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -2234,7 +2241,9 @@
% XXX this should perhaps be part of backend_pass
% rather than output_pass.
%
- { get_c_interface_info(HLDS, C_InterfaceInfo) },
+ globals__io_lookup_foreign_language_option(use_foreign_language,
+ UseForeignLanguage),
+ { get_c_interface_info(HLDS, UseForeignLanguage, C_InterfaceInfo) },
{ global_data_get_all_proc_vars(GlobalData, GlobalVars) },
{ global_data_get_all_non_common_static_data(GlobalData,
NonCommonStaticData) },
@@ -2311,7 +2320,7 @@
+ CompGenVarCount + CompGenDataCount + CompGenCodeCount }.
:- pred maybe_add_header_file_include(foreign_export_decls, module_name,
- foreign_header_info, foreign_header_info, io__state, io__state).
+ foreign_decl_info, foreign_decl_info, io__state, io__state).
:- mode maybe_add_header_file_include(in, in, in, out, di, uo) is det.
maybe_add_header_file_include(C_ExportDecls, ModuleName,
@@ -2327,16 +2336,16 @@
SplitFiles = yes,
string__append_list(
["#include ""../", HeaderFileName, """\n"],
- Include0)
+ IncludeString)
;
SplitFiles = no,
string__append_list(
["#include """, HeaderFileName, """\n"],
- Include0)
+ IncludeString)
},
{ term__context_init(Context) },
- { Include = Include0 - Context },
+ { Include = foreign_decl_code(c, IncludeString, Context) },
% We put the new include at the end since the list is
% stored in reverse, and we want this include to come
@@ -2348,8 +2357,8 @@
:- mode get_c_body_code(in, out) is det.
get_c_body_code([], []).
-get_c_body_code([Code - Context | CodesAndContexts],
- [user_foreign_code(c, Code, Context) | C_Modules]) :-
+get_c_body_code([foreign_body_code(Lang, Code, Context) | CodesAndContexts],
+ [user_foreign_code(Lang, Code, Context) | C_Modules]) :-
get_c_body_code(CodesAndContexts, C_Modules).
:- pred mercury_compile__combine_chunks(list(list(c_procedure)), string,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.179
diff -u -r1.179 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2000/11/01 05:12:02 1.179
+++ compiler/mercury_to_mercury.m 2000/11/10 05:51:37
@@ -80,10 +80,12 @@
io__state, io__state).
:- mode mercury_output_pragma_decl(in, in, in, in, di, uo) is det.
-:- pred mercury_output_pragma_c_code(pragma_foreign_code_attributes, sym_name,
+:- pred mercury_output_pragma_foreign_code(
+ pragma_foreign_code_attributes, sym_name,
pred_or_func, list(pragma_var), prog_varset,
pragma_foreign_code_impl, io__state, io__state).
-:- mode mercury_output_pragma_c_code(in, in, in, in, in, in, di, uo) is det.
+:- mode mercury_output_pragma_foreign_code(
+ in, in, in, in, in, in, di, uo) is det.
:- inst type_spec == bound(type_spec(ground, ground, ground, ground,
ground, ground, ground)).
@@ -101,9 +103,9 @@
:- pred mercury_output_index_spec(index_spec, io__state, io__state).
:- mode mercury_output_index_spec(in, di, uo) is det.
- % Output the given c_header_code declaration
-:- pred mercury_output_pragma_c_header(string, io__state, io__state).
-:- mode mercury_output_pragma_c_header(in, di, uo) is det.
+ % Output the given foreign_decl declaration
+:- pred mercury_output_pragma_foreign_decl(foreign_language, string, io__state, io__state).
+:- mode mercury_output_pragma_foreign_decl(in, in, di, uo) is det.
:- pred mercury_output_type_defn(tvarset, type_defn, prog_context,
io__state, io__state).
@@ -343,18 +345,16 @@
{ Pragma = source_file(SourceFile) },
mercury_output_pragma_source_file(SourceFile)
;
- { Pragma = c_header_code(C_HeaderString) },
- mercury_output_pragma_c_header(C_HeaderString)
+ { Pragma = foreign_decl(Lang, ForeignHeaderString) },
+ mercury_output_pragma_foreign_decl(Lang, ForeignHeaderString)
;
- { Pragma = foreign(_Lang, Code) },
- % XXX if it is C code only
- mercury_output_pragma_c_body_code(Code)
+ { Pragma = foreign(Lang, Code) },
+ mercury_output_pragma_foreign_body_code(Lang, Code)
;
- { Pragma = foreign(_Lang, Attributes, Pred, PredOrFunc, Vars,
+ { Pragma = foreign(Attributes, Pred, PredOrFunc, Vars,
VarSet, PragmaCode) },
- % XXX if it is C code only
- mercury_output_pragma_c_code(Attributes, Pred, PredOrFunc,
- Vars, VarSet, PragmaCode)
+ mercury_output_pragma_foreign_code(Attributes, Pred,
+ PredOrFunc, Vars, VarSet, PragmaCode)
;
{ Pragma = import(Pred, PredOrFunc, ModeList, Attributes,
C_Function) },
@@ -2061,20 +2061,29 @@
%-----------------------------------------------------------------------------%
-mercury_output_pragma_c_header(C_HeaderString) -->
- io__write_string(":- pragma c_header_code("),
- mercury_output_c_code_string(C_HeaderString),
+mercury_output_pragma_foreign_decl(Lang, ForeignDeclString) -->
+ io__write_string(":- pragma foreign_decl("),
+ mercury_output_foreign_language_string(Lang),
+ io__write_string(", "),
+ mercury_output_foreign_code_string(ForeignDeclString),
io__write_string(").\n").
+:- pred mercury_output_foreign_language_string(foreign_language::in,
+ io__state::di, io__state::uo) is det.
+mercury_output_foreign_language_string(c) -->
+ io__write_string("""C""").
+mercury_output_foreign_language_string(managedcplusplus) -->
+ io__write_string("""MC++""").
+
%-----------------------------------------------------------------------------%
% The code here is similar to the code for term_io__quote_string,
% but \n and \t are output directly, rather than escaped.
% Any changes here may require corresponding changes to term_io and vice versa.
-:- pred mercury_output_c_code_string(string::in, io__state::di, io__state::uo)
- is det.
-mercury_output_c_code_string(S) -->
+:- pred mercury_output_foreign_code_string(string::in,
+ io__state::di, io__state::uo) is det.
+mercury_output_foreign_code_string(S) -->
io__write_char('"'),
mercury_write_escaped_string(S),
io__write_char('"').
@@ -2173,7 +2182,8 @@
% escape_special_char(Char, EscapeChar)
% is true iff Char is character for which there is a special
% backslash-escape character EscapeChar that can be used
- % after a backslash in Mercury c_code string literals represent Char.
+ % after a backslash in Mercury foreign_code string literals
+ % represent Char.
:- pred escape_special_char(char, char).
:- mode escape_special_char(in, out) is semidet.
@@ -2195,27 +2205,32 @@
io__write_string(").\n").
%-----------------------------------------------------------------------------%
+
+ % Output the given foreign_body_code declaration
+:- pred mercury_output_pragma_foreign_body_code(foreign_language,
+ string, io__state, io__state).
+:- mode mercury_output_pragma_foreign_body_code(in, in, di, uo) is det.
- % Output the given c_body_code declaration
-:- pred mercury_output_pragma_c_body_code(string, io__state, io__state).
-:- mode mercury_output_pragma_c_body_code(in, di, uo) is det.
-
-mercury_output_pragma_c_body_code(C_CodeString) -->
- io__write_string(":- pragma c_code("),
- mercury_output_c_code_string(C_CodeString),
+mercury_output_pragma_foreign_body_code(Lang, ForeignCodeString) -->
+ io__write_string(":- pragma foreign_code("),
+ mercury_output_foreign_language_string(Lang),
+ mercury_output_foreign_code_string(ForeignCodeString),
io__write_string(").\n").
%-----------------------------------------------------------------------------%
- % Output the given pragma c_code declaration
-mercury_output_pragma_c_code(Attributes, PredName, PredOrFunc, Vars0,
+ % Output the given pragma foreign_code declaration
+mercury_output_pragma_foreign_code(Attributes, PredName, PredOrFunc, Vars0,
VarSet, PragmaCode) -->
(
{ PragmaCode = import(_, _, _, _) }
->
io__write_string(":- pragma import(")
;
- io__write_string(":- pragma c_code(")
+ io__write_string(":- pragma foreign_code("),
+ { foreign_language(Attributes, Lang) },
+ mercury_output_foreign_language_string(Lang),
+ io__write_string(", ")
),
mercury_output_sym_name(PredName),
{
@@ -2231,7 +2246,7 @@
[]
;
io__write_string("("),
- mercury_output_pragma_c_code_vars(Vars, VarSet),
+ mercury_output_pragma_foreign_code_vars(Vars, VarSet),
io__write_string(")")
),
(
@@ -2239,26 +2254,26 @@
;
{ PredOrFunc = function },
io__write_string(" = ("),
- mercury_output_pragma_c_code_vars(ResultVars, VarSet),
+ mercury_output_pragma_foreign_code_vars(ResultVars, VarSet),
io__write_string(")")
),
io__write_string(", "),
- mercury_output_pragma_c_attributes(Attributes),
+ mercury_output_pragma_foreign_attributes(Attributes),
io__write_string(", "),
(
{ PragmaCode = ordinary(C_Code, _) },
- mercury_output_c_code_string(C_Code)
+ mercury_output_foreign_code_string(C_Code)
;
{ PragmaCode = nondet(Fields, _, First, _,
Later, _, Treat, Shared, _) },
io__write_string("local_vars("),
- mercury_output_c_code_string(Fields),
+ mercury_output_foreign_code_string(Fields),
io__write_string("), "),
io__write_string("first_code("),
- mercury_output_c_code_string(First),
+ mercury_output_foreign_code_string(First),
io__write_string("), "),
io__write_string("retry_code("),
- mercury_output_c_code_string(Later),
+ mercury_output_foreign_code_string(Later),
io__write_string("), "),
(
{ Treat = share },
@@ -2270,7 +2285,7 @@
{ Treat = automatic },
io__write_string("common_code(")
),
- mercury_output_c_code_string(Shared),
+ mercury_output_foreign_code_string(Shared),
io__write_string(")")
;
{ PragmaCode = import(Name, _, _, _) },
@@ -2280,35 +2295,15 @@
),
io__write_string(").\n").
-:- pred mercury_output_c_ident_list(list(string), io__state, io__state).
-:- mode mercury_output_c_ident_list(in, di, uo) is det.
-
-mercury_output_c_ident_list([]) -->
- io__write_string("[]").
-mercury_output_c_ident_list([First | Rest]) -->
- io__write_string("["),
- io__write_string(First),
- mercury_output_c_ident_list_2(Rest),
- io__write_string("]").
-
-:- pred mercury_output_c_ident_list_2(list(string), io__state, io__state).
-:- mode mercury_output_c_ident_list_2(in, di, uo) is det.
-
-mercury_output_c_ident_list_2([]) --> [].
-mercury_output_c_ident_list_2([First | Rest]) -->
- io__write_string(", "),
- io__write_string(First),
- mercury_output_c_ident_list_2(Rest).
-
%-----------------------------------------------------------------------------%
% Output the varnames of the pragma vars
-:- pred mercury_output_pragma_c_code_vars(list(pragma_var), prog_varset,
+:- pred mercury_output_pragma_foreign_code_vars(list(pragma_var), prog_varset,
io__state, io__state).
-:- mode mercury_output_pragma_c_code_vars(in, in, di, uo) is det.
+:- mode mercury_output_pragma_foreign_code_vars(in, in, di, uo) is det.
-mercury_output_pragma_c_code_vars([], _) --> [].
-mercury_output_pragma_c_code_vars([V|Vars], VarSet) -->
+mercury_output_pragma_foreign_code_vars([], _) --> [].
+mercury_output_pragma_foreign_code_vars([V|Vars], VarSet) -->
{ V = pragma_var(_Var, VarName, Mode) },
io__write_string(VarName),
io__write_string(" :: "),
@@ -2321,7 +2316,7 @@
;
io__write_string(", ")
),
- mercury_output_pragma_c_code_vars(Vars, VarSet).
+ mercury_output_pragma_foreign_code_vars(Vars, VarSet).
%-----------------------------------------------------------------------------%
@@ -2449,7 +2444,7 @@
io__write_string(")")
),
io__write_string(", "),
- mercury_output_pragma_c_attributes(Attributes),
+ mercury_output_pragma_foreign_attributes(Attributes),
io__write_string(", "),
io__write_string(C_Function),
io__write_string(").\n").
@@ -2551,29 +2546,18 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_output_pragma_c_attributes(pragma_foreign_code_attributes,
- io__state, io__state).
-:- mode mercury_output_pragma_c_attributes(in, di, uo) is det.
-
-mercury_output_pragma_c_attributes(Attributes) -->
+:- pred mercury_output_pragma_foreign_attributes(
+ pragma_foreign_code_attributes, io__state, io__state).
+:- mode mercury_output_pragma_foreign_attributes(in, di, uo) is det.
+
+mercury_output_pragma_foreign_attributes(Attributes) -->
+ % This is one case where it is a bad idea to use field
+ % accessors.
+ { attributes_to_strings(Attributes, AttrStrings) },
io__write_string("["),
- { may_call_mercury(Attributes, MayCallMercury) },
- (
- { MayCallMercury = may_call_mercury },
- io__write_string("may_call_mercury, ")
- ;
- { MayCallMercury = will_not_call_mercury },
- io__write_string("will_not_call_mercury, ")
- ),
- { thread_safe(Attributes, ThreadSafe) },
- (
- { ThreadSafe = not_thread_safe },
- io__write_string("not_thread_safe")
- ;
- { ThreadSafe = thread_safe },
- io__write_string("thread_safe")
- ),
+ io__write_list(AttrStrings, ", ", io__write_string),
io__write_string("]").
+
%-----------------------------------------------------------------------------%
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.64
diff -u -r1.64 ml_code_gen.m
--- compiler/ml_code_gen.m 2000/11/08 07:23:06 1.64
+++ compiler/ml_code_gen.m 2000/11/08 11:25:30
@@ -720,7 +720,8 @@
:- import_module ml_type_gen, ml_call_gen, ml_unify_gen, ml_switch_gen.
:- import_module ml_code_util.
-:- import_module arg_info, export, llds_out. % XXX needed for pragma C code
+:- import_module llds_out. % XXX needed for pragma C code
+:- import_module arg_info, export, foreign.
:- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
:- import_module goal_util, type_util, mode_util, builtin_ops.
:- import_module passes_aux, modules.
@@ -746,14 +747,20 @@
:- mode ml_gen_foreign_code(in, out, di, uo) is det.
ml_gen_foreign_code(ModuleInfo, MLDS_ForeignCode) -->
- { module_info_get_foreign_header(ModuleInfo, C_Header_Info) },
- { module_info_get_foreign_body_code(ModuleInfo, C_Body_Info) },
- % XXX This assumes the language is C.
- { ConvBody = (func(S - C) = user_foreign_code(c, S, C)) },
- { User_C_Code = list__map(ConvBody, C_Body_Info) },
+ { module_info_get_foreign_decl(ModuleInfo, ForeignDecls) },
+ { module_info_get_foreign_body_code(ModuleInfo, ForeignBodys) },
+ globals__io_lookup_foreign_language_option(use_foreign_language,
+ UseForeignLanguage),
+ { foreign__filter_decls(UseForeignLanguage, ForeignDecls,
+ WantedForeignDecls, _OtherForeignDecls) },
+ { foreign__filter_bodys(UseForeignLanguage, ForeignBodys,
+ WantedForeignBodys, _OtherForeignBodys) },
+ { ConvBody = (func(foreign_body_code(L, S, C)) =
+ user_foreign_code(L, S, C)) },
+ { MLDSWantedForeignBodys = list__map(ConvBody, WantedForeignBodys) },
{ ml_gen_pragma_export(ModuleInfo, MLDS_PragmaExports) },
- { MLDS_ForeignCode = mlds__foreign_code(C_Header_Info, User_C_Code,
- MLDS_PragmaExports) }.
+ { MLDS_ForeignCode = mlds__foreign_code(WantedForeignDecls,
+ MLDSWantedForeignBodys, MLDS_PragmaExports) }.
:- pred ml_gen_imports(module_info, mlds__imports).
:- mode ml_gen_imports(in, out) is det.
@@ -1779,7 +1786,7 @@
ml_gen_unification(Unification, CodeModel, Context,
MLDS_Decls, MLDS_Statements).
-ml_gen_goal_expr(pragma_foreign_code(_Lang, Attributes,
+ml_gen_goal_expr(pragma_foreign_code(Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
CodeModel, OuterContext, MLDS_Decls, MLDS_Statements) -->
(
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.39
diff -u -r1.39 mlds.m
--- compiler/mlds.m 2000/11/08 07:23:08 1.39
+++ compiler/mlds.m 2000/11/08 08:59:23
@@ -620,7 +620,7 @@
%
:- type mlds__foreign_code
---> mlds__foreign_code(
- foreign_header_info,
+ foreign_decl_info,
list(user_foreign_code),
list(mlds__pragma_export)
).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.65
diff -u -r1.65 mlds_to_c.m
--- compiler/mlds_to_c.m 2000/11/08 07:23:08 1.65
+++ compiler/mlds_to_c.m 2000/11/10 06:51:02
@@ -45,7 +45,7 @@
:- import_module export. % for export__type_to_type_string
:- import_module globals, options, passes_aux.
:- import_module builtin_ops, c_util, modules.
-:- import_module prog_data, prog_out, type_util.
+:- import_module prog_data, prog_out, type_util, error_util.
:- import_module bool, int, string, library, list.
:- import_module assoc_list, term, std_util, require.
@@ -448,12 +448,17 @@
mlds_output_pragma_export_decl(ModuleName, Indent)).
:- pred mlds_output_c_hdr_decl(indent,
- foreign_header_code, io__state, io__state).
+ foreign_decl_code, io__state, io__state).
:- mode mlds_output_c_hdr_decl(in, in, di, uo) is det.
-mlds_output_c_hdr_decl(_Indent, Code - Context) -->
- mlds_output_context(mlds__make_context(Context)),
- io__write_string(Code).
+mlds_output_c_hdr_decl(_Indent, foreign_decl_code(Lang, Code, Context)) -->
+ % only output C code in the C header file.
+ ( { Lang = c } ->
+ mlds_output_context(mlds__make_context(Context)),
+ io__write_string(Code)
+ ;
+ { sorry(this_file, "foreign code other than C") }
+ ).
:- pred mlds_output_c_decls(indent, mlds__foreign_code,
io__state, io__state).
@@ -482,6 +487,8 @@
mlds_output_c_defn(_Indent, user_foreign_code(c, Code, Context)) -->
mlds_output_context(mlds__make_context(Context)),
io__write_string(Code).
+mlds_output_c_defn(_Indent, user_foreign_code(managedcplusplus, _, _)) -->
+ { sorry(this_file, "foreign code other than C") }.
:- pred mlds_output_pragma_export_decl(mlds_module_name, indent,
mlds__pragma_export, io__state, io__state).
@@ -2934,5 +2941,8 @@
io__write_string(" "),
mlds_indent(N - 1)
).
+
+:- func this_file = string.
+this_file = "mlds_to_c.m".
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.3
diff -u -r1.3 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 2000/11/09 07:47:04 1.3
+++ compiler/mlds_to_ilasm.m 2000/11/10 07:15:00
@@ -201,7 +201,7 @@
ForeignCode),
io__write_strings([
- "__gc public class ", ModuleNameStr, "__c_code\n",
+ "\n__gc public class ", ModuleNameStr, "__c_code\n",
"{\n",
"public:\n"]),
@@ -237,10 +237,15 @@
_ExportDefns)) -->
{ BodyCode = list__reverse(RevBodyCode) },
io__write_list(BodyCode, "\n",
- (pred(llds__user_foreign_code(c, Code, _Context)::in,
+ (pred(llds__user_foreign_code(Lang, Code, _Context)::in,
di, uo) is det -->
- io__write_string(Code))
- ).
+ ( { Lang = managedcplusplus } ->
+ io__write_string(Code)
+ ;
+ { sorry(this_file,
+ "foreign code other than MC++") }
+ )
+ )).
% XXX we don't handle export decls.
:- pred generate_foreign_header_code(mlds_module_name, mlds__foreign_code,
@@ -251,10 +256,15 @@
_ExportDefns)) -->
{ HeaderCode = list__reverse(RevHeaderCode) },
io__write_list(HeaderCode, "\n",
- (pred(Code - _Context::in, di, uo) is det -->
- io__write_string(Code))
- ).
-
+ (pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
+ di, uo) is det -->
+ ( { Lang = managedcplusplus } ->
+ io__write_string(Code)
+ ;
+ { sorry(this_file,
+ "foreign code other than MC++") }
+ )
+ )).
:- pred generate_method_c_code(mlds_module_name, mlds__defn,
io__state, io__state).
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.133
diff -u -r1.133 mode_util.m
--- compiler/mode_util.m 2000/10/24 05:58:44 1.133
+++ compiler/mode_util.m 2000/10/30 12:41:11
@@ -1393,8 +1393,8 @@
).
recompute_instmap_delta_2(_,
- pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H), _,
- pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H),
+ pragma_foreign_code(A, PredId, ProcId, Args, E, F, G), _,
+ pragma_foreign_code(A, PredId, ProcId, Args, E, F, G),
VarTypes, InstMap, InstMapDelta) -->
recompute_instmap_delta_call(PredId, ProcId,
Args, VarTypes, InstMap, InstMapDelta).
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.249
diff -u -r1.249 modes.m
--- compiler/modes.m 2000/10/14 13:41:26 1.249
+++ compiler/modes.m 2000/10/22 11:54:41
@@ -1231,7 +1231,7 @@
% to modecheck a pragma_c_code, we just modecheck the proc for
% which it is the goal.
-modecheck_goal_expr(pragma_foreign_code(Language, Attributes, PredId, ProcId0,
+modecheck_goal_expr(pragma_foreign_code(Attributes, PredId, ProcId0,
Args0, ArgNameMap, OrigArgTypes, PragmaCode),
GoalInfo, Goal) -->
mode_checkpoint(enter, "pragma_foreign_code"),
@@ -1245,7 +1245,7 @@
modecheck_call_pred(PredId, ProcId0, Args0, DeterminismKnown,
ProcId, Args, ExtraGoals),
- { Pragma = pragma_foreign_code(Language, Attributes, PredId, ProcId,
+ { Pragma = pragma_foreign_code(Attributes, PredId, ProcId,
Args0, ArgNameMap, OrigArgTypes, PragmaCode) },
handle_extra_goals(Pragma, ExtraGoals, GoalInfo, Args0, Args,
InstMap0, Goal),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.61
diff -u -r1.61 module_qual.m
--- compiler/module_qual.m 2000/11/01 05:12:04 1.61
+++ compiler/module_qual.m 2000/11/01 07:59:43
@@ -887,11 +887,11 @@
mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
qualify_pragma(source_file(File), source_file(File), Info, Info) --> [].
-qualify_pragma(c_header_code(Code), c_header_code(Code), Info, Info) --> [].
+qualify_pragma(foreign_decl(L, Code), foreign_decl(L, Code), Info, Info) --> [].
qualify_pragma(foreign(L, C), foreign(L, C), Info, Info) --> [].
qualify_pragma(
- foreign(Lang, Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
- foreign(Lang, Rec, SymName, PredOrFunc, PragmaVars, Varset, Code),
+ foreign(Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
+ foreign(Rec, SymName, PredOrFunc, PragmaVars, Varset, Code),
Info0, Info) -->
qualify_pragma_vars(PragmaVars0, PragmaVars, Info0, Info).
qualify_pragma(tabled(A, B, C, D, MModes0), tabled(A, B, C, D, MModes),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.136
diff -u -r1.136 modules.m
--- compiler/modules.m 2000/11/01 05:12:05 1.136
+++ compiler/modules.m 2000/11/01 07:59:43
@@ -1001,9 +1001,9 @@
% but if we do allow it, we should put it in the generated
% header file, which currently we don't.
-pragma_allowed_in_interface(c_header_code(_), no).
+pragma_allowed_in_interface(foreign_decl(_, _), no).
pragma_allowed_in_interface(foreign(_, _), no).
-pragma_allowed_in_interface(foreign(_, _, _, _, _, _, _), no).
+pragma_allowed_in_interface(foreign(_, _, _, _, _, _), no).
pragma_allowed_in_interface(inline(_, _), no).
pragma_allowed_in_interface(no_inline(_, _), no).
pragma_allowed_in_interface(obsolete(_, _), yes).
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.299
diff -u -r1.299 options.m
--- compiler/options.m 2000/11/08 08:20:45 1.299
+++ compiler/options.m 2000/11/08 08:59:24
@@ -177,9 +177,19 @@
; unboxed_no_tag_types
; sync_term_size % in words
; type_layout
+ % Foreign language interface options
+ % The foreign language that the user has
+ % selected for use in this module
+ % (defaults to the value of backend
+ % foreign target).
+ ; use_foreign_language
% Options for internal use only
% (the values of these options are implied by the
% settings of other options)
+ % The language that this backend can
+ % interface to most easily (probably the
+ % target language of the backend).
+ ; backend_foreign_language
% Stack layout information required to do
% a stack trace.
; basic_stack_layout
@@ -566,6 +576,11 @@
% of writing) - will usually be over-
% ridden by a value from configure.
type_layout - bool(yes),
+ use_foreign_language - string(""),
+ backend_foreign_language- string(""),
+ % The previous two options
+ % depend on the target and are
+ % set in handle_options.
basic_stack_layout - bool(no),
agc_stack_layout - bool(no),
procid_stack_layout - bool(no),
@@ -948,6 +963,7 @@
long_option("bytes-per-word", bytes_per_word).
long_option("conf-low-tag-bits", conf_low_tag_bits).
long_option("type-layout", type_layout).
+long_option("use-foreign-language", use_foreign_language).
long_option("agc-stack-layout", agc_stack_layout).
long_option("basic-stack-layout", basic_stack_layout).
long_option("procid-stack-layout", procid_stack_layout).
@@ -1972,6 +1988,15 @@
% The --bytes-per-word option is intended for use
% by the `mmc' script; it is deliberately not documented.
+ %
+ "--use-foreign-language <foreign language>",
+ "\tUse the given foreign language to implement predicates",
+ "\twritten in foreign languages. Any name that can be used",
+ "\tto specify foreign languages in pragma foreign declarations",
+ "\tis valid, but not all foreign languages are implemented",
+ "\tin all backends.",
+ "\tDefault value is C for the LLDS and MLDS->C backends,",
+ "\tor ManagedC++ for the .NET backend.",
"--no-type-layout",
"(This option is not for general use.)",
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.9
diff -u -r1.9 pd_cost.m
--- compiler/pd_cost.m 2000/10/06 10:18:31 1.9
+++ compiler/pd_cost.m 2000/10/16 01:17:34
@@ -91,7 +91,7 @@
goal_info_get_nonlocals(GoalInfo, NonLocals),
pd_cost__unify(NonLocals, Unification, Cost).
-pd_cost__goal(pragma_foreign_code(_, Attributes, _, _, Args, _, _, _) - _,
+pd_cost__goal(pragma_foreign_code(Attributes, _, _, Args, _, _, _) - _,
Cost) :-
( may_call_mercury(Attributes, will_not_call_mercury) ->
Cost1 = 0
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.203
diff -u -r1.203 polymorphism.m
--- compiler/polymorphism.m 2000/11/06 04:09:02 1.203
+++ compiler/polymorphism.m 2000/11/07 11:34:57
@@ -952,7 +952,7 @@
{ conj_list_to_goal(GoalList, GoalInfo, Goal) }.
polymorphism__process_goal_expr(Goal0, GoalInfo, Goal) -->
- { Goal0 = pragma_foreign_code(Lang, IsRecursive, PredId, ProcId,
+ { Goal0 = pragma_foreign_code(Attributes, PredId, ProcId,
ArgVars0, ArgInfo0, OrigArgTypes0, PragmaCode0) },
polymorphism__process_call(PredId, ArgVars0, GoalInfo,
ArgVars, ExtraVars, CallGoalInfo, ExtraGoals),
@@ -1004,7 +1004,7 @@
%
% plug it all back together
%
- { Call = pragma_foreign_code(Lang, IsRecursive, PredId,
+ { Call = pragma_foreign_code(Attributes, PredId,
ProcId, ArgVars, ArgInfo, OrigArgTypes, PragmaCode) -
CallGoalInfo },
{ list__append(ExtraGoals, [Call], GoalList) },
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.61
diff -u -r1.61 prog_data.m
--- compiler/prog_data.m 2000/11/01 05:12:10 1.61
+++ compiler/prog_data.m 2000/11/10 06:20:33
@@ -104,12 +104,11 @@
---> type_only(type)
; type_and_mode(type, mode).
- % We only support C right now.
:- type foreign_language
---> c
% ; cplusplus
% ; csharp
-% ; managedcplusplus
+ ; managedcplusplus
% ; java
% ; il
.
@@ -144,18 +143,21 @@
%
:- type pragma_type
- ---> c_header_code(string)
+ % a foreign language declaration, such as C
+ % header code.
+ ---> foreign_decl(foreign_language, string)
; foreign(foreign_language, string)
- ; foreign(foreign_language, pragma_foreign_code_attributes,
+ ; foreign(pragma_foreign_code_attributes,
sym_name, pred_or_func, list(pragma_var),
prog_varset, pragma_foreign_code_impl)
- % Set of C code attributes, eg.:
+ % Set of foreign code attributes, eg.:
+ % what language this code is in
% whether or not the code may call Mercury,
% whether or not the code is thread-safe
% PredName, Predicate or Function, Vars/Mode,
- % VarNames, C Code Implementation Info
+ % VarNames, Foreign Code Implementation Info
; type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
maybe(list(mode)), type_subst, tvarset)
@@ -518,8 +520,8 @@
% `pragma_c_code_attribute's.
:- type pragma_foreign_code_attributes.
-:- pred default_attributes(pragma_foreign_code_attributes).
-:- mode default_attributes(out) is det.
+:- pred default_attributes(foreign_language, pragma_foreign_code_attributes).
+:- mode default_attributes(in, out) is det.
:- pred may_call_mercury(pragma_foreign_code_attributes, may_call_mercury).
:- mode may_call_mercury(in, out) is det.
@@ -535,6 +537,13 @@
pragma_foreign_code_attributes).
:- mode set_thread_safe(in, in, out) is det.
+:- pred foreign_language(pragma_foreign_code_attributes, foreign_language).
+:- mode foreign_language(in, out) is det.
+
+:- pred set_foreign_language(pragma_foreign_code_attributes, foreign_language,
+ pragma_foreign_code_attributes).
+:- mode set_foreign_language(in, in, out) is det.
+
:- pred tabled_for_io(pragma_foreign_code_attributes, tabled_for_io).
:- mode tabled_for_io(in, out) is det.
@@ -928,6 +937,11 @@
---> must_be_qualified
; may_be_unqualified.
+ % Convert the attributes to their source code representations.
+ % Useful if you need to write a pragma out to a file.
+:- pred attributes_to_strings(pragma_foreign_code_attributes::in,
+ list(string)::out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -935,22 +949,23 @@
:- type pragma_foreign_code_attributes
---> attributes(
+ foreign_language :: foreign_language,
may_call_mercury :: may_call_mercury,
thread_safe :: thread_safe,
tabled_for_io :: tabled_for_io
).
+
+default_attributes(Language,
+ attributes(Language, may_call_mercury, not_thread_safe,
+ not_tabled_for_io)).
-default_attributes(attributes(may_call_mercury, not_thread_safe,
- not_tabled_for_io)).
+may_call_mercury(Attrs, Attrs ^ may_call_mercury).
-may_call_mercury(Attrs, MayCallMercury) :-
- MayCallMercury = Attrs ^ may_call_mercury.
+thread_safe(Attrs, Attrs ^ thread_safe).
-thread_safe(Attrs, ThreadSafe) :-
- ThreadSafe = Attrs ^ thread_safe.
+foreign_language(Attrs, Attrs ^ foreign_language).
-tabled_for_io(Attrs, TabledForIo) :-
- TabledForIo = Attrs ^ tabled_for_io.
+tabled_for_io(Attrs, Attrs ^ tabled_for_io).
set_may_call_mercury(Attrs0, MayCallMercury, Attrs) :-
Attrs = Attrs0 ^ may_call_mercury := MayCallMercury.
@@ -958,7 +973,35 @@
set_thread_safe(Attrs0, ThreadSafe, Attrs) :-
Attrs = Attrs0 ^ thread_safe := ThreadSafe.
+set_foreign_language(Attrs0, ForeignLanguage, Attrs) :-
+ Attrs = Attrs0 ^ foreign_language := ForeignLanguage.
+
set_tabled_for_io(Attrs0, TabledForIo, Attrs) :-
Attrs = Attrs0 ^ tabled_for_io := TabledForIo.
+
+attributes_to_strings(Attrs, StringList) :-
+ Attrs = attributes(_Lang, MayCallMercury, ThreadSafe, TabledForIO),
+ (
+ MayCallMercury = may_call_mercury,
+ MayCallMercuryStr = "may_call_mercury"
+ ;
+ MayCallMercury = will_not_call_mercury,
+ MayCallMercuryStr = "will_not_call_mercury"
+ ),
+ (
+ ThreadSafe = not_thread_safe,
+ ThreadSafeStr = "not_thread_safe"
+ ;
+ ThreadSafe = thread_safe,
+ ThreadSafeStr = "thread_safe"
+ ),
+ (
+ TabledForIO = tabled_for_io,
+ TabledForIOStr = "tabled_for_io"
+ ;
+ TabledForIO = not_tabled_for_io,
+ TabledForIOStr = "not_tabled_for_io"
+ ),
+ StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr].
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.24
diff -u -r1.24 prog_io_pragma.m
--- compiler/prog_io_pragma.m 2000/10/27 03:12:32 1.24
+++ compiler/prog_io_pragma.m 2000/11/10 07:10:12
@@ -22,7 +22,7 @@
:- implementation.
-:- import_module prog_io, prog_io_goal, prog_util.
+:- import_module globals, prog_io, prog_io_goal, prog_util.
:- import_module term_util, term_errors.
:- import_module int, map, string, std_util, bool, require.
@@ -70,23 +70,23 @@
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)
- )
+parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms,
+ ErrorTerm, VarSet, Result) :-
+ parse_pragma_foreign_decl_pragma(ModuleName, "foreign_decl",
+ PragmaTerms, ErrorTerm, VarSet, Result).
+
+parse_pragma_type(ModuleName, "c_header_code", PragmaTerms,
+ ErrorTerm, VarSet, Result) :-
+ (
+ PragmaTerms = [term__functor(_, _, Context) | _]
+ ->
+ LangC = term__functor(term__string("C"), [], Context),
+ parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code",
+ [LangC | PragmaTerms], ErrorTerm, VarSet, Result)
;
- Result = error(
-"wrong number of arguments in `:- pragma c_header_code' declaration",
- ErrorTerm)
- ).
+ Result = error("wrong number of arguments or unexpected variable in `:- pragma c_header_code' declaration",
+ ErrorTerm)
+ ).
parse_pragma_type(ModuleName, "foreign_code", PragmaTerms,
ErrorTerm, VarSet, Result) :-
@@ -111,17 +111,47 @@
ErrorTerm)
).
-
- % XXX this should use the same language specification
- % strings as globals__convert_target.
:- pred parse_foreign_language(term, foreign_language).
:- mode parse_foreign_language(in, out) is semidet.
-parse_foreign_language(term__functor(term__string("C"), _, _), c).
-parse_foreign_language(term__functor(term__string("c"), _, _), c).
-%parse_foreign_language(term__functor(term__string("C++"), _, _), cplusplus).
-%parse_foreign_language(term__functor(term__string("c++"), _, _), cplusplus).
+parse_foreign_language(term__functor(term__string(String), _, _), Lang) :-
+ globals__convert_foreign_language(String, Lang).
+ % This predicate parses both c_code and foreign_code pragmas.
+:- pred parse_pragma_foreign_decl_pragma(module_name, string,
+ list(term), term, varset, maybe1(item)).
+:- mode parse_pragma_foreign_decl_pragma(in, in, in, in, in, out) is det.
+parse_pragma_foreign_decl_pragma(_ModuleName, Pragma, PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+ InvalidDeclStr),
+ (
+ PragmaTerms = [Lang, HeaderTerm]
+ ->
+ (
+ parse_foreign_language(Lang, ForeignLanguage)
+ ->
+ (
+ HeaderTerm = term__functor(term__string(
+ HeaderCode), [], _)
+ ->
+ Result = ok(pragma(foreign_decl(
+ ForeignLanguage, HeaderCode)))
+ ;
+ ErrMsg = "-- expected string for foreign declaration code",
+ Result = error(string__append(InvalidDeclStr,
+ ErrMsg), HeaderTerm)
+ )
+ ;
+ ErrMsg = "-- invalid language parameter",
+ Result = error(string__append(InvalidDeclStr, ErrMsg),
+ Lang)
+ )
+ ;
+ string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+ ErrorStr),
+ Result = error(ErrorStr, ErrorTerm)
+ ).
% This predicate parses both c_code and foreign_code pragmas.
:- pred parse_pragma_foreign_code_pragma(module_name, string,
@@ -136,7 +166,8 @@
Check6 = (func(PTerms6, ForeignLanguage) = Res is semidet :-
PTerms6 = [PredAndVarsTerm, FlagsTerm,
FieldsTerm, FirstTerm, LaterTerm, SharedTerm],
- ( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
+ ( parse_pragma_foreign_code_attributes_term(
+ ForeignLanguage, FlagsTerm, Flags) ->
( parse_pragma_keyword("local_vars", FieldsTerm, Fields,
FieldsContext) ->
( parse_pragma_keyword("first_code", FirstTerm, First,
@@ -146,7 +177,7 @@
( parse_pragma_keyword("shared_code", SharedTerm,
Shared, SharedContext) ->
parse_pragma_foreign_code(ModuleName,
- ForeignLanguage, Flags, PredAndVarsTerm,
+ Flags, PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
Later, yes(LaterContext),
@@ -155,7 +186,7 @@
; parse_pragma_keyword("duplicated_code",
SharedTerm, Shared, SharedContext) ->
parse_pragma_foreign_code(ModuleName,
- ForeignLanguage, Flags, PredAndVarsTerm,
+ Flags, PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
Later, yes(LaterContext),
@@ -164,7 +195,7 @@
; parse_pragma_keyword("common_code", SharedTerm,
Shared, SharedContext) ->
parse_pragma_foreign_code(ModuleName,
- ForeignLanguage, Flags, PredAndVarsTerm,
+ Flags, PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
Later, yes(LaterContext),
@@ -212,16 +243,18 @@
(
CodeTerm = term__functor(term__string(Code), [], Context)
->
- ( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
- parse_pragma_foreign_code(ModuleName, ForeignLanguage,
- Flags, PredAndVarsTerm,
- ordinary(Code, yes(Context)), VarSet, Res)
- ; parse_pragma_c_code_attributes_term(PredAndVarsTerm, Flags) ->
+ ( parse_pragma_foreign_code_attributes_term(ForeignLanguage,
+ FlagsTerm, Flags) ->
+ parse_pragma_foreign_code(ModuleName, Flags,
+ PredAndVarsTerm, ordinary(Code, yes(Context)),
+ VarSet, Res)
+ ; parse_pragma_foreign_code_attributes_term(ForeignLanguage,
+ PredAndVarsTerm, Flags) ->
% XXX we should issue a warning; this syntax is deprecated
% We will continue to accept this if c_code is used, but
% not with foreign_code
( Pragma = "c_code" ->
- parse_pragma_foreign_code(ModuleName, ForeignLanguage,
+ parse_pragma_foreign_code(ModuleName,
Flags, FlagsTerm, ordinary(Code, yes(Context)),
VarSet, Res)
;
@@ -251,14 +284,13 @@
Pragma = "c_code"
->
% may_call_mercury is a conservative default.
- default_attributes(Attributes),
+ default_attributes(ForeignLanguage, Attributes),
(
CodeTerm = term__functor(term__string(Code), [],
Context)
->
parse_pragma_foreign_code(ModuleName,
- ForeignLanguage, Attributes,
- PredAndVarsTerm, ordinary(Code,
+ Attributes, PredAndVarsTerm, ordinary(Code,
yes(Context)), VarSet, Res)
;
ErrMsg = "-- expecting either `may_call_mercury' or `will_not_call_mercury', and a string for C code",
@@ -340,12 +372,16 @@
).
+
+
parse_pragma_type(ModuleName, "import", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
(
(
PragmaTerms = [PredAndModesTerm, FlagsTerm, C_FunctionTerm],
- ( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
+ % XXX we assume all imports are C
+ ( parse_pragma_foreign_code_attributes_term(c,
+ FlagsTerm, Flags) ->
FlagsResult = ok(Flags)
;
FlagsResult = error("invalid second argument in `:- pragma import/3' declaration -- expecting C code attribute or list of attributes'",
@@ -353,7 +389,7 @@
)
;
PragmaTerms = [PredAndModesTerm, C_FunctionTerm],
- default_attributes(Flags),
+ default_attributes(c, Flags),
FlagsResult = ok(Flags)
)
->
@@ -817,18 +853,18 @@
%-----------------------------------------------------------------------------%
-:- type collected_pragma_c_code_attribute
+:- type collected_pragma_foreign_code_attribute
---> may_call_mercury(may_call_mercury)
; thread_safe(thread_safe)
; tabled_for_io(tabled_for_io).
-:- pred parse_pragma_c_code_attributes_term(term,
+:- pred parse_pragma_foreign_code_attributes_term(foreign_language, term,
pragma_foreign_code_attributes).
-:- mode parse_pragma_c_code_attributes_term(in, out) is semidet.
+:- mode parse_pragma_foreign_code_attributes_term(in, in, out) is semidet.
-parse_pragma_c_code_attributes_term(Term, Attributes) :-
- default_attributes(Attributes0),
- parse_pragma_c_code_attributes_term0(Term, AttrList),
+parse_pragma_foreign_code_attributes_term(ForeignLanguage, Term, Attributes) :-
+ default_attributes(ForeignLanguage, Attributes0),
+ parse_pragma_foreign_code_attributes_term0(Term, AttrList),
( list__member(may_call_mercury(will_not_call_mercury), AttrList) ->
( list__member(may_call_mercury(may_call_mercury), AttrList) ->
% XXX an error message would be nice
@@ -862,13 +898,13 @@
Attributes = Attributes2
).
-:- pred parse_pragma_c_code_attributes_term0(term,
- list(collected_pragma_c_code_attribute)).
-:- mode parse_pragma_c_code_attributes_term0(in, out) is semidet.
+:- pred parse_pragma_foreign_code_attributes_term0(term,
+ list(collected_pragma_foreign_code_attribute)).
+:- mode parse_pragma_foreign_code_attributes_term0(in, out) is semidet.
-parse_pragma_c_code_attributes_term0(Term, Flags) :-
+parse_pragma_foreign_code_attributes_term0(Term, Flags) :-
(
- parse_single_pragma_c_code_attribute(Term, Flag)
+ parse_single_pragma_foreign_code_attribute(Term, Flag)
->
Flags = [Flag]
;
@@ -878,16 +914,16 @@
;
Term = term__functor(term__atom("."), [Hd, Tl], _),
Flags = [Flag|Flags0],
- parse_single_pragma_c_code_attribute(Hd, Flag),
- parse_pragma_c_code_attributes_term0(Tl, Flags0)
+ parse_single_pragma_foreign_code_attribute(Hd, Flag),
+ parse_pragma_foreign_code_attributes_term0(Tl, Flags0)
)
).
-:- pred parse_single_pragma_c_code_attribute(term,
- collected_pragma_c_code_attribute).
-:- mode parse_single_pragma_c_code_attribute(in, out) is semidet.
+:- pred parse_single_pragma_foreign_code_attribute(term,
+ collected_pragma_foreign_code_attribute).
+:- mode parse_single_pragma_foreign_code_attribute(in, out) is semidet.
-parse_single_pragma_c_code_attribute(Term, Flag) :-
+parse_single_pragma_foreign_code_attribute(Term, Flag) :-
( parse_may_call_mercury(Term, MayCallMercury) ->
Flag = may_call_mercury(MayCallMercury)
; parse_threadsafe(Term, ThreadSafe) ->
@@ -926,14 +962,13 @@
parse_tabled_for_io(term__functor(term__atom("not_tabled_for_io"), [], _),
not_tabled_for_io).
-% parse a pragma c_code declaration
+% parse a pragma foreign_code declaration
-:- pred parse_pragma_foreign_code(module_name, foreign_language,
- pragma_foreign_code_attributes, term, pragma_foreign_code_impl,
- varset, maybe1(item)).
-:- mode parse_pragma_foreign_code(in, in, in, in, in, in, out) is det.
+:- pred parse_pragma_foreign_code(module_name, pragma_foreign_code_attributes,
+ term, pragma_foreign_code_impl, varset, maybe1(item)).
+:- mode parse_pragma_foreign_code(in, in, in, in, in, out) is det.
-parse_pragma_foreign_code(ModuleName, ForeignLanguage, Flags, PredAndVarsTerm0,
+parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm0,
PragmaImpl, VarSet0, Result) :-
parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0,
PredAndVarsTerm0, "`:- pragma c_code' declaration", PredAndArgsResult),
@@ -955,7 +990,7 @@
(
Error = no,
varset__coerce(VarSet0, VarSet),
- Result = ok(pragma(foreign(ForeignLanguage, Flags, PredName,
+ Result = ok(pragma(foreign(Flags, PredName,
PredOrFunc, PragmaVars, VarSet, PragmaImpl)))
;
Error = yes(ErrorMessage),
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.3
diff -u -r1.3 prog_rep.m
--- compiler/prog_rep.m 2000/10/13 13:55:55 1.3
+++ compiler/prog_rep.m 2000/10/22 11:54:44
@@ -202,7 +202,7 @@
DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
ChangedVarsRep, AtomicGoalRep).
-prog_rep__represent_goal_expr(pragma_foreign_code(_, _,
+prog_rep__represent_goal_expr(pragma_foreign_code(_,
_PredId, _, Args, _, _, _),
GoalInfo, InstMap0, Info, Rep) :-
list__map(term__var_to_int, Args, ArgsRep),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.27
diff -u -r1.27 purity.m
--- compiler/purity.m 2000/08/09 07:47:43 1.27
+++ compiler/purity.m 2000/10/16 01:16:02
@@ -664,7 +664,7 @@
{ worst_purity(Purity12, Purity3, Purity) }.
compute_expr_purity(Ccode, Ccode, _, PredInfo, PredInfo, ModuleInfo, _, Purity,
NumErrors, NumErrors) -->
- { Ccode = pragma_foreign_code(_,_,PredId,_,_,_,_,_) },
+ { Ccode = pragma_foreign_code(_,PredId,_,_,_,_,_) },
{ module_info_preds(ModuleInfo, Preds) },
{ map__lookup(Preds, PredId, CalledPredInfo) },
{ pred_info_get_purity(CalledPredInfo, Purity) }.
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.76
diff -u -r1.76 quantification.m
--- compiler/quantification.m 2000/09/07 01:46:49 1.76
+++ compiler/quantification.m 2000/10/16 01:35:24
@@ -461,8 +461,8 @@
{ set__union(NonLocalVars1, NonLocalVars2, NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
-implicitly_quantify_goal_2(pragma_foreign_code(A,B,C,D,Vars,E,F,G), _,
- pragma_foreign_code(A,B,C,D,Vars,E,F,G)) -->
+implicitly_quantify_goal_2(pragma_foreign_code(A,B,C,Vars,E,F,G), _,
+ pragma_foreign_code(A,B,C,Vars,E,F,G)) -->
implicitly_quantify_atomic_goal(Vars).
implicitly_quantify_goal_2(bi_implication(LHS0, RHS0), Context, Goal) -->
@@ -965,7 +965,7 @@
set__union(Set5, Set6, Set),
set__union(LambdaSet5, LambdaSet6, LambdaSet).
-quantification__goal_vars_2(_, pragma_foreign_code(_,_,_,_, ArgVars, _, _, _),
+quantification__goal_vars_2(_, pragma_foreign_code(_,_,_, ArgVars, _, _, _),
Set0, LambdaSet, Set, LambdaSet) :-
set__insert_list(Set0, ArgVars, Set).
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.17
diff -u -r1.17 rl_exprn.m
--- compiler/rl_exprn.m 2000/10/06 10:18:33 1.17
+++ compiler/rl_exprn.m 2000/10/16 01:13:56
@@ -853,7 +853,7 @@
{ Code = tree(SwitchCode, node([rl_PROC_label(EndSwitch)])) }.
rl_exprn__goal(generic_call(_, _, _, _) - _, _, _) -->
{ error("rl_exprn__goal: higher-order and class-method calls not yet implemented") }.
-rl_exprn__goal(pragma_foreign_code(_, _, _, _, _, _, _, _) - _, _, _) -->
+rl_exprn__goal(pragma_foreign_code(_, _, _, _, _, _, _) - _, _, _) -->
{ error("rl_exprn__goal: pragma_c_code not yet implemented") }.
rl_exprn__goal(some(_, _, Goal) - _, Fail, Code) -->
rl_exprn__goal(Goal, Fail, Code).
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.28
diff -u -r1.28 saved_vars.m
--- compiler/saved_vars.m 2000/10/13 13:55:55 1.28
+++ compiler/saved_vars.m 2000/10/22 11:54:46
@@ -133,7 +133,7 @@
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
- GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
@@ -292,7 +292,7 @@
IsNonLocal, SlotInfo1, Goals1, SlotInfo),
Goals = [NewConstruct, Goal1 | Goals1]
;
- Goal0Expr = pragma_foreign_code(_, _, _, _, _, _, _, _),
+ Goal0Expr = pragma_foreign_code(_, _, _, _, _, _, _),
rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
goal_util__rename_vars_in_goal(Construct, Subst,
NewConstruct),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.89
diff -u -r1.89 simplify.m
--- compiler/simplify.m 2000/10/26 05:30:55 1.89
+++ compiler/simplify.m 2000/10/30 12:41:14
@@ -1130,7 +1130,7 @@
).
simplify__goal_2(Goal0, GoalInfo, Goal, GoalInfo, Info0, Info) :-
- Goal0 = pragma_foreign_code(_, _, PredId, ProcId, Args, _, _, _),
+ Goal0 = pragma_foreign_code(_, PredId, ProcId, Args, _, _, _),
(
simplify_do_calls(Info0),
goal_info_is_pure(GoalInfo)
@@ -2281,7 +2281,7 @@
Goal = GoalExpr - _,
GoalExpr \= call(_, _, _, _, _, _),
GoalExpr \= generic_call(_, _, _, _),
- GoalExpr \= pragma_foreign_code(_, _, _, _, _, _, _, _)
+ GoalExpr \= pragma_foreign_code(_, _, _, _, _, _, _)
)
->
simplify_info_get_common_info(Info0, CommonInfo0),
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.74
diff -u -r1.74 store_alloc.m
--- compiler/store_alloc.m 2000/10/03 00:34:29 1.74
+++ compiler/store_alloc.m 2000/10/16 01:13:29
@@ -207,8 +207,8 @@
store_alloc_in_goal_2(unify(A,B,C,D,E), Liveness, _, _,
_, unify(A,B,C,D,E), Liveness).
-store_alloc_in_goal_2(pragma_foreign_code(A, B, C, D, E, F, G, H), Liveness,
- _, _, _, pragma_foreign_code(A, B, C, D, E, F, G, H), Liveness).
+store_alloc_in_goal_2(pragma_foreign_code(A, B, C, D, E, F, G), Liveness,
+ _, _, _, pragma_foreign_code(A, B, C, D, E, F, G), Liveness).
store_alloc_in_goal_2(bi_implication(_, _), _, _, _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.22
diff -u -r1.22 stratify.m
--- compiler/stratify.m 2000/08/09 07:47:52 1.22
+++ compiler/stratify.m 2000/10/16 01:13:19
@@ -178,7 +178,7 @@
WholeScc, ThisPredProcId, Error, Module0, Module) -->
first_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
Error, Module0, Module).
-first_order_check_goal(pragma_foreign_code(_Language, _Attributes, CPred,
+first_order_check_goal(pragma_foreign_code(_Attributes, CPred,
CProc, _, _, _, _),
GoalInfo, Negated, WholeScc, ThisPredProcId,
Error, Module0, Module) -->
@@ -335,7 +335,7 @@
ThisPredProcId, HighOrderLoops, Error, Module0, Module) -->
higher_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
HighOrderLoops, Error, Module0, Module).
-higher_order_check_goal(pragma_foreign_code(_, _IsRec, _, _, _, _, _, _),
+higher_order_check_goal(pragma_foreign_code(_IsRec, _, _, _, _, _, _),
_GoalInfo, _Negated, _WholeScc, _ThisPredProcId, _HighOrderLoops,
_, Module, Module) --> [].
higher_order_check_goal(unify(_Var, _RHS, _Mode, _Uni, _Context), _GoalInfo,
@@ -822,7 +822,7 @@
CallsHO) :-
check_goal1(Goal, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
-check_goal1(pragma_foreign_code(_Lang, _Attrib, _CPred, _CProc, _, _, _, _),
+check_goal1(pragma_foreign_code(_Attrib, _CPred, _CProc, _, _, _, _),
Calls, Calls, HasAT, HasAT, CallsHO, CallsHO).
check_goal1(bi_implication(_, _), _, _, _, _, _, _) :-
@@ -913,7 +913,7 @@
get_called_procs(Goal, Calls0, Calls).
get_called_procs(not(Goal - _GoalInfo), Calls0, Calls) :-
get_called_procs(Goal, Calls0, Calls).
-get_called_procs(pragma_foreign_code(_Lang, _Attrib, _CPred, _CProc,
+get_called_procs(pragma_foreign_code(_Attrib, _CPred, _CProc,
_, _, _, _), Calls, Calls).
get_called_procs(bi_implication(_, _), _, _) :-
% these should have been expanded out by now
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.91
diff -u -r1.91 switch_detection.m
--- compiler/switch_detection.m 2000/10/06 10:18:35 1.91
+++ compiler/switch_detection.m 2000/10/16 01:12:58
@@ -216,8 +216,8 @@
VarTypes, ModuleInfo, switch(Var, CanFail, Cases, SM)) :-
detect_switches_in_cases(Cases0, InstMap, VarTypes, ModuleInfo, Cases).
-detect_switches_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H), _, _, _, _,
- pragma_foreign_code(A,B,C,D,E,F,G,H)).
+detect_switches_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G), _, _, _, _,
+ pragma_foreign_code(A,B,C,D,E,F,G)).
detect_switches_in_goal_2(bi_implication(_, _), _, _, _, _, _) :-
% these should have been expanded out by now
error("detect_switches_in_goal_2: unexpected bi_implication").
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.14
diff -u -r1.14 term_traversal.m
--- compiler/term_traversal.m 2000/10/06 10:18:36 1.14
+++ compiler/term_traversal.m 2000/10/16 01:11:11
@@ -183,7 +183,7 @@
traverse_goal(Else, Params, Info0, Info2),
combine_paths(Info1, Info2, Params, Info).
-traverse_goal_2(pragma_foreign_code(_,_, CallPredId, CallProcId, Args, _,_,_),
+traverse_goal_2(pragma_foreign_code(_, CallPredId, CallProcId, Args, _,_,_),
GoalInfo, Params, Info0, Info) :-
params_get_module_info(Params, Module),
module_info_pred_proc_info(Module, CallPredId, CallProcId, _,
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.292
diff -u -r1.292 typecheck.m
--- compiler/typecheck.m 2000/11/06 04:09:06 1.292
+++ compiler/typecheck.m 2000/11/07 11:35:02
@@ -1039,8 +1039,8 @@
typecheck_unification(A, B0, B).
typecheck_goal_2(switch(_, _, _, _), _) -->
{ error("unexpected switch") }.
-typecheck_goal_2(pragma_foreign_code(A, B, PredId, D, Args, F, G, H),
- pragma_foreign_code(A, B, PredId, D, Args, F, G, H)) -->
+typecheck_goal_2(pragma_foreign_code(A, PredId, C, Args, E, F, G),
+ pragma_foreign_code(A, PredId, C, Args, E, F, G)) -->
% pragma_foreign_codes are automatically generated, so they
% will always be type-correct, but we need to do
% the type analysis in order to correctly compute the
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.67
diff -u -r1.67 unique_modes.m
--- compiler/unique_modes.m 2000/10/14 13:41:29 1.67
+++ compiler/unique_modes.m 2000/10/22 11:54:49
@@ -509,7 +509,7 @@
% to modecheck a pragma_c_code, we just modecheck the proc for
% which it is the goal.
-unique_modes__check_goal_2(pragma_foreign_code(Language, Attributes,
+unique_modes__check_goal_2(pragma_foreign_code(Attributes,
PredId, ProcId0, Args, ArgNameMap, OrigArgTypes, PragmaCode),
_GoalInfo, Goal) -->
mode_checkpoint(enter, "pragma_c_code"),
@@ -517,7 +517,7 @@
{ mode_info_get_call_id(ModeInfo, PredId, CallId) },
mode_info_set_call_context(call(call(CallId))),
unique_modes__check_call(PredId, ProcId0, Args, ProcId),
- { Goal = pragma_foreign_code(Language, Attributes, PredId, ProcId, Args,
+ { Goal = pragma_foreign_code(Attributes, PredId, ProcId, Args,
ArgNameMap, OrigArgTypes, PragmaCode) },
mode_info_unset_call_context,
mode_checkpoint(exit, "pragma_c_code").
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.6
diff -u -r1.6 unneeded_code.m
--- compiler/unneeded_code.m 2000/10/13 13:56:03 1.6
+++ compiler/unneeded_code.m 2000/10/22 11:54:50
@@ -616,7 +616,7 @@
RefinedGoals = RefinedGoals0,
Changed = Changed0
;
- GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _),
Goal = Goal0,
unneeded_code__demand_inputs(Goal, ModuleInfo, InstMap0,
everywhere, WhereNeededMap0, WhereNeededMap),
@@ -963,7 +963,7 @@
Goal = Goal0,
RefinedGoals = RefinedGoals0
;
- GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _),
Goal = Goal0,
RefinedGoals = RefinedGoals0
;
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.69
diff -u -r1.69 unused_args.m
--- compiler/unused_args.m 2000/10/13 13:56:03 1.69
+++ compiler/unused_args.m 2000/11/10 07:12:22
@@ -437,8 +437,8 @@
set_list_vars_used(UseInf1, Args, UseInf).
% handle pragma foreign(...) -
-% only those arguments which have C names can be used in the C code.
-traverse_goal(_, pragma_foreign_code(_, _, _, _, Args, Names, _, _),
+% only those arguments which have names can be used in the foreign code.
+traverse_goal(_, pragma_foreign_code(_, _, _, Args, Names, _, _),
UseInf0, UseInf) :-
assoc_list__from_corresponding_lists(Args, Names, ArgsAndNames),
ArgIsUsed = lambda([ArgAndName::in, Arg::out] is semidet, (
@@ -1275,7 +1275,7 @@
fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
- GoalExpr = pragma_foreign_code(_, _, _, _, _, _, _, _).
+ GoalExpr = pragma_foreign_code(_, _, _, _, _, _, _).
fixup_goal_expr(_, _, _, _, bi_implication(_, _) - _, _) :-
% these should have been expanded out by now
Index: tests/invalid/pragma_c_code_and_clauses1.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/pragma_c_code_and_clauses1.err_exp,v
retrieving revision 1.3
diff -u -r1.3 pragma_c_code_and_clauses1.err_exp
--- tests/invalid/pragma_c_code_and_clauses1.err_exp 1998/02/02 03:01:11 1.3
+++ tests/invalid/pragma_c_code_and_clauses1.err_exp 2000/11/09 00:58:23
@@ -1,6 +1,6 @@
pragma_c_code_and_clauses1.m:009: Warning: `pragma' declaration in module interface.
pragma_c_code_and_clauses1.m:007: Warning: clause in module interface.
-pragma_c_code_and_clauses1.m:009: Error: `:- pragma c_code' declaration for predicate `pragma_c_code_and_clauses1:foo/1'
+pragma_c_code_and_clauses1.m:009: Error: `:- pragma foreign_code' declaration for predicate `pragma_c_code_and_clauses1:foo/1'
pragma_c_code_and_clauses1.m:009: with preceding clauses.
pragma_c_code_and_clauses1.m:005: In `foo(in)':
pragma_c_code_and_clauses1.m:005: error: determinism declaration not satisfied.
Index: tests/invalid/pragma_c_code_dup_var.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/pragma_c_code_dup_var.err_exp,v
retrieving revision 1.2
diff -u -r1.2 pragma_c_code_dup_var.err_exp
--- tests/invalid/pragma_c_code_dup_var.err_exp 2000/02/15 00:36:03 1.2
+++ tests/invalid/pragma_c_code_dup_var.err_exp 2000/11/09 00:59:00
@@ -1,4 +1,4 @@
-pragma_c_code_dup_var.m:019: In `:- pragma c_code' declaration for function `pragma_c_code_dup_var:bread_impl/6':
+pragma_c_code_dup_var.m:019: In `:- pragma foreign_code' declaration for function `pragma_c_code_dup_var:bread_impl/6':
pragma_c_code_dup_var.m:019: error: variable `Buf' occurs multiple times
pragma_c_code_dup_var.m:019: in the argument list.
pragma_c_code_dup_var.m:014: Error: no clauses for
Index: tests/warnings/singleton_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/singleton_test.exp,v
retrieving revision 1.5
diff -u -r1.5 singleton_test.exp
--- tests/warnings/singleton_test.exp 1998/01/02 00:11:41 1.5
+++ tests/warnings/singleton_test.exp 2000/11/09 01:32:40
@@ -4,12 +4,12 @@
singleton_test.m:026: warning: variables `L1, L2' occur only once in this scope.
singleton_test.m:027: In clause for function `singleton_test:my_append_func/2':
singleton_test.m:027: warning: variable `T' occurs only once in this scope.
-singleton_test.m:029: In `:- pragma c_code' for predicate `singleton_test:my_c_pred/3':
-singleton_test.m:029: warning: variable `Y' does not occur in the C code.
-singleton_test.m:033: In `:- pragma c_code' for function `singleton_test:my_c_func/2':
-singleton_test.m:033: warning: variable `X' does not occur in the C code.
-singleton_test.m:039: In `:- pragma c_code' for predicate `singleton_test:c_hello_world/3':
-singleton_test.m:039: warning: variable `Msg' does not occur in the C code.
+singleton_test.m:029: In `:- pragma foreign_code' for predicate `singleton_test:my_c_pred/3':
+singleton_test.m:029: warning: variable `Y' does not occur in the foreign code.
+singleton_test.m:033: In `:- pragma foreign_code' for function `singleton_test:my_c_func/2':
+singleton_test.m:033: warning: variable `X' does not occur in the foreign code.
+singleton_test.m:039: In `:- pragma foreign_code' for predicate `singleton_test:c_hello_world/3':
+singleton_test.m:039: warning: variable `Msg' does not occur in the foreign code.
singleton_test.m:008: In function `singleton_test:my_append_func/2':
singleton_test.m:008: warning: unresolved polymorphism.
singleton_test.m:008: The variables with unbound types were:
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list