mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 10:23:46 +00:00
9a9067171d
compiler/pred_name.m:
Add two more pred name transforms: one used by I/O tabling,
and one used by stm_expand.m.
Change the names we generate for I/O tabling to fit in with our schemes,
because we can (there is no part of the whole Mercury system that looks for
the names we *used* to construct.
Leave the names we generate for stm as they are, even though they also
do not fit into our scheme, because changing them would obsolete
the documentation (such as it is) in stm_expand.m.
Return the name of instance predicates as strings, rather than
as always-unqualified sym_names.
Return the name of instance predicates and uci (unify, compare and index)
predicates as strings, rather than as always-unqualified sym_names.
compiler/hlds_pred.m:
Change the interface of the pred_info_create predicate to put the
pred_or_func indication before the pred name. I did this originally
to flush out places that constructed predicate names without
going through pred_name.m. However, I also took the opportunity
to fix an old issue, which was that
- pred_info_create took in a sym_name to specify the name of the
new predicate, but
- it ignored the module name part of the sym_name, using a separately
passed module name instead.
This definitely violates the law of least astonishment.
I change the interface of both pred_info_create and pred_info_init
(which also had a similar issue, using the separately-passed module name
only if the sym_name specifying the name was unqualified) to require
their callers to decide the module name part of the name of the new pred,
and pass it alongside the name that it qualifies. The changes to do this
ended up being the bulk of the diff. (The define_new_pred predicate should
also have this treatment applied to it, but that would have made the diff
even larger.)
compiler/add_clause.m:
compiler/add_foreign_proc.m:
compiler/add_pragma_tabling.m:
compiler/add_pred.m:
Conform to the changes above. Use variable names that distinguish
raw names (strings) from sym_names.
Require the sym_names in item_clause_infos, item_pred_decl_infos,
item_mode_decl_infos, and various pragma_info_xyzs to be qualified.
The parsing predicates that generate them implicitly qualify them
if the name in the source code is unqualified.
Delete the code that generated an error message when handed an
item_pred_decl_info containing an unqualified sym_name. Due to
the implicit quantification mentioned above, this can't happen.
When adding foreign_procs to the HLDS, use the module name that
came with the foreign_proc (which could have been explicit or implicit),
*not* the name of the current module (which is what we used to use),
when generating error messages. This difference could make the error
message quite misleading. (We did not have a test case for this error
message.)
compiler/add_pragma_type_spec.m:
Conform to the changes above. Use variable names that distinguish
raw names (strings) from sym_names.
When adding adding type-specialized versions of predicates to the HLDS,
use the module name that was created in parse_pragma.m; do not override
it with the name of the module qualifier of the original predicate.
If parse_pragma.m did its job right, the two should always be the same.
compiler/add_special_pred.m:
Conform to the changes above.
Add an XXX for a questionable module qualifier we specify for a unify,
compare or index predicate.
compiler/higher_order.m:
Conform to the changes above.
Fix a variable version issue that caused progress messages to be
printed at an unexpected time.
compiler/structure_reuse.versions.m:
Conform to the changes above.
Simplify the too-complex structure of the code that constructs
predicate names.
compiler/accumulator.m:
compiler/check_typeclass.m:
compiler/dep_par_conj.m:
compiler/lambda.m:
compiler/par_loop_control.m:
compiler/stm_expand.m:
compiler/table_gen.m:
compiler/unused_args.m:
Conform to the changes above.
compiler/make_hlds_error.m:
Take the pred_or_func indicator before the predicate name.
Use variable names that distinguish raw names (strings) from sym_names.
compiler/parse_util.m:
Fix a missing undo of an nl_indent_delta.
compiler/foreign.m:
Add a note about a predicate, that as far I can tell has not done
anything useful for years, if not decades, is now unused. (This diff
comments out the only call to it, in add_foreign_proc.m.) The only
thing it *could* do was warn about a foreign_proc not being able
to be implemented for the current target language, but that test
in now done way earlier in the process, and foreign.m does not
get called in any situation in which the message would be relevant.
607 lines
21 KiB
Mathematica
607 lines
21 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2000-2011 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.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: foreign.m.
|
|
% Main authors: trd, dgj.
|
|
%
|
|
% This module defines predicates for interfacing with foreign languages.
|
|
% In particular, this module supports interfacing with languages
|
|
% other than the target of compilation.
|
|
%
|
|
% Parts of this code were originally written by dgj, and have since been moved
|
|
% here.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module backend_libs.foreign.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_foreign.
|
|
:- import_module parse_tree.prog_foreign.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type foreign_type_and_assertions
|
|
---> foreign_type_and_assertions(sym_name, foreign_type_assertions).
|
|
% A type defined by a pragma foreign_type, and the assertions
|
|
% on that foreign_type.
|
|
|
|
% Given an arbitrary mercury type, get the exported_type representation
|
|
% of that type on the current backend.
|
|
%
|
|
:- func is_this_a_foreign_type(module_info, mer_type)
|
|
= maybe(foreign_type_and_assertions).
|
|
|
|
% Given a type, determine the string which corresponds to that type
|
|
% in the specified foreign language, for use with foreign language
|
|
% interfacing (`pragma export' or `pragma foreign_proc').
|
|
%
|
|
:- func exported_type_to_string(module_info, foreign_language, mer_type)
|
|
= string.
|
|
:- func exported_type_to_c_string(module_info, mer_type) = string.
|
|
|
|
:- func maybe_foreign_type_to_string(foreign_language, mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
:- func maybe_foreign_type_to_c_string(mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
:- func foreign_type_to_c_string(foreign_type_and_assertions) = string.
|
|
:- func maybe_foreign_type_to_csharp_string(mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
:- func maybe_foreign_type_to_java_string(mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
|
|
:- func exported_builtin_type_to_c_string(builtin_type) = string.
|
|
:- func exported_builtin_type_to_csharp_string(builtin_type) = string.
|
|
:- func exported_builtin_type_to_java_string(builtin_type) = string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Find the current target backend from the module_info, and given
|
|
% a foreign_type_body, return the name of the foreign language type
|
|
% the identity of any user-defined unify/compare predicates, and the
|
|
% assertions applicable to that backend.
|
|
%
|
|
:- pred foreign_type_body_to_exported_type(module_info::in,
|
|
foreign_type_body::in, sym_name::out, maybe_canonical::out,
|
|
foreign_type_assertions::out) is det.
|
|
|
|
% Does the foreign_type_body contain a definition usable
|
|
% when compiling to the given target.
|
|
%
|
|
:- pred have_foreign_type_for_backend(compilation_target::in,
|
|
foreign_type_body::in, bool::out) is det.
|
|
|
|
% Does the implementation of the given foreign type body on
|
|
% the current backend use a user-defined comparison predicate.
|
|
%
|
|
:- pred foreign_type_body_has_user_defined_eq_comp_pred(module_info::in,
|
|
foreign_type_body::in, noncanonical::out) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Filter the decls for the given foreign language.
|
|
% The first return value is the list of matches, the second is
|
|
% the list of mis-matches.
|
|
%
|
|
:- pred filter_decls(foreign_language::in, list(foreign_decl_code)::in,
|
|
list(foreign_decl_code)::out, list(foreign_decl_code)::out) is det.
|
|
|
|
% Filter the bodys for the given foreign language.
|
|
% The first return value is the list of matches, the second is
|
|
% the list of mis-matches.
|
|
%
|
|
:- pred filter_bodys(foreign_language::in, list(foreign_body_code)::in,
|
|
list(foreign_body_code)::out, list(foreign_body_code)::out) is det.
|
|
|
|
% Filter the foreign exports for the given foreign language.
|
|
% The first return value is the list of matches, the second is
|
|
% the list of mis-matches.
|
|
%
|
|
:- pred filter_exports(foreign_language::in,
|
|
list(pragma_exported_proc)::in,
|
|
list(pragma_exported_proc)::out, list(pragma_exported_proc)::out)
|
|
is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given some foreign code, generate some suitable proxy code for
|
|
% calling the code via one of the given languages.
|
|
% This might mean, for example, generating a call to a
|
|
% forwarding function in C.
|
|
% The foreign language argument specifies which language is the
|
|
% target language, the other inputs are the name, types, input
|
|
% variables and so on for a piece of pragma foreign code.
|
|
% The outputs are the new attributes and implementation for this
|
|
% code.
|
|
% XXX This implementation is currently incomplete, so in future
|
|
% this interface may change.
|
|
% XXX As of 2022 feb 15, this predicate, which effectively does nothing,
|
|
% is unused.
|
|
%
|
|
:- pred extrude_pragma_implementation(list(foreign_language)::in,
|
|
list(pragma_var)::in, sym_name::in, pred_or_func::in, prog_context::in,
|
|
module_info::in, module_info::out,
|
|
pragma_foreign_proc_attributes::in, pragma_foreign_proc_attributes::out,
|
|
pragma_foreign_proc_impl::in, pragma_foreign_proc_impl::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The name of the #define which can be used to guard declarations with
|
|
% to prevent entities being declared twice.
|
|
%
|
|
:- func decl_guard(sym_name) = string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
is_this_a_foreign_type(ModuleInfo, Type) = MaybeForeignTypeAssertions :-
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
( if
|
|
type_to_ctor(Type, TypeCtor),
|
|
search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn)
|
|
then
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
(
|
|
TypeBody = hlds_foreign_type(ForeignTypeBody),
|
|
foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody,
|
|
ForeignTypeName, _, Assertions),
|
|
MaybeForeignTypeAssertions =
|
|
yes(foreign_type_and_assertions(ForeignTypeName, Assertions))
|
|
;
|
|
( TypeBody = hlds_du_type(_)
|
|
; TypeBody = hlds_eqv_type(_)
|
|
; TypeBody = hlds_solver_type(_)
|
|
; TypeBody = hlds_abstract_type(_)
|
|
),
|
|
MaybeForeignTypeAssertions = no
|
|
)
|
|
else
|
|
MaybeForeignTypeAssertions = no
|
|
).
|
|
|
|
exported_type_to_string(ModuleInfo, Lang, Type) = String :-
|
|
MaybeForeignType = is_this_a_foreign_type(ModuleInfo, Type),
|
|
String = maybe_foreign_type_to_string(Lang, Type, MaybeForeignType).
|
|
|
|
exported_type_to_c_string(ModuleInfo, Type) = String :-
|
|
MaybeForeignType = is_this_a_foreign_type(ModuleInfo, Type),
|
|
String = maybe_foreign_type_to_c_string(Type, MaybeForeignType).
|
|
|
|
maybe_foreign_type_to_string(Lang, Type, MaybeForeignType) = String :-
|
|
(
|
|
Lang = lang_c,
|
|
String = maybe_foreign_type_to_c_string(Type, MaybeForeignType)
|
|
;
|
|
Lang = lang_csharp,
|
|
String = maybe_foreign_type_to_csharp_string(Type, MaybeForeignType)
|
|
;
|
|
Lang = lang_java,
|
|
String = maybe_foreign_type_to_java_string(Type, MaybeForeignType)
|
|
).
|
|
|
|
maybe_foreign_type_to_c_string(Type, MaybeForeignType) = String :-
|
|
(
|
|
MaybeForeignType = yes(ForeignTypeAndAssertions),
|
|
String = foreign_type_to_c_string(ForeignTypeAndAssertions)
|
|
;
|
|
MaybeForeignType = no,
|
|
% With --high-level-code, the value we return here should agree
|
|
% with what happens is generated (indirectly) through
|
|
% mercury_type_to_mlds_type.
|
|
%
|
|
% XXX I don't think this is yet true in all cases. -zs
|
|
%
|
|
% It is possible that in some cases, the right type name may depend
|
|
% on whether --high-level-code is set.
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
String = exported_builtin_type_to_c_string(BuiltinType)
|
|
;
|
|
Type = tuple_type(_, _),
|
|
String = "MR_Tuple"
|
|
;
|
|
% XXX Is MR_Word the right thing for any of these kinds of
|
|
% types for high level code, with or without high level data?
|
|
( Type = defined_type(_, _, _)
|
|
; Type = higher_order_type(_, _, _, _, _)
|
|
; Type = apply_n_type(_, _, _)
|
|
),
|
|
String = "MR_Word"
|
|
;
|
|
Type = type_variable(_, _),
|
|
String = "MR_Word"
|
|
;
|
|
Type = kinded_type(_, _),
|
|
unexpected($pred, "kinded type")
|
|
)
|
|
).
|
|
|
|
foreign_type_to_c_string(ForeignTypeAndAssertions) = String :-
|
|
ForeignTypeAndAssertions = foreign_type_and_assertions(ForeignType, _),
|
|
(
|
|
ForeignType = unqualified(String)
|
|
;
|
|
ForeignType = qualified(_, _),
|
|
unexpected($pred, "qualified C type")
|
|
).
|
|
|
|
maybe_foreign_type_to_csharp_string(Type, MaybeForeignType) = String :-
|
|
(
|
|
MaybeForeignType = yes(foreign_type_and_assertions(ForeignType, _)),
|
|
String = sym_name_to_string(ForeignType)
|
|
;
|
|
MaybeForeignType = no,
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
String = exported_builtin_type_to_csharp_string(BuiltinType)
|
|
;
|
|
( Type = tuple_type(_, _)
|
|
; Type = defined_type(_, _, _)
|
|
; Type = higher_order_type(_, _, _, _, _)
|
|
; Type = apply_n_type(_, _, _)
|
|
; Type = type_variable(_, _)
|
|
; Type = kinded_type(_, _)
|
|
),
|
|
% This is here so we can share some code between C/C#/Java
|
|
% backends. This is not the correct type to use in general.
|
|
String = "object"
|
|
)
|
|
).
|
|
|
|
maybe_foreign_type_to_java_string(Type, MaybeForeignType) = String :-
|
|
(
|
|
MaybeForeignType = yes(foreign_type_and_assertions(ForeignType, _)),
|
|
String = sym_name_to_string(ForeignType)
|
|
;
|
|
MaybeForeignType = no,
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
String = exported_builtin_type_to_java_string(BuiltinType)
|
|
;
|
|
( Type = tuple_type(_, _)
|
|
; Type = defined_type(_, _, _)
|
|
; Type = higher_order_type(_, _, _, _, _)
|
|
; Type = apply_n_type(_, _, _)
|
|
; Type = type_variable(_, _)
|
|
; Type = kinded_type(_, _)
|
|
),
|
|
% This is here so we can share some code between C/C#/Java
|
|
% backends. This is not the correct type to use in general.
|
|
String = "java.lang.Object"
|
|
)
|
|
).
|
|
|
|
exported_builtin_type_to_c_string(BuiltinType) = CTypeName :-
|
|
(
|
|
BuiltinType = builtin_type_int(IntType),
|
|
(
|
|
IntType = int_type_int,
|
|
CTypeName = "MR_Integer"
|
|
;
|
|
IntType = int_type_uint,
|
|
CTypeName = "MR_Unsigned"
|
|
;
|
|
IntType = int_type_int8,
|
|
CTypeName = "int8_t"
|
|
;
|
|
IntType = int_type_uint8,
|
|
CTypeName = "uint8_t"
|
|
;
|
|
IntType = int_type_int16,
|
|
CTypeName = "int16_t"
|
|
;
|
|
IntType = int_type_uint16,
|
|
CTypeName = "uint16_t"
|
|
;
|
|
IntType = int_type_int32,
|
|
CTypeName = "int32_t"
|
|
;
|
|
IntType = int_type_uint32,
|
|
CTypeName = "uint32_t"
|
|
;
|
|
IntType = int_type_int64,
|
|
CTypeName = "int64_t"
|
|
;
|
|
IntType = int_type_uint64,
|
|
CTypeName = "uint64_t"
|
|
)
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
CTypeName = "MR_Float"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
CTypeName = "MR_String"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
CTypeName = "MR_Char"
|
|
).
|
|
|
|
exported_builtin_type_to_csharp_string(BuiltinType) = CsharpTypeName :-
|
|
(
|
|
BuiltinType = builtin_type_int(IntType),
|
|
(
|
|
IntType = int_type_int,
|
|
CsharpTypeName = "int"
|
|
;
|
|
IntType = int_type_uint,
|
|
CsharpTypeName = "uint"
|
|
;
|
|
IntType = int_type_int8,
|
|
CsharpTypeName = "sbyte"
|
|
;
|
|
IntType = int_type_uint8,
|
|
CsharpTypeName = "byte"
|
|
;
|
|
IntType = int_type_int16,
|
|
CsharpTypeName = "short"
|
|
;
|
|
IntType = int_type_uint16,
|
|
CsharpTypeName = "ushort"
|
|
;
|
|
IntType = int_type_int32,
|
|
CsharpTypeName = "int"
|
|
;
|
|
IntType = int_type_uint32,
|
|
CsharpTypeName = "uint"
|
|
;
|
|
IntType = int_type_int64,
|
|
CsharpTypeName = "long"
|
|
;
|
|
IntType = int_type_uint64,
|
|
CsharpTypeName = "ulong"
|
|
)
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
CsharpTypeName = "double"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
CsharpTypeName = "string"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
CsharpTypeName = "char"
|
|
).
|
|
|
|
exported_builtin_type_to_java_string(BuiltinType) = JavaTypeName :-
|
|
(
|
|
BuiltinType = builtin_type_int(IntType),
|
|
(
|
|
IntType = int_type_int,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType = int_type_uint,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType= int_type_int8,
|
|
JavaTypeName = "byte"
|
|
;
|
|
IntType = int_type_uint8,
|
|
JavaTypeName = "byte"
|
|
;
|
|
IntType = int_type_int16,
|
|
JavaTypeName = "short"
|
|
;
|
|
IntType = int_type_uint16,
|
|
JavaTypeName = "short"
|
|
;
|
|
IntType = int_type_int32,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType = int_type_uint32,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType = int_type_int64,
|
|
JavaTypeName = "long"
|
|
;
|
|
IntType = int_type_uint64,
|
|
JavaTypeName = "long"
|
|
)
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
JavaTypeName = "double"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
JavaTypeName = "java.lang.String"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
JavaTypeName = "char"
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name,
|
|
MaybeUserEqComp, Assertions) :-
|
|
% The body of this function is very similar to the function
|
|
% foreign_type_to_mlds_type in mlds.m.
|
|
% Any changes here may require changes there as well.
|
|
|
|
ForeignTypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_target(Globals, Target),
|
|
(
|
|
Target = target_c,
|
|
(
|
|
MaybeC = yes(Data),
|
|
Data = type_details_foreign(c_type(NameStr), MaybeUserEqComp,
|
|
Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeC = no,
|
|
unexpected($pred, "no C type")
|
|
)
|
|
;
|
|
Target = target_csharp,
|
|
(
|
|
MaybeCSharp = yes(Data),
|
|
Data = type_details_foreign(csharp_type(NameStr),
|
|
MaybeUserEqComp, Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeCSharp = no,
|
|
unexpected($pred, "no C# type")
|
|
)
|
|
;
|
|
Target = target_java,
|
|
(
|
|
MaybeJava = yes(Data),
|
|
Data = type_details_foreign(java_type(NameStr), MaybeUserEqComp,
|
|
Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeJava = no,
|
|
unexpected($pred, "no Java type")
|
|
)
|
|
).
|
|
|
|
have_foreign_type_for_backend(Target, ForeignTypeBody, Have) :-
|
|
(
|
|
Target = target_c,
|
|
Have = ( if ForeignTypeBody ^ c = yes(_) then yes else no )
|
|
;
|
|
Target = target_java,
|
|
Have = ( if ForeignTypeBody ^ java = yes(_) then yes else no )
|
|
;
|
|
Target = target_csharp,
|
|
Have = ( if ForeignTypeBody ^ csharp = yes(_) then yes else no )
|
|
).
|
|
|
|
foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo, Body,
|
|
NonCanonical) :-
|
|
foreign_type_body_to_exported_type(ModuleInfo, Body, _,
|
|
MaybeCanonical, _),
|
|
MaybeCanonical = noncanon(NonCanonical).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
filter_decls(WantedLang, Decls0, LangDecls, NotLangDecls) :-
|
|
IsWanted =
|
|
( pred(foreign_decl_code(Lang, _, _, _)::in) is semidet :-
|
|
WantedLang = Lang
|
|
),
|
|
list.filter(IsWanted, Decls0, LangDecls, NotLangDecls).
|
|
|
|
filter_bodys(WantedLang, Bodys0, LangBodys, NotLangBodys) :-
|
|
IsWanted =
|
|
( pred(foreign_body_code(Lang, _, _)::in) is semidet :-
|
|
WantedLang = Lang
|
|
),
|
|
list.filter(IsWanted, Bodys0, LangBodys, NotLangBodys).
|
|
|
|
filter_exports(WantedLang, Exports0, LangExports, NotLangExports) :-
|
|
IsWanted =
|
|
( pred(pragma_exported_proc(Lang, _, _, _, _)::in) is semidet :-
|
|
WantedLang = Lang
|
|
),
|
|
list.filter(IsWanted, Exports0, LangExports, NotLangExports).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
extrude_pragma_implementation([], _PragmaVars, _PredName, _PredOrFunc,
|
|
_Context, !ModuleInfo, !NewAttributes, !Impl) :-
|
|
unexpected($pred, "no suitable target languages available").
|
|
extrude_pragma_implementation([TargetLang | TargetLangs], _PragmaVars,
|
|
_PredName, _PredOrFunc, _Context, !ModuleInfo, !Attributes, !Impl) :-
|
|
% We just use the first target language for now, it might be nice
|
|
% to try a few others if the backend supports multiple ones.
|
|
ForeignLanguage = get_foreign_language(!.Attributes),
|
|
|
|
% If the foreign language is available as a target language,
|
|
% we don't need to do anything.
|
|
( if list.member(ForeignLanguage, [TargetLang | TargetLangs]) then
|
|
true
|
|
else
|
|
set_foreign_language(TargetLang, !Attributes),
|
|
extrude_pragma_implementation_2(TargetLang, ForeignLanguage,
|
|
!ModuleInfo, !Impl)
|
|
).
|
|
|
|
:- pred extrude_pragma_implementation_2(
|
|
foreign_language::in, foreign_language::in,
|
|
module_info::in, module_info::out,
|
|
pragma_foreign_proc_impl::in, pragma_foreign_proc_impl::out) is det.
|
|
|
|
extrude_pragma_implementation_2(TargetLanguage, ForeignLanguage,
|
|
!ModuleInfo, !Impl) :-
|
|
% 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.
|
|
(
|
|
TargetLanguage = lang_c,
|
|
(
|
|
ForeignLanguage = lang_c
|
|
;
|
|
( ForeignLanguage = lang_csharp
|
|
; ForeignLanguage = lang_java
|
|
),
|
|
unimplemented_combination(TargetLanguage, ForeignLanguage)
|
|
)
|
|
;
|
|
TargetLanguage = lang_csharp,
|
|
(
|
|
ForeignLanguage = lang_csharp
|
|
;
|
|
( ForeignLanguage = lang_c
|
|
; ForeignLanguage = lang_java
|
|
),
|
|
unimplemented_combination(TargetLanguage, ForeignLanguage)
|
|
)
|
|
;
|
|
TargetLanguage = lang_java,
|
|
(
|
|
ForeignLanguage = lang_java
|
|
;
|
|
( ForeignLanguage = lang_c
|
|
; ForeignLanguage = lang_csharp
|
|
),
|
|
unimplemented_combination(TargetLanguage, ForeignLanguage)
|
|
)
|
|
).
|
|
|
|
:- pred unimplemented_combination(foreign_language::in, foreign_language::in)
|
|
is erroneous.
|
|
|
|
unimplemented_combination(Lang1, Lang2) :-
|
|
sorry($pred, "unimplemented: calling "
|
|
++ foreign_language_string(Lang2) ++ " foreign code from "
|
|
++ foreign_language_string(Lang1)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
decl_guard(ModuleName) = UppercaseModuleName ++ "_DECL_GUARD" :-
|
|
MangledModuleName = sym_name_mangle(ModuleName),
|
|
string.to_upper(MangledModuleName, UppercaseModuleName).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module backend_libs.foreign.
|
|
%-----------------------------------------------------------------------------%
|