mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 23:05:21 +00:00
62db25b371
Add a new foreign type assertion `word_aligned_pointer' that asserts the
necessary conditions for the compiler to use the direct argument functor
representation on constructors of a single argument of that foreign type.
The conditions on the values of the foreign type are
- the values must fit in a single word
- the values must be clear in the tag bits ("word-aligned")
The first condition is the same as that asserted by
`can_pass_as_mercury_type' so we let `word_aligned_pointer' imply
`can_pass_as_mercury_type'.
compiler/prog_data.m:
Add `foreign_type_word_aligned_pointer' option.
Wrap list(foreign_type_assertions) in a new type to dissuade
direct checks for individual list members.
compiler/prog_io_pragma.m:
Parse `word_aligned_pointer' as a foreign type assertion.
compiler/hlds_data.m:
Add predicates for checking foreign type assertions. The
implication word_aligned_pointer => can_pass_as_mercury_type is
implemented in a single place.
compiler/make_tags.m:
Take `word_aligned_pointer' assertions into consideration when
deciding if a constructor can use the direct argument functor
representation.
Clarify the code.
compiler/foreign.m:
compiler/llds.m:
compiler/llds_out_instr.m:
compiler/ml_foreign_proc_gen.m:
compiler/parse_tree_out.m:
compiler/type_ctor_info.m:
Conform to changes.
doc/reference_manual.texi:
Add documentation.
tests/hard_coded/Mmakefile:
tests/hard_coded/word_aligned_pointer.exp:
tests/hard_coded/word_aligned_pointer.m:
tests/hard_coded/word_aligned_pointer_2.m:
Add test case.
NEWS:
Announce change.
509 lines
18 KiB
Mathematica
509 lines
18 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.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_foreign.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% A type which is used to determine the string representation of a
|
|
% mercury type for various foreign languages.
|
|
%
|
|
:- type exported_type.
|
|
|
|
% Given a type which is not defined as a foreign type, get the
|
|
% exported_type representation of that type.
|
|
%
|
|
:- func non_foreign_type(mer_type) = exported_type.
|
|
|
|
% 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.
|
|
|
|
% Given an arbitary mercury type, get the exported_type representation
|
|
% of that type on the current backend.
|
|
%
|
|
:- func to_exported_type(module_info, mer_type) = exported_type.
|
|
|
|
% 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, unify_compare::out) is semidet.
|
|
|
|
% 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(unify_compare)::out,
|
|
foreign_type_assertions::out) is det.
|
|
|
|
% Given the exported_type representation for a type, determine
|
|
% whether or not it is a foreign type, and if yes, return the foreign
|
|
% type's assertions.
|
|
%
|
|
:- func is_foreign_type(exported_type) = maybe(foreign_type_assertions).
|
|
|
|
% Given a representation of 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(foreign_language, exported_type) = string.
|
|
:- func mercury_exported_type_to_string(module_info, foreign_language,
|
|
mer_type) = string.
|
|
|
|
% 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.
|
|
%
|
|
:- 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 libs.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
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($module, $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
|
|
; ForeignLanguage = lang_erlang
|
|
),
|
|
unimplemented_combination(TargetLanguage, ForeignLanguage)
|
|
)
|
|
;
|
|
TargetLanguage = lang_csharp,
|
|
(
|
|
ForeignLanguage = lang_csharp
|
|
;
|
|
( ForeignLanguage = lang_c
|
|
; ForeignLanguage = lang_java
|
|
; ForeignLanguage = lang_erlang
|
|
),
|
|
unimplemented_combination(TargetLanguage, ForeignLanguage)
|
|
)
|
|
;
|
|
TargetLanguage = lang_java,
|
|
(
|
|
ForeignLanguage = lang_java
|
|
;
|
|
( ForeignLanguage = lang_c
|
|
; ForeignLanguage = lang_csharp
|
|
; ForeignLanguage = lang_erlang
|
|
),
|
|
unimplemented_combination(TargetLanguage, ForeignLanguage)
|
|
)
|
|
;
|
|
TargetLanguage = lang_erlang,
|
|
(
|
|
ForeignLanguage = lang_erlang
|
|
;
|
|
( ForeignLanguage = lang_c
|
|
; ForeignLanguage = lang_csharp
|
|
; ForeignLanguage = lang_java
|
|
),
|
|
unimplemented_combination(TargetLanguage, ForeignLanguage)
|
|
)
|
|
).
|
|
|
|
:- pred unimplemented_combination(foreign_language::in, foreign_language::in)
|
|
is erroneous.
|
|
|
|
unimplemented_combination(Lang1, Lang2) :-
|
|
sorry($module, $pred, "unimplemented: calling "
|
|
++ foreign_language_string(Lang2) ++ " foreign code from "
|
|
++ foreign_language_string(Lang1)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
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 )
|
|
;
|
|
Target = target_erlang,
|
|
Have = ( if ForeignTypeBody ^ erlang = yes(_) then yes else no )
|
|
).
|
|
|
|
:- type exported_type
|
|
---> exported_type_foreign(sym_name, foreign_type_assertions)
|
|
% A type defined by a pragma foreign_type, and the assertions
|
|
% on that foreign_type.
|
|
|
|
; exported_type_mercury(mer_type).
|
|
% Any other mercury type.
|
|
|
|
non_foreign_type(Type) = exported_type_mercury(Type).
|
|
|
|
to_exported_type(ModuleInfo, Type) = ExportType :-
|
|
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),
|
|
ExportType = exported_type_foreign(ForeignTypeName, Assertions)
|
|
;
|
|
( TypeBody = hlds_du_type(_, _, _, _, _, _, _, _, _)
|
|
; TypeBody = hlds_eqv_type(_)
|
|
; TypeBody = hlds_solver_type(_, _)
|
|
; TypeBody = hlds_abstract_type(_)
|
|
),
|
|
ExportType = exported_type_mercury(Type)
|
|
)
|
|
else
|
|
ExportType = exported_type_mercury(Type)
|
|
).
|
|
|
|
foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo, Body,
|
|
UserEqComp) :-
|
|
foreign_type_body_to_exported_type(ModuleInfo, Body, _,
|
|
MaybeUserEqComp, _),
|
|
MaybeUserEqComp = yes(UserEqComp).
|
|
|
|
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, MaybeErlang),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_target(Globals, Target),
|
|
(
|
|
Target = target_c,
|
|
(
|
|
MaybeC = yes(Data),
|
|
Data = foreign_type_lang_data(c_type(NameStr), MaybeUserEqComp,
|
|
Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeC = no,
|
|
unexpected($module, $pred, "no C type")
|
|
)
|
|
;
|
|
Target = target_csharp,
|
|
(
|
|
MaybeCSharp = yes(Data),
|
|
Data = foreign_type_lang_data(csharp_type(NameStr),
|
|
MaybeUserEqComp, Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeCSharp = no,
|
|
unexpected($module, $pred, "no C# type")
|
|
)
|
|
;
|
|
Target = target_java,
|
|
(
|
|
MaybeJava = yes(Data),
|
|
Data = foreign_type_lang_data(java_type(NameStr), MaybeUserEqComp,
|
|
Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeJava = no,
|
|
unexpected($module, $pred, "no Java type")
|
|
)
|
|
;
|
|
Target = target_erlang,
|
|
(
|
|
MaybeErlang = yes(Data),
|
|
Data = foreign_type_lang_data(erlang_type, MaybeUserEqComp,
|
|
Assertions),
|
|
Name = unqualified("")
|
|
;
|
|
MaybeErlang = no,
|
|
unexpected($module, $pred, "no Erlang type")
|
|
)
|
|
).
|
|
|
|
is_foreign_type(exported_type_foreign(_, Assertions)) = yes(Assertions).
|
|
is_foreign_type(exported_type_mercury(_)) = no.
|
|
|
|
mercury_exported_type_to_string(ModuleInfo, Lang, Type) =
|
|
exported_type_to_string(Lang, to_exported_type(ModuleInfo, Type)).
|
|
|
|
exported_type_to_string(Lang, ExportedType) = Result :-
|
|
(
|
|
ExportedType = exported_type_foreign(ForeignType, _),
|
|
(
|
|
Lang = lang_c,
|
|
(
|
|
ForeignType = unqualified(Result0),
|
|
Result = Result0
|
|
;
|
|
ForeignType = qualified(_, _),
|
|
unexpected($module, $pred, "qualified C type")
|
|
)
|
|
;
|
|
( Lang = lang_csharp
|
|
; Lang = lang_java
|
|
; Lang = lang_erlang
|
|
),
|
|
Result = sym_name_to_string(ForeignType)
|
|
)
|
|
;
|
|
ExportedType = exported_type_mercury(Type),
|
|
(
|
|
Lang = lang_c,
|
|
% 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),
|
|
(
|
|
BuiltinType = builtin_type_int,
|
|
Result = "MR_Integer"
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
Result = "MR_Float"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
Result = "MR_String"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
Result = "MR_Char"
|
|
)
|
|
;
|
|
Type = tuple_type(_, _),
|
|
Result = "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(_, _, _)
|
|
),
|
|
Result = "MR_Word"
|
|
;
|
|
Type = type_variable(_, _),
|
|
Result = "MR_Word"
|
|
;
|
|
Type = kinded_type(_, _),
|
|
unexpected($module, $pred, "kinded type")
|
|
)
|
|
;
|
|
Lang = lang_csharp,
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
(
|
|
BuiltinType = builtin_type_int,
|
|
Result = "int"
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
Result = "double"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
Result = "string"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
Result = "char"
|
|
)
|
|
;
|
|
( 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.
|
|
Result = "object"
|
|
)
|
|
;
|
|
Lang = lang_java,
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
(
|
|
BuiltinType = builtin_type_int,
|
|
Result = "int"
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
Result = "double"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
Result = "java.lang.String"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
Result = "char"
|
|
)
|
|
;
|
|
( 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.
|
|
Result = "java.lang.Object"
|
|
)
|
|
;
|
|
Lang = lang_erlang,
|
|
sorry($module, $pred, "erlang")
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
decl_guard(ModuleName) = UppercaseModuleName ++ "_DECL_GUARD" :-
|
|
MangledModuleName = sym_name_mangle(ModuleName),
|
|
string.to_upper(MangledModuleName, UppercaseModuleName).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module backend_libs.foreign.
|
|
%-----------------------------------------------------------------------------%
|