%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 2000-2008, 2010 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. %-----------------------------------------------------------------------------% % % This module defines predicate for interfacing with foreign languages. % that are necessary for the frontend of the compiler to construct % the list of items. The predicates in this module should not depend % on the HLDS in any way. The predicates for interfacing with foreign % languages that do depend on the HLDS are defined in foreign.m. % % This module also contains the parts of the name mangler that are used % by the frontend of the compiler. % % Warning: any changes to the name mangling algorithms implemented in this % module may also require changes to profiler/demangle.m, util/mdemangle.c and % compiler/name_mangle.m. % % Main authors: trd, dgj. % This code was originally part of the foreign module and was moved here. % %-----------------------------------------------------------------------------% :- module parse_tree.prog_foreign. :- interface. :- import_module libs. :- import_module libs.globals. :- import_module parse_tree.prog_data. :- import_module mdbcomp.prim_data. :- import_module bool. :- import_module list. :- import_module term. %-----------------------------------------------------------------------------% :- type foreign_decl_info == list(foreign_decl_code). % in reverse order :- type foreign_body_info == list(foreign_body_code). % in reverse order :- type foreign_decl_code ---> foreign_decl_code( fdecl_lang :: foreign_language, fdecl_is_local :: foreign_decl_is_local, fdecl_code :: string, fdecl_context :: prog_context ). :- type foreign_body_code ---> foreign_body_code( fbody_lang :: foreign_language, fbody_code :: string, fbody_context :: prog_context ). :- type foreign_export_defns == list(foreign_export). :- type foreign_export_decls ---> foreign_export_decls( fexp_decls_info :: foreign_decl_info, fexp_decls_list :: list(foreign_export_decl) ). :- type foreign_export_decl ---> foreign_export_decl( fexp_decl_lang :: foreign_language, % Language of the export. fexp_decl_ret_type :: string, % Return type. fexp_decl_func_name :: string, % Function name. fexp_decl_arg_decls :: string % Argument declarations. ). % Some code from a `pragma foreign_code' declaration that is not % associated with a given procedure. % :- type user_foreign_code ---> user_foreign_code( foreign_language, % language of this code string, % code term.context % source code location ). % The code for `pragma foreign_export' is generated directly as strings % by export.m. % :- type foreign_export == string. %-----------------------------------------------------------------------------% % foreign_import_module_name(ForeignImport) % % returns the module name which represents the ForeignImport. % % For instance for the foreign_import_module representing % :- foreign_import_module("C#", module) % would return the module_name % unqualified("module__csharp_code") % :- func foreign_import_module_name(foreign_import_module_info) = module_name. % foreign_import_module_name_from_module(ForeignImport, CurrentModule) % % returns the module name needed to refer to ForeignImport from the % CurrentModule. % :- func foreign_import_module_name_from_module(foreign_import_module_info, module_name) = module_name. % Sub-type of foreign_language for languages for which % we generate external files for foreign code. % :- inst lang_gen_ext_file ---> lang_c ; lang_csharp. % The module name used for this foreign language. % Not all foreign languages generate external modules % so this function only succeeds for those that do. % :- func foreign_language_module_name(module_name, foreign_language) = module_name. :- mode foreign_language_module_name(in, in) = out is semidet. :- mode foreign_language_module_name(in, in(lang_gen_ext_file)) = out is det. % The file extension used for this foreign language (including the dot). % Not all foreign languages generate external files, % so this function only succeeds for those that do. % :- func foreign_language_file_extension(foreign_language) = string. :- mode foreign_language_file_extension(in) = out is semidet. :- mode foreign_language_file_extension(in(lang_gen_ext_file)) = out is det. % It is possible that more than one foreign language could be used to % implement a particular piece of code. % Therefore, foreign languages have an order of preference, from most % preferred to least perferred. % prefer_foreign_language(Globals, Target, Lang1, Lang2) returns the % yes if Lang2 is preferred over Lang1. % % Otherwise it will return no. % :- func prefer_foreign_language(globals, compilation_target, foreign_language, foreign_language) = bool. % Return all supported foreign languages. % :- func all_foreign_languages = list(foreign_language). :- func foreign_type_language(foreign_language_type) = foreign_language. %-----------------------------------------------------------------------------% % % The following are the parts of the name mangler that are needed by % the compiler frontend so that it can write out makefile fragments. % Returns the name of the initialization function for a given module. % :- func make_init_name(module_name) = string. % Mangle a possibly module-qualified Mercury symbol name % into a C identifier. % :- func sym_name_mangle(sym_name) = string. % Mangle an arbitrary name into a C etc identifier. % Initial digits are allowed. % :- func name_mangle(string) = string. % Mangle an arbitrary name into a C etc identifier. % The resulting identifier will not begin with a digit. % :- func name_mangle_no_leading_digit(string) = string. % Produces a string of the form Module__Name. % :- func qualify_name(string, string) = string. :- func convert_to_valid_c_identifier(string) = string. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module parse_tree.file_names. :- import_module char. :- import_module int. :- import_module solutions. :- import_module string. %-----------------------------------------------------------------------------% foreign_import_module_name(ImportModule) = ModuleName :- ImportModule = foreign_import_module_info(Lang, ForeignImportModule, _), ( Lang = lang_c, ModuleName = ForeignImportModule ; Lang = lang_il, ModuleName = ForeignImportModule ; Lang = lang_java, ModuleName = ForeignImportModule ; Lang = lang_erlang, ModuleName = ForeignImportModule ; Lang = lang_csharp, ModuleName = foreign_language_module_name(ForeignImportModule, Lang) ). foreign_import_module_name_from_module(ModuleForeignImported, CurrentModule) = ImportedForeignCodeModuleName :- ModuleForeignImported = foreign_import_module_info(Lang, _, _), ImportedForeignCodeModuleName1 = ModuleForeignImported ^ foreign_import_module_name, ( Lang = lang_c, ImportedForeignCodeModuleName = ImportedForeignCodeModuleName1 ; Lang = lang_il, ImportedForeignCodeModuleName = handle_std_library(CurrentModule, ImportedForeignCodeModuleName1) ; Lang = lang_csharp, ImportedForeignCodeModuleName = handle_std_library(CurrentModule, ImportedForeignCodeModuleName1) ; Lang = lang_java, ImportedForeignCodeModuleName = handle_std_library(CurrentModule, ImportedForeignCodeModuleName1) ; Lang = lang_erlang, ImportedForeignCodeModuleName = handle_std_library(CurrentModule, ImportedForeignCodeModuleName1) ). % On the il backend, we need to refer to the module "mercury" when % referencing a std library module when we are not actually building % the std library. % :- func handle_std_library(module_name, module_name) = module_name. handle_std_library(CurrentModule, ModuleName0) = ModuleName :- ( mercury_std_library_module_name(ModuleName0), \+ mercury_std_library_module_name(CurrentModule) -> ModuleName = unqualified("mercury") ; ModuleName = ModuleName0 ). %-----------------------------------------------------------------------------% foreign_language_module_name(ModuleName, Lang) = FullyQualifiedModuleName :- % Only succeed if this language generates external files. _ = foreign_language_file_extension(Lang), Ending = "__" ++ simple_foreign_language_string(Lang) ++ "_code", ( ModuleName = unqualified(Name), FullyQualifiedModuleName = unqualified(Name ++ Ending) ; ModuleName = qualified(Module, Name), FullyQualifiedModuleName = qualified(Module, Name ++ Ending) ). %-----------------------------------------------------------------------------% foreign_language_file_extension(lang_c) = ".c". foreign_language_file_extension(lang_csharp) = ".cs". foreign_language_file_extension(lang_java) = ".java". foreign_language_file_extension(lang_il) = _ :- fail. %-----------------------------------------------------------------------------% % Currently we don't use the globals to compare foreign language % interfaces, but if we added appropriate options we might want % to do this later. % prefer_foreign_language(_Globals, target_c, Lang1, Lang2) = % When compiling to C, C is always preferred over any other language. ( Lang2 = lang_c, not Lang1 = lang_c -> yes ; no ). prefer_foreign_language(_Globals, target_asm, Lang1, Lang2) = % When compiling to asm, C is always preferred over any other language. ( Lang2 = lang_c, not Lang1 = lang_c -> yes ; no ). prefer_foreign_language(_Globals, target_il, Lang1, Lang2) = Comp :- % When compiling to il, first we prefer il, then csharp. % After that we don't care. PreferredList = [lang_il, lang_csharp], FindLangPriority = (func(L) = X :- ( list.nth_member_search(PreferredList, L, X0) -> X = X0 ; X = list.length(PreferredList) + 1 )), N1 = FindLangPriority(Lang1), N2 = FindLangPriority(Lang2), ( N2 < N1 -> Comp = yes ; Comp = no ). prefer_foreign_language(_Globals, target_csharp, _Lang1, _Lang2) = no. prefer_foreign_language(_Globals, target_java, _Lang1, _Lang2) = no. % Nothing useful to do here, but when we add Java as a foreign language, % we should add it here. prefer_foreign_language(_Globals, target_x86_64, Lang1, Lang2) = % When compiling to x86_64 assembler, C is always preferred over any % other language. ( Lang2 = lang_c, not Lang1 = lang_c -> yes ; no ). prefer_foreign_language(_Globals, target_erlang, _Lang1, _Lang2) = no. % Nothing useful to do here, but when we add Erlang as a foreign language, % we should add it here. %-----------------------------------------------------------------------------% all_foreign_languages = Langs :- GetLangs = (pred(Lang::out) is multi :- valid_foreign_language(Lang)), solutions(GetLangs, Langs). :- pred valid_foreign_language(foreign_language). :- mode valid_foreign_language(in) is det. :- mode valid_foreign_language(out) is multi. valid_foreign_language(lang_c). valid_foreign_language(lang_java). valid_foreign_language(lang_csharp). valid_foreign_language(lang_il). valid_foreign_language(lang_erlang). %-----------------------------------------------------------------------------% foreign_type_language(il(_)) = lang_il. foreign_type_language(c(_)) = lang_c. foreign_type_language(java(_)) = lang_java. foreign_type_language(csharp(_)) = lang_csharp. foreign_type_language(erlang(_)) = lang_erlang. %-----------------------------------------------------------------------------% make_init_name(ModuleName) = InitName :- MangledModuleName = sym_name_mangle(ModuleName), InitName = "mercury__" ++ MangledModuleName ++ "__". sym_name_mangle(unqualified(Name)) = name_mangle(Name). sym_name_mangle(qualified(ModuleName, PlainName)) = MangledName :- MangledModuleName = sym_name_mangle(ModuleName), MangledPlainName = name_mangle(PlainName), MangledName = qualify_name(MangledModuleName, MangledPlainName). name_mangle(Name) = name_mangle_2(yes, Name). name_mangle_no_leading_digit(Name) = name_mangle_2(no, Name). :- func name_mangle_2(bool, string) = string. name_mangle_2(AllowLeadingDigit, Name) = MangledName :- % Warning: any changes to the name mangling algorithm here may also % require changes to profiler/demangle.m, util/mdemangle.c, % compiler/name_mangle.m and library/rtti_implementation.m. ( string.is_all_alnum_or_underscore(Name), ( AllowLeadingDigit = yes ; AllowLeadingDigit = no, % If the mangled name may be used at the start of a symbol then % leading digits are invalid. string.index(Name, 0, FirstChar), not char.is_digit(FirstChar) ) -> % Any names that start with `f_' are changed so that they start with % `f__', so that we can use names starting with `f_' (followed by % anything except an underscore) without fear of name collisions. ( string.append("f_", Suffix, Name) -> MangledName = "f__" ++ Suffix ; MangledName = Name ) ; MangledName = convert_to_valid_c_identifier(Name) ). qualify_name(Module0, Name0) = Name :- string.append_list([Module0, "__", Name0], Name). convert_to_valid_c_identifier(String) = Name :- ( name_conversion_table(String, Name0) -> Name = Name0 ; Name = "f" ++ convert_to_valid_c_identifier_2(String) ). % A table used to convert Mercury functors into C identifiers. % Feel free to add any new translations you want. The C identifiers % should start with "f_", to avoid introducing name clashes. If the functor % name is not found in the table, then we use a fall-back method which % produces ugly names. % % Additions to this table should be reflected in rtti_implementation.m, % in the ML_name_mangle() method. % :- pred name_conversion_table(string::in, string::out) is semidet. name_conversion_table("\\=", "f_not_equal"). name_conversion_table(">=", "f_greater_or_equal"). name_conversion_table("=<", "f_less_or_equal"). name_conversion_table("=", "f_equal"). name_conversion_table("<", "f_less_than"). name_conversion_table(">", "f_greater_than"). name_conversion_table("-", "f_minus"). name_conversion_table("+", "f_plus"). name_conversion_table("*", "f_times"). name_conversion_table("/", "f_slash"). name_conversion_table(",", "f_comma"). name_conversion_table(";", "f_semicolon"). name_conversion_table("!", "f_cut"). name_conversion_table("{}", "f_tuple"). name_conversion_table("[|]", "f_cons"). name_conversion_table("[]", "f_nil"). % This is the fall-back method. Given a string, produce a C identifier % for that string by concatenating the decimal expansions of the character % codes in the string, separated by underlines. The C identifier will % start with "f_"; this predicate constructs everything except the initial % "f". % % For example, given the input "\n\t" we return "_10_8". % :- func convert_to_valid_c_identifier_2(string) = string. convert_to_valid_c_identifier_2(String) = Name :- ( string.first_char(String, Char, Rest) -> % XXX This will cause ABI incompatibilities between compilers which are % built in grades that have different character representations. char.to_int(Char, Code), string.int_to_string(Code, CodeString), string.append("_", CodeString, ThisCharString), Name0 = convert_to_valid_c_identifier_2(Rest), string.append(ThisCharString, Name0, Name) ; % String is the empty string Name = String ). %-----------------------------------------------------------------------------% :- end_module prog_foreign. %-----------------------------------------------------------------------------%