mercury/compiler/prog_foreign.m

%-----------------------------------------------------------------------------%
% 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_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.
%-----------------------------------------------------------------------------%