mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 13:23:53 +00:00
8a28e40c9b
Estimated hours taken: 2 Branches: main Add the predicates sorry, unexpected and expect to library/error.m. compiler/compiler_util.m: library/error.m: Move the predicates sorry, unexpected and expect from compiler_util to error. Put the predicates in error.m into the same order as their declarations. compiler/*.m: Change imports as needed. compiler/lp.m: compiler/lp_rational.m: Change imports as needed, and some minor cleanups. deep_profiler/*.m: Switch to using the new library predicates, instead of calling error directly. Some other minor cleanups. NEWS: Mention the new predicates in the standard library.
487 lines
17 KiB
Mathematica
487 lines
17 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% 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.
|
|
%-----------------------------------------------------------------------------%
|