[m-dev.] C++ interface
Tyson Dowd
trd at cs.mu.OZ.AU
Thu Jun 13 13:04:10 AEST 2002
Actually further testing reveals this code doesn't work quite right,
I'll work on it a bit and see whether I can fix it.
On 13-Jun-2002, Tyson Richard DOWD <trd at cs.mu.OZ.AU> wrote:
> On 08-Jun-2002, Roberto Bagnara <bagnara at cs.unipr.it> wrote:
> >
> > Hi there,
> >
> > I thought the message I sent to mercury-developers on March 9 was left
> > unanswered, but I was wrong: simply the answers were sent to the list only.
> > So, please accept my apologies for this long delay.
> >
> > Yes, I am interested in directly interfacing a C++ library with Mercury,
> > and I am willing to work with an experimental version as long as I can
> > be reasonably confident that the experimental features I am using will be
> > available in, say, the next Mercury release.
> > If you could direct me to the sources/patches I should use, I am willing
> > to start working as soon as possible.
> > All the best
>
> Code that does this on the current CVS Mercury compiler (should apply
> pretty cleanly to any recent release of the day) is attached.
>
> It is does not yet work cleanly with Mmake, but it works reasonably well
> with the mmc command line compiler.
>
> I suspect it will make it into the next release of the Mercury compiler,
> but it's not clear how much work is remaining before it can pass review.
>
> --
> Tyson Dowd #
> # Surreal humour isn't everyone's cup of fur.
> trd at cs.mu.oz.au #
> http://www.cs.mu.oz.au/~trd #
> Index: compiler/compile_target_code.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/compile_target_code.m,v
> retrieving revision 1.12
> diff -u -r1.12 compile_target_code.m
> --- compiler/compile_target_code.m 12 Jun 2002 14:26:47 -0000 1.12
> +++ compiler/compile_target_code.m 13 Jun 2002 01:02:00 -0000
> @@ -64,6 +64,17 @@
> file_name, file_name, bool, io__state, io__state).
> :- mode compile_managed_cplusplus_file(in, in, in, out, di, uo) is det.
>
> + % compile_cplusplus_file(ErrorStream, ModuleName, Succeeded).
> +:- pred compile_cplusplus_file(io__output_stream, module_name,
> + bool, io__state, io__state).
> +:- mode compile_cplusplus_file(in, in, out, di, uo) is det.
> +
> + % compile_cplusplus_file(ErrorStream,
> + % CPPFile, OFile, Succeeded).
> +:- pred compile_cplusplus_file(io__output_stream,
> + file_name, file_name, bool, io__state, io__state).
> +:- mode compile_cplusplus_file(in, in, in, out, di, uo) is det.
> +
> % compile_csharp_file(ErrorStream, C#File, DLLFile, Succeeded).
> :- pred compile_csharp_file(io__output_stream, file_name, file_name,
> bool, io__state, io__state).
> @@ -197,6 +208,35 @@
> { string__append_list([ILASM, " ", SignOpt, VerboseOpt, DebugOpt,
> TargetOpt, ILASMFlags, " /out=", TargetFile,
> " ", IL_File], Command) },
> + invoke_system_command(ErrorStream, verbose_commands,
> + Command, Succeeded).
> +
> +compile_cplusplus_file(ErrorStream, ModuleName, Succeeded) -->
> + module_name_to_file_name(ModuleName, "__cpp_code.cpp", yes, C_File),
> + globals__io_lookup_string_option(object_file_extension, ObjExt),
> + module_name_to_file_name(ModuleName, ObjExt, yes, O_File),
> + compile_cplusplus_file(ErrorStream, C_File, O_File, Succeeded).
> +
> +compile_cplusplus_file(ErrorStream,
> + CPPFileName, OFileName, Succeeded) -->
> + globals__io_lookup_bool_option(verbose, Verbose),
> + maybe_write_string(Verbose, "% Compiling `"),
> + maybe_write_string(Verbose, CPPFileName),
> + maybe_write_string(Verbose, "':\n"),
> + globals__io_lookup_string_option(cpp_compiler, CPP),
> + globals__io_lookup_accumulating_option(cpp_flags, CPPFlagsList),
> + { join_string_list(CPPFlagsList, "", "", " ", CPPFlags) },
> +
> + globals__io_lookup_accumulating_option(c_include_directory,
> + C_Incl_Dirs),
> + { InclOpts = string__append_list(list__condense(list__map(
> + (func(C_INCL) = ["-I", C_INCL, " "]), C_Incl_Dirs))) },
> +
> + globals__io_lookup_string_option(c_flag_to_name_object_file,
> + NameObjectFile),
> + { string__append_list([CPP, " ", InclOpts, CPPFlags,
> + " -c ", CPPFileName, " ", NameObjectFile, OFileName],
> + Command) },
> invoke_system_command(ErrorStream, verbose_commands,
> Command, Succeeded).
>
> Index: compiler/foreign.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
> retrieving revision 1.16
> diff -u -r1.16 foreign.m
> --- compiler/foreign.m 30 May 2002 08:00:01 -0000 1.16
> +++ compiler/foreign.m 13 Jun 2002 00:47:00 -0000
> @@ -1,4 +1,4 @@
> -%-----------------------------------------------------------------------------%
> +%-----------------------------------------------------------------------------
> % Copyright (C) 2000-2002 The University of Melbourne.
> % This file may only be copied under the terms of the GNU General
> % Public License - see the file COPYING in the Mercury distribution.
> @@ -21,7 +21,21 @@
> :- import_module parse_tree__prog_data, libs__globals.
> :- import_module hlds__hlds_module, hlds__hlds_pred.
>
> -:- import_module bool, list, string, term.
> +:- import_module bool, list, string, term, io, assoc_list, std_util.
> +
> +% foreign_interface_info holds information used when generating
> +% code that uses the foreign language interface.
> +:- type foreign_interface_info
> + ---> foreign_interface_info(
> + module_name,
> + % info about stuff imported from C:
> + foreign_decl_info,
> + foreign_import_module_info,
> + foreign_body_info,
> + % info about stuff exported to C:
> + foreign_export_decls,
> + foreign_export_defns
> + ).
>
> :- type foreign_decl_info == list(foreign_decl_code).
> % in reverse order
> @@ -31,12 +45,17 @@
> % in reverse order
>
> :- type foreign_decl_code --->
> - foreign_decl_code(foreign_language, string, prog_context).
> + foreign_decl_code(foreign_language, foreign_code_fragments).
> +
> :- type foreign_import_module --->
> foreign_import_module(foreign_language, module_name,
> prog_context).
> +
> :- type foreign_body_code --->
> - foreign_body_code(foreign_language, string, prog_context).
> + foreign_body_code(foreign_language,
> + foreign_code_fragments).
> +
> +:- type foreign_code_fragments == assoc_list(string, maybe(prog_context)).
>
> :- type foreign_export_defns == list(foreign_export).
> :- type foreign_export_decls == list(foreign_export_decl).
> @@ -117,13 +136,14 @@
> % code.
> % XXX This implementation is currently incomplete, so in future
> % this interface may change.
> -:- pred foreign__extrude_pragma_implementation(list(foreign_language),
> - list(pragma_var), sym_name, pred_or_func, prog_context,
> +:- pred foreign__piggyback_pragma_implementation(list(foreign_language),
> + list(pragma_var), list(type),
> + sym_name, pred_or_func, prog_context,
> module_info, pragma_foreign_proc_attributes,
> pragma_foreign_code_impl,
> module_info, pragma_foreign_proc_attributes,
> pragma_foreign_code_impl).
> -:- mode foreign__extrude_pragma_implementation(in, in, in, in, in,
> +:- mode foreign__piggyback_pragma_implementation(in, in, in, in, in, in,
> in, in, in, out, out, out) is det.
>
> % make_pragma_import turns pragma imports into pragma foreign_code.
> @@ -160,11 +180,16 @@
> % for use in machine-readable name mangling.
> :- func simple_foreign_language_string(foreign_language) = string.
>
> + % A string representation of the foreign language which can
> + % be used to specify the foreign language in Mercury syntax
> +:- func foreign_language_specification_string(foreign_language) = string.
> +
> % Sub-type of foreign_language for languages for which
> % we generate external files for foreign code.
> :- inst lang_gen_ext_file
> ---> c
> ; managed_cplusplus
> + ; cplusplus
> ; csharp
> .
>
> @@ -184,15 +209,220 @@
> :- mode foreign_language_module_name(in, in) = out is semidet.
> :- mode foreign_language_module_name(in, in(lang_gen_ext_file)) = out is det.
>
> +:- pred piggyback_languages(list(foreign_language)::in,
> + list(foreign_language)::out) is det.
> +
> + % can_piggyback_language(X, Y) is true iff we can generate code to
> + % call language Y from language X
> +:- pred can_piggyback_language(foreign_language, foreign_language).
> +:- mode can_piggyback_language(in, out) is multi.
> +:- mode can_piggyback_language(in, in) is semidet.
> +
> +
> + % XXX TYSE should these two preds really live here?
> +:- pred foreign__output_interface_info(
> + foreign_language::in, foreign_interface_info::in,
> + io__state::di, io__state::uo) is det.
> +
> +:- pred foreign__output_c_code_fragments(foreign_code_fragments,
> + io, io).
> +:- mode foreign__output_c_code_fragments(in, di, uo) is det.
> +
> +:- func foreign__fragments_to_string(foreign_code_fragments) = string.
> +
> +:- pred foreign__compile_foreign_file(io__output_stream::in,
> + foreign_language::in, module_name::in, bool::out,
> + io__state::di, io__state::uo) is det.
> +
> +:- pred foreign__interface_info_generates_output(
> + foreign_interface_info::in) is semidet.
> +
> +:- func foreign__body_info_to_body_code(foreign_language, foreign_body_info) =
> + list(user_foreign_code).
> +
> :- implementation.
>
> :- import_module list, map, assoc_list, std_util, string, varset, int, term.
> -:- import_module require.
> +:- import_module require, library, getopt.
>
> :- import_module hlds__hlds_pred, hlds__hlds_module, check_hlds__type_util.
> :- import_module check_hlds__mode_util, hlds__error_util.
> :- import_module hlds__hlds_data, parse_tree__prog_out.
> -:- import_module backend_libs__code_model, libs__globals.
> +:- import_module hlds__passes_aux, parse_tree__modules.
> +:- import_module backend_libs__code_model, libs__globals, libs__options.
> +:- import_module backend_libs__c_util, backend_libs__compile_target_code.
> +
> +%-----------------------------------------------------------------------------%
> +
> + % XXX reuse the code below to generate names of _c_code and
> + % stuff more elegantly.
> +foreign__compile_foreign_file(ErrorStream, Lang, ModuleName, Succeeded) -->
> + foreign_language_external_filename(Lang, ModuleName, InFile),
> + (
> + { Lang = c },
> + globals__io_lookup_string_option(object_file_extension,
> + ObjExt)
> + ;
> + { Lang = cplusplus },
> + globals__io_lookup_string_option(object_file_extension,
> + ObjExt)
> + ;
> + { Lang = csharp },
> + { ObjExt = ".dll" }
> + ;
> + { Lang = managed_cplusplus },
> + { ObjExt = ".dll" }
> + ;
> + { Lang = il },
> + { error("no support for IL in external files") }
> + ),
> + foreign_language_external_filename(Lang, ModuleName, ObjExt, OutFile),
> + (
> + { Lang = c },
> + compile_c_file(ErrorStream, non_pic, InFile, OutFile,
> + Succeeded),
> + globals__io_lookup_accumulating_option(link_objects,
> + LinkObjects),
> + globals__io_set_option(link_objects, accumulating([OutFile |
> + LinkObjects]))
> + ;
> + { Lang = cplusplus },
> + compile_cplusplus_file(ErrorStream, InFile, OutFile,
> + Succeeded),
> + globals__io_lookup_accumulating_option(link_objects,
> + LinkObjects),
> + globals__io_set_option(link_objects, accumulating([OutFile |
> + LinkObjects]))
> + ;
> + { Lang = csharp },
> + compile_csharp_file(ErrorStream, InFile, OutFile, Succeeded)
> + ;
> +
> + { Lang = managed_cplusplus },
> + compile_managed_cplusplus_file(ErrorStream, InFile, OutFile,
> + Succeeded)
> + ;
> + { Lang = il },
> + { error("no support for IL in external files") }
> + ).
> +
> +
> +foreign__interface_info_generates_output(Info) :-
> + Info = foreign_interface_info(_, DeclCodes, _, BodyCodes, _, _),
> + % If there is a decl or a body code we are going to
> + % generate output
> + ( DeclCodes = [_|_] ; BodyCodes = [_|_] ).
> +
> +%-----------------------------------------------------------------------------%
> +
> +foreign__output_interface_info(Lang, Info) -->
> + { Info = foreign_interface_info(ModuleName, _, _, _, _, _) },
> + foreign_language_external_filename(Lang, ModuleName, FileName),
> + output_to_file(FileName, output_interface_info_2(Lang, Info)).
> +
> +:- pred foreign_language_external_filename(foreign_language::in,
> + module_name::in, string::out, io__state::di, io__state::uo)
> + is det.
> +foreign_language_external_filename(Lang, ModuleName, FileName) -->
> + (
> + { Ext = foreign_language_file_extension(Lang) }
> + ->
> + foreign_language_external_filename(
> + Lang, ModuleName, Ext, FileName)
> + ;
> + { error("foreign language " ++ foreign_language_string(Lang)
> + ++ " does not generate an external output file.") }
> + ).
> +
> +:- pred foreign_language_external_filename(foreign_language::in,
> + module_name::in, string::in, string::out,
> + io__state::di, io__state::uo) is det.
> +foreign_language_external_filename(Lang, ModuleName, Ext, FileName) -->
> + (
> + { ForeignModuleName = foreign_language_module_name(
> + ModuleName, Lang) }
> + ->
> + module_name_to_file_name(ForeignModuleName, Ext, yes,
> + FileName)
> + ;
> + { error("foreign language " ++ foreign_language_string(Lang)
> + ++ " does not generate an external output file.") }
> + ).
> +
> +
> +:- pred foreign__output_interface_info_2(
> + foreign_language::in, foreign_interface_info::in,
> + io__state::di, io__state::uo) is det.
> +foreign__output_interface_info_2(cplusplus, Info) -->
> + { Info = foreign_interface_info(ModuleName,
> + DeclCodes, _, BodyCodes, _, _) },
> +
> + output_src_start(ModuleName),
> +
> + io__write_string("#include <mercury_types.h>\n"),
> + io__write_list(DeclCodes, "\n", (pred(X::in, di, uo) is det -->
> + { X = foreign_decl_code(_, CodeList) },
> + foreign__output_c_code_fragments(CodeList)
> + )),
> + io__nl,
> +
> + io__write_string("extern ""C"" {\n"),
> +
> + io__write_list(BodyCodes, "\n", (pred(X::in, di, uo) is det -->
> + { X = foreign_body_code(_, CodeList) },
> + foreign__output_c_code_fragments(CodeList)
> + )),
> + io__nl,
> + io__write_string("}\n"),
> + output_src_end(ModuleName).
> +foreign__output_interface_info_2(c, _) -->
> + { error("output_interface_info_2: c not handled here") }.
> +foreign__output_interface_info_2(csharp, _) -->
> + { error("output_interface_info_2: csharp not handled here") }.
> +foreign__output_interface_info_2(managed_cplusplus, _) -->
> + { error("output_interface_info_2: managed_cplusplus not handled here")
> + }.
> +foreign__output_interface_info_2(il, _) -->
> + { error("output_interface_info_2: il not handled here") }.
> +
> +
> +foreign__output_c_code_fragments(CodeList) -->
> + io__write_list(CodeList, "", (pred(C::in, di, uo) is det -->
> + ( { C = CodeStr - no },
> + io__write_string(CodeStr)
> + ; { C = CodeStr - yes(Context) },
> + { term__context_file(Context, FileName) },
> + { term__context_line(Context, LineNumber) },
> + c_util__set_line_num(FileName, LineNumber),
> + io__write_string(CodeStr),
> + c_util__reset_line_num
> + ))).
> +
> +:- pred output_src_start(module_name, io__state, io__state).
> +:- mode output_src_start(in, di, uo) is det.
> +
> +output_src_start(ModuleName) -->
> + { library__version(Version) },
> + { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
> + io__write_strings(
> + ["//\n// Automatically generated from `",
> + ModuleNameStr,
> + ".m' by the\n",
> + "// Mercury compiler, version ",
> + Version,
> + ".\n",
> + "// Do not edit.\n",
> + "\n\n"]).
> +
> +:- pred output_src_end(module_name, io__state, io__state).
> +:- mode output_src_end(in, di, uo) is det.
> +output_src_end(ModuleName) -->
> + io__write_string("// End of module: "),
> + prog_out__write_sym_name(ModuleName),
> + io__write_string(". \n").
> +
> +
> +%-----------------------------------------------------------------------------%
>
> % Currently we don't use the globals to compare foreign language
> % interfaces, but if we added appropriate options we might want
> @@ -239,7 +469,7 @@
>
>
> foreign__filter_decls(WantedLang, Decls0, LangDecls, NotLangDecls) :-
> - list__filter((pred(foreign_decl_code(Lang, _, _)::in) is semidet :-
> + list__filter((pred(foreign_decl_code(Lang, _)::in) is semidet :-
> WantedLang = Lang),
> Decls0, LangDecls, NotLangDecls).
>
> @@ -250,114 +480,210 @@
> Imports0, LangImports, NotLangImports).
>
> foreign__filter_bodys(WantedLang, Bodys0, LangBodys, NotLangBodys) :-
> - list__filter((pred(foreign_body_code(Lang, _, _)::in) is semidet :-
> + list__filter((pred(foreign_body_code(Lang, _)::in) is semidet :-
> WantedLang = Lang),
> Bodys0, LangBodys, NotLangBodys).
>
> -foreign__extrude_pragma_implementation([], _PragmaVars,
> +foreign__piggyback_pragma_implementation([], _PragmaVars, _ArgTypes,
> _PredName, _PredOrFunc, _Context, _ModuleInfo0, _Attributes, _Impl0,
> _ModuleInfo, _NewAttributes, _Impl) :-
> unexpected(this_file, "no suitable target languages available").
>
> - % We just use the first target language for now, it might be nice
> + % We just use the first foreign language for now, it might be nice
> % to try a few others if the backend supports multiple ones.
> -foreign__extrude_pragma_implementation([TargetLang | TargetLangs],
> - _PragmaVars, _PredName, _PredOrFunc, _Context,
> +foreign__piggyback_pragma_implementation([BackendForeignLang | BackendLangs],
> + PragmaVars, ArgTypes, PredName, PredOrFunc, Context,
> ModuleInfo0, Attributes, Impl0,
> ModuleInfo, NewAttributes, Impl) :-
> foreign_language(Attributes, ForeignLanguage),
>
> % If the foreign language is available as a target language,
> % we don't need to do anything.
> - ( list__member(ForeignLanguage, [TargetLang | TargetLangs]) ->
> + ( list__member(ForeignLanguage, [BackendForeignLang | BackendLangs]) ->
> Impl = Impl0,
> ModuleInfo = ModuleInfo0,
> NewAttributes = Attributes
> ;
> - set_foreign_language(Attributes, TargetLang, NewAttributes),
> - extrude_pragma_implementation_2(TargetLang, ForeignLanguage,
> - ModuleInfo0, Impl0, ModuleInfo, Impl)
> + set_foreign_language(Attributes, BackendForeignLang,
> + NewAttributes),
> + piggyback_pragma_implementation2(BackendForeignLang,
> + ForeignLanguage, ModuleInfo0, Impl0,
> + PragmaVars, ArgTypes, PredName, PredOrFunc, Context,
> + ModuleInfo, Impl)
> ).
>
>
> -:- pred extrude_pragma_implementation_2(
> +can_piggyback_language(X, X).
> +can_piggyback_language(c, cplusplus).
> +
> +piggyback_languages(BackendLangs, PossibleMatches) :-
> + solutions((pred(Y::out) is nondet :-
> + list__member(Lang, BackendLangs),
> + can_piggyback_language(Lang, Y)
> + ), PossibleMatches).
> +
> +:- pred piggyback_pragma_implementation2(
> foreign_language::in, foreign_language::in,
> module_info::in, pragma_foreign_code_impl::in,
> + list(pragma_var)::in, list(type)::in,
> + sym_name::in, pred_or_func::in, prog_context::in,
> module_info::out, pragma_foreign_code_impl::out) is det.
>
> - % 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
> - % function in C++ (implemented in a piece of C++ body code) with C
> - % linkage, and import that function. The backend would spit the C++
> - % body code into a separate file.
> - % The code would look a little like this:
> - /*
> - NewName = make_pred_name(ForeignLanguage, PredName),
> - ( PredOrFunc = predicate ->
> - ReturnCode = ""
> - ;
> - ReturnCode = "ReturnVal = "
> - ),
> - C_ExtraCode = "Some Extra Code To Run",
> - create_pragma_import_c_code(PragmaVars, ModuleInfo0, "", VarString),
> - module_add_foreign_body_code(cplusplus,
> - C_ExtraCode, Context, ModuleInfo0, ModuleInfo),
> - Impl = import(NewName, ReturnCode, VarString, no)
> - */
> -
> -extrude_pragma_implementation_2(c, managed_cplusplus, _, _, _, _) :-
> - unimplemented_combination(c, managed_cplusplus).
>
> -extrude_pragma_implementation_2(c, csharp, _, _, _, _) :-
> - unimplemented_combination(c, csharp).
> +piggyback_pragma_implementation2(c, Lang, ModuleInfo0, Impl0,
> + PragmaVars, ArgTypes, PredName, PredOrFunc, Context,
> + ModuleInfo, Impl) :-
> + ( Lang = cplusplus ->
> + NewName = make_pred_name(Lang, PredName),
> + ReturnCode = "",
> + assoc_list__from_corresponding_lists(PragmaVars, ArgTypes,
> + Args0),
> + list__filter(include_import_arg(ModuleInfo0), Args0, Args,
> + DummyArgs),
> + create_pragma_import_c_code(assoc_list__keys(Args),
> + ModuleInfo0, "", VarString),
> + Impl = import(NewName, ReturnCode, VarString, no),
> +
> + ( Impl0 = ordinary(UserCode, _) ->
> + create_new_implementation(NewName, ModuleInfo0,
> + Args, DummyArgs, PredOrFunc,
> + UserCode, Context, DeclCode, BodyCode),
> +
> + % Add a C++ foreign_code which contains a
> + % C++ function definition
>
> -extrude_pragma_implementation_2(c, il, _, _, _, _) :-
> - unimplemented_combination(c, il).
> + module_add_foreign_body_code(cplusplus,
> + BodyCode, ModuleInfo0, ModuleInfo1),
>
> -extrude_pragma_implementation_2(c, c, ModuleInfo, Impl, ModuleInfo, Impl).
> -
> -
> - % Don't do anything - C and MC++ are embedded inside MC++
> - % without any changes.
> -extrude_pragma_implementation_2(managed_cplusplus, managed_cplusplus,
> - ModuleInfo, Impl, ModuleInfo, Impl).
> -
> -extrude_pragma_implementation_2(managed_cplusplus, c,
> - ModuleInfo, Impl, ModuleInfo, Impl).
> -
> -extrude_pragma_implementation_2(managed_cplusplus, csharp, _, _, _, _) :-
> - unimplemented_combination(managed_cplusplus, csharp).
> -
> -extrude_pragma_implementation_2(managed_cplusplus, il, _, _, _, _) :-
> - unimplemented_combination(managed_cplusplus, il).
> + % Add a C foreign_decl which has a prototype
> + % for the C++ function
>
> + module_add_foreign_decl(c,
> + DeclCode, ModuleInfo1, ModuleInfo)
> + ;
> + error("unimplemented: piggybacking anything but "
> + ++ "ordinary code")
> + )
> + ;
> + unimplemented_combination(c, Lang)
> + ).
>
>
> -extrude_pragma_implementation_2(csharp, csharp,
> - ModuleInfo, Impl, ModuleInfo, Impl).
> +:- pred create_new_implementation(string::in, module_info::in,
> + list(pair(pragma_var, type))::in,
> + list(pair(pragma_var, type))::in,
> + pred_or_func::in, string::in, context::in,
> + foreign_code_fragments::out,
> + foreign_code_fragments::out) is det.
> +create_new_implementation(NewName, ModuleInfo, Args, DummyArgs,
> + _PredOrFunc, UserCode, Context, NewDecl, NewImpl) :-
> + ( Args = [] ->
> + DeclString = "void"
> + ;
> + DeclString = create_pragma_var_decl_string(Args, ModuleInfo)
> + ),
>
> -extrude_pragma_implementation_2(csharp, c, _, _, _, _) :-
> - unimplemented_combination(csharp, c).
> + DummyDeclString = create_arg_decls(DummyArgs, ModuleInfo),
> + MarshalInputString = create_marshal_inputs_string(Args, ModuleInfo),
> + MarshalOutputString = create_marshal_outputs_string(Args, ModuleInfo),
> +
> + HeadCode = "void " ++ NewName ++ "(" ++ DeclString ++ ")",
> + NewDecl = [(HeadCode ++ ";\n") - no],
> + NewImpl1 = HeadCode ++ "\n" ++ "{\n"
> + ++ DummyDeclString ++ "\n"
> + ++ MarshalInputString ++ "\n",
> +
> + NewImpl2 = "\n" ++ MarshalOutputString ++ "\n}\n",
> + NewImpl = [NewImpl1 - no, UserCode - yes(Context), NewImpl2 - no].
> +
> +:- func create_marshal_inputs_string(list(pair(pragma_var, type)),
> + module_info) = string.
> +
> +create_marshal_inputs_string(Args, ModuleInfo) = Str :-
> + Strs = list__map((func(PragmaVar - VarType) = S :-
> + PragmaVar = pragma_var(_Var, ArgName, Mode),
> + S = ( mode_is_output(ModuleInfo, Mode) ->
> + to_type_string(c, ModuleInfo, VarType) ++ " " ++
> + ArgName ++ ";\n"
> + ;
> + to_type_string(c, ModuleInfo, VarType) ++ " "
> + ++ ArgName ++ " = " ++ ArgName ++ "_param;\n"
> + )
> + ), Args),
> + Str = string__append_list(Strs).
>
> -extrude_pragma_implementation_2(csharp, managed_cplusplus, _, _, _, _) :-
> - unimplemented_combination(csharp, managed_cplusplus).
> +:- func create_marshal_outputs_string(list(pair(pragma_var, type)),
> + module_info) = string.
>
> -extrude_pragma_implementation_2(csharp, il, _, _, _, _) :-
> - unimplemented_combination(csharp, il).
> +create_marshal_outputs_string(Args, ModuleInfo) = Str :-
> + Strs = list__map((func(PragmaVar - _VarType) = S :-
> + PragmaVar = pragma_var(_Var, ArgName, Mode),
> + S = ( mode_is_output(ModuleInfo, Mode) ->
> + "*" ++ ArgName ++ "_param = " ++ ArgName ++ ";\n"
> + ;
> + ""
> + )
> + ), Args),
> + Str = string__append_list(Strs).
>
> +:- func create_arg_decls(list(pair(pragma_var, type)), module_info) = string.
>
> -extrude_pragma_implementation_2(il, il,
> - ModuleInfo, Impl, ModuleInfo, Impl).
> +create_arg_decls(Args, ModuleInfo) = Str :-
> + Strs = list__map((func(PragmaVar - VarType) = S :-
> + PragmaVar = pragma_var(_Var, ArgName, _Mode),
> + S = to_type_string(c, ModuleInfo, VarType) ++ " "
> + ++ ArgName ++ ";\n"
> + ), Args),
> + Str = string__append_list(Strs).
> +
> +
> +:- func create_pragma_var_decl_string(list(pair(pragma_var, type)),
> + module_info) = string.
> +
> +create_pragma_var_decl_string(Args, ModuleInfo) = Str :-
> + Commas = list__duplicate(list__length(Args) - 1, ", "),
> + Strs0 = list__map((func(PragmaVar - VarType) = S :-
> + PragmaVar = pragma_var(_Var, ArgName, Mode),
> +
> + %
> + % Construct the C code fragment for passing this argument,
> + % and append it to C_Code0.
> + % Note that C handles output arguments by passing the variable'
> + % address, so if the mode is output, we need to put an `&'
> + % before the variable name.
> + %
> + S = to_type_string(c, ModuleInfo, VarType) ++ " " ++
> + ( mode_is_output(ModuleInfo, Mode) ->
> + "*"
> + ;
> + ""
> + ) ++ ArgName ++ "_param"
> + ), Args),
> + Strs = list__zip(Strs0, Commas),
> + Str = string__append_list(Strs).
>
> -extrude_pragma_implementation_2(il, c, _, _, _, _) :-
> - unimplemented_combination(il, c).
>
> -extrude_pragma_implementation_2(il, managed_cplusplus, _, _, _, _) :-
> - unimplemented_combination(il, managed_cplusplus).
>
> -extrude_pragma_implementation_2(il, csharp, _, _, _, _) :-
> - unimplemented_combination(il, csharp).
>
> +piggyback_pragma_implementation2(csharp, Lang, _ModuleInfo0, _Impl0,
> + _PragmaVars, _ArgTypes, _PredName, _PredOrFunc, _Context,
> + _ModuleInfo, _Impl) :-
> + unimplemented_combination(csharp, Lang).
> +
> +piggyback_pragma_implementation2(il, Lang, _ModuleInfo0, _Impl0,
> + _PragmaVars, _ArgTypes, _PredName, _PredOrFunc, _Context,
> + _ModuleInfo, _Impl) :-
> + unimplemented_combination(il, Lang).
> +
> +piggyback_pragma_implementation2(cplusplus, Lang, _ModuleInfo0, _Impl0,
> + _PragmaVars, _ArgTypes, _PredName, _PredOrFunc, _Context,
> + _ModuleInfo, _Impl) :-
> + unimplemented_combination(cplusplus, Lang).
> +
> +piggyback_pragma_implementation2(managed_cplusplus, Lang, _ModuleInfo0, _Impl0,
> + _PragmaVars, _ArgTypes, _PredName, _PredOrFunc, _Context,
> + _ModuleInfo, _Impl) :-
> + unimplemented_combination(managed_cplusplus, Lang).
>
>
> :- pred unimplemented_combination(foreign_language::in, foreign_language::in)
> @@ -377,12 +703,16 @@
>
> :- func make_pred_name_rest(foreign_language, sym_name) = string.
> make_pred_name_rest(c, _SymName) = "some_c_name".
> +make_pred_name_rest(csharp, _SymName) = "some_csharp_name".
> +make_pred_name_rest(il, _SymName) = "some_il_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_pred_name_rest(csharp, _SymName) = "some_csharp_name".
> -make_pred_name_rest(il, _SymName) = "some_il_name".
>
> +make_pred_name_rest(cplusplus, qualified(ModuleSpec, Name)) =
> + make_pred_name_rest(managed_cplusplus, ModuleSpec) ++ "__" ++ Name.
> +make_pred_name_rest(cplusplus, unqualified(Name)) = Name.
>
> make_pragma_import(PredInfo, ProcInfo, C_Function, Context,
> ModuleInfo, PragmaImpl, VarSet, PragmaVars, ArgTypes,
> @@ -560,15 +890,24 @@
> foreign_language_string(managed_cplusplus) = "Managed C++".
> foreign_language_string(csharp) = "C#".
> foreign_language_string(il) = "IL".
> +foreign_language_string(cplusplus) = "C++".
>
> simple_foreign_language_string(c) = "c".
> simple_foreign_language_string(managed_cplusplus) = "cpp". % XXX mcpp is better
> simple_foreign_language_string(csharp) = "csharp".
> simple_foreign_language_string(il) = "il".
> +simple_foreign_language_string(cplusplus) = "cpp".
> +
> +foreign_language_specification_string(c) = "c".
> +foreign_language_specification_string(managed_cplusplus) = "mc++".
> +foreign_language_specification_string(csharp) = "csharp".
> +foreign_language_specification_string(il) = "il".
> +foreign_language_specification_string(cplusplus) = "c++".
>
> foreign_language_file_extension(c) = ".c".
> foreign_language_file_extension(managed_cplusplus) = ".cpp".
> foreign_language_file_extension(csharp) = ".cs".
> +foreign_language_file_extension(cplusplus) = ".cpp".
> foreign_language_file_extension(il) = _ :- fail.
>
> foreign_language_module_name(M, L) = FM :-
> @@ -583,6 +922,26 @@
> FM = qualified(Module, Name ++ Ending)
> ).
>
> +
> +%-----------------------------------------------------------------------------%
> +
> +foreign__body_info_to_body_code(Lang, BodyInfos) = BodyCodes :-
> + BodyCodes = list__condense(list__map(ConvBody, BodyInfos)),
> + ConvBody = (func(foreign_body_code(_L, Fragments)) =
> + list__map(FragmentToBody, Fragments)),
> + FragmentToBody = (func(CodeStr - MaybeContext) = U :-
> + ( MaybeContext = yes(Context),
> + U = user_foreign_code(Lang, CodeStr,
> + Context)
> + ; MaybeContext = no,
> + U = user_foreign_code(Lang, CodeStr,
> + term__context_init)
> + )).
> +
> + % XXX should we put the contexts in here?
> +foreign__fragments_to_string(Frags) =
> + string__append_list(assoc_list__keys(Frags)).
> +
> %-----------------------------------------------------------------------------%
>
> :- type exported_type
> @@ -645,6 +1004,12 @@
> ;
> unexpected(this_file, "to_type_string: qualified C type")
> ).
> +to_type_string(cplusplus, foreign(ForeignType)) = Result :-
> + ( ForeignType = unqualified(Result0) ->
> + Result = Result0
> + ;
> + unexpected(this_file, "to_type_string: qualified C++ type")
> + ).
> to_type_string(csharp, foreign(ForeignType)) = Result :-
> sym_name_to_string(ForeignType, ".", Result).
> to_type_string(managed_cplusplus, foreign(ForeignType)) = Result ++ " *":-
> @@ -677,6 +1042,8 @@
> ).
> to_type_string(il, mercury(_Type)) = _ :-
> sorry(this_file, "to_type_string for il").
> +to_type_string(cplusplus, mercury(Type))
> + = to_type_string(managed_cplusplus, mercury(Type)).
>
> %-----------------------------------------------------------------------------%
>
> Index: compiler/globals.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
> retrieving revision 1.50
> diff -u -r1.50 globals.m
> --- compiler/globals.m 15 Apr 2002 05:04:02 -0000 1.50
> +++ compiler/globals.m 12 Jun 2002 02:27:15 -0000
> @@ -35,7 +35,7 @@
>
> :- type foreign_language
> ---> c
> -% ; cplusplus
> + ; cplusplus
> ; csharp
> ; managed_cplusplus
> % ; java
> @@ -86,6 +86,8 @@
> :- pred globals__get_target(globals::in, compilation_target::out) is det.
> :- pred globals__get_backend_foreign_languages(globals::in,
> list(foreign_language)::out) is det.
> +:- pred globals__get_supported_foreign_languages(globals::in,
> + list(foreign_language)::out) is det.
> :- pred globals__get_gc_method(globals::in, gc_method::out) is det.
> :- pred globals__get_tags_method(globals::in, tags_method::out) is det.
> :- pred globals__get_termination_norm(globals::in, termination_norm::out)
> @@ -151,8 +153,15 @@
> :- pred globals__io_get_target(compilation_target::out,
> io__state::di, io__state::uo) is det.
>
> + % The list of foreign languages out backend supports directly
> :- pred globals__io_get_backend_foreign_languages(list(foreign_language)::out,
> io__state::di, io__state::uo) is det.
> +
> + % The list of foreign languages we can support with this backend
> + % (directly or indirectly)
> +:- pred globals__io_get_supported_foreign_languages(
> + list(foreign_language)::out,
> + io__state::di, io__state::uo) is det.
>
> :- pred globals__io_lookup_foreign_language_option(option::in,
> foreign_language::out, io__state::di, io__state::uo) is det.
> @@ -233,6 +242,7 @@
> is semidet.
>
> convert_foreign_language_2("c", c).
> +convert_foreign_language_2("c++", cplusplus).
> convert_foreign_language_2("mc++", managed_cplusplus).
> convert_foreign_language_2("managedc++", managed_cplusplus).
> convert_foreign_language_2("managed c++", managed_cplusplus).
> @@ -282,6 +292,15 @@
> globals__get_trace_suppress(Globals, Globals ^ trace_suppress_items).
> globals__get_source_file_map(Globals, Globals ^ source_file_map).
>
> +globals__get_supported_foreign_languages(Globals, ForeignLangs) :-
> + globals__lookup_accumulating_option(Globals,
> + supported_foreign_languages, LangStrs),
> + ForeignLangs = list__map(func(String) = ForeignLang :-
> + ( convert_foreign_language(String, ForeignLang0) ->
> + ForeignLang = ForeignLang0
> + ;
> + error("globals__io_get_supported_foreign_languages: invalid foreign_language string")
> + ), LangStrs).
> globals__get_backend_foreign_languages(Globals, ForeignLangs) :-
> globals__lookup_accumulating_option(Globals, backend_foreign_languages,
> LangStrs),
> @@ -490,6 +509,10 @@
> globals__io_get_backend_foreign_languages(ForeignLangs) -->
> globals__io_get_globals(Globals),
> { globals__get_backend_foreign_languages(Globals, ForeignLangs) }.
> +
> +globals__io_get_supported_foreign_languages(ForeignLangs) -->
> + globals__io_get_globals(Globals),
> + { globals__get_supported_foreign_languages(Globals, ForeignLangs) }.
>
> globals__io_lookup_bool_option(Option, Value) -->
> globals__io_get_globals(Globals),
> Index: compiler/handle_options.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
> retrieving revision 1.140
> diff -u -r1.140 handle_options.m
> --- compiler/handle_options.m 30 May 2002 12:54:56 -0000 1.140
> +++ compiler/handle_options.m 12 Jun 2002 02:27:15 -0000
> @@ -978,6 +978,25 @@
> []
> ),
>
> + globals__io_get_backend_foreign_languages(BackendFLs),
> + { piggyback_languages(BackendFLs, SupportedForeignLanguages) },
> +
> + { SupportedForeignLanguageStrs = list__map(
> + foreign_language_specification_string,
> + SupportedForeignLanguages) },
> +
> + % only set the supported foreign languages if they are unset
> + globals__io_lookup_accumulating_option(supported_foreign_languages,
> + CurrentSupportedForeignLanguage),
> + (
> + { CurrentSupportedForeignLanguage = [] }
> + ->
> + globals__io_set_option(supported_foreign_languages,
> + accumulating(SupportedForeignLanguageStrs))
> + ;
> + []
> + ),
> +
> globals__io_lookup_int_option(compare_specialization, CompareSpec),
> ( { CompareSpec < 0 } ->
> % This indicates that the option was not set by the user;
> Index: compiler/hlds_module.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
> retrieving revision 1.74
> diff -u -r1.74 hlds_module.m
> --- compiler/hlds_module.m 7 Apr 2002 10:22:30 -0000 1.74
> +++ compiler/hlds_module.m 12 Jun 2002 02:27:15 -0000
> @@ -289,17 +289,17 @@
> foreign_import_module_info, module_info).
> :- mode module_info_set_foreign_import_module(in, in, out) is det.
>
> -:- pred module_add_foreign_decl(foreign_language, string, prog_context,
> +:- pred module_add_foreign_decl(foreign_language, foreign_code_fragments,
> module_info, module_info).
> -:- mode module_add_foreign_decl(in, in, in, in, out) is det.
> +:- mode module_add_foreign_decl(in, in, in, out) is det.
>
> :- pred module_add_foreign_import_module(foreign_language,
> module_name, prog_context, module_info, module_info).
> :- mode module_add_foreign_import_module(in, in, in, in, out) is det.
>
> -:- pred module_add_foreign_body_code(foreign_language, string, prog_context,
> +:- pred module_add_foreign_body_code(foreign_language, foreign_code_fragments,
> module_info, module_info).
> -:- mode module_add_foreign_body_code(in, in, in, in, out) is det.
> +:- mode module_add_foreign_body_code(in, in, in, out) is det.
>
> % Please see module_info_ensure_dependency_info for the
> % constraints on this dependency_info.
> @@ -912,12 +912,12 @@
> AllImports = (IndirectImports `set__union` DirectImports)
> `set__union` set__list_to_set(Parents).
>
> -module_add_foreign_decl(Lang, ForeignDecl, Context, Module0, Module) :-
> +module_add_foreign_decl(Lang, ForeignDecl, Module0, Module) :-
> module_info_get_foreign_decl(Module0, ForeignDeclIndex0),
> % store the decls in reverse order and reverse them later
> % for efficiency
> - ForeignDeclIndex1 = [foreign_decl_code(Lang, ForeignDecl, Context) |
> - ForeignDeclIndex0],
> + ForeignDeclIndex1 = [foreign_decl_code(Lang, ForeignDecl)
> + | ForeignDeclIndex0],
> module_info_set_foreign_decl(Module0, ForeignDeclIndex1, Module).
>
> module_add_foreign_import_module(Lang, ModuleName, Context, Module0, Module) :-
> @@ -930,13 +930,12 @@
> module_info_set_foreign_import_module(Module0,
> ForeignImportIndex1, Module).
>
> -module_add_foreign_body_code(Lang, Foreign_Body_Code, Context,
> - Module0, Module) :-
> +module_add_foreign_body_code(Lang, Foreign_Body_Code, Module0, Module) :-
> module_info_get_foreign_body_code(Module0, Foreign_Body_List0),
> % store the decls in reverse order and reverse them later
> % for efficiency
> Foreign_Body_List =
> - [foreign_body_code(Lang, Foreign_Body_Code, Context) |
> + [foreign_body_code(Lang, Foreign_Body_Code) |
> Foreign_Body_List0],
> module_info_set_foreign_body_code(Module0, Foreign_Body_List, Module).
>
> Index: compiler/intermod.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
> retrieving revision 1.121
> diff -u -r1.121 intermod.m
> --- compiler/intermod.m 10 May 2002 14:03:58 -0000 1.121
> +++ compiler/intermod.m 13 Jun 2002 00:47:45 -0000
> @@ -98,7 +98,7 @@
> :- import_module parse_tree__prog_util.
> :- import_module hlds__special_pred, check_hlds__typecheck.
> :- import_module check_hlds__type_util, hlds__instmap, (parse_tree__inst).
> -:- import_module backend_libs__foreign.
> +:- import_module backend_libs, backend_libs__foreign.
>
> %-----------------------------------------------------------------------------%
>
> @@ -1144,8 +1144,9 @@
>
> list__foldl(
> (pred(ForeignDecl::in, di, uo) is det -->
> - { ForeignDecl = foreign_decl_code(Lang, Header, _) },
> - mercury_output_pragma_foreign_decl(Lang, Header)
> + { ForeignDecl = foreign_decl_code(Lang, CodeFrags) },
> + { Str = foreign__fragments_to_string(CodeFrags) },
> + mercury_output_pragma_foreign_decl(Lang, Str)
> ), ForeignDecls)
> ;
> []
> Index: compiler/llds.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
> retrieving revision 1.286
> diff -u -r1.286 llds.m
> --- compiler/llds.m 9 May 2002 16:30:53 -0000 1.286
> +++ compiler/llds.m 12 Jun 2002 02:27:15 -0000
> @@ -25,21 +25,6 @@
>
> :- import_module bool, list, assoc_list, map, set, std_util, counter, term.
>
> -%-----------------------------------------------------------------------------%
> -
> -% foreign_interface_info holds information used when generating
> -% code that uses the foreign language interface.
> -:- type foreign_interface_info
> - ---> foreign_interface_info(
> - module_name,
> - % info about stuff imported from C:
> - foreign_decl_info,
> - foreign_import_module_info,
> - foreign_body_info,
> - % info about stuff exported to C:
> - foreign_export_decls,
> - foreign_export_defns
> - ).
>
> %-----------------------------------------------------------------------------%
>
> Index: compiler/llds_out.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
> retrieving revision 1.194
> diff -u -r1.194 llds_out.m
> --- compiler/llds_out.m 30 May 2002 08:00:01 -0000 1.194
> +++ compiler/llds_out.m 13 Jun 2002 00:45:17 -0000
> @@ -1089,22 +1089,38 @@
>
> output_foreign_header_include_lines_2([]) --> [].
> output_foreign_header_include_lines_2(
> - [foreign_decl_code(Lang, Code, Context) | Hs]) -->
> + [foreign_decl_code(Lang, CodeAndContexts) | Hs]) -->
> ( { Lang = c } ->
> globals__io_lookup_bool_option(auto_comments, PrintComments),
> ( { PrintComments = yes } ->
> io__write_string("/* "),
> - prog_out__write_context(Context),
> + % if there is a context on the first element,
> + % consider this the context to put in the
> + % comments
> + ( { CodeAndContexts = [_ - yes(Context0) | _] } ->
> + prog_out__write_context(Context0)
> + ;
> + []
> + ),
> io__write_string(" pragma foreign_decl_code( "),
> io__write(Lang),
> io__write_string(" */\n")
> ;
> []
> ),
> - output_set_line_num(Context),
> - io__write_string(Code),
> - io__write_string("\n"),
> - output_reset_line_num
> + list__foldl((pred((Code - MaybeContext)::in, di, uo) is det -->
> + ( { MaybeContext = yes(Context1) } ->
> + output_set_line_num(Context1)
> + ;
> + []
> + ),
> + io__write_string(Code),
> + io__write_string("\n"),
> + ( { MaybeContext = yes(_) } ->
> + output_reset_line_num
> + ;
> + []
> + )), CodeAndContexts)
> ;
> { error("llds_out__output_user_foreign_code: unexpected: foreign code other than C") }
> ),
> Index: compiler/make.module_target.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/make.module_target.m,v
> retrieving revision 1.7
> diff -u -r1.7 make.module_target.m
> --- compiler/make.module_target.m 30 May 2002 12:55:01 -0000 1.7
> +++ compiler/make.module_target.m 12 Jun 2002 02:27:15 -0000
> @@ -319,6 +319,11 @@
> Succeeded) -->
> compile_target_code__compile_csharp_file(ErrorStream,
> CSharpFile, DLLFile, Succeeded).
> + % XXX TYSE this might need to be fixed!!!!
> +compile_foreign_code_file(ErrorStream, Pic,
> + foreign_code_file(cplusplus, CppFile, ObjFile), Succeeded) -->
> + compile_target_code__compile_c_file(ErrorStream, Pic,
> + CppFile, ObjFile, Succeeded).
>
> %-----------------------------------------------------------------------------%
>
> Index: compiler/make_hlds.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
> retrieving revision 1.414
> diff -u -r1.414 make_hlds.m
> --- compiler/make_hlds.m 10 Jun 2002 15:58:05 -0000 1.414
> +++ compiler/make_hlds.m 13 Jun 2002 00:56:42 -0000
> @@ -393,11 +393,11 @@
> { Module = Module0 }
> ;
> { Pragma = foreign_code(Lang, Body_Code) },
> - { module_add_foreign_body_code(Lang, Body_Code, Context,
> - Module0, Module) }
> + { module_add_foreign_body_code(Lang,
> + [Body_Code - yes(Context)], Module0, Module) }
> ;
> - { Pragma = foreign_decl(Lang, C_Header) },
> - { module_add_foreign_decl(Lang, C_Header, Context,
> + { Pragma = foreign_decl(Lang, Decl_Code) },
> + { module_add_foreign_decl(Lang, [Decl_Code - yes(Context)],
> Module0, Module) }
> ;
> { Pragma = foreign_import_module(Lang, Import) },
> @@ -4345,7 +4345,7 @@
> []
> ),
>
> - globals__io_get_backend_foreign_languages(BackendForeignLangs),
> + globals__io_get_supported_foreign_languages(SupportedForeignLangs),
>
> % Lookup the pred declaration in the predicate table.
> % (If it's not there, print an error message and insert
> @@ -4413,7 +4413,8 @@
> ;
> % Don't add clauses for foreign languages other
> % than the ones we can generate code for.
> - { not list__member(PragmaForeignLanguage, BackendForeignLangs) }
> + { not list__member(PragmaForeignLanguage,
> + SupportedForeignLangs) }
> ->
> { ModuleInfo = ModuleInfo1 },
> { Info = Info0 }
> @@ -5594,6 +5595,7 @@
>
>
> globals__io_get_backend_foreign_languages(BackendForeignLanguages),
> + globals__io_get_supported_foreign_languages(SupportedForeignLanguages),
> {
> pragma_get_vars(PVars, Args0),
> pragma_get_var_infos(PVars, ArgInfo),
> @@ -5603,10 +5605,22 @@
> % languages, we will have to generate an interface to it in a
> % backend language.
> %
> - foreign__extrude_pragma_implementation(BackendForeignLanguages,
> - PVars, PredName, PredOrFunc, Context,
> - ModuleInfo0, Attributes0, PragmaImpl0,
> - ModuleInfo1, Attributes, PragmaImpl),
> +
> + foreign_language(Attributes0, PragmaLang),
> +
> + (
> + list__member(PragmaLang, SupportedForeignLanguages)
> + ->
> + % we might need to generate piggyback code for it
> + foreign__piggyback_pragma_implementation(
> + BackendForeignLanguages, PVars, OrigArgTypes,
> + PredName, PredOrFunc, Context, ModuleInfo0,
> + Attributes0, PragmaImpl0, ModuleInfo1, Attributes,
> + PragmaImpl)
> + ;
> + % XXX crummy error message
> + error("sorry, foreign_proc not compatible")
> + ),
>
> %
> % Check for arguments occurring multiple times.
> @@ -8375,7 +8389,7 @@
> { adjust_func_arity(PredOrFunc, Arity, NumArgs) },
>
> % create pragma c_header_code to declare extern variables
> - { module_add_foreign_decl(c, C_HeaderCode, Context,
> + { module_add_foreign_decl(c, [C_HeaderCode - yes(Context)],
> Module1, Module2) },
>
> io__get_exit_status(ExitStatus),
> @@ -8465,7 +8479,7 @@
> ->
> Module2 = Module1
> ;
> - module_add_foreign_body_code(c, C_ExtraCode, Context,
> + module_add_foreign_body_code(c, [C_ExtraCode - yes(Context)],
> Module1, Module2)
> },
> %
> Index: compiler/maybe_mlds_to_gcc.pp
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/maybe_mlds_to_gcc.pp,v
> retrieving revision 1.5
> diff -u -r1.5 maybe_mlds_to_gcc.pp
> --- compiler/maybe_mlds_to_gcc.pp 20 Mar 2002 12:35:47 -0000 1.5
> +++ compiler/maybe_mlds_to_gcc.pp 12 Jun 2002 14:10:25 -0000
> @@ -17,7 +17,7 @@
> :- module ml_backend__maybe_mlds_to_gcc.
> :- interface.
>
> -:- import_module ml_backend__mlds, bool.
> +:- import_module ml_backend__mlds, libs__globals, set.
> :- use_module io.
>
> :- type frontend_callback(T) == pred(T, io__state, io__state).
> @@ -33,9 +33,9 @@
>
> % Either invoke mlds_to_gcc__compile_to_asm, or report an error
> % message, depending on whether the gcc back-end interface has
> - % been enabled. In the former case,
> - % the bool returned is `yes' iff the module contained C code.
> -:- pred maybe_mlds_to_gcc__compile_to_asm(mlds__mlds, bool,
> + % been enabled. The set of foreign languages used in the code is
> + % returned.
> +:- pred maybe_mlds_to_gcc__compile_to_asm(mlds__mlds, set(foreign_language),
> io__state, io__state).
> :- mode maybe_mlds_to_gcc__compile_to_asm(in, out, di, uo) is det.
>
> @@ -61,7 +61,7 @@
> maybe_mlds_to_gcc__run_gcc_backend(_ModuleName, CallBack, CallBackOutput) -->
> CallBack(CallBackOutput).
>
> -maybe_mlds_to_gcc__compile_to_asm(_MLDS, no) -->
> +maybe_mlds_to_gcc__compile_to_asm(_MLDS, set__init) -->
> report_error(
> "Sorry, `--target asm' not supported: this installation of the Mercury\n" ++
> "compiler was built without support for the GCC back-end interface.").
> Index: compiler/mercury_compile.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
> retrieving revision 1.253
> diff -u -r1.253 mercury_compile.m
> --- compiler/mercury_compile.m 10 Jun 2002 10:05:47 -0000 1.253
> +++ compiler/mercury_compile.m 13 Jun 2002 00:55:51 -0000
> @@ -1164,7 +1164,7 @@
> { HLDS = HLDS50 },
> mercury_compile__mlds_backend(HLDS, MLDS),
> mercury_compile__maybe_mlds_to_gcc(MLDS,
> - ContainsCCode),
> + _ForeignLangSet),
> ( { TargetCodeOnly = yes } ->
> []
> ;
> @@ -1177,7 +1177,24 @@
> % separate C file. We need to invoke the
> % C compiler on that.
> %
> - ( { ContainsCCode = yes } ->
> + get_all_foreign_language_interface_info(
> + HLDS, ForeignLangInfoMap),
> + % don't generate files for C
> + % because we already did that
> + % when generating code
> + % XXX better to do it all in the
> + % one place though
> + create_all_foreign_language_files([c],
> + ForeignLangInfoMap),
> +
> + io__output_stream(OutputStream),
> + compile_all_foreign_language_files(
> + OutputStream, ModuleName, [c],
> + ForeignLangInfoMap)
> +/*
> + % XXX I don't think we need this any more
> +
> + ( { set__member(c, ForeignLangSet) } ->
> module_name_to_file_name(ModuleName,
> ".c", no, CCode_C_File),
> globals__io_lookup_string_option(
> @@ -1203,6 +1220,7 @@
> ;
> []
> )
> +*/
> )
> ; { HighLevelCode = yes } ->
> { HLDS = HLDS50 },
> @@ -1220,7 +1238,24 @@
> io__output_stream(OutputStream),
> compile_target_code__compile_c_file(
> OutputStream, non_pic, C_File, O_File,
> - _CompileOK)
> + _CompileOK),
> +
> + %
> + % Create all the other foreign language files
> + %
> +
> + get_all_foreign_language_interface_info(
> + HLDS, ForeignLangInfoMap),
> + create_all_foreign_language_files([c],
> + ForeignLangInfoMap),
> +
> + %
> + % Compile all the other foreign language files
> + %
> +
> + compile_all_foreign_language_files(
> + OutputStream, ModuleName, [c],
> + ForeignLangInfoMap)
> )
> ;
> mercury_compile__backend_pass(HLDS50, HLDS,
> @@ -3251,18 +3286,89 @@
> C_ExportDecls, _) },
> export__produce_header_file(C_ExportDecls, ModuleName),
>
> +
> +
> %
> % Finally we invoke the C compiler to compile it.
> %
> globals__io_lookup_bool_option(target_code_only, TargetCodeOnly),
> + io__output_stream(OutputStream),
> ( { TargetCodeOnly = no } ->
> - io__output_stream(OutputStream),
> mercury_compile__c_to_obj(OutputStream,
> ModuleName, NumChunks, CompileOK),
> { bool__not(CompileOK, CompileErrors) }
> ;
> { CompileErrors = no }
> - ).
> + ),
> +
> + %
> + % XXX TYSE
> + % If there are other (non-C) foreign languages code, we output them
> + % to the appropriate files.
> + %
> +
> + get_all_foreign_language_interface_info(HLDS, ForeignLangInfoMap),
> + create_all_foreign_language_files([c], ForeignLangInfoMap),
> +
> + %
> + % Compile all the other foreign language files
> + %
> +
> + compile_all_foreign_language_files(OutputStream, ModuleName, [c],
> + ForeignLangInfoMap).
> +
> +:- pred create_all_foreign_language_files(list(foreign_language)::in,
> + map(foreign_language, foreign_interface_info)::in,
> + io__state::di, io__state::uo) is det.
> +create_all_foreign_language_files(ExcludeList, ForeignLangInfoMap) -->
> + map__foldl((pred(Lang::in, InterfaceInfo::in, di, uo) is det -->
> + (
> + { not list__member(Lang, ExcludeList) }
> + ->
> + foreign__output_interface_info(Lang, InterfaceInfo)
> + ;
> + []
> + )
> + ), ForeignLangInfoMap).
> +
> +:- pred compile_all_foreign_language_files(io__output_stream::in,
> + module_name::in, list(foreign_language)::in,
> + map(foreign_language, foreign_interface_info)::in,
> + io__state::di, io__state::uo) is det.
> +compile_all_foreign_language_files(OutputStream, ModuleName, ExcludeList,
> + ForeignLangInfoMap) -->
> + map__foldl((pred(Lang::in, _InterfaceInfo::in, di, uo) is det -->
> + (
> + { not list__member(Lang, ExcludeList) }
> + ->
> + foreign__compile_foreign_file(
> + OutputStream, Lang, ModuleName, _CompileOK)
> + % XXX we ignore status
> + ;
> + []
> + )
> + ), ForeignLangInfoMap).
> +
> +:- pred get_all_foreign_language_interface_info(module_info::in,
> + map(foreign_language, foreign_interface_info)::out,
> + io__state::di, io__state::uo) is det.
> +get_all_foreign_language_interface_info(HLDS, Map) -->
> + globals__io_get_supported_foreign_languages(SupportedForeignLangs),
> + { map__init(EmptyMap) },
> + { list__foldl((pred(Lang::in, Map0::in, Map1::out) is det :-
> + get_c_interface_info(HLDS, Lang, Lang_InterfaceInfo),
> + (
> + foreign__interface_info_generates_output(
> + Lang_InterfaceInfo)
> + ->
> + map__det_insert(Map0, Lang, Lang_InterfaceInfo, Map1)
> + ;
> + Map0 = Map1
> + )
> + ), SupportedForeignLangs, EmptyMap, Map) }.
> +
> +
> +
>
> % Split the code up into bite-size chunks for the C compiler.
>
> @@ -3275,12 +3381,12 @@
> mercury_compile__construct_c_file(C_InterfaceInfo, Procedures, GlobalVars,
> AllData, CFile, ComponentCount) -->
> { C_InterfaceInfo = foreign_interface_info(ModuleSymName,
> - C_HeaderCode0, C_Includes, C_BodyCode0,
> + C_HeaderCode0, C_Includes, C_BodyInfo,
> _C_ExportDecls, C_ExportDefns) },
> { llds_out__sym_name_mangle(ModuleSymName, MangledModuleName) },
> { string__append(MangledModuleName, "_module", ModuleName) },
> globals__io_lookup_int_option(procs_per_c_function, ProcsPerFunc),
> - { get_c_body_code(C_BodyCode0, C_BodyCode) },
> + { C_BodyCode = foreign__body_info_to_body_code(c, C_BodyInfo) },
> ( { ProcsPerFunc = 0 } ->
> % ProcsPerFunc = 0 really means infinity -
> % we store all the procs in a single function.
> @@ -3318,7 +3424,11 @@
> { string__append_list(
> ["#include """, HeaderFileName, """\n"],
> IncludeString) },
> - { Include = foreign_decl_code(c, IncludeString, Context) }
> + { Include = foreign_decl_code(c, [IncludeString -
> + yes(Context)]) }
> + ;
> + { Lang = cplusplus },
> + { error("sorry, not yet implemented: `:- pragma foreign_import_module' for C++") }
> ;
> { Lang = csharp },
> { error("sorry.
> @@ -3333,13 +3443,6 @@
> :- import_module not yet implemented: `:- pragma foreign_import_module' for IL") }
> ).
>
> -:- pred get_c_body_code(foreign_body_info, list(user_foreign_code)).
> -:- mode get_c_body_code(in, out) is det.
> -
> -get_c_body_code([], []).
> -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,
> list(comp_gen_c_module)).
> @@ -3598,16 +3701,17 @@
> maybe_write_string(Verbose, "% Finished converting MLDS to Java.\n"),
> maybe_report_stats(Stats).
>
> -:- pred mercury_compile__maybe_mlds_to_gcc(mlds, bool, io__state, io__state).
> +:- pred mercury_compile__maybe_mlds_to_gcc(mlds, set(foreign_language),
> + io__state, io__state).
> :- mode mercury_compile__maybe_mlds_to_gcc(in, out, di, uo) is det.
>
> -mercury_compile__maybe_mlds_to_gcc(MLDS, ContainsCCode) -->
> +mercury_compile__maybe_mlds_to_gcc(MLDS, ForeignLangSet) -->
> globals__io_lookup_bool_option(verbose, Verbose),
> globals__io_lookup_bool_option(statistics, Stats),
>
> maybe_write_string(Verbose,
> "% Passing MLDS to GCC and compiling to assembler...\n"),
> - maybe_mlds_to_gcc__compile_to_asm(MLDS, ContainsCCode),
> + maybe_mlds_to_gcc__compile_to_asm(MLDS, ForeignLangSet),
> maybe_write_string(Verbose, "% Finished compiling to assembler.\n"),
> maybe_report_stats(Stats).
>
> Index: compiler/ml_code_gen.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
> retrieving revision 1.118
> diff -u -r1.118 ml_code_gen.m
> --- compiler/ml_code_gen.m 4 Jun 2002 14:56:02 -0000 1.118
> +++ compiler/ml_code_gen.m 13 Jun 2002 00:54:43 -0000
> @@ -829,10 +829,9 @@
> foreign__filter_bodys(Lang,
> ForeignBodys, WantedForeignBodys,
> _OtherForeignBodys),
> - ConvBody = (func(foreign_body_code(L, S, C)) =
> - user_foreign_code(L, S, C)),
> - MLDSWantedForeignBodys = list__map(ConvBody,
> - WantedForeignBodys),
> + MLDSWantedForeignBodys=
> + foreign__body_info_to_body_code(Lang,
> + WantedForeignBodys),
> % XXX exports are only implemented for
> % C and IL at the moment
> ( ( Lang = c ; Lang = il ) ->
> @@ -2350,6 +2349,11 @@
> Foreign_Code, Context, MLDS_Decls, MLDS_Statements) -->
> { foreign_language(Attributes, Lang) },
> ( { Lang = c },
> + ml_gen_ordinary_pragma_c_proc(CodeModel, Attributes,
> + PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
> + Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
> + % XXX is this right for C++?
> + ; { Lang = cplusplus },
> ml_gen_ordinary_pragma_c_proc(CodeModel, Attributes,
> PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
> Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
> Index: compiler/mlds.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
> retrieving revision 1.92
> diff -u -r1.92 mlds.m
> --- compiler/mlds.m 30 May 2002 12:55:05 -0000 1.92
> +++ compiler/mlds.m 12 Jun 2002 02:27:15 -0000
> @@ -293,7 +293,7 @@
> :- import_module backend_libs__foreign, check_hlds__type_util.
> :- import_module libs__globals.
>
> -:- import_module bool, list, std_util, map.
> +:- import_module bool, list, std_util, map, set.
>
> %-----------------------------------------------------------------------------%
>
> @@ -811,6 +811,8 @@
> mlds__context
> ).
>
> +:- func mlds__get_foreign_language_set(mlds) = set(foreign_language).
> +
> %-----------------------------------------------------------------------------%
> %
> % Attributes
> @@ -1765,6 +1767,11 @@
> = name(Package, qualified(Module, Name)).
>
> wrapper_class_name = "mercury_code".
> +
> +%-----------------------------------------------------------------------------%
> +
> +mlds__get_foreign_language_set(MLDS)
> + = set__list_to_set(map__keys(MLDS ^ foreign_code)).
>
> %-----------------------------------------------------------------------------%
>
> Index: compiler/mlds_to_c.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
> retrieving revision 1.131
> diff -u -r1.131 mlds_to_c.m
> --- compiler/mlds_to_c.m 7 Jun 2002 00:48:45 -0000 1.131
> +++ compiler/mlds_to_c.m 12 Jun 2002 02:27:15 -0000
> @@ -59,6 +59,7 @@
> :- import_module ml_backend__ml_code_util. % for ml_gen_public_field_decl_flags, which is
> % used by the code that handles derived classes
> :- import_module ml_backend__ml_type_gen. % for ml_gen_type_name
> +:- import_module backend_libs.
> :- import_module backend_libs__foreign.
> :- import_module libs__globals, libs__options, hlds__passes_aux.
> :- import_module backend_libs__builtin_ops, backend_libs__c_util.
> @@ -557,11 +558,10 @@
> 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, foreign_decl_code(Lang, Code, Context)) -->
> +mlds_output_c_hdr_decl(_Indent, foreign_decl_code(Lang, CodeFragments)) -->
> % only output C code in the C header file.
> ( { Lang = c } ->
> - mlds_to_c__output_context(mlds__make_context(Context)),
> - io__write_string(Code)
> + foreign__output_c_code_fragments(CodeFragments)
> ;
> { sorry(this_file, "foreign code other than C") }
> ).
> @@ -610,6 +610,8 @@
> mlds_output_c_defn(_Indent, user_foreign_code(csharp, _, _)) -->
> { sorry(this_file, "foreign code other than C") }.
> mlds_output_c_defn(_Indent, user_foreign_code(il, _, _)) -->
> + { sorry(this_file, "foreign code other than C") }.
> +mlds_output_c_defn(_Indent, user_foreign_code(cplusplus, _, _)) -->
> { sorry(this_file, "foreign code other than C") }.
>
> :- pred mlds_output_pragma_export_defn(mlds_module_name, indent,
> Index: compiler/mlds_to_csharp.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
> retrieving revision 1.22
> diff -u -r1.22 mlds_to_csharp.m
> --- compiler/mlds_to_csharp.m 20 Mar 2002 12:36:50 -0000 1.22
> +++ compiler/mlds_to_csharp.m 12 Jun 2002 02:27:15 -0000
> @@ -184,15 +184,25 @@
> _ExportDefns)) -->
> { HeaderCode = list__reverse(RevHeaderCode) },
> io__write_list(HeaderCode, "\n",
> - (pred(foreign_decl_code(Lang, Code, _Context)::in,
> + (pred(foreign_decl_code(Lang, CodeFragments)::in,
> di, uo) is det -->
> ( { Lang = csharp } ->
> - io__write_string(Code)
> + output_csharp_code_fragments(CodeFragments)
> ;
> { sorry(this_file,
> "foreign code other than MC++") }
> )
> )).
> +
> +:- pred output_csharp_code_fragments(foreign_code_fragments, io, io).
> +:- mode output_csharp_code_fragments(in, di, uo) is det.
> +output_csharp_code_fragments(CodeList) -->
> + io__write_list(CodeList, "",
> + (pred(C::in, di, uo) is det -->
> + % XXX we ignore the context
> + { C = CodeStr - _ },
> + io__write_string(CodeStr)
> + )).
>
> :- pred generate_method_csharp_code(mlds_module_name, mlds__defn,
> io__state, io__state).
> Index: compiler/mlds_to_gcc.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
> retrieving revision 1.71
> diff -u -r1.71 mlds_to_gcc.m
> --- compiler/mlds_to_gcc.m 7 May 2002 11:03:06 -0000 1.71
> +++ compiler/mlds_to_gcc.m 12 Jun 2002 02:27:15 -0000
> @@ -92,7 +92,7 @@
> :- interface.
>
> :- import_module ml_backend.
> -:- import_module ml_backend__mlds, ml_backend__maybe_mlds_to_gcc, bool.
> +:- import_module ml_backend__mlds, ml_backend__maybe_mlds_to_gcc, set.
> :- use_module io.
>
> % run_gcc_backend(ModuleName, CallBack, CallBackOutput):
> @@ -122,19 +122,11 @@
> % try to use the GCC back-end before it has been properly
> % initialized.
> %
> - % The ContainsCCode bool returned is `yes' iff the module contained
> - % C code. In that case, we will have output a separate C file which
> - % needs to be compiled with the C compiler.
> - %
> - % XXX Currently the only foreign language we handle is C.
> - % To make it work properly we'd need to change the
> - % `ContainsCCode' boolean that we return to instead be a list
> - % of the foreign languages used, so that mercury_compile.m
> - % will know which foreign language files have been generated
> - % which foreign language compilers it needs to invoke,
> - % and which object files to link into the executable.
> + % The set of foreign languages contained in the code is returned, as
> + % these languages will be output into separate files.
>
> -:- pred mlds_to_gcc__compile_to_asm(mlds__mlds, bool, io__state, io__state).
> +:- pred mlds_to_gcc__compile_to_asm(mlds__mlds, set(foreign_language),
> + io__state, io__state).
> :- mode mlds_to_gcc__compile_to_asm(in, out, di, uo) is det.
>
> %-----------------------------------------------------------------------------%
> @@ -224,7 +216,7 @@
> maybe_write_string(Verbose, "% GCC back-end done.\n")
> ).
>
> -mlds_to_gcc__compile_to_asm(MLDS, ContainsCCode) -->
> +mlds_to_gcc__compile_to_asm(MLDS, ForeignLangSet) -->
> { MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns0) },
>
> %
> @@ -262,7 +254,7 @@
> { ForeignCode = mlds__foreign_code(_Decls, _Imports, [], []) },
> { ForeignDefns = [] }
> ->
> - { ContainsCCode = no },
> + { ForeignLangSet = set__init },
> % there's no foreign code, so we don't need to
> % do anything special
> { NeedInitFn = yes }
> @@ -274,9 +266,8 @@
> list__map(make_public, ForeignDefns)) },
> mlds_to_c__output_mlds(ForeignMLDS, ""),
> % XXX currently the only foreign code we handle is C;
> - % see comments above (at the declaration for
> - % mlds_to_c__compile_to_asm)
> - { ContainsCCode = yes },
> + % but if we handled others we could just place them here
> + { ForeignLangSet = set__insert(set__init, c) },
> { NeedInitFn = no }
> ),
>
> Index: compiler/mlds_to_ilasm.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
> retrieving revision 1.17
> diff -u -r1.17 mlds_to_ilasm.m
> --- compiler/mlds_to_ilasm.m 20 Mar 2002 12:36:52 -0000 1.17
> +++ compiler/mlds_to_ilasm.m 12 Jun 2002 02:27:15 -0000
> @@ -87,6 +87,8 @@
> sorry(this_file, "language C foreign code not supported").
> handle_foreign_lang(il, _, _) :-
> sorry(this_file, "language IL foreign code not supported").
> +handle_foreign_lang(cplusplus, _, _) :-
> + sorry(this_file, "language C++ foreign code not supported").
>
> %
> % Generate the `.il' file.
> Index: compiler/mlds_to_mcpp.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
> retrieving revision 1.26
> diff -u -r1.26 mlds_to_mcpp.m
> --- compiler/mlds_to_mcpp.m 20 Mar 2002 12:36:53 -0000 1.26
> +++ compiler/mlds_to_mcpp.m 12 Jun 2002 02:27:15 -0000
> @@ -52,6 +52,8 @@
> :- import_module ml_backend__ilds, ml_backend__ilasm, ml_backend__il_peephole.
> :- import_module ml_backend__ml_util, ml_backend__ml_code_util.
> :- import_module ml_backend__mlds_to_c. /* to output C code for .cpp files */
> +:- import_module backend_libs.
> +:- import_module backend_libs__foreign.
> :- use_module ll_backend__llds. /* for user_c_code */
>
> :- import_module bool, int, map, string, list, assoc_list, term, std_util.
> @@ -200,10 +202,11 @@
> _ExportDefns)) -->
> { HeaderCode = list__reverse(RevHeaderCode) },
> io__write_list(HeaderCode, "\n",
> - (pred(foreign_decl_code(Lang, Code, _Context)::in,
> + (pred(foreign_decl_code(Lang, CodeFragments)::in,
> di, uo) is det -->
> ( { Lang = managed_cplusplus } ->
> - io__write_string(Code)
> + foreign__output_c_code_fragments(
> + CodeFragments)
> ;
> % ignore it if it isn't MC++
> []
> Index: compiler/modules.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
> retrieving revision 1.234
> diff -u -r1.234 modules.m
> --- compiler/modules.m 10 Jun 2002 10:05:50 -0000 1.234
> +++ compiler/modules.m 12 Jun 2002 02:27:15 -0000
> @@ -2307,6 +2307,13 @@
> list__foldl(write_foreign_dependency_for_il(DepStream,
> ModuleName, AllDeps), Langs)
> ;
> + { Target = c },
> + { not set__empty(LangSet) }
> + ->
> + { Langs = set__to_sorted_list(LangSet) },
> + list__foldl(write_foreign_dependency_for_c(DepStream,
> + ModuleName, AllDeps), Langs)
> + ;
> []
> ),
>
> @@ -2515,6 +2522,31 @@
> )
> ).
>
> +:- pred write_foreign_dependency_for_c(io__output_stream::in,
> + sym_name::in, list(module_name)::in, foreign_language::in,
> + io__state::di, io__state::uo) is det.
> +write_foreign_dependency_for_c(DepStream, ModuleName, _AllDeps, ForeignLang)
> + -->
> + (
> + { ForeignModuleName = foreign_language_module_name(
> + ModuleName, ForeignLang) },
> +
> + % XXX not a great way to test for creating an external
> + % file
> + { ForeignExt = foreign_language_file_extension(ForeignLang) }
> + ->
> + module_name_to_file_name(ForeignModuleName, ForeignExt, no,
> + ForeignFileName),
> + module_name_to_file_name(ModuleName, ".c", no, CFileName),
> +
> + io__write_strings(DepStream, [
> + ForeignFileName, " : ", CFileName, "\n\n"])
> + ;
> + % This foreign language doesn't generate an external file
> + % so there are no dependencies to generate.
> + []
> + ).
> +
> % Generate the following dependency. This dependency is
> % needed because module__cpp_code.dll might refer to
> % high level data in any of the mercury modules it
> @@ -2531,8 +2563,8 @@
> % (the rule to generate .dll from .cpp is a pattern rule in
> % scripts/Mmake.rules).
> %
> -:- pred write_foreign_dependency_for_il(io__output_stream::in,sym_name::in,
> - list(module_name)::in, foreign_language::in,
> +:- pred write_foreign_dependency_for_il(io__output_stream::in,
> + sym_name::in, list(module_name)::in, foreign_language::in,
> io__state::di, io__state::uo) is det.
> write_foreign_dependency_for_il(DepStream, ModuleName, AllDeps, ForeignLang)
> -->
> @@ -3378,6 +3410,8 @@
> globals__io_get_target(Target),
> ( { Target = il } ->
> { ForeignModulesAndExts = foreign_modules(Modules, DepsMap) }
> + ; { Target = c } ->
> + { ForeignModulesAndExts = foreign_modules(Modules, DepsMap) }
> ;
> { ForeignModulesAndExts = [] }
> ),
> @@ -3423,6 +3457,13 @@
> ".dll", ForeignBasis, DepStream),
> io__write_string(DepStream, "\n"),
>
> + % The .os which contain the foreign_code.
> + io__write_string(DepStream, MakeVarName),
> + io__write_string(DepStream, ".foreign_os = "),
> + write_compact_dependencies_list(ForeignModules, "$(os_subdir)",
> + ".o", ForeignBasis, DepStream),
> + io__write_string(DepStream, "\n"),
> +
> io__write_string(DepStream, MakeVarName),
> io__write_string(DepStream, ".init_cs = "),
> write_compact_dependencies_list(Modules, "$(cs_subdir)", ".c",
> @@ -3471,6 +3512,7 @@
> write_compact_dependencies_list(Modules, "$(os_subdir)", ".$O",
> Basis, DepStream),
> write_extra_link_dependencies_list(ExtraLinkObjs, ".$O", DepStream),
> + io__write_string(DepStream, " $(short_example.foreign_os)"),
> io__write_string(DepStream, "\n"),
>
> io__write_string(DepStream, MakeVarName),
> @@ -4432,7 +4474,7 @@
>
> get_item_foreign_code(Globals, Item, Info0, Info) :-
> ( Item = pragma(Pragma) - Context ->
> - globals__get_backend_foreign_languages(Globals, BackendLangs),
> + globals__get_supported_foreign_languages(Globals, SupportedLangs),
> globals__get_target(Globals, Target),
>
> % The code here should match the way that mlds_to_gcc.m
> @@ -4445,7 +4487,7 @@
> % intermodule optimization.
> (
> Pragma = foreign_code(Lang, _),
> - list__member(Lang, BackendLangs)
> + list__member(Lang, SupportedLangs)
> ->
> Info = Info0 ^ used_foreign_languages :=
> set__insert(Info0 ^ used_foreign_languages, Lang)
> @@ -4466,7 +4508,7 @@
> )
> ;
> % is it one of the languages we support?
> - ( list__member(NewLang, BackendLangs) ->
> + ( list__member(NewLang, SupportedLangs) ->
> Info = Info0 ^ foreign_proc_languages
> ^ elem(Name) := NewLang
> ;
> @@ -4482,7 +4524,7 @@
> % we need to treat `pragma export' like the
> % other pragmas for foreign code.
> Pragma = export(_, _, _, _),
> - list__member(c, BackendLangs)
> + list__member(c, SupportedLangs)
> ->
> % XXX we assume lang = c for exports
> Lang = c,
> @@ -4495,7 +4537,7 @@
> % `:- pragma foreign_import_module'.
> Pragma = foreign_import_module(Lang, Import),
> Lang = c,
> - list__member(c, BackendLangs)
> + list__member(c, SupportedLangs)
> ->
> Info = Info0 ^ all_foreign_import_module_info :=
> [foreign_import_module(Lang, Import, Context) |
> Index: compiler/options.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
> retrieving revision 1.374
> diff -u -r1.374 options.m
> --- compiler/options.m 12 Jun 2002 14:26:50 -0000 1.374
> +++ compiler/options.m 13 Jun 2002 01:02:14 -0000
> @@ -259,8 +259,12 @@
> % (the values of these options are implied by the
> % settings of other options)
> % The foreign programming languages that this
> - % backend can interface to.
> + % backend can interface to directly.
> ; backend_foreign_languages
> + % The foreign programming languages that this
> + % backend can interface to directly or
> + % indirectly.
> + ; supported_foreign_languages
> % Stack layout information required to do
> % a stack trace.
> ; basic_stack_layout
> @@ -504,6 +508,10 @@
> ; dotnet_library_version
> ; support_ms_clr
>
> + % C++
> + ; cpp_compiler
> + ; cpp_flags
> +
> % Managed C++
> ; mcpp_compiler
> ; mcpp_flags
> @@ -810,6 +818,10 @@
> % The backend_foreign_languages option
> % depends on the target and is set in
> % handle_options.
> + supported_foreign_languages- accumulating([]),
> + % The supported_foreign_languages option
> + % depends on the target and is set in
> + % handle_options.
> basic_stack_layout - bool(no),
> agc_stack_layout - bool(no),
> procid_stack_layout - bool(no),
> @@ -1028,6 +1040,10 @@
> dotnet_library_version - string("1.0.3300.0"),
> support_ms_clr - bool(yes),
>
> +% C++
> + cpp_compiler - string("gcc"),
> + cpp_flags - accumulating([]),
> +
> % Managed C++
> mcpp_compiler - string("cl"),
> mcpp_flags - accumulating([]),
> @@ -1356,6 +1372,8 @@
> % internal use options
> long_option("backend-foreign-languages",
> backend_foreign_languages).
> +long_option("supported-foreign-languages",
> + supported_foreign_languages).
> long_option("agc-stack-layout", agc_stack_layout).
> long_option("basic-stack-layout", basic_stack_layout).
> long_option("procid-stack-layout", procid_stack_layout).
> @@ -1621,6 +1639,10 @@
>
> long_option("csharp-compiler", csharp_compiler).
> long_option("csharp-flags", csharp_flags).
> +
> +long_option("cpp-compiler", cpp_compiler).
> +long_option("cpp-flags", cpp_flags).
> +
>
> % link options
> long_option("output-file", output_file_name).
> Index: compiler/prog_io_pragma.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
> retrieving revision 1.50
> diff -u -r1.50 prog_io_pragma.m
> --- compiler/prog_io_pragma.m 7 May 2002 11:03:12 -0000 1.50
> +++ compiler/prog_io_pragma.m 12 Jun 2002 02:27:15 -0000
> @@ -1205,6 +1205,7 @@
>
> check_required_attributes(c, Attrs, _Term) = ok(Attrs).
> check_required_attributes(managed_cplusplus, Attrs, _Term) = ok(Attrs).
> +check_required_attributes(cplusplus, Attrs, _Term) = ok(Attrs).
> check_required_attributes(csharp, Attrs, _Term) = ok(Attrs).
> check_required_attributes(il, Attrs, Term) = Res :-
> ( [] = list__filter_map(
> Index: doc/user_guide.texi
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
> retrieving revision 1.314
> diff -u -r1.314 user_guide.texi
> --- doc/user_guide.texi 12 Jun 2002 14:26:55 -0000 1.314
> +++ doc/user_guide.texi 13 Jun 2002 01:02:25 -0000
> @@ -5821,6 +5821,18 @@
> Specify options to be passed to the C compiler.
>
> @sp 1
> + at item --cppflags @var{options}
> + at findex --cppflags
> + at cindex C++ compiler options
> +Specify options to be passed to the C++ compiler.
> +
> + at sp 1
> + at item --cpp-compiler @var{options}
> + at findex --cppflags
> + at cindex C++ compiler options
> +Specify which C++ compiler to use.
> +
> + at sp 1
> @item --javac @var{compiler-name}
> @item --java-compiler @var{compiler-name}
> @findex --javac
> Index: library/list.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/list.m,v
> retrieving revision 1.105
> diff -u -r1.105 list.m
> --- library/list.m 12 Mar 2002 16:33:23 -0000 1.105
> +++ library/list.m 12 Jun 2002 02:27:15 -0000
> @@ -1392,7 +1392,7 @@
> M = [H0|M1]
> ),
> list__filter_map(P, T0, L1, M1).
> -
> +
> list__takewhile(_, [], [], []).
> list__takewhile(P, [X|Xs], Ins, Outs) :-
> ( call(P, X) ->
> Index: scripts/Mmake.rules
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/scripts/Mmake.rules,v
> retrieving revision 1.125
> diff -u -r1.125 Mmake.rules
> --- scripts/Mmake.rules 10 Jun 2002 07:03:14 -0000 1.125
> +++ scripts/Mmake.rules 12 Jun 2002 02:27:15 -0000
> @@ -227,6 +227,22 @@
> endif
>
> # C back-end
> +#
> +
> +# C++ interface -- <module>__cpp_code.o should depend on <module>.c
> +# as generating the __cpp_code.cpp file is a side-effect of generating
> +# the .c file.
> +# XXX but this won't work with gcc backend -- it should depend on
> +# .s instead.
> +
> +$(os_subdir)%__cpp_code.$O : $(cs_subdir)%.c
> + $(MGNUC) $(ALL_GRADEFLAGS) $(ALL_MGNUCFLAGS) \
> + -c $(cs_subdir)$*__cpp_code.cpp $(OBJFILE_OPT)$@
> +
> +$(os_subdir)%__cpp_code.pic_o : $(cs_subdir)%.c
> + $(MGNUC) $(ALL_GRADEFLAGS) $(ALL_MGNUCFLAGS) $(CFLAGS_FOR_PIC) \
> + -c $(cs_subdir)$*__cpp_code.cpp $(OBJFILE_OPT)$@
> +
>
> # When smart recompilation finds that a module does not need to be
> # recompiled, it only touches the `.c_date' file.
>
--
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