[m-dev.] for review: pragma foreign_code for MC++ (part 2/2)
Tyson Dowd
trd at cs.mu.OZ.AU
Thu Nov 16 12:05:21 AEDT 2000
Incremental diff of the fixes made after Fergus' review suggestions.
Still to come is the diff to the tests expected error messages, I'll get
that right after the bootstrap has completed.
diff -u compiler/export.m compiler/export.m
--- compiler/export.m
+++ compiler/export.m
@@ -46,7 +46,7 @@
%-----------------------------------------------------------------------------%
% Utilities for generating C code which interfaces with Mercury.
-% The MLDS->C backend and fact tables use this code.
+% The {MLDS,LLDS}->C backends and fact tables use this code.
% Convert the type to a string corresponding to its C type.
% (Defaults to MR_Word).
@@ -563,8 +563,9 @@
:- mode export__produce_header_file_2(in, di, uo) is det.
export__produce_header_file_2([]) --> [].
export__produce_header_file_2([E|ExportedProcs]) -->
+ { E = foreign_export_decl(Lang, C_RetType, C_Function, ArgDecls) },
(
- { E = foreign_export_decl(c, C_RetType, C_Function, ArgDecls) }
+ { Lang = c }
->
% output the function header
io__write_string(C_RetType),
diff -u foreign.m foreign.m
--- foreign.m
+++ foreign.m
@@ -24,11 +24,15 @@
:- import_module list.
% Filter the decls for the given foreign language.
+ % The first return value is the list of matches, the second is
+ % the list of mis-matches.
:- pred foreign__filter_decls(foreign_language, foreign_decl_info,
foreign_decl_info, foreign_decl_info).
:- mode foreign__filter_decls(in, in, out, out) is det.
% Filter the bodys for the given foreign language.
+ % The first return value is the list of matches, the second is
+ % the list of mis-matches.
:- pred foreign__filter_bodys(foreign_language, foreign_body_info,
foreign_body_info, foreign_body_info).
:- mode foreign__filter_bodys(in, in, out, out) is det.
@@ -37,6 +41,13 @@
% calling the code via the given language.
% This might mean, for example, generating a call to a
% forwarding function in C.
+ % The foreign language argument specifies which language is the
+ % target language, the other inputs are the name, types, input
+ % variables and so on for a piece of pragma foreign code.
+ % The outputs are the new attributes and implementation for this
+ % code.
+ % XXX This implementation is currently incomplete, so in future
+ % this interface may change.
:- pred foreign__extrude_pragma_implementation(foreign_language,
list(pragma_var), sym_name, pred_or_func, prog_context,
module_info, pragma_foreign_code_attributes,
@@ -46,6 +57,13 @@
:- mode foreign__extrude_pragma_implementation(in, in, in, in, in,
in, in, in, out, out, out) is det.
+ % make_pragma_import turns pragma imports into pragma foreign_code.
+ % Given the pred and proc info for this predicate, the name
+ % of the function to import, the context of the import pragma
+ % and the module_info, create a pragma_foreign_code_impl
+ % which imports the foreign function, and return the varset,
+ % pragma_vars, argument types and other information about the
+ % generated predicate body.
:- pred foreign__make_pragma_import(pred_info, proc_info, string, prog_context,
module_info, pragma_foreign_code_impl, prog_varset,
list(pragma_var), list(type), arity, pred_or_func).
@@ -76,7 +94,7 @@
foreign_language(Attributes, ForeignLanguage),
set_foreign_language(Attributes, TargetLang, NewAttributes),
( TargetLang = c ->
- ( ForeignLanguage = managedcplusplus,
+ ( ForeignLanguage = managed_cplusplus,
% This isn't finished yet, and we probably won't
% implement it for C calling MC++.
% For C calling normal C++ we would generate a proxy
@@ -105,10 +123,10 @@
Impl = Impl0,
ModuleInfo = ModuleInfo0
)
- ; TargetLang = managedcplusplus ->
+ ; TargetLang = managed_cplusplus ->
% Don't do anything - C and MC++ are embedded
% inside MC++ without any changes.
- ( ForeignLanguage = managedcplusplus,
+ ( ForeignLanguage = managed_cplusplus,
Impl = Impl0,
ModuleInfo = ModuleInfo0
; ForeignLanguage = c,
@@ -119,17 +137,19 @@
error("extrude_pragma_implementation: unsupported foreign language")
).
+ % XXX we haven't implemented these functions yet.
+ % What is here is only a guide
:- func make_pred_name(foreign_language, sym_name) = string.
make_pred_name(c, SymName) =
"mercury_c__" ++ make_pred_name_rest(c, SymName).
-make_pred_name(managedcplusplus, SymName) =
- "mercury_cpp__" ++ make_pred_name_rest(managedcplusplus, SymName).
+make_pred_name(managed_cplusplus, SymName) =
+ "mercury_cpp__" ++ make_pred_name_rest(managed_cplusplus, SymName).
:- func make_pred_name_rest(foreign_language, sym_name) = string.
make_pred_name_rest(c, _SymName) = "some_c_name".
-make_pred_name_rest(managedcplusplus, qualified(ModuleSpec, Name)) =
- make_pred_name_rest(managedcplusplus, ModuleSpec) ++ "__" ++ Name.
-make_pred_name_rest(managedcplusplus, unqualified(Name)) = Name.
+make_pred_name_rest(managed_cplusplus, qualified(ModuleSpec, Name)) =
+ make_pred_name_rest(managed_cplusplus, ModuleSpec) ++ "__" ++ Name.
+make_pred_name_rest(managed_cplusplus, unqualified(Name)) = Name.
make_pragma_import(PredInfo, ProcInfo, C_Function, Context,
@@ -155,7 +175,7 @@
PragmaVarsAndTypes),
%
- % Construct parts of the C_Code string for calling C_Function.
+ % Construct parts of the C_code string for calling a C_function.
% This C code fragment invokes the specified C function
% with the appropriate arguments from the list constructed
% above, passed in the appropriate manner (by value, or by
@@ -172,7 +192,7 @@
"", Variables),
%
- % Add the C_Code for this `pragma import' to the clauses_info
+ % Make an import implementation
%
PragmaImpl = import(C_Function, Return, Variables, yes(Context)).
@@ -215,7 +235,7 @@
% which means that for Mercury functions the Mercury return
% value becomes the last argument, and the C return value
% is a bool that is used to indicate success or failure.
- C_Code0 = "SUCCESS_INDICATOR = ",
+ C_Code0 = "MR_SUCCESS_INDICATOR = ",
Args2 = Args0
; CodeModel = model_non,
% XXX we should report an error here, rather than generating
diff -u compiler/globals.m compiler/globals.m
--- compiler/globals.m
+++ compiler/globals.m
@@ -195,11 +195,13 @@
% test against known strings.
convert_foreign_language("C", c).
convert_foreign_language("c", c).
-convert_foreign_language("MC++", managedcplusplus).
-convert_foreign_language("mc++", managedcplusplus).
+convert_foreign_language("MC++", managed_cplusplus).
+convert_foreign_language("mc++", managed_cplusplus).
+convert_foreign_language("Managed C++", managed_cplusplus).
+convert_foreign_language("ManagedC++", managed_cplusplus).
foreign_language_string(c) = "C".
-foreign_language_string(managedcplusplus) = "MC++".
+foreign_language_string(managed_cplusplus) = "ManagedC++".
convert_gc_method("none", none).
convert_gc_method("conservative", conservative).
diff -u compiler/handle_options.m compiler/handle_options.m
--- compiler/handle_options.m
+++ compiler/handle_options.m
@@ -46,6 +46,7 @@
:- implementation.
:- import_module options, globals, prog_io_util, trace_params, unify_proc.
+:- import_module prog_data.
:- import_module char, int, string, map, set, getopt, library.
handle_options(MaybeError, Args, Link) -->
@@ -572,26 +573,38 @@
% The preferred backend foreign language depends on the target.
(
{ Target = c },
- { BackendForeignLanguage = "c" }
+ { BackendForeignLanguage = foreign_language_string(c) }
;
{ Target = il },
- { BackendForeignLanguage = "mc++" }
+ { BackendForeignLanguage =
+ foreign_language_string(managed_cplusplus) }
;
- % we don't generate java or handle it as a foreign
- % language just yet, but if we did...
+ % XXX We don't generate java or handle it as a foreign
+ % language just yet, but if we did, we should fix this
{ Target = java },
- { BackendForeignLanguage = "java" }
+ { BackendForeignLanguage = foreign_language_string(c) }
),
globals__io_set_option(backend_foreign_language,
string(BackendForeignLanguage)),
% The default foreign language we use is the same as the backend.
globals__io_lookup_string_option(use_foreign_language,
UseForeignLanguage),
- ( { UseForeignLanguage = "" } ->
+ (
+ { UseForeignLanguage = "" }
+ ->
globals__io_set_option(use_foreign_language,
string(BackendForeignLanguage))
+ ;
+ { convert_foreign_language(UseForeignLanguage, FL) }
+ ->
+ { CanonicalLangName = foreign_language_string(FL) },
+ globals__io_set_option(use_foreign_language,
+ string(CanonicalLangName))
;
- []
+ usage_error(
+ string__format(
+ "unrecognized foreign language argument `%s' for --use-foreign-language",
+ [s(UseForeignLanguage)]))
),
globals__io_lookup_bool_option(highlevel_code, HighLevel),
diff -u compiler/intermod.m compiler/intermod.m
--- compiler/intermod.m
+++ compiler/intermod.m
@@ -218,7 +218,7 @@
intermod_info_get_preds(Preds0),
( { pred_info_get_goal_type(PredInfo, pragmas) } ->
% The header code must be written since
- % it could be used by the pragma_foreign_code.
+ % it could be used by the pragma_c_code.
intermod_info_set_write_header
;
[]
@@ -254,7 +254,7 @@
intermod_info_get_preds(Preds0),
( { pred_info_get_goal_type(PredInfo, pragmas) } ->
% The header code must be written since
- % it could be used by the pragma_c_code.
+ % it could be used by the pragma_foreign_code.
intermod_info_set_write_header
;
[]
@@ -459,10 +459,10 @@
intermod__traverse_goal(Else0, Else, DoWrite3),
{ bool__and_list([DoWrite1, DoWrite2, DoWrite3], DoWrite) }.
- % Inlineable exported pragma_foreign_code goals can't use any
+ % Inlineable exported pragma_c_code goals can't use any
% non-exported types, so we just write out the clauses.
-intermod__traverse_goal(pragma_foreign_code(A,B,C,D,E,F,G) - Info,
- pragma_foreign_code(A,B,C,D,E,F,G) - Info, yes) --> [].
+intermod__traverse_goal(pragma_foreign_code(A,B,C,D,E,F,G,H) - Info,
+ pragma_foreign_code(A,B,C,D,E,F,G,H) - Info, yes) --> [].
intermod__traverse_goal(bi_implication(_, _) - _, _, _) -->
% these should have been expanded out by now
@@ -501,10 +501,10 @@
intermod__traverse_goal(Else0, Else, DoWrite3),
{ bool__and_list([DoWrite1, DoWrite2, DoWrite3], DoWrite) }.
- % Inlineable exported pragma_c_code goals can't use any
+ % Inlineable exported pragma_foreign_code goals can't use any
% non-exported types, so we just write out the clauses.
-intermod__traverse_goal(pragma_foreign_code(A,B,C,D,E,F,G,H) - Info,
- pragma_foreign_code(A,B,C,D,E,F,G,H) - Info, yes) --> [].
+intermod__traverse_goal(pragma_foreign_code(A,B,C,D,E,F,G) - Info,
+ pragma_foreign_code(A,B,C,D,E,F,G) - Info, yes) --> [].
intermod__traverse_goal(bi_implication(_, _) - _, _, _) -->
% these should have been expanded out by now
@@ -1098,8 +1098,8 @@
globals__io_lookup_string_option(dump_hlds_options, VerboseDump),
globals__io_set_option(dump_hlds_options, string("")),
( { WriteHeader = yes } ->
- { module_info_get_foreign_decl(ModuleInfo, ForeignDecl) },
- intermod__write_foreign_decl(ForeignDecl)
+ { module_info_get_foreign_header(ModuleInfo, CHeader) },
+ intermod__write_c_header(CHeader)
;
[]
),
@@ -1122,14 +1122,13 @@
intermod__write_modules(Rest)
).
-:- pred intermod__write_foreign_decl(list(foreign_decl_code)::in,
+:- pred intermod__write_c_header(list(foreign_header_code)::in,
io__state::di, io__state::uo) is det.
-intermod__write_foreign_decl([]) --> [].
-intermod__write_foreign_decl(
- [foreign_decl_code(Language, Header, _) | Headers]) -->
- intermod__write_foreign_decl(Headers),
- mercury_output_pragma_foreign_decl(Language, Header).
+intermod__write_c_header([]) --> [].
+intermod__write_c_header([Header - _ | Headers]) -->
+ intermod__write_c_header(Headers),
+ mercury_output_pragma_c_header(Header).
:- pred intermod__write_types(assoc_list(type_id, hlds_type_defn)::in,
io__state::di, io__state::uo) is det.
@@ -1141,8 +1140,8 @@
globals__io_lookup_string_option(dump_hlds_options, VerboseDump),
globals__io_set_option(dump_hlds_options, string("")),
( { WriteHeader = yes } ->
- { module_info_get_foreign_header(ModuleInfo, CHeader) },
- intermod__write_c_header(CHeader)
+ { module_info_get_foreign_decl(ModuleInfo, ForeignDecl) },
+ intermod__write_foreign_decl(ForeignDecl)
;
[]
),
@@ -1165,13 +1164,14 @@
intermod__write_modules(Rest)
).
-:- pred intermod__write_c_header(list(foreign_header_code)::in,
+:- pred intermod__write_foreign_decl(list(foreign_decl_code)::in,
io__state::di, io__state::uo) is det.
-intermod__write_c_header([]) --> [].
-intermod__write_c_header([Header - _ | Headers]) -->
- intermod__write_c_header(Headers),
- mercury_output_pragma_c_header(Header).
+intermod__write_foreign_decl([]) --> [].
+intermod__write_foreign_decl(
+ [foreign_decl_code(Language, Header, _) | Headers]) -->
+ intermod__write_foreign_decl(Headers),
+ mercury_output_pragma_foreign_decl(Language, Header).
:- pred intermod__write_types(assoc_list(type_id, hlds_type_defn)::in,
io__state::di, io__state::uo) is det.
@@ -1374,11 +1374,11 @@
{ clauses_info_headvars(ClausesInfo, HeadVars) },
{ clauses_info_clauses(ClausesInfo, Clauses) },
- % handle pragma foreign_code(...) separately
+ % handle pragma c_code(...) separately
( { pred_info_get_goal_type(PredInfo, pragmas) } ->
{ pred_info_procedures(PredInfo, Procs) },
- intermod__write_foreign_code(SymName, PredOrFunc, HeadVars,
- VarSet, Clauses, Procs)
+ intermod__write_c_code(SymName, PredOrFunc, HeadVars, VarSet,
+ Clauses, Procs)
;
{ pred_info_get_goal_type(PredInfo, assertion) }
->
@@ -1416,11 +1416,11 @@
{ clauses_info_headvars(ClausesInfo, HeadVars) },
{ clauses_info_clauses(ClausesInfo, Clauses) },
- % handle pragma c_code(...) separately
+ % handle pragma foreign_code(...) separately
( { pred_info_get_goal_type(PredInfo, pragmas) } ->
{ pred_info_procedures(PredInfo, Procs) },
- intermod__write_c_code(SymName, PredOrFunc, HeadVars, VarSet,
- Clauses, Procs)
+ intermod__write_foreign_code(SymName, PredOrFunc, HeadVars,
+ VarSet, Clauses, Procs)
;
{ pred_info_get_goal_type(PredInfo, assertion) }
->
@@ -1594,13 +1594,13 @@
% This marker should only occur after the magic sets transformation.
error("intermod__should_output_marker: generate_inline").
- % Some pretty kludgy stuff to get foreign code written correctly.
-:- pred intermod__write_foreign_code(sym_name::in, pred_or_func::in,
+ % Some pretty kludgy stuff to get c code written correctly.
+:- pred intermod__write_c_code(sym_name::in, pred_or_func::in,
list(prog_var)::in, prog_varset::in,
list(clause)::in, proc_table::in, io__state::di, io__state::uo) is det.
-intermod__write_foreign_code(_, _, _, _, [], _) --> [].
-intermod__write_foreign_code(SymName, PredOrFunc, HeadVars, Varset,
+intermod__write_c_code(_, _, _, _, [], _) --> [].
+intermod__write_c_code(SymName, PredOrFunc, HeadVars, Varset,
[Clause | Clauses], Procs) -->
{ Clause = clause(ProcIds, Goal, _) },
(
@@ -1636,13 +1636,13 @@
% This marker should only occur after the magic sets transformation.
error("intermod__should_output_marker: generate_inline").
- % Some pretty kludgy stuff to get c code written correctly.
-:- pred intermod__write_c_code(sym_name::in, pred_or_func::in,
+ % Some pretty kludgy stuff to get foreign code written correctly.
+:- pred intermod__write_foreign_code(sym_name::in, pred_or_func::in,
list(prog_var)::in, prog_varset::in,
list(clause)::in, proc_table::in, io__state::di, io__state::uo) is det.
-intermod__write_c_code(_, _, _, _, [], _) --> [].
-intermod__write_c_code(SymName, PredOrFunc, HeadVars, Varset,
+intermod__write_foreign_code(_, _, _, _, [], _) --> [].
+intermod__write_foreign_code(SymName, PredOrFunc, HeadVars, Varset,
[Clause | Clauses], Procs) -->
{ Clause = clause(ProcIds, Goal, _) },
(
diff -u compiler/make_hlds.m compiler/make_hlds.m
--- compiler/make_hlds.m
+++ compiler/make_hlds.m
@@ -408,7 +408,7 @@
{ module_add_foreign_decl(Lang, C_Header, Context,
Module0, Module) }
;
- % Handle pragma c_code decls later on (when we process
+ % Handle pragma foreign decls later on (when we process
% clauses).
{ Pragma = foreign(_, _, _, _, _, _) },
{ Module = Module0 }
@@ -3941,6 +3941,7 @@
PVars, VarSet, PragmaImpl, Status, Context,
ModuleInfo0, ModuleInfo, Info0, Info) -->
{ module_info_name(ModuleInfo0, ModuleName) },
+ { foreign_language(Attributes, PragmaForeignLanguage) },
{ list__length(PVars, Arity) },
% print out a progress message
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
@@ -3992,7 +3993,8 @@
->
{ module_info_incr_errors(ModuleInfo1, ModuleInfo) },
prog_out__write_context(Context),
- io__write_string("Error: `:- pragma foreign_code' "),
+ io__write_string("Error: `:- pragma foreign_code' (or `pragma c_code')\n"),
+ prog_out__write_context(Context),
io__write_string("declaration for imported "),
hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string(".\n"),
@@ -4002,8 +4004,9 @@
->
{ module_info_incr_errors(ModuleInfo1, ModuleInfo) },
prog_out__write_context(Context),
- io__write_string(
- "Error: `:- pragma foreign_code' declaration for "),
+ io__write_string("Error: `:- pragma foreign_code' (or `pragma c_code')\n"),
+ prog_out__write_context(Context),
+ io__write_string("declaration for "),
hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string("\n"),
prog_out__write_context(Context),
@@ -4012,7 +4015,6 @@
;
% Don't add clauses for foreign languages other
% than the one we are using.
- { foreign_language(Attributes, PragmaForeignLanguage) },
{ UseForeignLang \= PragmaForeignLanguage }
->
{ ModuleInfo = ModuleInfo1 },
@@ -4045,7 +4047,8 @@
{ module_info_set_predicate_table(ModuleInfo2,
PredicateTable, ModuleInfo) },
{ pragma_get_var_infos(PVars, ArgInfo) },
- maybe_warn_pragma_singletons(PragmaImpl, ArgInfo,
+ maybe_warn_pragma_singletons(PragmaImpl,
+ PragmaForeignLanguage, ArgInfo,
Context, PredOrFunc - PredName/Arity,
ModuleInfo)
;
@@ -4565,12 +4568,12 @@
warn_singletons_in_unify(Var, RHS, GoalInfo, QuantVars, VarSet,
PredCallId, MI).
-warn_singletons_in_goal_2(pragma_foreign_code(_, _, _, _, ArgInfo, _,
+warn_singletons_in_goal_2(pragma_foreign_code(Attrs, _, _, _, ArgInfo, _,
PragmaImpl), GoalInfo, _QuantVars, _VarSet, PredCallId, MI) -->
{ goal_info_get_context(GoalInfo, Context) },
- % XXX not just C code
- warn_singletons_in_pragma_foreign_code(PragmaImpl, ArgInfo, Context,
- PredCallId, MI).
+ { foreign_language(Attrs, Lang) },
+ warn_singletons_in_pragma_foreign_code(PragmaImpl, Lang,
+ ArgInfo, Context, PredCallId, MI).
warn_singletons_in_goal_2(bi_implication(LHS, RHS), _GoalInfo, QuantVars,
VarSet, PredCallId, MI) -->
@@ -4645,15 +4648,15 @@
%-----------------------------------------------------------------------------%
:- pred maybe_warn_pragma_singletons(pragma_foreign_code_impl,
- list(maybe(pair(string, mode))), prog_context, simple_call_id,
- module_info, io__state, io__state).
-:- mode maybe_warn_pragma_singletons(in, in, in, in, in, di, uo) is det.
+ foreign_language, list(maybe(pair(string, mode))), prog_context,
+ simple_call_id, module_info, io__state, io__state).
+:- mode maybe_warn_pragma_singletons(in, in, in, in, in, in, di, uo) is det.
-maybe_warn_pragma_singletons(PragmaImpl, ArgInfo, Context, CallId, MI) -->
+maybe_warn_pragma_singletons(PragmaImpl, Lang, ArgInfo, Context, CallId, MI) -->
globals__io_lookup_bool_option(warn_singleton_vars, WarnSingletonVars),
( { WarnSingletonVars = yes } ->
- warn_singletons_in_pragma_foreign_code(PragmaImpl, ArgInfo,
- Context, CallId, MI)
+ warn_singletons_in_pragma_foreign_code(PragmaImpl, Lang,
+ ArgInfo, Context, CallId, MI)
;
[]
).
@@ -4662,18 +4665,19 @@
% variable is mentioned at least once in the foreign code
% fragments that ought to mention it. If not, it gives a
% warning.
- % (note that for some foreign languages it might not be
- % appropriate to do this check, or you may been to add a
+ % (Note that for some foreign languages it might not be
+ % appropriate to do this check, or you may need to add a
% transformation to map Mercury variable names into identifiers
% for that foreign language).
:- pred warn_singletons_in_pragma_foreign_code(pragma_foreign_code_impl,
- list(maybe(pair(string, mode))), prog_context, simple_call_id,
- module_info, io__state, io__state).
-:- mode warn_singletons_in_pragma_foreign_code(in, in, in, in, in,
+ foreign_language, list(maybe(pair(string, mode))), prog_context,
+ simple_call_id, module_info, io__state, io__state).
+:- mode warn_singletons_in_pragma_foreign_code(in, in, in, in, in, in,
di, uo) is det.
-warn_singletons_in_pragma_foreign_code(PragmaImpl, ArgInfo,
+warn_singletons_in_pragma_foreign_code(PragmaImpl, Lang, ArgInfo,
Context, PredOrFuncCallId, ModuleInfo) -->
+ { LangStr = foreign_language_string(Lang) },
(
{ PragmaImpl = ordinary(C_Code, _) },
{ c_code_to_name_list(C_Code, C_CodeList) },
@@ -4688,19 +4692,13 @@
io__stderr_stream(StdErr1),
io__set_output_stream(StdErr1, OldStream1),
prog_out__write_context(Context),
- io__write_string("In `:- pragma foreign_code' for "),
+ io__write_string("In the " ++ LangStr ++ " code for "),
hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
- ( { UnmentionedVars = [_] } ->
- io__write_string(" warning: variable `"),
- write_string_list(UnmentionedVars),
- io__write_string("' does not occur in the foreign code.\n")
- ;
- io__write_string(" warning: variables `"),
- write_string_list(UnmentionedVars),
- io__write_string("' do not occur in the foreign code.\n")
- ),
+ write_variable_warning_start(UnmentionedVars),
+ io__write_string("not occur in the " ++
+ LangStr ++ " code.\n"),
io__set_output_stream(OldStream1, _)
)
;
@@ -4721,19 +4719,13 @@
io__stderr_stream(StdErr2),
io__set_output_stream(StdErr2, OldStream2),
prog_out__write_context(Context),
- io__write_string("In `:- pragma foreign_code' for "),
+ io__write_string("In the " ++ LangStr ++ " code for "),
hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
- ( { UnmentionedInputVars = [_] } ->
- io__write_string(" warning: variable `"),
- write_string_list(UnmentionedInputVars),
- io__write_string("' does not occur in the first C code.\n")
- ;
- io__write_string(" warning: variables `"),
- write_string_list(UnmentionedInputVars),
- io__write_string("' do not occur in the first C code.\n")
- ),
+ write_variable_warning_start(UnmentionedInputVars),
+ io__write_string("not occur in the first " ++
+ LangStr ++ " code.\n "),
io__set_output_stream(OldStream2, _)
),
{ solutions(lambda([Name::out] is nondet, (
@@ -4749,19 +4741,15 @@
io__stderr_stream(StdErr3),
io__set_output_stream(StdErr3, OldStream3),
prog_out__write_context(Context),
- io__write_string("In `:- pragma foreign_code' for "),
+ io__write_string("In the " ++ LangStr ++ " code for "),
hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
- ( { UnmentionedFirstOutputVars = [_] } ->
- io__write_string(" warning: variable `"),
- write_string_list(UnmentionedFirstOutputVars),
- io__write_string("' does not occur in the first C code or the shared C code.\n")
- ;
- io__write_string(" warning: variables `"),
- write_string_list(UnmentionedFirstOutputVars),
- io__write_string("' do not occur in the first C code or the shared C code.\n")
- ),
+ write_variable_warning_start(
+ UnmentionedFirstOutputVars),
+ io__write_string("not occur in the first " ++
+ LangStr ++ " code or the shared " ++ LangStr ++
+ " code.\n "),
io__set_output_stream(OldStream3, _)
),
{ solutions(lambda([Name::out] is nondet, (
@@ -4777,25 +4765,34 @@
io__stderr_stream(StdErr4),
io__set_output_stream(StdErr4, OldStream4),
prog_out__write_context(Context),
- io__write_string("In `:- pragma foreign_code' for "),
+ io__write_string("In the " ++ LangStr ++ " code for "),
hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
- ( { UnmentionedLaterOutputVars = [_] } ->
- io__write_string(" warning: variable `"),
- write_string_list(UnmentionedLaterOutputVars),
- io__write_string("' does not occur in the retry C code or the shared C code.\n")
- ;
- io__write_string(" warning: variables `"),
- write_string_list(UnmentionedLaterOutputVars),
- io__write_string("' do not occur in the retry C code or the shared C code.\n")
- ),
+ write_variable_warning_start(
+ UnmentionedLaterOutputVars),
+ io__write_string("not occur in the retry " ++
+ LangStr ++ " code or the shared " ++ LangStr ++
+ " code.\n "),
io__set_output_stream(OldStream4, _)
)
;
{ PragmaImpl = import(_, _, _, _) }
).
+:- pred write_variable_warning_start(list(string)::in, io__state::di,
+ io__state::uo) is det.
+write_variable_warning_start(UnmentionedVars) -->
+ ( { UnmentionedVars = [_] } ->
+ io__write_string(" warning: variable `"),
+ write_string_list(UnmentionedVars),
+ io__write_string("' does ")
+ ;
+ io__write_string(" warning: variables `"),
+ write_string_list(UnmentionedVars),
+ io__write_string("' do ")
+ ).
+
%-----------------------------------------------------------------------------%
% c_code_to_name_list(Code, List) is true iff List is a list of the
@@ -5054,13 +5051,12 @@
% return the hlds_goal.
:- pred clauses_info_add_pragma_foreign_code(
- clauses_info, purity, pragma_foreign_code_attributes, pred_id,
- proc_id, prog_varset, list(pragma_var), list(type),
- pragma_foreign_code_impl, prog_context, pred_or_func, sym_name,
- arity, clauses_info, module_info, module_info, qual_info,
- qual_info, io__state, io__state) is det.
-:- mode clauses_info_add_pragma_foreign_code(in, in, in, in, in, in, in,
- in, in, in, in, in, in, out, in, out, in, out, di, uo) is det.
+ clauses_info::in, purity::in, pragma_foreign_code_attributes::in,
+ pred_id::in, proc_id::in, prog_varset::in, list(pragma_var)::in,
+ list(type)::in, pragma_foreign_code_impl::in, prog_context::in,
+ pred_or_func::in, sym_name::in, arity::in, clauses_info::out,
+ module_info::in, module_info::out, qual_info::in,
+ qual_info::out, io__state::di, io__state::uo) is det.
clauses_info_add_pragma_foreign_code(ClausesInfo0, Purity, Attributes0, PredId,
ModeId, PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context,
@@ -5137,7 +5133,7 @@
goal_info_init(GoalInfo0),
goal_info_set_context(GoalInfo0, Context, GoalInfo1),
% Put the purity in the goal_info in case
- % this c code is inlined
+ % this foreign code is inlined
add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
HldsGoal0 = pragma_foreign_code(Attributes, PredId,
ModeId, Args, ArgInfo, OrigArgTypes, PragmaImpl)
@@ -5145,8 +5141,9 @@
},
% Apply unifications with the head args.
% Since the set of head vars and the set vars in the
- % pragma C code are disjoint, the unifications can be
- % implemented as substitutions, and they will be.
+ % pragma foreign code are disjoint, the
+ % unifications can be implemented as
+ % substitutions, and they will be.
insert_arg_unifications(HeadVars, TermArgs, Context,
head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
HldsGoal1, VarSet2, transform_info(ModuleInfo1, Info0),
diff -u compiler/mercury_to_mercury.m compiler/mercury_to_mercury.m
--- compiler/mercury_to_mercury.m
+++ compiler/mercury_to_mercury.m
@@ -2070,10 +2070,8 @@
:- 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++""").
+mercury_output_foreign_language_string(Lang) -->
+ io__write_string("""" ++ foreign_language_string(Lang) ++ """").
%-----------------------------------------------------------------------------%
diff -u compiler/ml_code_gen.m compiler/ml_code_gen.m
--- compiler/ml_code_gen.m
+++ compiler/ml_code_gen.m
@@ -720,8 +720,7 @@
:- import_module ml_type_gen, ml_call_gen, ml_unify_gen, ml_switch_gen.
:- import_module ml_code_util.
-:- import_module llds_out. % XXX needed for pragma C code
-:- import_module arg_info, export, foreign.
+:- import_module arg_info, export, llds_out. % XXX needed for pragma C code
:- 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.
@@ -733,7 +732,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 arg_info, llds_out. % XXX needed for pragma foreign code
+:- import_module export, foreign. % XXX needed for pragma foreign code
:- 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.
diff -u compiler/mlds_to_c.m compiler/mlds_to_c.m
--- compiler/mlds_to_c.m
+++ compiler/mlds_to_c.m
@@ -448,17 +448,12 @@
mlds_output_pragma_export_decl(ModuleName, Indent)).
:- pred mlds_output_c_hdr_decl(indent,
- foreign_decl_code, io__state, io__state).
+ foreign_header_code, io__state, io__state).
:- mode mlds_output_c_hdr_decl(in, in, di, uo) is det.
-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") }
- ).
+mlds_output_c_hdr_decl(_Indent, Code - Context) -->
+ mlds_output_context(mlds__make_context(Context)),
+ io__write_string(Code).
:- pred mlds_output_c_decls(indent, mlds__foreign_code,
io__state, io__state).
@@ -490,12 +485,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).
@@ -524,7 +524,7 @@
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, _, _)) -->
+mlds_output_c_defn(_Indent, user_foreign_code(managed_cplusplus, _, _)) -->
{ sorry(this_file, "foreign code other than C") }.
:- pred mlds_output_pragma_export_decl(mlds_module_name, indent,
@@ -2981,5 +2981,7 @@
:- func this_file = string.
this_file = "mlds_to_c.m".
+
+:- end_module mlds_to_c.
%-----------------------------------------------------------------------------%
diff -u compiler/mlds_to_ilasm.m compiler/mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m
+++ compiler/mlds_to_ilasm.m
@@ -239,7 +239,7 @@
io__write_list(BodyCode, "\n",
(pred(llds__user_foreign_code(Lang, Code, _Context)::in,
di, uo) is det -->
- ( { Lang = managedcplusplus } ->
+ ( { Lang = managed_cplusplus } ->
io__write_string(Code)
;
{ sorry(this_file,
@@ -258,7 +258,7 @@
io__write_list(HeaderCode, "\n",
(pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
di, uo) is det -->
- ( { Lang = managedcplusplus } ->
+ ( { Lang = managed_cplusplus } ->
io__write_string(Code)
;
{ sorry(this_file,
diff -u compiler/options.m compiler/options.m
--- compiler/options.m
+++ compiler/options.m
@@ -1997,8 +1997,8 @@
"\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.",
+ "\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.)",
diff -u compiler/prog_data.m compiler/prog_data.m
--- compiler/prog_data.m
+++ compiler/prog_data.m
@@ -108,7 +108,7 @@
---> c
% ; cplusplus
% ; csharp
- ; managedcplusplus
+ ; managed_cplusplus
% ; java
% ; il
.
@@ -937,7 +937,8 @@
---> must_be_qualified
; may_be_unqualified.
- % Convert the attributes to their source code representations.
+ % Convert the foreign code attributes to their source code
+ % representations (not all attributes have one).
% 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.
@@ -980,6 +981,9 @@
Attrs = Attrs0 ^ tabled_for_io := TabledForIo.
attributes_to_strings(Attrs, StringList) :-
+ % We ingore Lang because it isn't an attribute that you can put
+ % in the attribute list -- the foreign language specifier string
+ % is at the start of the pragma.
Attrs = attributes(_Lang, MayCallMercury, ThreadSafe, TabledForIO),
(
MayCallMercury = may_call_mercury,
diff -u compiler/prog_io_pragma.m compiler/prog_io_pragma.m
--- compiler/prog_io_pragma.m
+++ compiler/prog_io_pragma.m
@@ -293,7 +293,7 @@
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",
+ ErrMsg = "-- expecting either `may_call_mercury' or `will_not_call_mercury', and a string for foreign code",
Res = error(string__append(InvalidDeclStr, ErrMsg),
CodeTerm)
)
@@ -376,25 +376,26 @@
parse_pragma_type(ModuleName, "import", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
+ % XXX we assume all imports are C
+ ForeignLanguage = c,
(
(
- PragmaTerms = [PredAndModesTerm, FlagsTerm, C_FunctionTerm],
- % XXX we assume all imports are C
- ( parse_pragma_foreign_code_attributes_term(c,
+ PragmaTerms = [PredAndModesTerm, FlagsTerm, FunctionTerm],
+ ( parse_pragma_foreign_code_attributes_term(ForeignLanguage,
FlagsTerm, Flags) ->
FlagsResult = ok(Flags)
;
- FlagsResult = error("invalid second argument in `:- pragma import/3' declaration -- expecting C code attribute or list of attributes'",
+ FlagsResult = error("invalid second argument in `:- pragma import/3' declaration -- expecting foreign code attribute or list of attributes'",
FlagsTerm)
)
;
- PragmaTerms = [PredAndModesTerm, C_FunctionTerm],
- default_attributes(c, Flags),
+ PragmaTerms = [PredAndModesTerm, FunctionTerm],
+ default_attributes(ForeignLanguage, Flags),
FlagsResult = ok(Flags)
)
->
(
- C_FunctionTerm = term__functor(term__string(C_Function), [], _)
+ FunctionTerm = term__functor(term__string(Function), [], _)
->
parse_pred_or_func_and_arg_modes(yes(ModuleName),
PredAndModesTerm, ErrorTerm,
@@ -406,7 +407,7 @@
(
FlagsResult = ok(Attributes),
Result = ok(pragma(import(PredName, PredOrFunc,
- ArgModes, Attributes, C_Function)))
+ ArgModes, Attributes, Function)))
;
FlagsResult = error(Msg, Term),
Result = error(Msg, Term)
@@ -417,7 +418,7 @@
)
;
Result = error(
- "expected pragma import(PredName(ModeList), C_Function)",
+ "expected pragma import(PredName(ModeList), Function)",
PredAndModesTerm)
)
;
@@ -429,11 +430,12 @@
parse_pragma_type(_ModuleName, "export", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
+ % XXX we implicitly assume exports are only for C
(
- PragmaTerms = [PredAndModesTerm, C_FunctionTerm]
+ PragmaTerms = [PredAndModesTerm, FunctionTerm]
->
(
- C_FunctionTerm = term__functor(term__string(C_Function), [], _)
+ FunctionTerm = term__functor(term__string(Function), [], _)
->
parse_pred_or_func_and_arg_modes(no, PredAndModesTerm,
ErrorTerm, "`:- pragma export' declaration",
@@ -441,14 +443,14 @@
(
PredAndModesResult = ok(PredName - PredOrFunc, Modes),
Result = ok(pragma(export(PredName, PredOrFunc,
- Modes, C_Function)))
+ Modes, Function)))
;
PredAndModesResult = error(Msg, Term),
Result = error(Msg, Term)
)
;
Result = error(
- "expected pragma export(PredName(ModeList), C_Function)",
+ "expected pragma export(PredName(ModeList), Function)",
PredAndModesTerm)
)
;
diff -u compiler/quantification.m compiler/quantification.m
--- compiler/quantification.m
+++ compiler/quantification.m
@@ -461,8 +461,8 @@
{ set__union(NonLocalVars1, NonLocalVars2, NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
-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_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_atomic_goal(Vars).
implicitly_quantify_goal_2(bi_implication(LHS0, RHS0), Context, Goal) -->
@@ -474,8 +474,8 @@
{ 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).
@@ -985,7 +985,7 @@
union(Set5, Set6, 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) :-
insert_list(Set0, ArgVars, Set).
only in patch2:
--- doc/user_guide.texi 2000/10/27 08:38:50 1.226
+++ doc/user_guide.texi 2000/11/16 00:50:35
@@ -3622,6 +3622,16 @@
is determined by the auto-configuration script.
@sp 1
+ at item @code{--use-foreign-language @var{foreign language}}
+Use the given foreign language to implement predicates
+written in foreign languages. Any name that can be used
+to specify foreign languages in pragma foreign declarations
+is valid, but not all foreign languages are implemented
+in all backends.
+Default value is `C' for the LLDS and MLDS->C backends,
+or `ManagedC++' for the .NET backend.
+
+ at sp 1
@item @code{--no-type-layout}
(This option is not intended for general use.)@*
Don't output base_type_layout structures or references to them.
--
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