mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-18 15:26:31 +00:00
31476884e7
Branches: main
In generated Java code, split initialisation of data definitions into small
methods which are called in turn from static initialisation blocks.
Initialisations at the class level are concatenated by the Java compiler into
one method, and when there is a lot of data the method can exceed the maximum
size limit.
compiler/mlds_to_java.m:
As above.
Delete the name field from `func_info'; it was never used.
compiler/make.util.m:
Unrelated: add foreign type stub.
4619 lines
166 KiB
Mathematica
4619 lines
166 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2000-2009 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: mlds_to_java.m.
|
|
% Main authors: juliensf, mjwybrow, fjh, wangp.
|
|
%
|
|
% Convert MLDS to Java code.
|
|
%
|
|
% DONE:
|
|
% det and semidet predicates
|
|
% multiple output arguments
|
|
% boxing and unboxing
|
|
% conjunctions
|
|
% disjunctions
|
|
% if-then-else's
|
|
% enumerations
|
|
% discriminated unions
|
|
% higher order functions
|
|
% multidet and nondet predicates
|
|
% test tests/benchmarks/*.m
|
|
% generate optimized tailcalls
|
|
% RTTI generation
|
|
% handle foreign code written in Java
|
|
% Support for Java in mmc --make
|
|
% Support for nested modules
|
|
%
|
|
% TODO:
|
|
% - Support nested modules
|
|
% (The problem with current code generation scheme for nested
|
|
% modules is that Java does not allow the name of a class to
|
|
% be the same as the name of its enclosing package.
|
|
% That should work now, but javac doesn't like the filenames
|
|
% we give for submodules.)
|
|
%
|
|
% - Support for Java in Mmake.
|
|
%
|
|
% - Generate names of classes etc. correctly (mostly same as IL backend)
|
|
%
|
|
% - General code cleanup
|
|
%
|
|
% - handle static ground terms(?)
|
|
%
|
|
% - support foreign_import_module for Java
|
|
%
|
|
% - handle foreign code written in C
|
|
%
|
|
% NOTES:
|
|
% To avoid namespace conflicts all Java names must be fully qualified,
|
|
% e.g. The classname `String' must be qualified as `java.lang.String'
|
|
% to avoid conflicting with `mercury.String'.
|
|
%
|
|
% There is currently some code threaded through the output predicates (usually
|
|
% a variable called `ExitMethods') which keeps track of, and removes
|
|
% unreachable code. Ideally this would be done as an MLDS->MLDS transformation,
|
|
% preferably in a separate module. Unfortunately this is not possible
|
|
% due to the fact that the back-end generates `break' statements for cases
|
|
% in switches as they are output, meaning that we can't remove them in
|
|
% a pass over the MLDS.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module ml_backend.mlds_to_java.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module ml_backend.mlds.
|
|
|
|
:- import_module io.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_java_mlds(module_info::in, mlds::in, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
% XXX needed for c_util.output_quoted_string,
|
|
% c_util.output_quoted_multi_string, and
|
|
% c_util.make_float_literal.
|
|
:- import_module backend_libs.builtin_ops.
|
|
:- import_module backend_libs.c_util.
|
|
:- import_module backend_libs.rtti.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.hlds_pred. % for pred_proc_id.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module libs.file_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module ml_backend.java_util.
|
|
:- import_module ml_backend.ml_code_util. % for ml_gen_local_var_decl_flags.
|
|
:- import_module ml_backend.ml_global_data.
|
|
:- import_module ml_backend.ml_type_gen. % for ml_gen_type_name
|
|
:- import_module ml_backend.ml_util.
|
|
:- import_module ml_backend.mlds.
|
|
:- import_module ml_backend.rtti_to_mlds.
|
|
:- import_module parse_tree.builtin_lib_types.
|
|
:- import_module parse_tree.file_names. % for mercury_std_library_name.
|
|
:- import_module parse_tree.java_names.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_foreign.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module char.
|
|
:- import_module int.
|
|
:- import_module library.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module multi_map.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module svmap.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
output_java_mlds(ModuleInfo, MLDS, !IO) :-
|
|
% Note that the Java file name that we use for modules in the
|
|
% Mercury standard library do not include a "mercury." prefix;
|
|
% that's why we don't call mercury_module_name_to_mlds here.
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
ModuleName = mlds_get_module_name(MLDS),
|
|
module_name_to_file_name(Globals, ModuleName, ".java", do_create_dirs,
|
|
JavaSourceFile, !IO),
|
|
Indent = 0,
|
|
output_to_file(Globals, JavaSourceFile,
|
|
output_java_src_file(ModuleInfo, Indent, MLDS), !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Utility predicates for various purposes.
|
|
%
|
|
|
|
% Succeeds iff this definition is a data definition which defines RTTI.
|
|
%
|
|
:- pred defn_is_rtti_data(mlds_defn::in) is semidet.
|
|
|
|
defn_is_rtti_data(Defn) :-
|
|
Defn = mlds_defn(_Name, _Context, _Flags, Body),
|
|
Body = mlds_data(Type, _, _),
|
|
Type = mlds_rtti_type(_).
|
|
|
|
% Succeeds iff this definition is a data definition.
|
|
%
|
|
:- pred defn_is_data(mlds_defn::in) is semidet.
|
|
|
|
defn_is_data(Defn) :-
|
|
Defn = mlds_defn(_Name, _Context, _Flags, Body),
|
|
Body = mlds_data(_, _, _).
|
|
|
|
% Succeeds iff this type is a enumeration.
|
|
%
|
|
:- pred type_is_enum(mlds_type::in) is semidet.
|
|
|
|
type_is_enum(Type) :-
|
|
Type = mercury_type(_, Builtin, _),
|
|
Builtin = ctor_cat_enum(_).
|
|
|
|
% Succeeds iff this type is something that the Java backend will represent
|
|
% as an object i.e. something created using the new operator.
|
|
%
|
|
:- pred type_is_object(mlds_type::in) is semidet.
|
|
|
|
type_is_object(Type) :-
|
|
Type = mercury_type(_, CtorCat, _),
|
|
type_category_is_object(CtorCat) = yes.
|
|
|
|
:- func type_category_is_object(type_ctor_category) = bool.
|
|
|
|
type_category_is_object(CtorCat) = IsObject :-
|
|
(
|
|
( CtorCat = ctor_cat_builtin(_)
|
|
; CtorCat = ctor_cat_higher_order
|
|
; CtorCat = ctor_cat_tuple
|
|
; CtorCat = ctor_cat_void
|
|
),
|
|
IsObject = no
|
|
;
|
|
( CtorCat = ctor_cat_enum(_)
|
|
; CtorCat = ctor_cat_builtin_dummy
|
|
; CtorCat = ctor_cat_variable
|
|
; CtorCat = ctor_cat_system(_)
|
|
; CtorCat = ctor_cat_user(_)
|
|
),
|
|
IsObject = yes
|
|
).
|
|
|
|
% Given an lval, return its type.
|
|
%
|
|
:- func mlds_lval_type(mlds_lval) = mlds_type.
|
|
|
|
mlds_lval_type(ml_var(_, VarType)) = VarType.
|
|
mlds_lval_type(ml_field(_, _, _, FieldType, _)) = FieldType.
|
|
mlds_lval_type(ml_mem_ref(_, PtrType)) =
|
|
( PtrType = mlds_ptr_type(Type) ->
|
|
Type
|
|
;
|
|
unexpected(this_file, "mlds_lval_type: mem_ref of non-pointer")
|
|
).
|
|
mlds_lval_type(ml_global_var_ref(_)) = _ :-
|
|
sorry(this_file, "mlds_lval_type: global_var_ref NYI").
|
|
|
|
% Succeeds iff the Rval represents an enumeration object in the Java
|
|
% backend. We need to check both Rvals that are variables and Rvals
|
|
% that are casts. We need to know this in order to append the field name
|
|
% to the object so we can access the value of the enumeration object.
|
|
%
|
|
:- pred rval_is_enum_object(mlds_rval::in) is semidet.
|
|
|
|
rval_is_enum_object(Rval) :-
|
|
Rval = ml_lval(Lval),
|
|
(
|
|
Lval = ml_var(_, VarType),
|
|
type_is_enum(VarType)
|
|
;
|
|
Lval = ml_field(_, _, _, FieldType, _),
|
|
type_is_enum(FieldType)
|
|
).
|
|
|
|
% Succeeds iff a given string matches the unqualified interface name
|
|
% of a interface in Mercury's Java runtime system.
|
|
%
|
|
:- pred interface_is_special(string::in) is semidet.
|
|
|
|
interface_is_special("MercuryType").
|
|
interface_is_special("MethodPtr").
|
|
interface_is_special("MethodPtr1").
|
|
interface_is_special("MethodPtr2").
|
|
interface_is_special("MethodPtr3").
|
|
interface_is_special("MethodPtr4").
|
|
interface_is_special("MethodPtr5").
|
|
interface_is_special("MethodPtr6").
|
|
interface_is_special("MethodPtr7").
|
|
interface_is_special("MethodPtr8").
|
|
interface_is_special("MethodPtr9").
|
|
interface_is_special("MethodPtr10").
|
|
interface_is_special("MethodPtr11").
|
|
interface_is_special("MethodPtr12").
|
|
interface_is_special("MethodPtr13").
|
|
interface_is_special("MethodPtr14").
|
|
interface_is_special("MethodPtr15").
|
|
interface_is_special("MethodPtrN").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to mangle names, enforce Java code conventions regarding class names
|
|
% etc.
|
|
% XXX None of this stuff works as it should. The idea is that class
|
|
% names should start with an uppercase letter, while method names and
|
|
% package specifiers should start with a lowercase letter.
|
|
% The current implementation of the MLDS makes this rather harder to achieve
|
|
% than it might initially seem. The current position is that coding
|
|
% conventions are only enforced on library modules.
|
|
% This is needed as Java compilers don't take too well to compiling
|
|
% classes named `char',`int', `float' etc.
|
|
% XXX It might be nice if the name mangling code was taken out of which
|
|
% ever LLDS module it's hiding in and put in a separate one.
|
|
%
|
|
|
|
% XXX This won't work if we start using the Java coding conventions
|
|
% for all names. At the moment it only affects library modules.
|
|
%
|
|
:- pred enforce_java_names(string::in, string::out) is det.
|
|
|
|
enforce_java_names(Name, JavaName) :-
|
|
% If the Name contains one or more dots (`.'), then capitalize
|
|
% the first letter after the last dot.
|
|
reverse_string(Name, RevName),
|
|
( string.sub_string_search(RevName, ".", Pos) ->
|
|
string.split(RevName, Pos, Head0, Tail0),
|
|
reverse_string(Tail0, Tail),
|
|
reverse_string(Head0, Head1),
|
|
string.capitalize_first(Head1, Head),
|
|
string.append(Tail, Head, JavaName)
|
|
;
|
|
JavaName = Name
|
|
).
|
|
|
|
:- pred reverse_string(string::in, string::out) is det.
|
|
|
|
reverse_string(String0, String) :-
|
|
string.to_char_list(String0, String1),
|
|
string.from_rev_char_list(String1, String).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output imports.
|
|
%
|
|
|
|
:- pred output_imports(mlds_imports::in, io::di, io::uo) is det.
|
|
|
|
output_imports(Imports, !IO) :-
|
|
list.foldl(output_import, Imports, !IO).
|
|
|
|
:- pred output_import(mlds_import::in, io::di, io::uo) is det.
|
|
|
|
output_import(Import, !IO) :-
|
|
(
|
|
Import = mercury_import(ImportType, ImportName),
|
|
(
|
|
ImportType = user_visible_interface,
|
|
unexpected(this_file,
|
|
"import_type `user_visible_interface' in Java backend")
|
|
;
|
|
ImportType = compiler_visible_interface
|
|
)
|
|
;
|
|
Import = foreign_import(_),
|
|
unexpected(this_file, "foreign import in Java backend")
|
|
),
|
|
SymName = mlds_module_name_to_sym_name(ImportName),
|
|
mangle_sym_name_for_java(SymName, module_qual, "__", ClassFile),
|
|
% There are issues related to using import statements and Java's naming
|
|
% conventions. To avoid these problems, we output dependencies as comments
|
|
% only. This is ok, since we always use fully qualified names anyway.
|
|
io.write_strings(["// import ", ClassFile, ";\n"], !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to generate the `.java' file.
|
|
%
|
|
|
|
:- pred output_java_src_file(module_info::in, indent::in, mlds::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
|
|
% Run further transformations on the MLDS.
|
|
MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, Defns0,
|
|
InitPreds, FinalPreds, ExportedEnums),
|
|
ml_global_data_get_all_global_defns(GlobalData,
|
|
ScalarCellGroupMap, VectorCellGroupMap, GlobalDefns),
|
|
expect(map.is_empty(ScalarCellGroupMap), this_file,
|
|
"output_java_src_file: nonempty ScalarCellGroupMap"),
|
|
expect(map.is_empty(VectorCellGroupMap), this_file,
|
|
"output_java_src_file: nonempty VectorCellGroupMap"),
|
|
|
|
% Do NOT enforce the outermost "mercury" qualifier here. This module
|
|
% name is compared with other module names in the MLDS, to avoid
|
|
% unnecessary module qualification.
|
|
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
|
|
|
|
% Find and build list of all methods which would have their addresses
|
|
% taken to be used as a function pointer.
|
|
find_pointer_addressed_methods(GlobalDefns, [], CodeAddrs0),
|
|
find_pointer_addressed_methods(Defns0, CodeAddrs0, CodeAddrs),
|
|
make_code_addr_map(CodeAddrs, multi_map.init, CodeAddrsMap),
|
|
map.to_assoc_list(CodeAddrsMap, CodeAddrsAssocList),
|
|
|
|
% Create wrappers in MLDS for all pointer addressed methods.
|
|
list.map_foldl(generate_addr_wrapper_class(MLDS_ModuleName),
|
|
CodeAddrsAssocList, WrapperClassDefns, map.init, AddrOfMap),
|
|
Defns1 = GlobalDefns ++ WrapperClassDefns ++ Defns0,
|
|
|
|
% Rename classes with excessively long names.
|
|
shorten_long_class_names(MLDS_ModuleName, Defns1, Defns),
|
|
|
|
% Get the foreign code for Java
|
|
% XXX We should not ignore _RevImports.
|
|
ForeignCode = mlds_get_java_foreign_code(AllForeignCode),
|
|
ForeignCode = mlds_foreign_code(RevForeignDecls, _RevImports,
|
|
RevBodyCode, ExportDefns),
|
|
ForeignDecls = list.reverse(RevForeignDecls),
|
|
ForeignBodyCode = list.reverse(RevBodyCode),
|
|
|
|
% Output transformed MLDS as Java source.
|
|
%
|
|
% The order is important here, because Java requires static constants
|
|
% be defined before they can be used in static initializers.
|
|
% We start with the Java foreign code declarations, since for
|
|
% library/private_builtin.m they contain static constants
|
|
% that will get used in the RTTI definitions.
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
Info = init_java_out_info(ModuleInfo, AddrOfMap),
|
|
output_src_start(Globals, Info, Indent, ModuleName, Imports, ForeignDecls,
|
|
Defns, !IO),
|
|
io.write_list(ForeignBodyCode, "\n", output_java_body_code(Info, Indent),
|
|
!IO),
|
|
|
|
list.filter(defn_is_rtti_data, Defns, RttiDefns, NonRttiDefns),
|
|
io.write_string("\n// RttiDefns\n", !IO),
|
|
output_defns(Info, Indent + 1, alloc_only, RttiDefns, !IO),
|
|
output_rtti_assignments(Info, Indent + 1, RttiDefns, !IO),
|
|
|
|
list.filter(defn_is_data, NonRttiDefns, DataDefns, NonDataDefns),
|
|
io.write_string("\n// DataDefns\n", !IO),
|
|
output_data_decls(Info, Indent + 1, DataDefns, !IO),
|
|
output_data_assignments(Info, Indent + 1, DataDefns, !IO),
|
|
|
|
io.write_string("\n// NonDataDefns\n", !IO),
|
|
output_defns(Info, Indent + 1, none, NonDataDefns, !IO),
|
|
|
|
io.write_string("\n// ExportDefns\n", !IO),
|
|
output_exports(Info, Indent + 1, ExportDefns, !IO),
|
|
|
|
io.write_string("\n// ExportedEnums\n", !IO),
|
|
output_exported_enums(Info, Indent + 1, ExportedEnums, !IO),
|
|
|
|
io.write_string("\n// InitPreds\n", !IO),
|
|
output_inits(Indent + 1, InitPreds, !IO),
|
|
|
|
io.write_string("\n// FinalPreds\n", !IO),
|
|
output_finals(Indent + 1, FinalPreds, !IO),
|
|
|
|
io.write_string("\n// EnvVarNames\n", !IO),
|
|
output_env_vars(Indent + 1, NonRttiDefns, !IO),
|
|
|
|
output_src_end(Indent, ModuleName, !IO).
|
|
% XXX Need to handle non-Java foreign code at this point.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for working with Java `foreign_code'.
|
|
%
|
|
|
|
:- pred output_java_decl(java_out_info::in, indent::in, foreign_decl_code::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_java_decl(Info, Indent, DeclCode, !IO) :-
|
|
DeclCode = foreign_decl_code(Lang, _IsLocal, Code, Context),
|
|
(
|
|
Lang = lang_java,
|
|
indent_line(Info, mlds_make_context(Context), Indent, !IO),
|
|
io.write_string(Code, !IO),
|
|
io.nl(!IO)
|
|
;
|
|
( Lang = lang_c
|
|
; Lang = lang_csharp
|
|
; Lang = lang_il
|
|
; Lang = lang_erlang
|
|
),
|
|
sorry(this_file, "foreign decl other than Java")
|
|
).
|
|
|
|
:- pred output_java_body_code(java_out_info::in, indent::in,
|
|
user_foreign_code::in, io::di, io.state::uo) is det.
|
|
|
|
output_java_body_code(Info, Indent, UserForeignCode, !IO) :-
|
|
UserForeignCode = user_foreign_code(Lang, Code, Context),
|
|
% Only output Java code.
|
|
(
|
|
Lang = lang_java,
|
|
indent_line(Info, mlds_make_context(Context), Indent, !IO),
|
|
io.write_string(Code, !IO),
|
|
io.nl(!IO)
|
|
;
|
|
( Lang = lang_c
|
|
; Lang = lang_csharp
|
|
; Lang = lang_il
|
|
; Lang = lang_erlang
|
|
),
|
|
sorry(this_file, "foreign code other than Java")
|
|
).
|
|
|
|
% Get the foreign code for Java.
|
|
%
|
|
:- func mlds_get_java_foreign_code(map(foreign_language, mlds_foreign_code))
|
|
= mlds_foreign_code.
|
|
|
|
mlds_get_java_foreign_code(AllForeignCode) = ForeignCode :-
|
|
( map.search(AllForeignCode, lang_java, ForeignCode0) ->
|
|
ForeignCode = ForeignCode0
|
|
;
|
|
ForeignCode = mlds_foreign_code([], [], [], [])
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for handling `pragma foreign_export' for Java.
|
|
%
|
|
|
|
% Exports are converted into forwarding methods that are given the
|
|
% specified name. These simply call the exported procedure.
|
|
%
|
|
% NOTE: the forwarding methods must be declared public as they might
|
|
% be referred to within foreign_procs that are inlined across module
|
|
% boundaries.
|
|
%
|
|
:- pred output_exports(java_out_info::in, indent::in,
|
|
list(mlds_pragma_export)::in, io::di, io::uo) is det.
|
|
|
|
output_exports(_, _, [], !IO).
|
|
output_exports(Info, Indent, [Export | Exports], !IO) :-
|
|
Export = ml_pragma_export(Lang, ExportName, MLDS_Name, MLDS_Signature,
|
|
MLDS_Context),
|
|
expect(unify(Lang, lang_java), this_file,
|
|
"foreign_export for language other than Java."),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("public static ", !IO),
|
|
MLDS_Signature = mlds_func_params(Parameters, ReturnTypes),
|
|
(
|
|
ReturnTypes = [],
|
|
io.write_string("void", !IO)
|
|
;
|
|
ReturnTypes = [RetType],
|
|
output_type(Info, normal_style, RetType, !IO)
|
|
;
|
|
ReturnTypes = [_, _ | _],
|
|
% For multiple outputs, we return an array of objects.
|
|
io.write_string("java.lang.Object []", !IO)
|
|
),
|
|
io.write_string(" " ++ ExportName, !IO),
|
|
output_params(Info, Indent + 1, MLDS_Context, Parameters, !IO),
|
|
io.nl(!IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
(
|
|
ReturnTypes = []
|
|
;
|
|
ReturnTypes = [_ | _],
|
|
io.write_string("return ", !IO)
|
|
),
|
|
output_fully_qualified_name(MLDS_Name, !IO),
|
|
io.write_char('(', !IO),
|
|
WriteCallArg = (pred(Arg::in, !.IO::di, !:IO::uo) is det :-
|
|
Arg = mlds_argument(Name, _, _),
|
|
output_name(Name, !IO)
|
|
),
|
|
io.write_list(Parameters, ", ", WriteCallArg, !IO),
|
|
io.write_string(");\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO),
|
|
output_exports(Info, Indent, Exports, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for handling `pragma foreign_export_enum' for Java.
|
|
%
|
|
|
|
:- pred output_exported_enums(java_out_info::in, indent::in,
|
|
list(mlds_exported_enum)::in, io::di, io::uo) is det.
|
|
|
|
output_exported_enums(Info, Indent, ExportedEnums, !IO) :-
|
|
list.foldl(output_exported_enum(Info, Indent), ExportedEnums, !IO).
|
|
|
|
:- pred output_exported_enum(java_out_info::in, indent::in,
|
|
mlds_exported_enum::in, io::di, io::uo) is det.
|
|
|
|
output_exported_enum(Info, Indent, ExportedEnum, !IO) :-
|
|
ExportedEnum = mlds_exported_enum(Lang, _, TypeCtor, ExportedConstants0),
|
|
(
|
|
Lang = lang_java,
|
|
ml_gen_type_name(TypeCtor, ClassName, ClassArity),
|
|
MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_enum),
|
|
% We reverse the list so the constants are printed out in order.
|
|
list.reverse(ExportedConstants0, ExportedConstants),
|
|
list.foldl(output_exported_enum_constant(Info, Indent, MLDS_Type),
|
|
ExportedConstants, !IO)
|
|
;
|
|
( Lang = lang_c
|
|
; Lang = lang_csharp
|
|
; Lang = lang_il
|
|
; Lang = lang_erlang
|
|
)
|
|
).
|
|
|
|
:- pred output_exported_enum_constant(java_out_info::in, indent::in,
|
|
mlds_type::in, mlds_exported_enum_constant::in, io::di, io::uo) is det.
|
|
|
|
output_exported_enum_constant(Info, Indent, MLDS_Type, ExportedConstant,
|
|
!IO) :-
|
|
ExportedConstant = mlds_exported_enum_constant(Name, Initializer),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("public static final ", !IO),
|
|
output_type(Info, normal_style, MLDS_Type, !IO),
|
|
io.write_string(" ", !IO),
|
|
io.write_string(Name, !IO),
|
|
io.write_string(" = ", !IO),
|
|
output_initializer_body(Info, Initializer, no, !IO),
|
|
io.write_string(";\n", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to search MLDS for all uses of function pointers.
|
|
%
|
|
|
|
% Returns code-address information (function label and signature)
|
|
% for each method/function which has its address taken in the MLDS.
|
|
%
|
|
:- pred find_pointer_addressed_methods(list(mlds_defn)::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
find_pointer_addressed_methods([], !CodeAddrs).
|
|
find_pointer_addressed_methods([Defn | Defns], !CodeAddrs) :-
|
|
Defn = mlds_defn(_Name, _Context, _Flags, Body),
|
|
method_ptrs_in_entity_defn(Body, !CodeAddrs),
|
|
find_pointer_addressed_methods(Defns, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_entity_defn(mlds_entity_defn::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_entity_defn(mlds_function(_MaybeID, _Params, Body,
|
|
_Attributes, _EnvVars), !CodeAddrs) :-
|
|
(
|
|
Body = body_defined_here(Statement),
|
|
method_ptrs_in_statement(Statement, !CodeAddrs)
|
|
;
|
|
Body = body_external
|
|
).
|
|
method_ptrs_in_entity_defn(mlds_data(_Type, Initializer, _GCStatement),
|
|
!CodeAddrs) :-
|
|
method_ptrs_in_initializer(Initializer, !CodeAddrs).
|
|
method_ptrs_in_entity_defn(mlds_class(ClassDefn), !CodeAddrs) :-
|
|
ClassDefn = mlds_class_defn(_, _, _, _, Ctors, Members),
|
|
method_ptrs_in_defns(Ctors, !CodeAddrs),
|
|
method_ptrs_in_defns(Members, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_statements(list(statement)::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_statements([], !CodeAddrs).
|
|
method_ptrs_in_statements([Statement | Statements], !CodeAddrs) :-
|
|
method_ptrs_in_statement(Statement, !CodeAddrs),
|
|
method_ptrs_in_statements(Statements, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_statement(statement::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_statement(statement(Stmt, _Context), !CodeAddrs) :-
|
|
method_ptrs_in_stmt(Stmt, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_stmt(mlds_stmt::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_stmt(ml_stmt_block(Defns, Statements), !CodeAddrs) :-
|
|
method_ptrs_in_defns(Defns, !CodeAddrs),
|
|
method_ptrs_in_statements(Statements, !CodeAddrs).
|
|
method_ptrs_in_stmt(ml_stmt_while(_Kind, Rval, Statement), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs),
|
|
method_ptrs_in_statement(Statement, !CodeAddrs).
|
|
method_ptrs_in_stmt(ml_stmt_if_then_else(Rval, StatementThen,
|
|
MaybeStatementElse), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs),
|
|
method_ptrs_in_statement(StatementThen, !CodeAddrs),
|
|
(
|
|
MaybeStatementElse = yes(StatementElse),
|
|
method_ptrs_in_statement(StatementElse, !CodeAddrs)
|
|
;
|
|
MaybeStatementElse = no
|
|
).
|
|
method_ptrs_in_stmt(ml_stmt_switch(_Type, Rval, _Range, Cases, Default),
|
|
!CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs),
|
|
method_ptrs_in_switch_cases(Cases, !CodeAddrs),
|
|
method_ptrs_in_switch_default(Default, !CodeAddrs).
|
|
method_ptrs_in_stmt(ml_stmt_label(_), _, _) :-
|
|
unexpected(this_file,
|
|
"method_ptrs_in_stmt: labels not supported in Java.").
|
|
method_ptrs_in_stmt(ml_stmt_goto(goto_break), !CodeAddrs).
|
|
method_ptrs_in_stmt(ml_stmt_goto(goto_continue), !CodeAddrs).
|
|
method_ptrs_in_stmt(ml_stmt_goto(goto_label(_)), _, _) :-
|
|
unexpected(this_file,
|
|
"method_ptrs_in_stmt: goto label not supported in Java.").
|
|
method_ptrs_in_stmt(ml_stmt_computed_goto(_, _), _, _) :-
|
|
unexpected(this_file,
|
|
"method_ptrs_in_stmt: computed gotos not supported in Java.").
|
|
method_ptrs_in_stmt(ml_stmt_try_commit(_Lval, StatementGoal,
|
|
StatementHandler), !CodeAddrs) :-
|
|
% We don't check "_Lval" here as we expect it to be a local variable
|
|
% of type mlds_commit_type.
|
|
method_ptrs_in_statement(StatementGoal, !CodeAddrs),
|
|
method_ptrs_in_statement(StatementHandler, !CodeAddrs).
|
|
method_ptrs_in_stmt(ml_stmt_do_commit(_Rval), !CodeAddrs).
|
|
% We don't check "_Rval" here as we expect it to be a local variable
|
|
% of type mlds_commit_type.
|
|
method_ptrs_in_stmt(ml_stmt_return(Rvals), !CodeAddrs) :-
|
|
method_ptrs_in_rvals(Rvals, !CodeAddrs).
|
|
method_ptrs_in_stmt(CallStmt, !CodeAddrs) :-
|
|
CallStmt = ml_stmt_call(_FuncSig, _Rval, _MaybeThis, Rvals, _ReturnVars,
|
|
_IsTailCall),
|
|
% We don't check "_Rval" - it may be a code address but is a
|
|
% standard call rather than a function pointer use.
|
|
method_ptrs_in_rvals(Rvals, !CodeAddrs).
|
|
method_ptrs_in_stmt(ml_stmt_atomic(AtomicStatement), !CodeAddrs) :-
|
|
(
|
|
AtomicStatement = new_object(Lval, _MaybeTag, _Bool,
|
|
_Type, _MemRval, _MaybeCtorName, Rvals, _Types, _MayUseAtomic)
|
|
->
|
|
% We don't need to check "_MemRval" since this just stores
|
|
% the amount of memory needed for the new object.
|
|
method_ptrs_in_lval(Lval, !CodeAddrs),
|
|
method_ptrs_in_rvals(Rvals, !CodeAddrs)
|
|
; AtomicStatement = assign(Lval, Rval) ->
|
|
method_ptrs_in_lval(Lval, !CodeAddrs),
|
|
method_ptrs_in_rval(Rval, !CodeAddrs)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred method_ptrs_in_switch_default(mlds_switch_default::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_switch_default(default_is_unreachable, !CodeAddrs).
|
|
method_ptrs_in_switch_default(default_do_nothing, !CodeAddrs).
|
|
method_ptrs_in_switch_default(default_case(Statement), !CodeAddrs) :-
|
|
method_ptrs_in_statement(Statement, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_switch_cases(list(mlds_switch_case)::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_switch_cases([], !CodeAddrs).
|
|
method_ptrs_in_switch_cases([Case | Cases], !CodeAddrs) :-
|
|
Case = mlds_switch_case(_FirstCond, _LaterConds, Statement),
|
|
method_ptrs_in_statement(Statement, !CodeAddrs),
|
|
method_ptrs_in_switch_cases(Cases, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_defns(list(mlds_defn)::in, list(mlds_code_addr)::in,
|
|
list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_defns([], !CodeAddrs).
|
|
method_ptrs_in_defns([Defn | Defns], !CodeAddrs) :-
|
|
method_ptrs_in_defn(Defn, !CodeAddrs),
|
|
method_ptrs_in_defns(Defns, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_defn(mlds_defn::in, list(mlds_code_addr)::in,
|
|
list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_defn(mlds_defn(_Name, _Context, _Flags, Body), !CodeAddrs) :-
|
|
method_ptrs_in_entity_defn(Body, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_initializer(mlds_initializer::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_initializer(no_initializer, !CodeAddrs).
|
|
method_ptrs_in_initializer(init_struct(_Type, Initializers),
|
|
!CodeAddrs) :-
|
|
method_ptrs_in_initializers(Initializers, !CodeAddrs).
|
|
method_ptrs_in_initializer(init_array(Initializers), !CodeAddrs) :-
|
|
method_ptrs_in_initializers(Initializers, !CodeAddrs).
|
|
method_ptrs_in_initializer(init_obj(Rval), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_initializers(list(mlds_initializer)::in,
|
|
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_initializers([], !CodeAddrs).
|
|
method_ptrs_in_initializers([Initializer | Initializers], !CodeAddrs) :-
|
|
method_ptrs_in_initializer(Initializer, !CodeAddrs),
|
|
method_ptrs_in_initializers(Initializers, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_rvals(list(mlds_rval)::in, list(mlds_code_addr)::in,
|
|
list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_rvals([], !CodeAddrs).
|
|
method_ptrs_in_rvals([Rval | Rvals], !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs),
|
|
method_ptrs_in_rvals(Rvals, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_rval(mlds_rval::in, list(mlds_code_addr)::in,
|
|
list(mlds_code_addr)::out) is det.
|
|
|
|
method_ptrs_in_rval(ml_lval(Lval), !CodeAddrs) :-
|
|
method_ptrs_in_lval(Lval, !CodeAddrs).
|
|
method_ptrs_in_rval(ml_mkword(_Tag, Rval), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs).
|
|
method_ptrs_in_rval(ml_const(RvalConst), !CodeAddrs) :-
|
|
(
|
|
RvalConst = mlconst_code_addr(CodeAddr),
|
|
!:CodeAddrs = [CodeAddr | !.CodeAddrs]
|
|
;
|
|
( RvalConst = mlconst_true
|
|
; RvalConst = mlconst_false
|
|
; RvalConst = mlconst_int(_)
|
|
; RvalConst = mlconst_char(_)
|
|
; RvalConst = mlconst_enum(_, _)
|
|
; RvalConst = mlconst_foreign(_, _, _)
|
|
; RvalConst = mlconst_float(_)
|
|
; RvalConst = mlconst_string(_)
|
|
; RvalConst = mlconst_multi_string(_)
|
|
; RvalConst = mlconst_named_const(_)
|
|
; RvalConst = mlconst_data_addr(_)
|
|
; RvalConst = mlconst_null(_)
|
|
)
|
|
).
|
|
method_ptrs_in_rval(ml_unop(_UnaryOp, Rval), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs).
|
|
method_ptrs_in_rval(ml_binop(_BinaryOp, RvalA, RvalB), !CodeAddrs) :-
|
|
method_ptrs_in_rval(RvalA, !CodeAddrs),
|
|
method_ptrs_in_rval(RvalB, !CodeAddrs).
|
|
method_ptrs_in_rval(ml_scalar_common(_), !CodeAddrs).
|
|
method_ptrs_in_rval(ml_vector_common_row(_, RowRval), !CodeAddrs) :-
|
|
method_ptrs_in_rval(RowRval, !CodeAddrs).
|
|
method_ptrs_in_rval(ml_mem_addr(_Address), !CodeAddrs).
|
|
method_ptrs_in_rval(ml_self(_Type), !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_lval(mlds_lval::in, list(mlds_code_addr)::in,
|
|
list(mlds_code_addr)::out) is det.
|
|
|
|
% Here, "_Rval" is the address of a variable so we don't check it.
|
|
method_ptrs_in_lval(ml_mem_ref(_Rval, _Type), !CodeAddrs).
|
|
% Here, "_Rval" is a pointer to a cell on the heap, and doesn't need
|
|
% to be considered.
|
|
method_ptrs_in_lval(ml_field(_MaybeTag, _Rval, _FieldId, _FieldType, _PtrType),
|
|
!CodeAddrs).
|
|
method_ptrs_in_lval(ml_var(_Variable, _Type), !CodeAddrs).
|
|
method_ptrs_in_lval(ml_global_var_ref(_), !CodeAddrs).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output wrapper classes for the implementation of function pointers
|
|
% in Java.
|
|
%
|
|
% As there is no way to take the address of a method in Java, we must create a
|
|
% wrapper for that method which implements a common interface. We are then able
|
|
% to pass that class around as a java.lang.Object.
|
|
%
|
|
% XXX This implementation will not handle taking the address of instance
|
|
% methods. This is not currently a problem as they will never be generated
|
|
% by the MLDS back-end.
|
|
%
|
|
% XXX This implementation will not corectly handle the case which occurs where
|
|
% there are two or more overloaded MLDS functions (that we take the address of)
|
|
% with the same name and arity but different argument types, both in the same
|
|
% module. This is due to the fact that the names of the generated wrapper
|
|
% classes are based purely on the method name.
|
|
|
|
:- type call_method_inputs
|
|
---> cmi_separate(list(mlds_var_name))
|
|
; cmi_array(mlds_var_name).
|
|
|
|
:- pred make_code_addr_map(list(mlds_code_addr)::in,
|
|
multi_map(arity, mlds_code_addr)::in,
|
|
multi_map(arity, mlds_code_addr)::out) is det.
|
|
|
|
make_code_addr_map([], !Map).
|
|
make_code_addr_map([CodeAddr | CodeAddrs], !Map) :-
|
|
(
|
|
CodeAddr = code_addr_proc(_ProcLabel, OrigFuncSignature)
|
|
;
|
|
CodeAddr = code_addr_internal(_ProcLabel, _SeqNum, OrigFuncSignature)
|
|
),
|
|
OrigFuncSignature = mlds_func_signature(OrigArgTypes, _OrigRetTypes),
|
|
list.length(OrigArgTypes, Arity),
|
|
multi_map.set(!.Map, Arity, CodeAddr, !:Map),
|
|
make_code_addr_map(CodeAddrs, !Map).
|
|
|
|
:- pred generate_addr_wrapper_class(mlds_module_name::in,
|
|
pair(arity, list(mlds_code_addr))::in, mlds_defn::out,
|
|
map(mlds_code_addr, code_addr_wrapper)::in,
|
|
map(mlds_code_addr, code_addr_wrapper)::out) is det.
|
|
|
|
generate_addr_wrapper_class(MLDS_ModuleName, Arity - CodeAddrs, ClassDefn,
|
|
!AddrOfMap) :-
|
|
% Create a name for this wrapper class based on the fully qualified method
|
|
% (predicate) name.
|
|
ClassName = "addrOf" ++ string.from_int(Arity),
|
|
|
|
% If the class is wrapping more than one method then add a member variable
|
|
% which says which predicate to call, and a constructor function to
|
|
% initialise that variable.
|
|
(
|
|
CodeAddrs = [_],
|
|
DataDefns = [],
|
|
CtorDefns = []
|
|
;
|
|
CodeAddrs = [_, _ | _],
|
|
Context = mlds_make_context(term.context_init),
|
|
|
|
% Create the member variable.
|
|
DataDefn = mlds_defn(
|
|
entity_data(mlds_data_var(mlds_var_name("ptr_num", no))),
|
|
Context, ml_gen_final_member_decl_flags,
|
|
mlds_data(mlds_native_int_type, no_initializer, gc_no_stmt)),
|
|
DataDefns = [DataDefn],
|
|
|
|
% Create the constructor function.
|
|
QualClassName = qual(MLDS_ModuleName, module_qual, ClassName),
|
|
ClassType = mlds_class_type(QualClassName, 0, mlds_class),
|
|
|
|
FieldName = qual(MLDS_ModuleName, type_qual, "ptr_num"),
|
|
FieldId = ml_field_named(FieldName, ClassType),
|
|
FieldLval = ml_field(no, ml_self(ClassType), FieldId,
|
|
mlds_native_int_type, ClassType),
|
|
|
|
CtorArgName = mlds_var_name("ptr_num", no),
|
|
CtorArg = entity_data(mlds_data_var(CtorArgName)),
|
|
CtorArgs = [mlds_argument(CtorArg, mlds_native_int_type, gc_no_stmt)],
|
|
CtorReturnValues = [],
|
|
|
|
CtorArgLval = ml_var(qual(MLDS_ModuleName, type_qual, CtorArgName),
|
|
mlds_native_int_type),
|
|
CtorArgRval = ml_lval(CtorArgLval),
|
|
CtorStatement = statement(
|
|
ml_stmt_atomic(assign(FieldLval, CtorArgRval)), Context),
|
|
|
|
Attributes = [],
|
|
EnvVarNames = set.init,
|
|
Ctor = mlds_function(no, mlds_func_params(CtorArgs, CtorReturnValues),
|
|
body_defined_here(CtorStatement), Attributes, EnvVarNames),
|
|
CtorFlags = init_decl_flags(acc_public, per_instance, non_virtual,
|
|
overridable, modifiable, concrete),
|
|
CtorDefn = mlds_defn(entity_export("<constructor>"), Context,
|
|
CtorFlags, Ctor),
|
|
CtorDefns = [CtorDefn]
|
|
;
|
|
CodeAddrs = [],
|
|
unexpected(this_file,
|
|
"generate_addr_wrapper_class_for_arity: no addresses")
|
|
),
|
|
|
|
% Create a method that calls the original predicates.
|
|
generate_call_method(MLDS_ModuleName, Arity, CodeAddrs, MethodDefn),
|
|
|
|
( Arity =< max_specialised_method_ptr_arity ->
|
|
InterfaceName = "MethodPtr" ++ string.from_int(Arity)
|
|
;
|
|
InterfaceName = "MethodPtrN"
|
|
),
|
|
InterfaceModuleName = mercury_module_name_to_mlds(
|
|
mercury_runtime_package_name),
|
|
Interface = qual(InterfaceModuleName, module_qual, InterfaceName),
|
|
|
|
% Create class components.
|
|
ClassImports = [],
|
|
ClassExtends = [],
|
|
InterfaceDefn = mlds_class_type(Interface, 0, mlds_interface),
|
|
ClassImplements = [InterfaceDefn],
|
|
|
|
% Put it all together.
|
|
ClassMembers = DataDefns ++ [MethodDefn],
|
|
ClassEntityName = entity_type(ClassName, 0),
|
|
ClassContext = mlds_make_context(term.context_init),
|
|
ClassFlags = addr_wrapper_decl_flags,
|
|
ClassBodyDefn = mlds_class_defn(mlds_class, ClassImports,
|
|
ClassExtends, ClassImplements, CtorDefns, ClassMembers),
|
|
ClassBody = mlds_class(ClassBodyDefn),
|
|
ClassDefn = mlds_defn(ClassEntityName, ClassContext, ClassFlags,
|
|
ClassBody),
|
|
|
|
add_to_address_map(ClassName, CodeAddrs, !AddrOfMap).
|
|
|
|
% The highest arity for which there is a specialised MethodPtr<n> interface.
|
|
%
|
|
:- func max_specialised_method_ptr_arity = int.
|
|
|
|
max_specialised_method_ptr_arity = 15.
|
|
|
|
:- pred generate_call_method(mlds_module_name::in, arity::in,
|
|
list(mlds_code_addr)::in, mlds_defn::out) is det.
|
|
|
|
generate_call_method(MLDS_ModuleName, Arity, CodeAddrs, MethodDefn) :-
|
|
% Create the arguments to the call method. For low arities the method
|
|
% takes n arguments directly. For higher arities the arguments are passed
|
|
% in as an array.
|
|
( Arity =< max_specialised_method_ptr_arity ->
|
|
list.map2(create_generic_arg, 1 .. Arity, ArgNames, MethodArgs),
|
|
InputArgs = cmi_separate(ArgNames)
|
|
;
|
|
ArgName = mlds_var_name("args", no),
|
|
ArgDataName = entity_data(mlds_data_var(ArgName)),
|
|
ArgType = mlds_array_type(mlds_generic_type),
|
|
Arg = mlds_argument(ArgDataName, ArgType, gc_no_stmt),
|
|
MethodArgs = [Arg],
|
|
InputArgs = cmi_array(ArgName)
|
|
),
|
|
|
|
% Create a statement to call each of the original methods.
|
|
list.map(generate_call_statement_for_addr(InputArgs), CodeAddrs,
|
|
CodeAddrStatements),
|
|
|
|
Context = mlds_make_context(term.context_init),
|
|
|
|
% If there is more than one original method then we need to switch on the
|
|
% ptr_num member variable.
|
|
(
|
|
CodeAddrStatements = [Statement]
|
|
;
|
|
CodeAddrStatements = [_, _ | _],
|
|
MaxCase = list.length(CodeAddrs) - 1,
|
|
MakeCase = (func(I, CaseStatement) = Case :-
|
|
MatchCond = match_value(ml_const(mlconst_int(I))),
|
|
Case = mlds_switch_case(MatchCond, [], CaseStatement)
|
|
),
|
|
Cases = list.map_corresponding(MakeCase, 0 .. MaxCase,
|
|
CodeAddrStatements),
|
|
|
|
SwitchVarName = mlds_var_name("ptr_num", no),
|
|
SwitchVar = qual(MLDS_ModuleName, module_qual, SwitchVarName),
|
|
SwitchVarRval = ml_lval(ml_var(SwitchVar, mlds_native_int_type)),
|
|
SwitchRange = mlds_switch_range(0, MaxCase),
|
|
Switch = ml_stmt_switch(mlds_native_int_type, SwitchVarRval,
|
|
SwitchRange, Cases, default_is_unreachable),
|
|
Statement = statement(Switch, Context)
|
|
;
|
|
CodeAddrStatements = [],
|
|
unexpected(this_file, "generate_call_method: no statements")
|
|
),
|
|
|
|
% Create new method name.
|
|
PredID = hlds_pred.initial_pred_id,
|
|
ProcID = initial_proc_id,
|
|
Label = mlds_special_pred_label("call", no, "", 0),
|
|
MethodName = entity_function(Label, ProcID, no, PredID),
|
|
|
|
% Create return type.
|
|
MethodRetType = mlds_generic_type,
|
|
MethodRets = [MethodRetType],
|
|
|
|
% Put it all together.
|
|
MethodParams = mlds_func_params(MethodArgs, MethodRets),
|
|
MethodMaybeID = no,
|
|
MethodAttribs = [],
|
|
MethodEnvVarNames = set.init,
|
|
MethodBody = mlds_function(MethodMaybeID, MethodParams,
|
|
body_defined_here(Statement), MethodAttribs, MethodEnvVarNames),
|
|
MethodFlags = ml_gen_final_member_decl_flags,
|
|
MethodDefn = mlds_defn(MethodName, Context, MethodFlags, MethodBody).
|
|
|
|
:- pred create_generic_arg(int::in, mlds_var_name::out, mlds_argument::out)
|
|
is det.
|
|
|
|
create_generic_arg(I, ArgName, Arg) :-
|
|
ArgName = mlds_var_name("arg" ++ string.from_int(I), no),
|
|
Arg = mlds_argument(entity_data(mlds_data_var(ArgName)),
|
|
mlds_generic_type, gc_no_stmt).
|
|
|
|
:- pred generate_call_statement_for_addr(call_method_inputs::in,
|
|
mlds_code_addr::in, statement::out) is det.
|
|
|
|
generate_call_statement_for_addr(InputArgs, CodeAddr, Statement) :-
|
|
(
|
|
CodeAddr = code_addr_proc(ProcLabel, OrigFuncSignature)
|
|
;
|
|
CodeAddr = code_addr_internal(ProcLabel, _SeqNum, OrigFuncSignature)
|
|
),
|
|
OrigFuncSignature = mlds_func_signature(OrigArgTypes, OrigRetTypes),
|
|
ModuleName = ProcLabel ^ mod_name,
|
|
|
|
% Create the arguments to pass to the original method.
|
|
(
|
|
InputArgs = cmi_separate(ArgNames),
|
|
list.map_corresponding(generate_call_method_nth_arg(ModuleName),
|
|
OrigArgTypes, ArgNames, CallArgs)
|
|
;
|
|
InputArgs = cmi_array(ArrayVarName),
|
|
ArrayVar = qual(ModuleName, module_qual, ArrayVarName),
|
|
generate_call_method_args_from_array(OrigArgTypes, ArrayVar, 0,
|
|
[], CallArgs)
|
|
),
|
|
|
|
% Create a temporary variable to store the result of the call to the
|
|
% original method.
|
|
ReturnVarName = mlds_var_name("return_value", no),
|
|
ReturnVar = qual(ModuleName, module_qual, ReturnVarName),
|
|
|
|
% Create a declaration for this variable.
|
|
(
|
|
OrigRetTypes = [],
|
|
ReturnVarType = mlds_generic_type
|
|
;
|
|
OrigRetTypes = [CallRetType],
|
|
ReturnVarType = CallRetType
|
|
;
|
|
OrigRetTypes = [_, _ | _],
|
|
ReturnVarType = mlds_array_type(mlds_generic_type)
|
|
),
|
|
ReturnLval = ml_var(ReturnVar, ReturnVarType),
|
|
ReturnEntityName = entity_data(mlds_data_var(ReturnVarName)),
|
|
|
|
ReturnDecFlags = ml_gen_local_var_decl_flags,
|
|
GCStatement = gc_no_stmt, % The Java back-end does its own GC.
|
|
ReturnEntityDefn = mlds_data(ReturnVarType, no_initializer, GCStatement),
|
|
Context = mlds_make_context(term.context_init),
|
|
ReturnVarDefn = mlds_defn(ReturnEntityName, Context, ReturnDecFlags,
|
|
ReturnEntityDefn),
|
|
MethodDefns = [ReturnVarDefn],
|
|
|
|
% Create the call to the original method.
|
|
CallRval = ml_const(mlconst_code_addr(CodeAddr)),
|
|
|
|
% If the original method has a return type of void, then we obviously
|
|
% cannot assign its return value to "return_value". Thus, in this
|
|
% case the value returned by the call method will just be the value
|
|
% which "return_value" was initialised to.
|
|
(
|
|
OrigRetTypes = [],
|
|
CallRetLvals = []
|
|
;
|
|
OrigRetTypes = [_ | _],
|
|
CallRetLvals = [ReturnLval]
|
|
),
|
|
Call = ml_stmt_call(OrigFuncSignature, CallRval, no, CallArgs,
|
|
CallRetLvals, ordinary_call),
|
|
CallStatement = statement(Call, Context),
|
|
|
|
% Create a return statement that returns the result of the call to the
|
|
% original method, boxed as a java.lang.Object.
|
|
ReturnRval = ml_unop(box(ReturnVarType), ml_lval(ReturnLval)),
|
|
Return = ml_stmt_return([ReturnRval]),
|
|
ReturnStatement = statement(Return, Context),
|
|
|
|
Block = ml_stmt_block(MethodDefns, [CallStatement, ReturnStatement]),
|
|
Statement = statement(Block, Context).
|
|
|
|
:- pred generate_call_method_nth_arg(mlds_module_name::in, mlds_type::in,
|
|
mlds_var_name::in, mlds_rval::out) is det.
|
|
|
|
generate_call_method_nth_arg(ModuleName, Type, MethodArgVariable, CallArg) :-
|
|
CallArgLabel = qual(ModuleName, module_qual, MethodArgVariable),
|
|
Rval = ml_lval(ml_var(CallArgLabel, mlds_generic_type)),
|
|
CallArg = ml_unop(unbox(Type), Rval).
|
|
|
|
:- pred generate_call_method_args_from_array(list(mlds_type)::in,
|
|
mlds_var::in, int::in, list(mlds_rval)::in, list(mlds_rval)::out) is det.
|
|
|
|
generate_call_method_args_from_array([], _, _, Args, Args).
|
|
generate_call_method_args_from_array([Type | Types], ArrayVar, Counter,
|
|
Args0, Args) :-
|
|
ArrayRval = ml_lval(ml_var(ArrayVar, mlds_native_int_type)),
|
|
IndexRval = ml_const(mlconst_int(Counter)),
|
|
ElemType = array_elem_scalar(scalar_elem_generic),
|
|
Rval = ml_binop(array_index(ElemType), ArrayRval, IndexRval),
|
|
UnBoxedRval = ml_unop(unbox(Type), Rval),
|
|
Args1 = Args0 ++ [UnBoxedRval],
|
|
generate_call_method_args_from_array(Types, ArrayVar, Counter + 1,
|
|
Args1, Args).
|
|
|
|
:- func addr_wrapper_decl_flags = mlds_decl_flags.
|
|
|
|
addr_wrapper_decl_flags = MLDS_DeclFlags :-
|
|
Access = acc_private,
|
|
PerInstance = one_copy,
|
|
Virtuality = non_virtual,
|
|
Finality = final,
|
|
Constness = const,
|
|
Abstractness = concrete,
|
|
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
|
|
Virtuality, Finality, Constness, Abstractness).
|
|
|
|
:- pred add_to_address_map(string::in, list(mlds_code_addr)::in,
|
|
map(mlds_code_addr, code_addr_wrapper)::in,
|
|
map(mlds_code_addr, code_addr_wrapper)::out) is det.
|
|
|
|
add_to_address_map(ClassName, CodeAddrs, !AddrOfMap) :-
|
|
FlippedClassName = flip_initial_case(ClassName),
|
|
(
|
|
CodeAddrs = [CodeAddr],
|
|
Wrapper = code_addr_wrapper(FlippedClassName, no),
|
|
svmap.det_insert(CodeAddr, Wrapper, !AddrOfMap)
|
|
;
|
|
CodeAddrs = [_, _ | _],
|
|
add_to_address_map_2(FlippedClassName, CodeAddrs, 0, !AddrOfMap)
|
|
;
|
|
CodeAddrs = [],
|
|
unexpected(this_file, "generate_addr_wrapper_class: no addresses")
|
|
).
|
|
|
|
:- pred add_to_address_map_2(string::in, list(mlds_code_addr)::in, int::in,
|
|
map(mlds_code_addr, code_addr_wrapper)::in,
|
|
map(mlds_code_addr, code_addr_wrapper)::out) is det.
|
|
|
|
add_to_address_map_2(_, [], _, !AddrOfMap).
|
|
add_to_address_map_2(FlippedClassName, [CodeAddr | CodeAddrs], I,
|
|
!AddrOfMap) :-
|
|
Wrapper = code_addr_wrapper(FlippedClassName, yes(I)),
|
|
svmap.det_insert(CodeAddr, Wrapper, !AddrOfMap),
|
|
add_to_address_map_2(FlippedClassName, CodeAddrs, I + 1, !AddrOfMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to rename long class names.
|
|
%
|
|
|
|
:- type class_name_renaming
|
|
---> class_name_renaming(
|
|
cnr_module :: mlds_module_name,
|
|
cnr_renaming :: map(mlds_class_name, mlds_class_name)
|
|
).
|
|
|
|
% Rename class names which are too long. Each class results in a separate
|
|
% `.class' file, so a long class name may exceed filesystem limits.
|
|
% The long names tend to be automatically generated by the compiler.
|
|
%
|
|
:- pred shorten_long_class_names(mlds_module_name::in,
|
|
list(mlds_defn)::in, list(mlds_defn)::out) is det.
|
|
|
|
shorten_long_class_names(ModuleName, Defns0, Defns) :-
|
|
list.map_foldl(maybe_shorten_long_class_name, Defns0, Defns1,
|
|
map.init, RenamingMap),
|
|
( map.is_empty(RenamingMap) ->
|
|
Defns = Defns1
|
|
;
|
|
Renaming = class_name_renaming(ModuleName, RenamingMap),
|
|
list.map(rename_class_names_defn(Renaming), Defns1, Defns)
|
|
).
|
|
|
|
:- pred maybe_shorten_long_class_name(mlds_defn::in, mlds_defn::out,
|
|
map(mlds_class_name, mlds_class_name)::in,
|
|
map(mlds_class_name, mlds_class_name)::out) is det.
|
|
|
|
maybe_shorten_long_class_name(!Defn, !Renaming) :-
|
|
Access = access(!.Defn ^ md_decl_flags),
|
|
(
|
|
% We only rename private classes for now.
|
|
Access = acc_private,
|
|
EntityName0 = !.Defn ^ md_entity_name,
|
|
(
|
|
EntityName0 = entity_type(ClassName0, Arity),
|
|
ClassName = shorten_class_name(ClassName0),
|
|
( ClassName \= ClassName0 ->
|
|
EntityName = entity_type(ClassName, Arity),
|
|
!Defn ^ md_entity_name := EntityName,
|
|
svmap.det_insert(ClassName0, ClassName, !Renaming)
|
|
;
|
|
true
|
|
)
|
|
;
|
|
( EntityName0 = entity_function(_, _, _, _)
|
|
; EntityName0 = entity_data(_)
|
|
; EntityName0 = entity_export(_)
|
|
)
|
|
)
|
|
;
|
|
( Access = acc_public
|
|
; Access = acc_protected
|
|
; Access = acc_default
|
|
; Access = acc_local
|
|
)
|
|
).
|
|
|
|
:- func shorten_class_name(string) = string.
|
|
|
|
shorten_class_name(ClassName0) = ClassName :-
|
|
MangledClassName0 = name_mangle_no_leading_digit(ClassName0),
|
|
( string.length(MangledClassName0) < 100 ->
|
|
ClassName = ClassName0
|
|
;
|
|
% The new name must not require name mangling, as then the name may
|
|
% again be too long. We replace all non-alphanumeric or underscore
|
|
% characters by underscores. The s_ prefix avoids having f_ as the
|
|
% prefix which is used to indicate a mangled name.
|
|
Left = string.left(ClassName0, 44),
|
|
Right = string.right(ClassName0, 44),
|
|
Hash = string.hash(ClassName0) /\ 0xffffffff,
|
|
GenName = string.format("s_%s_%08x_%s", [s(Left), i(Hash), s(Right)]),
|
|
GenList = string.to_char_list(GenName),
|
|
FilterList = list.map(replace_non_alphanum_underscore, GenList),
|
|
ClassName = string.from_char_list(FilterList)
|
|
).
|
|
|
|
:- func replace_non_alphanum_underscore(char) = char.
|
|
|
|
replace_non_alphanum_underscore(Char) =
|
|
( char.is_alnum_or_underscore(Char) ->
|
|
Char
|
|
;
|
|
'_'
|
|
).
|
|
|
|
:- pred rename_class_names_defn(class_name_renaming::in,
|
|
mlds_defn::in, mlds_defn::out) is det.
|
|
|
|
rename_class_names_defn(Renaming, !Defn) :-
|
|
EntityDefn0 = !.Defn ^ md_entity_defn,
|
|
(
|
|
EntityDefn0 = mlds_data(Type0, Initializer0, GCStatement),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
rename_class_names_initializer(Renaming, Initializer0, Initializer),
|
|
EntityDefn = mlds_data(Type, Initializer, GCStatement)
|
|
;
|
|
EntityDefn0 = mlds_function(MaybePPId, FuncParams0, FuncBody0,
|
|
Attributes, EnvVarNames),
|
|
rename_class_names_func_params(Renaming, FuncParams0, FuncParams),
|
|
(
|
|
FuncBody0 = body_defined_here(Statement0),
|
|
rename_class_names_statement(Renaming, Statement0, Statement),
|
|
FuncBody = body_defined_here(Statement)
|
|
;
|
|
FuncBody0 = body_external,
|
|
FuncBody = body_external
|
|
),
|
|
EntityDefn = mlds_function(MaybePPId, FuncParams, FuncBody,
|
|
Attributes, EnvVarNames)
|
|
;
|
|
EntityDefn0 = mlds_class(mlds_class_defn(ClassKind, Imports, Inherits,
|
|
Implements, Ctors0, Members0)),
|
|
list.map(rename_class_names_defn(Renaming), Ctors0, Ctors),
|
|
list.map(rename_class_names_defn(Renaming), Members0, Members),
|
|
EntityDefn = mlds_class(mlds_class_defn(ClassKind, Imports, Inherits,
|
|
Implements, Ctors, Members))
|
|
),
|
|
!Defn ^ md_entity_defn := EntityDefn.
|
|
|
|
:- pred rename_class_names_type(class_name_renaming::in,
|
|
mlds_type::in, mlds_type::out) is det.
|
|
|
|
rename_class_names_type(Renaming, !Type) :-
|
|
(
|
|
!.Type = mlds_mercury_array_type(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Type = mlds_mercury_array_type(Type)
|
|
;
|
|
!.Type = mlds_cont_type(RetTypes0),
|
|
list.map(rename_class_names_type(Renaming), RetTypes0, RetTypes),
|
|
!:Type = mlds_cont_type(RetTypes)
|
|
;
|
|
!.Type = mlds_class_type(Name0, Arity, ClassKind),
|
|
Name0 = qual(ModuleName, QualKind, UnqualName0),
|
|
(
|
|
Renaming = class_name_renaming(ModuleName, RenamingMap),
|
|
map.search(RenamingMap, UnqualName0, UnqualName)
|
|
->
|
|
Name = qual(ModuleName, QualKind, UnqualName),
|
|
!:Type = mlds_class_type(Name, Arity, ClassKind)
|
|
;
|
|
true
|
|
)
|
|
;
|
|
!.Type = mlds_array_type(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Type = mlds_array_type(Type)
|
|
;
|
|
!.Type = mlds_ptr_type(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Type = mlds_ptr_type(Type)
|
|
;
|
|
!.Type = mlds_func_type(FuncParams0),
|
|
rename_class_names_func_params(Renaming, FuncParams0, FuncParams),
|
|
!:Type = mlds_func_type(FuncParams)
|
|
;
|
|
( !.Type = mercury_type(_, _, _)
|
|
; !.Type = mlds_commit_type
|
|
; !.Type = mlds_native_bool_type
|
|
; !.Type = mlds_native_int_type
|
|
; !.Type = mlds_native_float_type
|
|
; !.Type = mlds_native_char_type
|
|
; !.Type = mlds_foreign_type(_)
|
|
; !.Type = mlds_generic_type
|
|
; !.Type = mlds_generic_env_ptr_type
|
|
; !.Type = mlds_type_info_type
|
|
; !.Type = mlds_pseudo_type_info_type
|
|
; !.Type = mlds_rtti_type(_)
|
|
; !.Type = mlds_tabling_type(_)
|
|
; !.Type = mlds_unknown_type
|
|
)
|
|
).
|
|
|
|
:- pred rename_class_names_initializer(class_name_renaming::in,
|
|
mlds_initializer::in, mlds_initializer::out) is det.
|
|
|
|
rename_class_names_initializer(Renaming, !Initializer) :-
|
|
(
|
|
!.Initializer = init_obj(Rval0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Initializer = init_obj(Rval)
|
|
;
|
|
!.Initializer = init_struct(Type0, Initializers0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
list.map(rename_class_names_initializer(Renaming), Initializers0,
|
|
Initializers),
|
|
!:Initializer = init_struct(Type, Initializers)
|
|
;
|
|
!.Initializer = init_array(Initializers0),
|
|
list.map(rename_class_names_initializer(Renaming), Initializers0,
|
|
Initializers),
|
|
!:Initializer = init_array(Initializers)
|
|
;
|
|
!.Initializer = no_initializer
|
|
).
|
|
|
|
:- pred rename_class_names_func_params(class_name_renaming::in,
|
|
mlds_func_params::in, mlds_func_params::out) is det.
|
|
|
|
rename_class_names_func_params(Renaming, !FuncParams) :-
|
|
!.FuncParams = mlds_func_params(Arguments0, RetTypes0),
|
|
list.map(rename_class_names_argument(Renaming), Arguments0, Arguments),
|
|
list.map(rename_class_names_type(Renaming), RetTypes0, RetTypes),
|
|
!:FuncParams = mlds_func_params(Arguments, RetTypes).
|
|
|
|
:- pred rename_class_names_argument(class_name_renaming::in,
|
|
mlds_argument::in, mlds_argument::out) is det.
|
|
|
|
rename_class_names_argument(Renaming, !Argument) :-
|
|
!.Argument = mlds_argument(Name, Type0, GCStatement),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Argument = mlds_argument(Name, Type, GCStatement).
|
|
|
|
:- pred rename_class_names_statement(class_name_renaming::in,
|
|
statement::in, statement::out) is det.
|
|
|
|
rename_class_names_statement(Renaming, !Statement) :-
|
|
!.Statement = statement(Stmt0, Context),
|
|
rename_class_names_stmt(Renaming, Stmt0, Stmt),
|
|
!:Statement = statement(Stmt, Context).
|
|
|
|
:- pred rename_class_names_stmt(class_name_renaming::in,
|
|
mlds_stmt::in, mlds_stmt::out) is det.
|
|
|
|
rename_class_names_stmt(Renaming, !Stmt) :-
|
|
(
|
|
!.Stmt = ml_stmt_block(Defns0, Statements0),
|
|
list.map(rename_class_names_defn(Renaming), Defns0, Defns),
|
|
list.map(rename_class_names_statement(Renaming),
|
|
Statements0, Statements),
|
|
!:Stmt = ml_stmt_block(Defns, Statements)
|
|
;
|
|
!.Stmt = ml_stmt_while(Kind, Rval0, Statement0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
rename_class_names_statement(Renaming, Statement0, Statement),
|
|
!:Stmt = ml_stmt_while(Kind, Rval, Statement)
|
|
;
|
|
!.Stmt = ml_stmt_if_then_else(Rval0, Statement0, MaybeElse0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
rename_class_names_statement(Renaming, Statement0, Statement),
|
|
(
|
|
MaybeElse0 = yes(Else0),
|
|
rename_class_names_statement(Renaming, Else0, Else),
|
|
MaybeElse = yes(Else)
|
|
;
|
|
MaybeElse0 = no,
|
|
MaybeElse = no
|
|
),
|
|
!:Stmt = ml_stmt_if_then_else(Rval, Statement, MaybeElse)
|
|
;
|
|
!.Stmt = ml_stmt_switch(Type0, Rval0, SwitchRange, Cases0, Default0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
list.map(rename_class_names_switch_case(Renaming), Cases0, Cases),
|
|
rename_class_names_switch_default(Renaming, Default0, Default),
|
|
!:Stmt = ml_stmt_switch(Type, Rval, SwitchRange, Cases, Default)
|
|
;
|
|
!.Stmt = ml_stmt_label(_)
|
|
;
|
|
!.Stmt = ml_stmt_goto(_)
|
|
;
|
|
!.Stmt = ml_stmt_computed_goto(Rval0, Labels),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Stmt = ml_stmt_computed_goto(Rval, Labels)
|
|
;
|
|
!.Stmt = ml_stmt_call(Signature0, Rval0, MaybeThis, Rvals0, RetLvals0,
|
|
CallKind),
|
|
Signature0 = mlds_func_signature(ArgTypes0, RetTypes0),
|
|
list.map(rename_class_names_type(Renaming), ArgTypes0, ArgTypes),
|
|
list.map(rename_class_names_type(Renaming), RetTypes0, RetTypes),
|
|
Signature = mlds_func_signature(ArgTypes, RetTypes),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
list.map(rename_class_names_rval(Renaming), Rvals0, Rvals),
|
|
list.map(rename_class_names_lval(Renaming), RetLvals0, RetLvals),
|
|
!:Stmt = ml_stmt_call(Signature, Rval, MaybeThis, Rvals, RetLvals,
|
|
CallKind)
|
|
;
|
|
!.Stmt = ml_stmt_return(Rvals0),
|
|
list.map(rename_class_names_rval(Renaming), Rvals0, Rvals),
|
|
!:Stmt = ml_stmt_return(Rvals)
|
|
;
|
|
!.Stmt = ml_stmt_try_commit(Lval0, StatementA0, StatementB0),
|
|
rename_class_names_lval(Renaming, Lval0, Lval),
|
|
rename_class_names_statement(Renaming, StatementA0, StatementA),
|
|
rename_class_names_statement(Renaming, StatementB0, StatementB),
|
|
!:Stmt = ml_stmt_try_commit(Lval, StatementA, StatementB)
|
|
;
|
|
!.Stmt = ml_stmt_do_commit(Rval0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Stmt = ml_stmt_do_commit(Rval)
|
|
;
|
|
!.Stmt = ml_stmt_atomic(AtomicStatement0),
|
|
rename_class_names_atomic(Renaming, AtomicStatement0, AtomicStatement),
|
|
!:Stmt = ml_stmt_atomic(AtomicStatement)
|
|
).
|
|
|
|
:- pred rename_class_names_switch_case(class_name_renaming::in,
|
|
mlds_switch_case::in, mlds_switch_case::out) is det.
|
|
|
|
rename_class_names_switch_case(Renaming, !Case) :-
|
|
!.Case = mlds_switch_case(FirstMatchCond, LaterMatchConds, Statement0),
|
|
% The rvals in the match conditions shouldn't need renaming.
|
|
rename_class_names_statement(Renaming, Statement0, Statement),
|
|
!:Case = mlds_switch_case(FirstMatchCond, LaterMatchConds, Statement).
|
|
|
|
:- pred rename_class_names_switch_default(class_name_renaming::in,
|
|
mlds_switch_default::in, mlds_switch_default::out) is det.
|
|
|
|
rename_class_names_switch_default(Renaming, !Default) :-
|
|
(
|
|
!.Default = default_is_unreachable
|
|
;
|
|
!.Default = default_do_nothing
|
|
;
|
|
!.Default = default_case(Statement0),
|
|
rename_class_names_statement(Renaming, Statement0, Statement),
|
|
!:Default = default_case(Statement)
|
|
).
|
|
|
|
:- pred rename_class_names_atomic(class_name_renaming::in,
|
|
mlds_atomic_statement::in, mlds_atomic_statement::out) is det.
|
|
|
|
rename_class_names_atomic(Renaming, !Statement) :-
|
|
(
|
|
!.Statement = assign(Lval0, Rval0),
|
|
rename_class_names_lval(Renaming, Lval0, Lval),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Statement = assign(Lval, Rval)
|
|
;
|
|
!.Statement = assign_if_in_heap(Lval0, Rval0),
|
|
rename_class_names_lval(Renaming, Lval0, Lval),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Statement = assign_if_in_heap(Lval, Rval)
|
|
;
|
|
!.Statement = delete_object(Rval0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Statement = delete_object(Rval)
|
|
;
|
|
!.Statement = new_object(TargetLval0, MaybeTag, ExplicitSecTag, Type0,
|
|
MaybeSize, MaybeCtorName, Args0, ArgTypes0, MayUseAtomic),
|
|
rename_class_names_lval(Renaming, TargetLval0, TargetLval),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
list.map(rename_class_names_rval(Renaming), Args0, Args),
|
|
list.map(rename_class_names_type(Renaming), ArgTypes0, ArgTypes),
|
|
!:Statement = new_object(TargetLval, MaybeTag, ExplicitSecTag, Type,
|
|
MaybeSize, MaybeCtorName, Args, ArgTypes, MayUseAtomic)
|
|
;
|
|
( !.Statement = comment(_)
|
|
; !.Statement = gc_check
|
|
; !.Statement = mark_hp(_)
|
|
; !.Statement = restore_hp(_)
|
|
; !.Statement = trail_op(_)
|
|
; !.Statement = inline_target_code(_, _)
|
|
; !.Statement = outline_foreign_proc(_, _, _, _)
|
|
)
|
|
).
|
|
|
|
:- pred rename_class_names_lval(class_name_renaming::in,
|
|
mlds_lval::in, mlds_lval::out) is det.
|
|
|
|
rename_class_names_lval(Renaming, !Lval) :-
|
|
(
|
|
!.Lval = ml_field(Tag, Address0, FieldId0, FieldType0, PtrType0),
|
|
rename_class_names_rval(Renaming, Address0, Address),
|
|
rename_class_names_field_id(Renaming, FieldId0, FieldId),
|
|
rename_class_names_type(Renaming, FieldType0, FieldType),
|
|
rename_class_names_type(Renaming, PtrType0, PtrType),
|
|
!:Lval = ml_field(Tag, Address, FieldId, FieldType, PtrType)
|
|
;
|
|
!.Lval = ml_mem_ref(Rval0, Type0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Lval = ml_mem_ref(Rval, Type)
|
|
;
|
|
!.Lval = ml_global_var_ref(_)
|
|
;
|
|
!.Lval = ml_var(Var, Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Lval = ml_var(Var, Type)
|
|
).
|
|
|
|
:- pred rename_class_names_field_id(class_name_renaming::in,
|
|
mlds_field_id::in, mlds_field_id::out) is det.
|
|
|
|
rename_class_names_field_id(Renaming, !FieldId) :-
|
|
(
|
|
!.FieldId = ml_field_offset(Rval0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:FieldId = ml_field_offset(Rval)
|
|
;
|
|
!.FieldId = ml_field_named(Name, Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:FieldId = ml_field_named(Name, Type)
|
|
).
|
|
|
|
:- pred rename_class_names_rval(class_name_renaming::in,
|
|
mlds_rval::in, mlds_rval::out) is det.
|
|
|
|
rename_class_names_rval(Renaming, !Rval) :-
|
|
(
|
|
!.Rval = ml_lval(Lval0),
|
|
rename_class_names_lval(Renaming, Lval0, Lval),
|
|
!:Rval = ml_lval(Lval)
|
|
;
|
|
!.Rval = ml_mkword(Tag, Rval0),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Rval = ml_mkword(Tag, Rval)
|
|
;
|
|
!.Rval = ml_const(RvalConst0),
|
|
rename_class_names_rval_const(Renaming, RvalConst0, RvalConst),
|
|
!:Rval = ml_const(RvalConst)
|
|
;
|
|
!.Rval = ml_unop(Op0, Rval0),
|
|
rename_class_names_unary_op(Renaming, Op0, Op),
|
|
rename_class_names_rval(Renaming, Rval0, Rval),
|
|
!:Rval = ml_unop(Op, Rval)
|
|
;
|
|
!.Rval = ml_binop(Op, RvalA0, RvalB0),
|
|
rename_class_names_rval(Renaming, RvalA0, RvalA),
|
|
rename_class_names_rval(Renaming, RvalB0, RvalB),
|
|
!:Rval = ml_binop(Op, RvalA, RvalB)
|
|
;
|
|
!.Rval = ml_mem_addr(Lval0),
|
|
rename_class_names_lval(Renaming, Lval0, Lval),
|
|
!:Rval = ml_mem_addr(Lval)
|
|
;
|
|
!.Rval = ml_scalar_common(_)
|
|
;
|
|
!.Rval = ml_vector_common_row(VectorCommon, RowRval0),
|
|
rename_class_names_rval(Renaming, RowRval0, RowRval),
|
|
!:Rval = ml_vector_common_row(VectorCommon, RowRval)
|
|
;
|
|
!.Rval = ml_self(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Rval = ml_self(Type)
|
|
).
|
|
|
|
:- pred rename_class_names_rval_const(class_name_renaming::in,
|
|
mlds_rval_const::in, mlds_rval_const::out) is det.
|
|
|
|
rename_class_names_rval_const(Renaming, !Const) :-
|
|
(
|
|
!.Const = mlconst_foreign(Lang, String, Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Const = mlconst_foreign(Lang, String, Type)
|
|
;
|
|
!.Const = mlconst_null(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Const = mlconst_null(Type)
|
|
;
|
|
( !.Const = mlconst_true
|
|
; !.Const = mlconst_false
|
|
; !.Const = mlconst_int(_)
|
|
; !.Const = mlconst_char(_)
|
|
; !.Const = mlconst_enum(_, _)
|
|
; !.Const = mlconst_float(_)
|
|
; !.Const = mlconst_string(_)
|
|
; !.Const = mlconst_multi_string(_)
|
|
; !.Const = mlconst_named_const(_)
|
|
; !.Const = mlconst_code_addr(_)
|
|
; !.Const = mlconst_data_addr(_)
|
|
)
|
|
).
|
|
|
|
:- pred rename_class_names_unary_op(class_name_renaming::in,
|
|
mlds_unary_op::in, mlds_unary_op::out) is det.
|
|
|
|
rename_class_names_unary_op(Renaming, !Op) :-
|
|
(
|
|
!.Op = box(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Op = box(Type)
|
|
;
|
|
!.Op = unbox(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Op = unbox(Type)
|
|
;
|
|
!.Op = cast(Type0),
|
|
rename_class_names_type(Renaming, Type0, Type),
|
|
!:Op = cast(Type)
|
|
;
|
|
!.Op = std_unop(_)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output calls to module initialisers.
|
|
%
|
|
|
|
:- pred output_inits(int::in, list(string)::in, io::di, io::uo) is det.
|
|
|
|
output_inits(Indent, InitPreds, !IO) :-
|
|
(
|
|
InitPreds = []
|
|
;
|
|
InitPreds = [_ | _],
|
|
% We call the initialisation predicates from a static initialisation
|
|
% block.
|
|
indent_line(Indent, !IO),
|
|
io.write_string("static {\n", !IO),
|
|
list.foldl(output_init_2(Indent + 1), InitPreds, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO)
|
|
).
|
|
|
|
:- pred output_init_2(int::in, string::in, io::di, io::uo) is det.
|
|
|
|
output_init_2(Indent, InitPred, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string(InitPred, !IO),
|
|
io.write_string("();\n", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output module finalisers.
|
|
%
|
|
|
|
:- pred output_finals(indent::in, list(string)::in, io::di, io::uo) is det.
|
|
|
|
output_finals(Indent, FinalPreds, !IO) :-
|
|
(
|
|
FinalPreds = []
|
|
;
|
|
FinalPreds = [_ | _],
|
|
indent_line(Indent, !IO),
|
|
io.write_string("static {\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("jmercury.runtime.JavaInternal.register_finaliser(\n",
|
|
!IO),
|
|
indent_line(Indent + 2, !IO),
|
|
io.write_string("new java.lang.Runnable() {\n", !IO),
|
|
indent_line(Indent + 3, !IO),
|
|
io.write_string("public void run() {\n", !IO),
|
|
list.foldl(output_final_pred_call(Indent + 4), FinalPreds, !IO),
|
|
indent_line(Indent + 3, !IO),
|
|
io.write_string("}\n", !IO),
|
|
indent_line(Indent + 2, !IO),
|
|
io.write_string("}\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string(");\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO)
|
|
).
|
|
|
|
:- pred output_final_pred_call(indent::in, string::in, io::di, io::uo) is det.
|
|
|
|
output_final_pred_call(Indent, FinalPred, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string(FinalPred, !IO),
|
|
io.write_string("();\n", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output globals for environment variables.
|
|
%
|
|
|
|
:- pred output_env_vars(indent::in, list(mlds_defn)::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_env_vars(Indent, NonRttiDefns, !IO) :-
|
|
list.foldl(collect_env_var_names, NonRttiDefns, set.init, EnvVarNamesSet),
|
|
EnvVarNames = set.to_sorted_list(EnvVarNamesSet),
|
|
(
|
|
EnvVarNames = []
|
|
;
|
|
EnvVarNames = [_ | _],
|
|
list.foldl(output_env_var_definition(Indent), EnvVarNames, !IO)
|
|
).
|
|
|
|
:- pred collect_env_var_names(mlds_defn::in,
|
|
set(string)::in, set(string)::out) is det.
|
|
|
|
collect_env_var_names(Defn, !EnvVarNames) :-
|
|
Defn = mlds_defn(_, _, _, EntityDefn),
|
|
(
|
|
EntityDefn = mlds_data(_, _, _)
|
|
;
|
|
EntityDefn = mlds_function(_, _, _, _, EnvVarNames),
|
|
set.union(EnvVarNames, !EnvVarNames)
|
|
;
|
|
EntityDefn = mlds_class(_)
|
|
).
|
|
|
|
:- pred output_env_var_definition(indent::in, string::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_env_var_definition(Indent, EnvVarName, !IO) :-
|
|
% We use int because the generated code compares against zero, and changing
|
|
% that is more trouble than it's worth as it affects the C backends.
|
|
indent_line(Indent, !IO),
|
|
io.write_string("private static int mercury_envvar_", !IO),
|
|
io.write_string(EnvVarName, !IO),
|
|
io.write_string(" =\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("java.lang.System.getenv(\"", !IO),
|
|
io.write_string(EnvVarName, !IO),
|
|
io.write_string("\") == null ? 0 : 1;\n", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output the start and end of a source file.
|
|
%
|
|
|
|
:- pred output_src_start(globals::in, java_out_info::in, indent::in,
|
|
mercury_module_name::in, mlds_imports::in, list(foreign_decl_code)::in,
|
|
list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_src_start(Globals, Info, Indent, MercuryModuleName, Imports,
|
|
ForeignDecls, Defns, !IO) :-
|
|
output_auto_gen_comment(Globals, MercuryModuleName, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("/* :- module ", !IO),
|
|
prog_out.write_sym_name(MercuryModuleName, !IO),
|
|
io.write_string(". */\n\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("package jmercury;\n", !IO),
|
|
|
|
output_imports(Imports, !IO),
|
|
io.write_list(ForeignDecls, "\n", output_java_decl(Info, Indent), !IO),
|
|
io.write_string("public class ", !IO),
|
|
mangle_sym_name_for_java(MercuryModuleName, module_qual, "__", ClassName),
|
|
io.write_string(ClassName, !IO),
|
|
io.write_string(" {\n", !IO),
|
|
|
|
output_debug_class_init(MercuryModuleName, "start", !IO),
|
|
|
|
% Check if this module contains a `main' predicate and if it does insert
|
|
% a `main' method in the resulting Java class that calls the `main'
|
|
% predicate.
|
|
( defns_contain_main(Defns) ->
|
|
write_main_driver(Indent + 1, ClassName, !IO)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred write_main_driver(indent::in, string::in, io::di, io::uo) is det.
|
|
|
|
write_main_driver(Indent, ClassName, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("public static void main", !IO),
|
|
io.write_string("(java.lang.String[] args)\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
|
|
% Save the progname and command line arguments in the class variables
|
|
% of `jmercury.runtime.JavaInternal', as well as setting the default
|
|
% exit status.
|
|
Body = [
|
|
"jmercury.runtime.JavaInternal.progname = """ ++ ClassName ++ """;",
|
|
"jmercury.runtime.JavaInternal.args = args;",
|
|
"jmercury.runtime.JavaInternal.exit_status = 0;",
|
|
"benchmarking.ML_initialise();",
|
|
"try {",
|
|
" " ++ ClassName ++ ".main_2_p_0();",
|
|
" jmercury.runtime.JavaInternal.run_finalisers();",
|
|
"} catch (jmercury.runtime.Exception e) {",
|
|
" exception.ML_report_uncaught_exception(",
|
|
" (univ.Univ_0) e.exception);",
|
|
" if (System.getenv(""MERCURY_SUPPRESS_STACK_TRACE"") == null) {",
|
|
" e.printStackTrace(System.err);",
|
|
" }",
|
|
" if (jmercury.runtime.JavaInternal.exit_status == 0) {",
|
|
" jmercury.runtime.JavaInternal.exit_status = 1;",
|
|
" }",
|
|
"}",
|
|
"java.lang.System.exit(jmercury.runtime.JavaInternal.exit_status);"
|
|
],
|
|
list.foldl(write_indented_line(Indent + 1), Body, !IO),
|
|
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
:- pred write_indented_line(indent::in, string::in, io::di, io::uo) is det.
|
|
|
|
write_indented_line(Indent, Line, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string(Line, !IO),
|
|
io.nl(!IO).
|
|
|
|
:- pred output_src_end(indent::in, mercury_module_name::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_src_end(Indent, ModuleName, !IO) :-
|
|
output_debug_class_init(ModuleName, "end", !IO),
|
|
io.write_string("}\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("// :- end_module ", !IO),
|
|
prog_out.write_sym_name(ModuleName, !IO),
|
|
io.write_string(".\n", !IO).
|
|
|
|
:- pred output_debug_class_init(mercury_module_name::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_debug_class_init(ModuleName, State, !IO) :-
|
|
list.foldl(io.write_string, [
|
|
" static {\n",
|
|
" if (System.getenv(""MERCURY_DEBUG_CLASS_INIT"") != null) {\n",
|
|
" System.out.println(""[", sym_name_mangle(ModuleName),
|
|
" ", State, " init]"");\n",
|
|
" }\n",
|
|
" }\n"
|
|
], !IO).
|
|
|
|
% Output a Java comment saying that the file was automatically
|
|
% generated and give details such as the compiler version.
|
|
%
|
|
:- pred output_auto_gen_comment(globals::in, mercury_module_name::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_auto_gen_comment(Globals, ModuleName, !IO) :-
|
|
library.version(Version),
|
|
module_name_to_file_name(Globals, ModuleName, ".m", do_not_create_dirs,
|
|
SourceFileName, !IO),
|
|
io.write_string("//\n//\n// Automatically generated from ", !IO),
|
|
io.write_string(SourceFileName, !IO),
|
|
io.write_string(" by the Mercury Compiler,\n", !IO),
|
|
io.write_string("// version ", !IO),
|
|
io.write_string(Version, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("//\n", !IO),
|
|
io.write_string("//\n", !IO),
|
|
io.nl(!IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output declarations and definitions.
|
|
%
|
|
|
|
% Options to adjust the behaviour of the output predicates.
|
|
%
|
|
:- type output_aux
|
|
---> none
|
|
% Nothing special.
|
|
|
|
; cname(mlds_entity_name)
|
|
% Pass down the class name if a definition is a constructor; this
|
|
% is needed since the class name is not available for a constructor
|
|
% in the MLDS.
|
|
|
|
; alloc_only
|
|
% When writing out RTTI structure definitions, initialise members
|
|
% with allocated top-level structures but don't fill in the fields
|
|
% yet.
|
|
|
|
; force_init.
|
|
% Used to force local variables to be initialised even if an
|
|
% initialiser is not provided.
|
|
|
|
:- pred output_defns(java_out_info::in, indent::in, output_aux::in,
|
|
list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_defns(Info, Indent, OutputAux, Defns, !IO) :-
|
|
list.foldl(output_defn(Info, Indent, OutputAux), Defns, !IO).
|
|
|
|
:- pred output_defn(java_out_info::in, indent::in, output_aux::in,
|
|
mlds_defn::in, io::di, io::uo) is det.
|
|
|
|
output_defn(Info, Indent, OutputAux, Defn, !IO) :-
|
|
Defn = mlds_defn(Name, Context, Flags, DefnBody),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
( DefnBody = mlds_function(_, _, body_external, _, _) ->
|
|
% This is just a function declaration, with no body.
|
|
% Java doesn't support separate declarations and definitions,
|
|
% so just output the declaration as a comment.
|
|
% (Note that the actual definition of an external procedure
|
|
% must be given in `pragma java_code' in the same module.)
|
|
io.write_string("/* external:\n", !IO),
|
|
output_decl_flags(Info, Flags, !IO),
|
|
output_defn_body(Info, Indent, Name, OutputAux, Context, DefnBody,
|
|
!IO),
|
|
io.write_string("*/\n", !IO)
|
|
;
|
|
output_decl_flags(Info, Flags, !IO),
|
|
output_defn_body(Info, Indent, Name, OutputAux, Context, DefnBody,
|
|
!IO)
|
|
).
|
|
|
|
:- pred output_defn_body(java_out_info::in, indent::in, mlds_entity_name::in,
|
|
output_aux::in, mlds_context::in, mlds_entity_defn::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_defn_body(Info, Indent, UnqualName, OutputAux, Context, Entity, !IO) :-
|
|
(
|
|
Entity = mlds_data(Type, Initializer, _),
|
|
output_data_defn(Info, UnqualName, OutputAux, Type, Initializer,
|
|
!IO)
|
|
;
|
|
Entity = mlds_function(MaybePredProcId, Signature, MaybeBody,
|
|
_Attributes, _EnvVarNames),
|
|
output_maybe(MaybePredProcId, output_pred_proc_id(Info), !IO),
|
|
output_func(Info, Indent, UnqualName, OutputAux, Context,
|
|
Signature, MaybeBody, !IO)
|
|
;
|
|
Entity = mlds_class(ClassDefn),
|
|
output_class(Info, Indent, UnqualName, Context, ClassDefn, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output classes.
|
|
%
|
|
|
|
:- pred output_class(java_out_info::in, indent::in, mlds_entity_name::in,
|
|
mlds_context::in, mlds_class_defn::in, io::di, io::uo) is det.
|
|
|
|
output_class(Info, Indent, UnqualName, _Context, ClassDefn, !IO) :-
|
|
(
|
|
UnqualName = entity_type(ClassNamePrime, ArityPrime),
|
|
ClassName = ClassNamePrime,
|
|
Arity = ArityPrime
|
|
;
|
|
( UnqualName = entity_data(_)
|
|
; UnqualName = entity_function(_, _, _, _)
|
|
; UnqualName = entity_export(_)
|
|
),
|
|
unexpected(this_file, "output_class: name is not entity_type.")
|
|
),
|
|
ClassDefn = mlds_class_defn(Kind, _Imports, BaseClasses, Implements,
|
|
Ctors, AllMembers),
|
|
(
|
|
Kind = mlds_interface,
|
|
io.write_string("interface ", !IO)
|
|
;
|
|
( Kind = mlds_class
|
|
; Kind = mlds_package
|
|
; Kind = mlds_enum
|
|
; Kind = mlds_struct
|
|
),
|
|
io.write_string("class ", !IO)
|
|
),
|
|
output_class_name_and_arity(ClassName, Arity, !IO),
|
|
io.nl(!IO),
|
|
output_extends_list(Info, Indent + 1, BaseClasses, !IO),
|
|
output_implements_list(Indent + 1, Implements, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
output_class_body(Info, Indent + 1, Kind, UnqualName, AllMembers, !IO),
|
|
io.nl(!IO),
|
|
output_defns(Info, Indent + 1, cname(UnqualName), Ctors, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n\n", !IO).
|
|
|
|
% Output superclass that this class extends. Java does not support
|
|
% multiple inheritance, so more than one superclass is an error.
|
|
%
|
|
:- pred output_extends_list(java_out_info::in, indent::in,
|
|
list(mlds_class_id)::in, io::di, io::uo) is det.
|
|
|
|
output_extends_list(_, _, [], !IO).
|
|
output_extends_list(Info, Indent, [SuperClass], !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("extends ", !IO),
|
|
output_type(Info, normal_style, SuperClass, !IO),
|
|
io.nl(!IO).
|
|
output_extends_list(_, _, [_, _ | _], _, _) :-
|
|
unexpected(this_file,
|
|
"output_extends_list: multiple inheritance not supported in Java").
|
|
|
|
% Output list of interfaces that this class implements.
|
|
%
|
|
:- pred output_implements_list(indent::in, list(mlds_interface_id)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_implements_list(Indent, InterfaceList, !IO) :-
|
|
(
|
|
InterfaceList = []
|
|
;
|
|
InterfaceList = [_ | _],
|
|
indent_line(Indent, !IO),
|
|
io.write_string("implements ", !IO),
|
|
io.write_list(InterfaceList, ",", output_interface, !IO),
|
|
io.nl(!IO)
|
|
).
|
|
|
|
:- pred output_interface(mlds_interface_id::in, io::di, io::uo) is det.
|
|
|
|
output_interface(Interface, !IO) :-
|
|
(
|
|
Interface = mlds_class_type(qual(ModuleQualifier, QualKind, Name),
|
|
Arity, _)
|
|
->
|
|
SymName = mlds_module_name_to_sym_name(ModuleQualifier),
|
|
mangle_sym_name_for_java(SymName, convert_qual_kind(QualKind),
|
|
".", ModuleName),
|
|
io.format("%s.%s", [s(ModuleName), s(Name)], !IO),
|
|
%
|
|
% Check if the interface is one of the ones in the runtime
|
|
% system. If it is we don't need to output the arity.
|
|
%
|
|
( interface_is_special(Name) ->
|
|
true
|
|
;
|
|
io.format("%d", [i(Arity)], !IO)
|
|
)
|
|
;
|
|
unexpected(this_file, "output_interface: interface was not a class.")
|
|
).
|
|
|
|
:- pred output_class_body(java_out_info::in, indent::in, mlds_class_kind::in,
|
|
mlds_entity_name::in, list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_class_body(Info, Indent, Kind, UnqualName, AllMembers, !IO) :-
|
|
(
|
|
Kind = mlds_class,
|
|
output_defns(Info, Indent, none, AllMembers, !IO)
|
|
;
|
|
Kind = mlds_package,
|
|
unexpected(this_file, "cannot use package as a type.")
|
|
;
|
|
Kind = mlds_interface,
|
|
output_defns(Info, Indent, none, AllMembers, !IO)
|
|
;
|
|
Kind = mlds_struct,
|
|
unexpected(this_file,
|
|
"output_class_body: structs not supported in Java.")
|
|
;
|
|
Kind = mlds_enum,
|
|
list.filter(defn_is_const, AllMembers, EnumConsts),
|
|
output_enum_constants(Info, Indent + 1, UnqualName, EnumConsts, !IO),
|
|
io.nl(!IO),
|
|
output_enum_ctor(Indent + 1, UnqualName, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Additional code for generating enumerations.
|
|
%
|
|
% Enumerations are a bit different from normal classes because although the
|
|
% ml code generator generates them as classes, it treats them as integers.
|
|
% Here we treat them as objects (instantiations of the classes) rather than
|
|
% just as integers.
|
|
|
|
:- pred defn_is_const(mlds_defn::in) is semidet.
|
|
|
|
defn_is_const(Defn) :-
|
|
Defn = mlds_defn(_Name, _Context, Flags, _DefnBody),
|
|
constness(Flags) = const.
|
|
|
|
% Output a (Java) constructor for the class representing the enumeration.
|
|
%
|
|
:- pred output_enum_ctor(indent::in, mlds_entity_name::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_enum_ctor(Indent, UnqualName, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("private ", !IO),
|
|
output_name(UnqualName, !IO),
|
|
io.write_string("(int val) {\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
% Call the MercuryEnum constructor, which will set the MR_value field.
|
|
io.write_string("super(val);\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
:- pred output_enum_constants(java_out_info::in, indent::in,
|
|
mlds_entity_name::in, list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_enum_constants(Info, Indent, EnumName, EnumConsts, !IO) :-
|
|
io.write_list(EnumConsts, "\n",
|
|
output_enum_constant(Info, Indent, EnumName), !IO),
|
|
io.nl(!IO).
|
|
|
|
:- pred output_enum_constant(java_out_info::in, indent::in,
|
|
mlds_entity_name::in, mlds_defn::in, io::di, io::uo) is det.
|
|
|
|
output_enum_constant(_Info, Indent, EnumName, Defn, !IO) :-
|
|
Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
|
|
( DefnBody = mlds_data(_Type, Initializer, _GCStatement) ->
|
|
% Make a static instance of the constant. The MLDS doesn't retain enum
|
|
% constructor names (that shouldn't be hard to change now) so it is
|
|
% easier to derive the name of the constant later by naming them after
|
|
% the integer values.
|
|
(
|
|
Initializer = init_obj(Rval),
|
|
( Rval = ml_const(mlconst_enum(N, _)) ->
|
|
indent_line(Indent, !IO),
|
|
io.write_string("public static final ", !IO),
|
|
output_name(EnumName, !IO),
|
|
io.format(" K%d = new ", [i(N)], !IO),
|
|
output_name(EnumName, !IO),
|
|
io.format("(%d); ", [i(N)], !IO),
|
|
|
|
io.write_string(" /* ", !IO),
|
|
output_name(Name, !IO),
|
|
io.write_string(" */", !IO)
|
|
;
|
|
unexpected(this_file, "output_enum_constant: not mlconst_enum")
|
|
)
|
|
;
|
|
( Initializer = no_initializer
|
|
; Initializer = init_struct(_, _)
|
|
; Initializer = init_array(_)
|
|
),
|
|
unexpected(this_file, "output_enum_constant: not mlconst_enum")
|
|
)
|
|
;
|
|
unexpected(this_file,
|
|
"output_enum_constant: definition body was not data.")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output data declarations/definitions.
|
|
%
|
|
|
|
:- pred output_data_decls(java_out_info::in, indent::in, list(mlds_defn)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_data_decls(_, _, [], !IO).
|
|
output_data_decls(Info, Indent, [Defn | Defns], !IO) :-
|
|
Defn = mlds_defn(Name, _Context, Flags, DefnBody),
|
|
( DefnBody = mlds_data(Type, _Initializer, _GCStatement) ->
|
|
indent_line(Indent, !IO),
|
|
% We can't honour `final' here as the variable is assigned separately.
|
|
NonFinalFlags = set_finality(Flags, overridable),
|
|
output_decl_flags(Info, NonFinalFlags, !IO),
|
|
output_data_decl(Info, Name, Type, !IO),
|
|
io.write_string(";\n", !IO)
|
|
;
|
|
unexpected(this_file, "output_data_decls: not data")
|
|
),
|
|
output_data_decls(Info, Indent, Defns, !IO).
|
|
|
|
:- pred output_data_decl(java_out_info::in, mlds_entity_name::in,
|
|
mlds_type::in, io::di, io::uo) is det.
|
|
|
|
output_data_decl(Info, Name, Type, !IO) :-
|
|
output_type(Info, normal_style, Type, !IO),
|
|
io.write_char(' ', !IO),
|
|
output_name(Name, !IO).
|
|
|
|
:- pred output_data_assignments(java_out_info::in, indent::in,
|
|
list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_data_assignments(Info, Indent, Defns, !IO) :-
|
|
% Divide into small methods to avoid running into the maximum method size
|
|
% limit.
|
|
list.chunk(Defns, 1000, DefnChunks),
|
|
list.foldl2(output_init_data_method(Info, Indent),
|
|
DefnChunks, 0, NumChunks, !IO),
|
|
|
|
% Call the individual methods.
|
|
indent_line(Indent, !IO),
|
|
io.write_string("static {\n", !IO),
|
|
int.fold_up(output_call_init_data_method(Indent + 1), 0, NumChunks - 1,
|
|
!IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
:- pred output_init_data_method(java_out_info::in, indent::in,
|
|
list(mlds_defn)::in, int::in, int::out, io::di, io::uo) is det.
|
|
|
|
output_init_data_method(Info, Indent, Defns, Chunk, Chunk + 1, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.format("private static void MR_init_data_%d() {\n", [i(Chunk)], !IO),
|
|
output_init_data_statements(Info, Indent + 1, Defns, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
:- pred output_init_data_statements(java_out_info::in, indent::in,
|
|
list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_init_data_statements(_, _, [], !IO).
|
|
output_init_data_statements(Info, Indent, [Defn | Defns], !IO) :-
|
|
Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
|
|
( DefnBody = mlds_data(Type, Initializer, _GCStatement) ->
|
|
indent_line(Indent, !IO),
|
|
output_name(Name, !IO),
|
|
output_initializer(Info, none, Type, Initializer, !IO),
|
|
io.write_string(";\n", !IO)
|
|
;
|
|
unexpected(this_file, "output_init_data_statements: not mlds_data")
|
|
),
|
|
output_init_data_statements(Info, Indent, Defns, !IO).
|
|
|
|
:- pred output_call_init_data_method(indent::in, int::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_call_init_data_method(Indent, I, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.format("MR_init_data_%d();\n", [i(I)], !IO).
|
|
|
|
:- pred output_data_defn(java_out_info::in, mlds_entity_name::in,
|
|
output_aux::in, mlds_type::in, mlds_initializer::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_data_defn(Info, Name, OutputAux, Type, Initializer, !IO) :-
|
|
output_data_decl(Info, Name, Type, !IO),
|
|
output_initializer(Info, OutputAux, Type, Initializer, !IO),
|
|
io.write_string(";\n", !IO).
|
|
|
|
% We need to provide initializers for local variables to avoid problems
|
|
% with Java's rules for definite assignment. This mirrors the default
|
|
% Java initializers for class and instance variables.
|
|
%
|
|
:- func get_java_type_initializer(mlds_type) = string.
|
|
|
|
get_java_type_initializer(Type) = Initializer :-
|
|
(
|
|
Type = mercury_type(_, CtorCat, _),
|
|
(
|
|
( CtorCat = ctor_cat_builtin(cat_builtin_int)
|
|
; CtorCat = ctor_cat_builtin(cat_builtin_float)
|
|
),
|
|
Initializer = "0"
|
|
;
|
|
CtorCat = ctor_cat_builtin(cat_builtin_char),
|
|
Initializer = "'\\u0000'"
|
|
;
|
|
( CtorCat = ctor_cat_builtin(cat_builtin_string)
|
|
; CtorCat = ctor_cat_system(_)
|
|
; CtorCat = ctor_cat_higher_order
|
|
; CtorCat = ctor_cat_tuple
|
|
; CtorCat = ctor_cat_enum(_)
|
|
; CtorCat = ctor_cat_builtin_dummy
|
|
; CtorCat = ctor_cat_variable
|
|
; CtorCat = ctor_cat_void
|
|
; CtorCat = ctor_cat_user(_)
|
|
),
|
|
Initializer = "null"
|
|
)
|
|
;
|
|
( Type = mlds_native_int_type
|
|
; Type = mlds_native_float_type
|
|
),
|
|
Initializer = "0"
|
|
;
|
|
Type = mlds_native_char_type,
|
|
Initializer = "'\\u0000'"
|
|
;
|
|
Type = mlds_native_bool_type,
|
|
Initializer = "false"
|
|
;
|
|
( Type = mlds_mercury_array_type(_)
|
|
; Type = mlds_cont_type(_)
|
|
; Type = mlds_commit_type
|
|
; Type = mlds_foreign_type(_)
|
|
; Type = mlds_class_type(_, _, _)
|
|
; Type = mlds_array_type(_)
|
|
; Type = mlds_ptr_type(_)
|
|
; Type = mlds_func_type(_)
|
|
; Type = mlds_generic_type
|
|
; Type = mlds_generic_env_ptr_type
|
|
; Type = mlds_type_info_type
|
|
; Type = mlds_pseudo_type_info_type
|
|
; Type = mlds_rtti_type(_)
|
|
; Type = mlds_tabling_type(_)
|
|
),
|
|
Initializer = "null"
|
|
;
|
|
Type = mlds_unknown_type,
|
|
unexpected(this_file,
|
|
"get_type_initializer: variable has unknown_type")
|
|
).
|
|
|
|
:- pred output_maybe(maybe(T)::in,
|
|
pred(T, io, io)::pred(in, di, uo) is det, io::di, io::uo) is det.
|
|
|
|
output_maybe(MaybeValue, OutputAction, !IO) :-
|
|
(
|
|
MaybeValue = yes(Value),
|
|
OutputAction(Value, !IO)
|
|
;
|
|
MaybeValue = no
|
|
).
|
|
|
|
:- pred output_initializer(java_out_info::in, output_aux::in, mlds_type::in,
|
|
mlds_initializer::in, io::di, io::uo) is det.
|
|
|
|
output_initializer(Info, OutputAux, Type, Initializer, !IO) :-
|
|
NeedsInit = needs_initialization(Initializer),
|
|
(
|
|
NeedsInit = yes,
|
|
io.write_string(" = ", !IO),
|
|
% Due to cyclic references, we need to separate the allocation and
|
|
% initialisation steps of RTTI structures. If InitStyle is alloc_only
|
|
% then we output an initializer to allocate a structure without filling
|
|
% in the fields.
|
|
(
|
|
( OutputAux = none
|
|
; OutputAux = cname(_)
|
|
; OutputAux = force_init
|
|
),
|
|
output_initializer_body(Info, Initializer, yes(Type), !IO)
|
|
;
|
|
OutputAux = alloc_only,
|
|
output_initializer_alloc_only(Info, Initializer, yes(Type), !IO)
|
|
)
|
|
;
|
|
NeedsInit = no,
|
|
(
|
|
OutputAux = force_init,
|
|
% Local variables need to be initialised to avoid warnings.
|
|
io.write_string(" = ", !IO),
|
|
io.write_string(get_java_type_initializer(Type), !IO)
|
|
;
|
|
( OutputAux = none
|
|
; OutputAux = cname(_)
|
|
; OutputAux = alloc_only
|
|
)
|
|
)
|
|
).
|
|
|
|
:- func needs_initialization(mlds_initializer) = bool.
|
|
|
|
needs_initialization(no_initializer) = no.
|
|
needs_initialization(init_obj(_)) = yes.
|
|
needs_initialization(init_struct(_, _)) = yes.
|
|
needs_initialization(init_array(_)) = yes.
|
|
|
|
:- pred output_initializer_alloc_only(java_out_info::in, mlds_initializer::in,
|
|
maybe(mlds_type)::in, io::di, io::uo) is det.
|
|
|
|
output_initializer_alloc_only(Info, Initializer, MaybeType, !IO) :-
|
|
(
|
|
Initializer = no_initializer,
|
|
unexpected(this_file, "output_initializer_alloc_only: no_initializer")
|
|
;
|
|
Initializer = init_obj(_),
|
|
unexpected(this_file, "output_initializer_alloc_only: init_obj")
|
|
;
|
|
Initializer = init_struct(StructType, _FieldInits),
|
|
io.write_string("new ", !IO),
|
|
output_type(Info, normal_style, StructType, !IO),
|
|
io.write_string("()", !IO)
|
|
;
|
|
Initializer = init_array(ElementInits),
|
|
Size = list.length(ElementInits),
|
|
io.write_string("new ", !IO),
|
|
(
|
|
MaybeType = yes(Type),
|
|
output_type(Info, sized_array(Size), Type, !IO)
|
|
;
|
|
MaybeType = no,
|
|
% XXX we need to know the type here
|
|
io.write_string("/* XXX init_array */ Object", !IO),
|
|
output_array_brackets(sized_array(Size), !IO)
|
|
)
|
|
).
|
|
|
|
:- pred output_initializer_body(java_out_info::in, mlds_initializer::in,
|
|
maybe(mlds_type)::in, io::di, io::uo) is det.
|
|
|
|
output_initializer_body(Info, Initializer, MaybeType, !IO) :-
|
|
(
|
|
Initializer = no_initializer,
|
|
unexpected(this_file, "output_initializer_body: no_initializer")
|
|
;
|
|
Initializer = init_obj(Rval),
|
|
output_rval(Info, Rval, !IO)
|
|
;
|
|
Initializer = init_struct(StructType, FieldInits),
|
|
io.write_string("new ", !IO),
|
|
output_type(Info, normal_style, StructType, !IO),
|
|
IsArray = type_is_array(StructType),
|
|
io.write_string(if IsArray = is_array then " {" else "(", !IO),
|
|
output_initializer_body_list(Info, FieldInits, !IO),
|
|
io.write_char(if IsArray = is_array then '}' else ')', !IO)
|
|
;
|
|
Initializer = init_array(ElementInits),
|
|
io.write_string("new ", !IO),
|
|
(
|
|
MaybeType = yes(Type),
|
|
output_type(Info, normal_style, Type, !IO)
|
|
;
|
|
MaybeType = no,
|
|
% XXX we need to know the type here
|
|
io.write_string("/* XXX init_array */ Object[]", !IO)
|
|
),
|
|
io.write_string(" {\n\t\t", !IO),
|
|
output_initializer_body_list(Info, ElementInits, !IO),
|
|
io.write_string("}", !IO)
|
|
).
|
|
|
|
:- pred output_initializer_body_list(java_out_info::in,
|
|
list(mlds_initializer)::in, io::di, io::uo) is det.
|
|
|
|
output_initializer_body_list(Info, Inits, !IO) :-
|
|
io.write_list(Inits, ",\n\t\t",
|
|
(pred(Init::in, !.IO::di, !:IO::uo) is det :-
|
|
output_initializer_body(Info, Init, no, !IO)),
|
|
!IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output RTTI data assignments.
|
|
%
|
|
|
|
:- pred output_rtti_assignments(java_out_info::in, indent::in,
|
|
list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_rtti_assignments(Info, Indent, Defns, !IO) :-
|
|
(
|
|
Defns = []
|
|
;
|
|
Defns = [_ | _],
|
|
OrderedDefns = order_mlds_rtti_defns(Defns),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("static {\n", !IO),
|
|
list.foldl(output_rtti_defns_assignments(Info, Indent + 1),
|
|
OrderedDefns, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO)
|
|
).
|
|
|
|
:- pred output_rtti_defns_assignments(java_out_info::in, indent::in,
|
|
list(mlds_defn)::in, io::di, io::uo) is det.
|
|
|
|
output_rtti_defns_assignments(Info, Indent, Defns, !IO) :-
|
|
% Separate cliques.
|
|
indent_line(Indent, !IO),
|
|
io.write_string("//\n", !IO),
|
|
list.foldl(output_rtti_defn_assignments(Info, Indent),
|
|
Defns, !IO).
|
|
|
|
:- pred output_rtti_defn_assignments(java_out_info::in, indent::in,
|
|
mlds_defn::in, io::di, io::uo) is det.
|
|
|
|
output_rtti_defn_assignments(Info, Indent, Defn, !IO) :-
|
|
Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
|
|
(
|
|
DefnBody = mlds_data(_Type, Initializer, _),
|
|
output_rtti_defn_assignments_2(Info, Indent, Name, Initializer, !IO)
|
|
;
|
|
( DefnBody = mlds_function(_, _, _, _, _)
|
|
; DefnBody = mlds_class(_)
|
|
),
|
|
unexpected(this_file,
|
|
"output_rtti_defn_assignments: expected mlds_data")
|
|
).
|
|
|
|
:- pred output_rtti_defn_assignments_2(java_out_info::in, indent::in,
|
|
mlds_entity_name::in, mlds_initializer::in, io::di, io::uo) is det.
|
|
|
|
output_rtti_defn_assignments_2(Info, Indent, Name, Initializer, !IO) :-
|
|
(
|
|
Initializer = no_initializer
|
|
;
|
|
Initializer = init_obj(_),
|
|
% Not encountered in practice.
|
|
unexpected(this_file, "output_rtti_defn_assignments_2: init_obj")
|
|
;
|
|
Initializer = init_struct(StructType, FieldInits),
|
|
IsArray = type_is_array(StructType),
|
|
(
|
|
IsArray = not_array,
|
|
indent_line(Indent, !IO),
|
|
output_name(Name, !IO),
|
|
io.write_string(".init(", !IO),
|
|
output_initializer_body_list(Info, FieldInits, !IO),
|
|
io.write_string(");\n", !IO)
|
|
;
|
|
IsArray = is_array,
|
|
% Not encountered in practice.
|
|
unexpected(this_file, "output_rtti_defn_assignments_2: is_array")
|
|
)
|
|
;
|
|
Initializer = init_array(ElementInits),
|
|
list.foldl2(output_rtti_array_assignments(Info, Indent, Name),
|
|
ElementInits, 0, _Index, !IO)
|
|
).
|
|
|
|
:- pred output_rtti_array_assignments(java_out_info::in, indent::in,
|
|
mlds_entity_name::in, mlds_initializer::in, int::in, int::out,
|
|
io::di, io::uo) is det.
|
|
|
|
output_rtti_array_assignments(Info, Indent, Name, ElementInit,
|
|
Index, Index + 1, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
output_name(Name, !IO),
|
|
io.write_string("[", !IO),
|
|
io.write_int(Index, !IO),
|
|
io.write_string("] = ", !IO),
|
|
output_initializer_body(Info, ElementInit, no, !IO),
|
|
io.write_string(";\n", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output function declarations/definitions.
|
|
%
|
|
|
|
:- pred output_pred_proc_id(java_out_info::in, pred_proc_id::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_pred_proc_id(Info, proc(PredId, ProcId), !IO) :-
|
|
AutoComments = Info ^ joi_auto_comments,
|
|
(
|
|
AutoComments = yes,
|
|
io.write_string("// pred_id: ", !IO),
|
|
pred_id_to_int(PredId, PredIdNum),
|
|
io.write_int(PredIdNum, !IO),
|
|
io.write_string(", proc_id: ", !IO),
|
|
proc_id_to_int(ProcId, ProcIdNum),
|
|
io.write_int(ProcIdNum, !IO),
|
|
io.nl(!IO)
|
|
;
|
|
AutoComments = no
|
|
).
|
|
|
|
:- pred output_func(java_out_info::in, indent::in, mlds_entity_name::in,
|
|
output_aux::in, mlds_context::in,
|
|
mlds_func_params::in, mlds_function_body::in, io::di, io::uo) is det.
|
|
|
|
output_func(Info, Indent, Name, OutputAux, Context, Signature, MaybeBody,
|
|
!IO) :-
|
|
(
|
|
MaybeBody = body_defined_here(Body),
|
|
output_func_decl(Info, Indent, Name, OutputAux, Context, Signature,
|
|
!IO),
|
|
io.write_string("\n", !IO),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
FuncInfo = func_info(Signature),
|
|
output_statement(Info, Indent + 1, FuncInfo, Body, _ExitMethods, !IO),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("}\n", !IO) % end the function
|
|
;
|
|
MaybeBody = body_external
|
|
).
|
|
|
|
:- pred output_func_decl(java_out_info::in, indent::in,
|
|
mlds_entity_name::in, output_aux::in, mlds_context::in,
|
|
mlds_func_params::in, io::di, io::uo) is det.
|
|
|
|
output_func_decl(Info, Indent, Name, OutputAux, Context, Signature, !IO) :-
|
|
(
|
|
OutputAux = cname(CtorName),
|
|
Signature = mlds_func_params(Parameters, _RetTypes),
|
|
output_name(CtorName, !IO),
|
|
output_params(Info, Indent, Context, Parameters, !IO)
|
|
;
|
|
( OutputAux = none
|
|
; OutputAux = alloc_only
|
|
; OutputAux = force_init
|
|
),
|
|
Signature = mlds_func_params(Parameters, RetTypes),
|
|
(
|
|
RetTypes = [],
|
|
io.write_string("void", !IO)
|
|
;
|
|
RetTypes = [RetType],
|
|
output_type(Info, normal_style, RetType, !IO)
|
|
;
|
|
RetTypes = [_, _ | _],
|
|
% For multiple outputs, we return an array of objects.
|
|
io.write_string("java.lang.Object []", !IO)
|
|
),
|
|
io.write_char(' ', !IO),
|
|
output_name(Name, !IO),
|
|
output_params(Info, Indent, Context, Parameters, !IO)
|
|
).
|
|
|
|
:- pred output_params(java_out_info::in, indent::in, mlds_context::in,
|
|
mlds_arguments::in, io::di, io::uo) is det.
|
|
|
|
output_params(Info, Indent, Context, Parameters, !IO) :-
|
|
io.write_char('(', !IO),
|
|
(
|
|
Parameters = []
|
|
;
|
|
Parameters = [_ | _],
|
|
io.nl(!IO),
|
|
io.write_list(Parameters, ",\n",
|
|
output_param(Info, Indent + 1, Context), !IO)
|
|
),
|
|
io.write_char(')', !IO).
|
|
|
|
:- pred output_param(java_out_info::in, indent::in, mlds_context::in,
|
|
mlds_argument::in, io::di, io::uo) is det.
|
|
|
|
output_param(Info, Indent, Context, Arg, !IO) :-
|
|
Arg = mlds_argument(Name, Type, _GCStatement),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
output_type(Info, normal_style, Type, !IO),
|
|
io.write_char(' ', !IO),
|
|
output_name(Name, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output names of various entities.
|
|
%
|
|
% XXX Much of the code in this section will not work when we start enforcing
|
|
% names properly.
|
|
%
|
|
|
|
:- pred output_maybe_qualified_name(java_out_info::in,
|
|
mlds_qualified_entity_name::in, io::di, io::uo) is det.
|
|
|
|
output_maybe_qualified_name(Info, QualifiedName, !IO) :-
|
|
% Don't module qualify names which are defined in the current module.
|
|
% This avoids unnecessary verbosity, and is also necessary in the case
|
|
% of local variables and function parameters, which must not be qualified.
|
|
QualifiedName = qual(ModuleName, _QualKind, Name),
|
|
CurrentModuleName = Info ^ joi_module_name,
|
|
( ModuleName = CurrentModuleName ->
|
|
output_name(Name, !IO)
|
|
;
|
|
output_fully_qualified_thing(QualifiedName, output_name, !IO)
|
|
).
|
|
|
|
:- pred output_fully_qualified_name(mlds_qualified_entity_name::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_fully_qualified_name(QualifiedName, !IO) :-
|
|
output_fully_qualified_thing(QualifiedName, output_name, !IO).
|
|
|
|
:- pred output_fully_qualified_proc_label(mlds_qualified_proc_label::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_fully_qualified_proc_label(QualifiedName, !IO) :-
|
|
output_fully_qualified_thing(QualifiedName, mlds_output_proc_label, !IO).
|
|
|
|
:- pred output_fully_qualified_thing(mlds_fully_qualified_name(T)::in,
|
|
pred(T, io, io)::pred(in, di, uo) is det, io::di, io::uo) is det.
|
|
|
|
output_fully_qualified_thing(qual(MLDS_ModuleName, QualKind, Name), OutputFunc,
|
|
!IO) :-
|
|
% XXX These functions are named wrongly for Java.
|
|
mlds_module_name_to_package_name(MLDS_ModuleName) = OuterName,
|
|
mlds_module_name_to_sym_name(MLDS_ModuleName) = InnerName,
|
|
|
|
% Write the part of the qualifier that corresponds to a top-level Java
|
|
% class.
|
|
mangle_sym_name_for_java(OuterName, module_qual, "__", MangledOuterName),
|
|
io.write_string(MangledOuterName, !IO),
|
|
|
|
% Write the later parts of the qualifier correspond to nested Java classes.
|
|
( OuterName = InnerName ->
|
|
true
|
|
;
|
|
io.write_string(".", !IO),
|
|
remove_sym_name_prefixes(InnerName, OuterName, Suffix),
|
|
mangle_sym_name_for_java(Suffix, convert_qual_kind(QualKind), ".",
|
|
MangledSuffix),
|
|
io.write_string(MangledSuffix, !IO)
|
|
),
|
|
|
|
% Write the qualified thing.
|
|
io.write_string(".", !IO),
|
|
OutputFunc(Name, !IO).
|
|
|
|
:- pred remove_sym_name_prefixes(sym_name::in, sym_name::in, sym_name::out)
|
|
is det.
|
|
|
|
remove_sym_name_prefixes(SymName0, Prefix, SymName) :-
|
|
(
|
|
SymName0 = qualified(Qual, Name),
|
|
( Qual = Prefix ->
|
|
SymName = unqualified(Name)
|
|
;
|
|
remove_sym_name_prefixes(Qual, Prefix, SymName1),
|
|
SymName = qualified(SymName1, Name)
|
|
)
|
|
;
|
|
SymName0 = unqualified(_),
|
|
unexpected(this_file, "remove_sym_name_prefixes: prefix not found")
|
|
).
|
|
|
|
:- func convert_qual_kind(mlds_qual_kind) = java_qual_kind.
|
|
|
|
convert_qual_kind(module_qual) = module_qual.
|
|
convert_qual_kind(type_qual) = type_qual.
|
|
|
|
:- pred output_module_name(mercury_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_module_name(ModuleName, !IO) :-
|
|
io.write_string(sym_name_mangle(ModuleName), !IO).
|
|
|
|
:- pred output_class_name_and_arity(mlds_class_name::in, arity::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_class_name_and_arity(Name, Arity, !IO) :-
|
|
output_class_name(Name, !IO),
|
|
io.format("_%d", [i(Arity)], !IO).
|
|
|
|
:- pred output_class_name(mlds_class_name::in, io::di, io::uo) is det.
|
|
|
|
output_class_name(Name, !IO) :-
|
|
MangledName = name_mangle_no_leading_digit(Name),
|
|
% By convention, class names should start with a capital letter.
|
|
UppercaseMangledName = flip_initial_case(MangledName),
|
|
io.write_string(UppercaseMangledName, !IO).
|
|
|
|
:- pred output_name(mlds_entity_name::in, io::di, io::uo) is det.
|
|
|
|
output_name(entity_type(Name, Arity), !IO) :-
|
|
output_class_name_and_arity(Name, Arity, !IO).
|
|
output_name(entity_data(DataName), !IO) :-
|
|
output_data_name(DataName, !IO).
|
|
output_name(entity_function(PredLabel, ProcId, MaybeSeqNum, _PredId), !IO) :-
|
|
output_pred_label(PredLabel, !IO),
|
|
proc_id_to_int(ProcId, ModeNum),
|
|
io.format("_%d", [i(ModeNum)], !IO),
|
|
(
|
|
MaybeSeqNum = yes(SeqNum),
|
|
io.format("_%d", [i(SeqNum)], !IO)
|
|
;
|
|
MaybeSeqNum = no
|
|
).
|
|
output_name(entity_export(Name), !IO) :-
|
|
io.write_string(Name, !IO).
|
|
|
|
:- pred output_pred_label(mlds_pred_label::in, io::di, io::uo) is det.
|
|
|
|
output_pred_label(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule, Name,
|
|
PredArity, _, _), !IO) :-
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
Suffix = "p",
|
|
OrigArity = PredArity
|
|
;
|
|
PredOrFunc = pf_function,
|
|
Suffix = "f",
|
|
OrigArity = PredArity - 1
|
|
),
|
|
MangledName = name_mangle_no_leading_digit(Name),
|
|
io.format("%s_%d_%s", [s(MangledName), i(OrigArity), s(Suffix)], !IO),
|
|
(
|
|
MaybeDefiningModule = yes(DefiningModule),
|
|
io.write_string("_in__", !IO),
|
|
output_module_name(DefiningModule, !IO)
|
|
;
|
|
MaybeDefiningModule = no
|
|
).
|
|
|
|
output_pred_label(mlds_special_pred_label(PredName, MaybeTypeModule, TypeName,
|
|
TypeArity), !IO) :-
|
|
MangledPredName = name_mangle_no_leading_digit(PredName),
|
|
MangledTypeName = name_mangle(TypeName),
|
|
io.write_string(MangledPredName, !IO),
|
|
io.write_string("__", !IO),
|
|
(
|
|
MaybeTypeModule = yes(TypeModule),
|
|
output_module_name(TypeModule, !IO),
|
|
io.write_string("__", !IO)
|
|
;
|
|
MaybeTypeModule = no
|
|
),
|
|
io.format("%s_%d", [s(MangledTypeName), i(TypeArity)], !IO).
|
|
|
|
:- pred output_data_name(mlds_data_name::in, io::di, io::uo) is det.
|
|
|
|
output_data_name(mlds_data_var(VarName), !IO) :-
|
|
output_mlds_var_name(VarName, !IO).
|
|
output_data_name(mlds_scalar_common_ref(_), !IO) :-
|
|
unexpected(this_file, "NYI: mlds_scalar_common_ref").
|
|
output_data_name(mlds_rtti(RttiId), !IO) :-
|
|
rtti.id_to_c_identifier(RttiId, RttiAddrName),
|
|
io.write_string(RttiAddrName, !IO).
|
|
output_data_name(mlds_module_layout, !IO) :-
|
|
unexpected(this_file, "NYI: mlds_module_layout").
|
|
output_data_name(mlds_proc_layout(_ProcLabel), !IO) :-
|
|
unexpected(this_file, "NYI: mlds_proc_layout").
|
|
output_data_name(mlds_internal_layout(_ProcLabel, _FuncSeqNum), !IO) :-
|
|
unexpected(this_file, "NYI: mlds_internal_layout").
|
|
output_data_name(mlds_tabling_ref(ProcLabel, Id), !IO) :-
|
|
Prefix = tabling_info_id_str(Id) ++ "_",
|
|
io.write_string(Prefix, !IO),
|
|
mlds_output_proc_label(mlds_std_tabling_proc_label(ProcLabel), !IO).
|
|
|
|
:- pred output_mlds_var_name(mlds_var_name::in, io::di, io::uo) is det.
|
|
|
|
output_mlds_var_name(mlds_var_name(Name, no), !IO) :-
|
|
output_valid_mangled_name(Name, !IO).
|
|
output_mlds_var_name(mlds_var_name(Name, yes(Num)), !IO) :-
|
|
output_mangled_name(string.format("%s_%d", [s(Name), i(Num)]), !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output types.
|
|
%
|
|
|
|
:- type output_style
|
|
---> normal_style
|
|
; sized_array(int).
|
|
% If writing an array type, include the integer within the
|
|
% square brackets.
|
|
|
|
:- pred output_type(java_out_info::in, output_style::in, mlds_type::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_type(Info, Style, MLDS_Type, !IO) :-
|
|
(
|
|
MLDS_Type = mercury_type(Type, CtorCat, _),
|
|
(
|
|
% We need to handle type_info (etc.) types specially --
|
|
% they get mapped to types in the runtime rather than
|
|
% in private_builtin.
|
|
hand_defined_type(CtorCat, SubstituteName)
|
|
->
|
|
io.write_string(SubstituteName, !IO)
|
|
;
|
|
% io.state and store.store
|
|
CtorCat = ctor_cat_builtin_dummy
|
|
->
|
|
io.write_string("/* builtin_dummy */ java.lang.Object", !IO)
|
|
;
|
|
Type = c_pointer_type
|
|
->
|
|
% The c_pointer type is used in the c back-end as a generic way
|
|
% to pass foreign types to automatically generated Compare and
|
|
% Unify code. When compiling to Java we must instead use
|
|
% java.lang.Object.
|
|
io.write_string("/* c_pointer */ java.lang.Object", !IO)
|
|
;
|
|
output_mercury_type(Info, Style, Type, CtorCat, !IO)
|
|
)
|
|
;
|
|
MLDS_Type = mlds_mercury_array_type(ElementType),
|
|
( ElementType = mercury_type(_, ctor_cat_variable, _) ->
|
|
% We can't use `java.lang.Object []', since we want a generic type
|
|
% that is capable of holding any kind of array, including e.g.
|
|
% `int []'. Java doesn't have any equivalent of .NET's System.Array
|
|
% class, so we just use the universal base `java.lang.Object'.
|
|
io.write_string("/* Array */ java.lang.Object", !IO)
|
|
;
|
|
% For primitive element types we use arrays of the primitive type.
|
|
% For non-primitive element types, we just use
|
|
% `java.lang.Object []'. We used to use more specific types,
|
|
% but then to create an array of the right type we need to use
|
|
% reflection to determine the class of a representative element.
|
|
% That doesn't work if the representative element is of a foreign
|
|
% type, and has the value null.
|
|
( java_builtin_type(ElementType, _, _, _) ->
|
|
output_type(Info, Style, ElementType, !IO)
|
|
;
|
|
io.write_string("/* ", !IO),
|
|
output_type(Info, Style, ElementType, !IO),
|
|
io.write_string("[] */ java.lang.Object", !IO)
|
|
),
|
|
output_array_brackets(Style, !IO)
|
|
)
|
|
;
|
|
MLDS_Type = mlds_native_int_type,
|
|
io.write_string("int", !IO)
|
|
;
|
|
MLDS_Type = mlds_native_float_type,
|
|
io.write_string("double", !IO)
|
|
;
|
|
MLDS_Type = mlds_native_bool_type,
|
|
io.write_string("boolean", !IO)
|
|
;
|
|
MLDS_Type = mlds_native_char_type,
|
|
io.write_string("char", !IO)
|
|
;
|
|
MLDS_Type = mlds_foreign_type(ForeignType),
|
|
(
|
|
ForeignType = java(java_type(Name)),
|
|
maybe_output_comment(Info, "foreign_type", !IO),
|
|
io.write_string(Name, !IO)
|
|
;
|
|
ForeignType = c(_),
|
|
unexpected(this_file, "output_type: c foreign_type")
|
|
;
|
|
ForeignType = il(_),
|
|
unexpected(this_file, "output_type: il foreign_type")
|
|
;
|
|
ForeignType = erlang(_),
|
|
unexpected(this_file, "output_type: erlang foreign_type")
|
|
)
|
|
;
|
|
MLDS_Type = mlds_class_type(Name, Arity, _ClassKind),
|
|
(
|
|
Name = qual(ModuleName, _, ClassName),
|
|
SymName = mlds_module_name_to_sym_name(ModuleName),
|
|
SymName = mercury_runtime_package_name
|
|
->
|
|
% Don't mangle runtime class names.
|
|
io.write_string("jmercury.runtime.", !IO),
|
|
io.write_string(ClassName, !IO)
|
|
;
|
|
% We used to treat enumerations specially here, outputting
|
|
% them as "int", but now we do the same for all classes.
|
|
output_fully_qualified_thing(Name, output_class_name, !IO),
|
|
io.format("_%d", [i(Arity)], !IO)
|
|
)
|
|
;
|
|
MLDS_Type = mlds_ptr_type(Type),
|
|
% XXX Should we report an error here, if the type pointed to
|
|
% is not a class type?
|
|
output_type(Info, Style, Type, !IO)
|
|
;
|
|
MLDS_Type = mlds_array_type(Type),
|
|
output_type(Info, Style, Type, !IO),
|
|
output_array_brackets(Style, !IO)
|
|
;
|
|
MLDS_Type = mlds_func_type(_FuncParams),
|
|
io.write_string("jmercury.runtime.MethodPtr", !IO)
|
|
;
|
|
MLDS_Type = mlds_generic_type,
|
|
io.write_string("java.lang.Object", !IO)
|
|
;
|
|
MLDS_Type = mlds_generic_env_ptr_type,
|
|
io.write_string("/* env_ptr */ java.lang.Object", !IO)
|
|
;
|
|
MLDS_Type = mlds_type_info_type,
|
|
io.write_string("jmercury.runtime.TypeInfo", !IO)
|
|
;
|
|
MLDS_Type = mlds_pseudo_type_info_type,
|
|
io.write_string("jmercury.runtime.PseudoTypeInfo", !IO)
|
|
;
|
|
MLDS_Type = mlds_cont_type(_),
|
|
% XXX Should this actually be a class that extends MethodPtr?
|
|
io.write_string("jmercury.runtime.MethodPtr", !IO)
|
|
;
|
|
MLDS_Type = mlds_commit_type,
|
|
io.write_string("jmercury.runtime.Commit", !IO)
|
|
;
|
|
MLDS_Type = mlds_rtti_type(RttiIdMaybeElement),
|
|
rtti_id_maybe_element_java_type(RttiIdMaybeElement, JavaTypeName,
|
|
IsArray),
|
|
io.write_string(JavaTypeName, !IO),
|
|
(
|
|
IsArray = is_array,
|
|
output_array_brackets(Style, !IO)
|
|
;
|
|
IsArray = not_array
|
|
)
|
|
;
|
|
MLDS_Type = mlds_tabling_type(TablingId),
|
|
tabling_id_java_type(TablingId, JavaTypeName, IsArray),
|
|
io.write_string(JavaTypeName, !IO),
|
|
(
|
|
IsArray = is_array,
|
|
output_array_brackets(Style, !IO)
|
|
;
|
|
IsArray = not_array
|
|
)
|
|
;
|
|
MLDS_Type = mlds_unknown_type,
|
|
unexpected(this_file, "output_type: unknown type")
|
|
).
|
|
|
|
:- pred output_mercury_type(java_out_info::in, output_style::in, mer_type::in,
|
|
type_ctor_category::in, io::di, io::uo) is det.
|
|
|
|
output_mercury_type(Info, Style, Type, CtorCat, !IO) :-
|
|
(
|
|
CtorCat = ctor_cat_builtin(cat_builtin_char),
|
|
io.write_string("char", !IO)
|
|
;
|
|
CtorCat = ctor_cat_builtin(cat_builtin_int),
|
|
io.write_string("int", !IO)
|
|
;
|
|
CtorCat = ctor_cat_builtin(cat_builtin_string),
|
|
io.write_string("java.lang.String", !IO)
|
|
;
|
|
CtorCat = ctor_cat_builtin(cat_builtin_float),
|
|
io.write_string("double", !IO)
|
|
;
|
|
CtorCat = ctor_cat_void,
|
|
io.write_string("builtin.Void_0", !IO)
|
|
;
|
|
CtorCat = ctor_cat_variable,
|
|
io.write_string("java.lang.Object", !IO)
|
|
;
|
|
CtorCat = ctor_cat_tuple,
|
|
io.write_string("/* tuple */ java.lang.Object", !IO),
|
|
output_array_brackets(Style, !IO)
|
|
;
|
|
CtorCat = ctor_cat_higher_order,
|
|
io.write_string("/* closure */ java.lang.Object", !IO),
|
|
output_array_brackets(Style, !IO)
|
|
;
|
|
CtorCat = ctor_cat_system(_),
|
|
output_mercury_user_type(Info, Style, Type,
|
|
ctor_cat_user(cat_user_general), !IO)
|
|
;
|
|
( CtorCat = ctor_cat_enum(_)
|
|
; CtorCat = ctor_cat_user(_)
|
|
; CtorCat = ctor_cat_builtin_dummy
|
|
),
|
|
output_mercury_user_type(Info, Style, Type, CtorCat, !IO)
|
|
).
|
|
|
|
:- pred output_mercury_user_type(java_out_info::in, output_style::in,
|
|
mer_type::in, type_ctor_category::in, io::di, io::uo) is det.
|
|
|
|
output_mercury_user_type(Info, Style, Type, CtorCat, !IO) :-
|
|
( type_to_ctor_and_args(Type, TypeCtor, _ArgsTypes) ->
|
|
ml_gen_type_name(TypeCtor, ClassName, ClassArity),
|
|
( CtorCat = ctor_cat_enum(_) ->
|
|
MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_enum)
|
|
;
|
|
MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_class)
|
|
),
|
|
output_type(Info, Style, MLDS_Type, !IO)
|
|
;
|
|
unexpected(this_file, "output_mercury_user_type: not a user type")
|
|
).
|
|
|
|
:- pred output_array_brackets(output_style::in, io::di, io::uo) is det.
|
|
|
|
output_array_brackets(Style, !IO) :-
|
|
io.write_string("[", !IO),
|
|
(
|
|
Style = normal_style
|
|
;
|
|
Style = sized_array(Size),
|
|
io.write_int(Size, !IO)
|
|
),
|
|
io.write_string("]", !IO).
|
|
|
|
% Return is_array if the corresponding Java type is an array type.
|
|
%
|
|
:- func type_is_array(mlds_type) = is_array.
|
|
|
|
type_is_array(Type) = IsArray :-
|
|
( Type = mlds_array_type(_) ->
|
|
IsArray = is_array
|
|
; Type = mlds_mercury_array_type(_) ->
|
|
IsArray = is_array
|
|
; Type = mercury_type(_, CtorCat, _) ->
|
|
IsArray = type_category_is_array(CtorCat)
|
|
; Type = mlds_rtti_type(RttiIdMaybeElement) ->
|
|
rtti_id_maybe_element_java_type(RttiIdMaybeElement,
|
|
_JavaTypeName, IsArray)
|
|
;
|
|
IsArray = not_array
|
|
).
|
|
|
|
% Return is_array if the corresponding Java type is an array type.
|
|
%
|
|
:- func type_category_is_array(type_ctor_category) = is_array.
|
|
|
|
type_category_is_array(CtorCat) = IsArray :-
|
|
(
|
|
( CtorCat = ctor_cat_builtin(_)
|
|
; CtorCat = ctor_cat_enum(_)
|
|
; CtorCat = ctor_cat_builtin_dummy
|
|
; CtorCat = ctor_cat_variable
|
|
; CtorCat = ctor_cat_system(cat_system_type_info)
|
|
; CtorCat = ctor_cat_system(cat_system_type_ctor_info)
|
|
; CtorCat = ctor_cat_void
|
|
; CtorCat = ctor_cat_user(_)
|
|
),
|
|
IsArray = not_array
|
|
;
|
|
( CtorCat = ctor_cat_higher_order
|
|
; CtorCat = ctor_cat_tuple
|
|
; CtorCat = ctor_cat_system(cat_system_typeclass_info)
|
|
; CtorCat = ctor_cat_system(cat_system_base_typeclass_info)
|
|
),
|
|
IsArray = is_array
|
|
).
|
|
|
|
% hand_defined_type(Type, SubstituteName):
|
|
%
|
|
% We need to handle type_info (etc.) types specially -- they get mapped
|
|
% to types in the runtime rather than in private_builtin.
|
|
%
|
|
:- pred hand_defined_type(type_ctor_category::in, string::out) is semidet.
|
|
|
|
hand_defined_type(ctor_cat_system(Kind), SubstituteName) :-
|
|
(
|
|
Kind = cat_system_type_info,
|
|
SubstituteName = "jmercury.runtime.TypeInfo_Struct"
|
|
;
|
|
Kind = cat_system_type_ctor_info,
|
|
SubstituteName = "jmercury.runtime.TypeCtorInfo_Struct"
|
|
;
|
|
Kind = cat_system_typeclass_info,
|
|
SubstituteName = "/* typeclass_info */ java.lang.Object[]"
|
|
;
|
|
Kind = cat_system_base_typeclass_info,
|
|
SubstituteName = "/* base_typeclass_info */ java.lang.Object[]"
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output declaration specifiers.
|
|
%
|
|
|
|
:- pred output_decl_flags(java_out_info::in, mlds_decl_flags::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_decl_flags(Info, Flags, !IO) :-
|
|
output_access(Info, access(Flags), !IO),
|
|
output_per_instance(per_instance(Flags), !IO),
|
|
output_virtuality(Info, virtuality(Flags), !IO),
|
|
output_finality(finality(Flags), !IO),
|
|
output_constness(Info, constness(Flags), !IO),
|
|
output_abstractness(abstractness(Flags), !IO).
|
|
|
|
:- pred output_access(java_out_info::in, access::in, io::di, io::uo) is det.
|
|
|
|
output_access(Info, Access, !IO) :-
|
|
(
|
|
Access = acc_public,
|
|
io.write_string("public ", !IO)
|
|
;
|
|
Access = acc_private,
|
|
io.write_string("private ", !IO)
|
|
;
|
|
Access = acc_protected,
|
|
io.write_string("protected ", !IO)
|
|
;
|
|
Access = acc_default,
|
|
maybe_output_comment(Info, "default", !IO)
|
|
;
|
|
Access = acc_local
|
|
).
|
|
|
|
:- pred output_per_instance(per_instance::in, io::di, io::uo) is det.
|
|
|
|
output_per_instance(PerInstance, !IO) :-
|
|
(
|
|
PerInstance = per_instance
|
|
;
|
|
PerInstance = one_copy,
|
|
io.write_string("static ", !IO)
|
|
).
|
|
|
|
:- pred output_virtuality(java_out_info::in, virtuality::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_virtuality(Info, Virtual, !IO) :-
|
|
(
|
|
Virtual = virtual,
|
|
maybe_output_comment(Info, "virtual", !IO)
|
|
;
|
|
Virtual = non_virtual
|
|
).
|
|
|
|
:- pred output_finality(finality::in, io::di, io::uo) is det.
|
|
|
|
output_finality(Finality, !IO) :-
|
|
(
|
|
Finality = final,
|
|
io.write_string("final ", !IO)
|
|
;
|
|
Finality = overridable
|
|
).
|
|
|
|
:- pred output_constness(java_out_info::in, constness::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_constness(Info, Constness, !IO) :-
|
|
(
|
|
Constness = const,
|
|
maybe_output_comment(Info, "const", !IO)
|
|
;
|
|
Constness = modifiable
|
|
).
|
|
|
|
:- pred output_abstractness(abstractness::in, io::di, io::uo) is det.
|
|
|
|
output_abstractness(Abstractness, !IO) :-
|
|
(
|
|
Abstractness = abstract,
|
|
io.write_string("abstract ", !IO)
|
|
;
|
|
Abstractness = concrete
|
|
).
|
|
|
|
:- pred maybe_output_comment(java_out_info::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
maybe_output_comment(Info, Comment, !IO) :-
|
|
AutoComments = Info ^ joi_auto_comments,
|
|
(
|
|
AutoComments = yes,
|
|
io.write_string("/* ", !IO),
|
|
io.write_string(Comment, !IO),
|
|
io.write_string(" */", !IO)
|
|
;
|
|
AutoComments = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output statements.
|
|
%
|
|
|
|
% These types are used by many of the output_stmt style predicates to
|
|
% return information about the statement's control flow,
|
|
% i.e. about the different ways in which the statement can exit.
|
|
% In general we only output the current statement if the previous
|
|
% statement could complete normally (fall through).
|
|
% We keep a set of exit methods since some statements (like an
|
|
% if-then-else) could potentially break, and also fall through.
|
|
:- type exit_methods == set.set(exit_method).
|
|
|
|
:- type exit_method
|
|
---> can_break
|
|
; can_continue
|
|
; can_return
|
|
; can_throw
|
|
; can_fall_through. % Where the instruction can complete
|
|
% normally and execution can continue
|
|
% with the following statement.
|
|
|
|
:- type code_addr_wrapper
|
|
---> code_addr_wrapper(
|
|
caw_class :: string,
|
|
caw_ptr_num :: maybe(int)
|
|
).
|
|
|
|
:- type func_info
|
|
---> func_info(
|
|
func_info_params :: mlds_func_params
|
|
).
|
|
|
|
:- func mod_name(mlds_fully_qualified_name(T)) = mlds_module_name.
|
|
|
|
mod_name(qual(ModuleName, _, _)) = ModuleName.
|
|
|
|
:- pred output_statements(java_out_info::in, indent::in, func_info::in,
|
|
list(statement)::in, exit_methods::out, io::di, io::uo) is det.
|
|
|
|
output_statements(_, _, _, [], ExitMethods, !IO) :-
|
|
ExitMethods = set.make_singleton_set(can_fall_through).
|
|
output_statements(Info, Indent, FuncInfo, [Statement | Statements],
|
|
ExitMethods, !IO) :-
|
|
output_statement(Info, Indent, FuncInfo, Statement,
|
|
StmtExitMethods, !IO),
|
|
( set.member(can_fall_through, StmtExitMethods) ->
|
|
output_statements(Info, Indent, FuncInfo, Statements,
|
|
StmtsExitMethods, !IO),
|
|
ExitMethods0 = StmtExitMethods `set.union` StmtsExitMethods,
|
|
( set.member(can_fall_through, StmtsExitMethods) ->
|
|
ExitMethods = ExitMethods0
|
|
;
|
|
% If the last statement could not complete normally
|
|
% the current block can no longer complete normally.
|
|
ExitMethods = ExitMethods0 `set.delete` can_fall_through
|
|
)
|
|
;
|
|
% Don't output any more statements from the current list since
|
|
% the preceeding statement cannot complete.
|
|
ExitMethods = StmtExitMethods
|
|
).
|
|
|
|
:- pred output_statement(java_out_info::in, indent::in,
|
|
func_info::in, statement::in, exit_methods::out, io::di, io::uo) is det.
|
|
|
|
output_statement(Info, Indent, FuncInfo,
|
|
statement(Statement, Context), ExitMethods, !IO) :-
|
|
output_context(Info, Context, !IO),
|
|
output_stmt(Info, Indent, FuncInfo, Statement, Context,
|
|
ExitMethods, !IO).
|
|
|
|
:- pred output_stmt(java_out_info::in, indent::in, func_info::in,
|
|
mlds_stmt::in, mlds_context::in, exit_methods::out, io::di, io::uo) is det.
|
|
|
|
output_stmt(Info, Indent, FuncInfo, Statement, Context, ExitMethods, !IO) :-
|
|
(
|
|
Statement = ml_stmt_block(Defns, Statements),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
(
|
|
Defns = [_ | _],
|
|
output_defns(Info, Indent + 1, force_init, Defns, !IO),
|
|
io.write_string("\n", !IO)
|
|
;
|
|
Defns = []
|
|
),
|
|
output_statements(Info, Indent + 1, FuncInfo, Statements,
|
|
ExitMethods, !IO),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("}\n", !IO)
|
|
;
|
|
Statement = ml_stmt_while(Kind, Cond, BodyStatement),
|
|
Kind = may_loop_zero_times,
|
|
indent_line(Indent, !IO),
|
|
io.write_string("while (", !IO),
|
|
output_rval(Info, Cond, !IO),
|
|
io.write_string(")\n", !IO),
|
|
% The contained statement is reachable iff the while statement is
|
|
% reachable and the condition expression is not a constant expression
|
|
% whose value is false.
|
|
( Cond = ml_const(mlconst_false) ->
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{ /* Unreachable code */ }\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_fall_through)
|
|
;
|
|
output_statement(Info, Indent + 1, FuncInfo, BodyStatement,
|
|
StmtExitMethods, !IO),
|
|
ExitMethods = while_exit_methods(Cond, StmtExitMethods)
|
|
)
|
|
;
|
|
Statement = ml_stmt_while(Kind, Cond, BodyStatement),
|
|
Kind = loop_at_least_once,
|
|
indent_line(Indent, !IO),
|
|
io.write_string("do\n", !IO),
|
|
output_statement(Info, Indent + 1, FuncInfo, BodyStatement,
|
|
StmtExitMethods, !IO),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("while (", !IO),
|
|
output_rval(Info, Cond, !IO),
|
|
io.write_string(");\n", !IO),
|
|
ExitMethods = while_exit_methods(Cond, StmtExitMethods)
|
|
;
|
|
Statement = ml_stmt_if_then_else(Cond, Then0, MaybeElse),
|
|
% We need to take care to avoid problems caused by the dangling else
|
|
% ambiguity.
|
|
(
|
|
% For examples of the form
|
|
%
|
|
% if (...)
|
|
% if (...)
|
|
% ...
|
|
% else
|
|
% ...
|
|
%
|
|
% we need braces around the inner `if', otherwise they wouldn't
|
|
% parse they way we want them to: Java would match the `else'
|
|
% with the inner `if' rather than the outer `if'.
|
|
|
|
MaybeElse = yes(_),
|
|
Then0 = statement(ml_stmt_if_then_else(_, _, no), ThenContext)
|
|
->
|
|
Then = statement(ml_stmt_block([], [Then0]), ThenContext)
|
|
;
|
|
Then = Then0
|
|
),
|
|
|
|
indent_line(Indent, !IO),
|
|
io.write_string("if (", !IO),
|
|
output_rval(Info, Cond, !IO),
|
|
io.write_string(")\n", !IO),
|
|
output_statement(Info, Indent + 1, FuncInfo, Then,
|
|
ThenExitMethods, !IO),
|
|
(
|
|
MaybeElse = yes(Else),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("else\n", !IO),
|
|
output_statement(Info, Indent + 1, FuncInfo, Else,
|
|
ElseExitMethods, !IO),
|
|
% An if-then-else statement can complete normally iff the
|
|
% then-statement can complete normally or the else-statement
|
|
% can complete normally.
|
|
ExitMethods = ThenExitMethods `set.union` ElseExitMethods
|
|
;
|
|
MaybeElse = no,
|
|
% An if-then statement can complete normally iff it is reachable.
|
|
ExitMethods = ThenExitMethods `set.union`
|
|
set.make_singleton_set(can_fall_through)
|
|
)
|
|
;
|
|
Statement = ml_stmt_switch(_Type, Val, _Range, Cases, Default),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("switch (", !IO),
|
|
output_rval_maybe_with_enum(Info, Val, !IO),
|
|
io.write_string(") {\n", !IO),
|
|
output_switch_cases(Info, Indent + 1, FuncInfo, Context, Cases,
|
|
Default, ExitMethods, !IO),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("}\n", !IO)
|
|
;
|
|
Statement = ml_stmt_label(_),
|
|
unexpected(this_file, "output_stmt: labels not supported in Java.")
|
|
;
|
|
Statement = ml_stmt_goto(goto_label(_)),
|
|
unexpected(this_file, "output_stmt: gotos not supported in Java.")
|
|
;
|
|
Statement = ml_stmt_goto(goto_break),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("break;\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_break)
|
|
;
|
|
Statement = ml_stmt_goto(goto_continue),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("continue;\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_continue)
|
|
;
|
|
Statement = ml_stmt_computed_goto(_, _),
|
|
unexpected(this_file,
|
|
"output_stmt: computed gotos not supported in Java.")
|
|
;
|
|
Statement = ml_stmt_call(Signature, FuncRval, MaybeObject, CallArgs,
|
|
Results, _IsTailCall),
|
|
Signature = mlds_func_signature(ArgTypes, RetTypes),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
indent_line(Info, Context, Indent + 1, !IO),
|
|
(
|
|
Results = []
|
|
;
|
|
Results = [Lval],
|
|
output_lval(Info, Lval, !IO),
|
|
io.write_string(" = ", !IO)
|
|
;
|
|
Results = [_, _ | _],
|
|
% for multiple return values,
|
|
% we generate the following code:
|
|
% { java.lang.Object [] result = <func>(<args>);
|
|
% <output1> = (<type1>) result[0];
|
|
% <output2> = (<type2>) result[1];
|
|
% ...
|
|
% }
|
|
%
|
|
io.write_string("java.lang.Object [] result = ", !IO)
|
|
),
|
|
( FuncRval = ml_const(mlconst_code_addr(_)) ->
|
|
% This is a standard method call.
|
|
(
|
|
MaybeObject = yes(Object),
|
|
output_bracketed_rval(Info, Object, !IO),
|
|
io.write_string(".", !IO)
|
|
;
|
|
MaybeObject = no
|
|
),
|
|
% This is a standard function call.
|
|
output_call_rval(Info, FuncRval, !IO),
|
|
io.write_string("(", !IO),
|
|
io.write_list(CallArgs, ", ", output_rval(Info), !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
% This is a call using a method pointer.
|
|
%
|
|
% Here we do downcasting, as a call will always return
|
|
% something of type java.lang.Object
|
|
%
|
|
% XXX This is a hack, I can't see any way to do this downcasting
|
|
% nicely, as it needs to effectively be wrapped around the method
|
|
% call itself, so it acts before this predicate's solution to
|
|
% multiple return values, see above.
|
|
|
|
(
|
|
RetTypes = []
|
|
;
|
|
RetTypes = [RetType],
|
|
( java_builtin_type(RetType, _, JavaBoxedName, _) ->
|
|
io.write_string("((", !IO),
|
|
io.write_string(JavaBoxedName, !IO),
|
|
io.write_string(") ", !IO)
|
|
;
|
|
io.write_string("((", !IO),
|
|
output_type(Info, normal_style, RetType, !IO),
|
|
io.write_string(") ", !IO)
|
|
)
|
|
;
|
|
RetTypes = [_, _ | _],
|
|
io.write_string("((java.lang.Object[]) ", !IO)
|
|
),
|
|
(
|
|
MaybeObject = yes(Object),
|
|
output_bracketed_rval(Info, Object, !IO),
|
|
io.write_string(".", !IO)
|
|
;
|
|
MaybeObject = no
|
|
),
|
|
|
|
list.length(CallArgs, Arity),
|
|
( Arity =< max_specialised_method_ptr_arity ->
|
|
io.write_string("((jmercury.runtime.MethodPtr", !IO),
|
|
io.write_int(Arity, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_bracketed_rval(Info, FuncRval, !IO),
|
|
io.write_string(").call___0_0(", !IO),
|
|
output_boxed_args(Info, CallArgs, ArgTypes, !IO)
|
|
;
|
|
io.write_string("((jmercury.runtime.MethodPtrN) ", !IO),
|
|
output_bracketed_rval(Info, FuncRval, !IO),
|
|
io.write_string(").call___0_0(", !IO),
|
|
output_args_as_array(Info, CallArgs, ArgTypes, !IO)
|
|
),
|
|
|
|
% Closes brackets, and calls unbox methods for downcasting.
|
|
% XXX This is a hack, see the above comment.
|
|
io.write_string(")", !IO),
|
|
(
|
|
RetTypes = []
|
|
;
|
|
RetTypes = [RetType2],
|
|
( java_builtin_type(RetType2, _, _, UnboxMethod) ->
|
|
io.write_string(").", !IO),
|
|
io.write_string(UnboxMethod, !IO),
|
|
io.write_string("()", !IO)
|
|
;
|
|
io.write_string(")", !IO)
|
|
)
|
|
;
|
|
RetTypes = [_, _ | _],
|
|
io.write_string(")", !IO)
|
|
)
|
|
),
|
|
io.write_string(";\n", !IO),
|
|
|
|
( Results = [_, _ | _] ->
|
|
% Copy the results from the "result" array into the Result
|
|
% lvals (unboxing them as we go).
|
|
output_assign_results(Info, Results, RetTypes, 0, Indent + 1,
|
|
Context, !IO)
|
|
;
|
|
true
|
|
),
|
|
% XXX Is this needed? If present, it causes compiler errors for a
|
|
% couple of files in the benchmarks directory. -mjwybrow
|
|
%
|
|
% ( IsTailCall = tail_call, Results = [] ->
|
|
% indent_line(Context, Indent + 1, !IO),
|
|
% io.write_string("return;\n", !IO)
|
|
% ;
|
|
% true
|
|
% ),
|
|
%
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_fall_through)
|
|
;
|
|
Statement = ml_stmt_return(Results),
|
|
(
|
|
Results = [],
|
|
indent_line(Indent, !IO),
|
|
io.write_string("return;\n", !IO)
|
|
;
|
|
Results = [Rval],
|
|
indent_line(Indent, !IO),
|
|
io.write_string("return ", !IO),
|
|
output_rval(Info, Rval, !IO),
|
|
io.write_string(";\n", !IO)
|
|
;
|
|
Results = [_, _ | _],
|
|
FuncInfo = func_info(Params),
|
|
Params = mlds_func_params(_Args, ReturnTypes),
|
|
TypesAndResults = assoc_list.from_corresponding_lists(
|
|
ReturnTypes, Results),
|
|
io.write_string("return new java.lang.Object[] {\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
Separator = ",\n" ++ duplicate_char(' ', (Indent + 1) * 2),
|
|
io.write_list(TypesAndResults, Separator,
|
|
(pred((Type - Result)::in, !.IO::di, !:IO::uo) is det :-
|
|
output_boxed_rval(Info, Type, Result, !IO)),
|
|
!IO),
|
|
io.write_string("\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("};\n", !IO)
|
|
),
|
|
ExitMethods = set.make_singleton_set(can_return)
|
|
;
|
|
Statement = ml_stmt_do_commit(Ref),
|
|
indent_line(Indent, !IO),
|
|
output_rval(Info, Ref, !IO),
|
|
io.write_string(" = new jmercury.runtime.Commit();\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("throw ", !IO),
|
|
output_rval(Info, Ref, !IO),
|
|
io.write_string(";\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_throw)
|
|
;
|
|
Statement = ml_stmt_try_commit(_Ref, Stmt, Handler),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("try\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
output_statement(Info, Indent + 1, FuncInfo, Stmt,
|
|
TryExitMethods0, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("catch (jmercury.runtime.Commit commit_variable)\n",
|
|
!IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
output_statement(Info, Indent + 1, FuncInfo, Handler,
|
|
CatchExitMethods, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO),
|
|
ExitMethods = (TryExitMethods0 `set.delete` can_throw)
|
|
`set.union` CatchExitMethods
|
|
;
|
|
Statement = ml_stmt_atomic(AtomicStatement),
|
|
output_atomic_stmt(Info, Indent, AtomicStatement, Context, !IO),
|
|
ExitMethods = set.make_singleton_set(can_fall_through)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Extra code for handling while-loops.
|
|
%
|
|
|
|
:- func while_exit_methods(mlds_rval, exit_methods) = exit_methods.
|
|
|
|
while_exit_methods(Cond, BlockExitMethods) = ExitMethods :-
|
|
% A while statement cannot complete normally if its condition
|
|
% expression is a constant expression with value true, and it
|
|
% doesn't contain a reachable break statement that exits the
|
|
% while statement.
|
|
(
|
|
% XXX This is not a sufficient way of testing for a Java
|
|
% "constant expression", though determining these accurately
|
|
% is a little difficult to do here.
|
|
Cond = ml_const(mlconst_true),
|
|
not set.member(can_break, BlockExitMethods)
|
|
->
|
|
% Cannot complete normally
|
|
ExitMethods0 = BlockExitMethods `set.delete` can_fall_through
|
|
;
|
|
ExitMethods0 = BlockExitMethods `set.insert` can_fall_through
|
|
),
|
|
ExitMethods = (ExitMethods0 `set.delete` can_continue)
|
|
`set.delete` can_break.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Extra code for handling function calls/returns.
|
|
%
|
|
|
|
:- pred output_args_as_array(java_out_info::in, list(mlds_rval)::in,
|
|
list(mlds_type)::in, io::di, io::uo) is det.
|
|
|
|
output_args_as_array(Info, CallArgs, CallArgTypes, !IO) :-
|
|
io.write_string("new java.lang.Object[] { ", !IO),
|
|
output_boxed_args(Info, CallArgs, CallArgTypes, !IO),
|
|
io.write_string("} ", !IO).
|
|
|
|
:- pred output_boxed_args(java_out_info::in, list(mlds_rval)::in,
|
|
list(mlds_type)::in, io::di, io::uo) is det.
|
|
|
|
output_boxed_args(_, [], [], !IO).
|
|
output_boxed_args(_, [_ | _], [], !IO) :-
|
|
unexpected(this_file, "output_boxed_args: length mismatch.").
|
|
output_boxed_args(_, [], [_ | _], !IO) :-
|
|
unexpected(this_file, "output_boxed_args: length mismatch.").
|
|
output_boxed_args(Info, [CallArg | CallArgs], [CallArgType | CallArgTypes],
|
|
!IO) :-
|
|
output_boxed_rval(Info, CallArgType, CallArg, !IO),
|
|
(
|
|
CallArgs = []
|
|
;
|
|
CallArgs = [_ | _],
|
|
io.write_string(", ", !IO),
|
|
output_boxed_args(Info, CallArgs, CallArgTypes, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for handling multiple return values.
|
|
%
|
|
|
|
% When returning multiple values,
|
|
% we generate the following code:
|
|
% { java.lang.Object [] result = <func>(<args>);
|
|
% <output1> = (<type1>) result[0];
|
|
% <output2> = (<type2>) result[1];
|
|
% ...
|
|
% }
|
|
%
|
|
|
|
% This procedure generates the assignments to the outputs.
|
|
%
|
|
:- pred output_assign_results(java_out_info::in, list(mlds_lval)::in,
|
|
list(mlds_type)::in, int::in, indent::in, mlds_context::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_assign_results(_, [], [], _, _, _, !IO).
|
|
output_assign_results(Info, [Lval | Lvals], [Type | Types], ResultIndex,
|
|
Indent, Context, !IO) :-
|
|
indent_line(Info, Context, Indent, !IO),
|
|
output_lval(Info, Lval, !IO),
|
|
io.write_string(" = ", !IO),
|
|
output_unboxed_result(Info, Type, ResultIndex, !IO),
|
|
io.write_string(";\n", !IO),
|
|
output_assign_results(Info, Lvals, Types, ResultIndex + 1,
|
|
Indent, Context, !IO).
|
|
output_assign_results(_, [_ | _], [], _, _, _, _, _) :-
|
|
unexpected(this_file, "output_assign_results: list length mismatch.").
|
|
output_assign_results(_, [], [_ | _], _, _, _, _, _) :-
|
|
unexpected(this_file, "output_assign_results: list length mismatch.").
|
|
|
|
:- pred output_unboxed_result(java_out_info::in, mlds_type::in, int::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_unboxed_result(Info, Type, ResultIndex, !IO) :-
|
|
( java_builtin_type(Type, _, JavaBoxedName, UnboxMethod) ->
|
|
io.write_string("((", !IO),
|
|
io.write_string(JavaBoxedName, !IO),
|
|
io.write_string(") ", !IO),
|
|
io.format("result[%d]).%s()", [i(ResultIndex), s(UnboxMethod)], !IO)
|
|
;
|
|
io.write_string("(", !IO),
|
|
output_type(Info, normal_style, Type, !IO),
|
|
io.write_string(") ", !IO),
|
|
io.format("result[%d]", [i(ResultIndex)], !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Extra code for outputting switch statements.
|
|
%
|
|
|
|
:- pred output_switch_cases(java_out_info::in, indent::in, func_info::in,
|
|
mlds_context::in, list(mlds_switch_case)::in, mlds_switch_default::in,
|
|
exit_methods::out, io::di, io::uo) is det.
|
|
|
|
output_switch_cases(Info, Indent, FuncInfo, Context,
|
|
[], Default, ExitMethods, !IO) :-
|
|
output_switch_default(Info, Indent, FuncInfo, Context, Default,
|
|
ExitMethods, !IO).
|
|
output_switch_cases(Info, Indent, FuncInfo, Context,
|
|
[Case | Cases], Default, ExitMethods, !IO) :-
|
|
output_switch_case(Info, Indent, FuncInfo, Context, Case,
|
|
CaseExitMethods0, !IO),
|
|
output_switch_cases(Info, Indent, FuncInfo, Context, Cases, Default,
|
|
CasesExitMethods, !IO),
|
|
( set.member(can_break, CaseExitMethods0) ->
|
|
CaseExitMethods = (CaseExitMethods0 `set.delete` can_break)
|
|
`set.insert` can_fall_through
|
|
;
|
|
CaseExitMethods = CaseExitMethods0
|
|
),
|
|
ExitMethods = CaseExitMethods `set.union` CasesExitMethods.
|
|
|
|
:- pred output_switch_case(java_out_info::in, indent::in, func_info::in,
|
|
mlds_context::in, mlds_switch_case::in, exit_methods::out,
|
|
io::di, io::uo) is det.
|
|
|
|
output_switch_case(Info, Indent, FuncInfo, Context, Case, ExitMethods, !IO) :-
|
|
Case = mlds_switch_case(FirstCond, LaterConds, Statement),
|
|
output_case_cond(Info, Indent, Context, FirstCond, !IO),
|
|
list.foldl(output_case_cond(Info, Indent, Context), LaterConds, !IO),
|
|
output_statement(Info, Indent + 1, FuncInfo, Statement,
|
|
StmtExitMethods, !IO),
|
|
( set.member(can_fall_through, StmtExitMethods) ->
|
|
indent_line(Info, Context, Indent + 1, !IO),
|
|
io.write_string("break;\n", !IO),
|
|
ExitMethods = (StmtExitMethods `set.insert` can_break)
|
|
`set.delete` can_fall_through
|
|
;
|
|
% Don't output `break' since it would be unreachable.
|
|
ExitMethods = StmtExitMethods
|
|
).
|
|
|
|
:- pred output_case_cond(java_out_info::in, indent::in, mlds_context::in,
|
|
mlds_case_match_cond::in, io::di, io::uo) is det.
|
|
|
|
output_case_cond(Info, Indent, Context, Match, !IO) :-
|
|
(
|
|
Match = match_value(Val),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("case ", !IO),
|
|
output_rval(Info, Val, !IO),
|
|
io.write_string(":\n", !IO)
|
|
;
|
|
Match = match_range(_, _),
|
|
unexpected(this_file,
|
|
"output_case_cond: cannot match ranges in Java cases")
|
|
).
|
|
|
|
:- pred output_switch_default(java_out_info::in, indent::in, func_info::in,
|
|
mlds_context::in, mlds_switch_default::in, exit_methods::out,
|
|
io::di, io::uo) is det.
|
|
|
|
output_switch_default(Info, Indent, FuncInfo, Context, Default,
|
|
ExitMethods, !IO) :-
|
|
(
|
|
Default = default_do_nothing,
|
|
ExitMethods = set.make_singleton_set(can_fall_through)
|
|
;
|
|
Default = default_case(Statement),
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("default:\n", !IO),
|
|
output_statement(Info, Indent + 1, FuncInfo, Statement, ExitMethods,
|
|
!IO)
|
|
;
|
|
Default = default_is_unreachable,
|
|
indent_line(Info, Context, Indent, !IO),
|
|
io.write_string("default: /*NOTREACHED*/\n", !IO),
|
|
indent_line(Info, Context, Indent + 1, !IO),
|
|
io.write_string("throw new jmercury.runtime.UnreachableDefault();\n",
|
|
!IO),
|
|
ExitMethods = set.make_singleton_set(can_throw)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for outputting atomic statements.
|
|
%
|
|
|
|
:- pred output_atomic_stmt(java_out_info::in, indent::in,
|
|
mlds_atomic_statement::in, mlds_context::in, io::di, io::uo) is det.
|
|
|
|
output_atomic_stmt(Info, Indent, AtomicStmt, Context, !IO) :-
|
|
(
|
|
AtomicStmt = comment(Comment),
|
|
% XXX We should escape any "*/"'s in the Comment. We should also split
|
|
% the comment into lines and indent each line appropriately.
|
|
indent_line(Indent, !IO),
|
|
io.write_string("/* ", !IO),
|
|
io.write_string(Comment, !IO),
|
|
io.write_string(" */\n", !IO)
|
|
;
|
|
AtomicStmt = assign(Lval, Rval),
|
|
indent_line(Indent, !IO),
|
|
output_lval(Info, Lval, !IO),
|
|
io.write_string(" = ", !IO),
|
|
output_rval(Info, Rval, !IO),
|
|
io.write_string(";\n", !IO)
|
|
;
|
|
AtomicStmt = assign_if_in_heap(_, _),
|
|
sorry(this_file, "output_atomic_stmt: assign_if_in_heap")
|
|
;
|
|
AtomicStmt = delete_object(_Lval),
|
|
unexpected(this_file, "delete_object not supported in Java.")
|
|
;
|
|
AtomicStmt = new_object(Target, _MaybeTag, ExplicitSecTag, Type,
|
|
_MaybeSize, MaybeCtorName, Args, ArgTypes, _MayUseAtomic),
|
|
(
|
|
ExplicitSecTag = yes,
|
|
unexpected(this_file, "output_atomic_stmt: explicit secondary tag")
|
|
;
|
|
ExplicitSecTag = no
|
|
),
|
|
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
indent_line(Info, Context, Indent + 1, !IO),
|
|
output_lval(Info, Target, !IO),
|
|
io.write_string(" = new ", !IO),
|
|
% Generate class constructor name.
|
|
(
|
|
MaybeCtorName = yes(QualifiedCtorId),
|
|
\+ (
|
|
Type = mercury_type(_, CtorCat, _),
|
|
hand_defined_type(CtorCat, _)
|
|
)
|
|
->
|
|
output_type(Info, normal_style, Type, !IO),
|
|
io.write_char('.', !IO),
|
|
QualifiedCtorId = qual(_ModuleName, _QualKind, CtorDefn),
|
|
CtorDefn = ctor_id(CtorName, CtorArity),
|
|
output_class_name_and_arity(CtorName, CtorArity, !IO)
|
|
;
|
|
output_type(Info, normal_style, Type, !IO)
|
|
),
|
|
IsArray = type_is_array(Type),
|
|
(
|
|
IsArray = is_array,
|
|
% The new object will be an array, so we need to initialise it
|
|
% using array literals syntax.
|
|
io.write_string(" {", !IO),
|
|
output_init_args(Info, Args, ArgTypes, !IO),
|
|
io.write_string("};\n", !IO)
|
|
;
|
|
IsArray = not_array,
|
|
% Generate constructor arguments.
|
|
io.write_string("(", !IO),
|
|
output_init_args(Info, Args, ArgTypes, !IO),
|
|
io.write_string(");\n", !IO)
|
|
),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO)
|
|
;
|
|
AtomicStmt = gc_check,
|
|
unexpected(this_file, "gc_check not implemented.")
|
|
;
|
|
AtomicStmt = mark_hp(_Lval),
|
|
unexpected(this_file, "mark_hp not implemented.")
|
|
;
|
|
AtomicStmt = restore_hp(_Rval),
|
|
unexpected(this_file, "restore_hp not implemented.")
|
|
;
|
|
AtomicStmt = trail_op(_TrailOp),
|
|
unexpected(this_file, "trail_ops not implemented.")
|
|
;
|
|
AtomicStmt = inline_target_code(TargetLang, Components),
|
|
(
|
|
TargetLang = ml_target_java,
|
|
indent_line(Indent, !IO),
|
|
list.foldl(output_target_code_component(Info), Components, !IO)
|
|
;
|
|
( TargetLang = ml_target_c
|
|
; TargetLang = ml_target_gnu_c
|
|
; TargetLang = ml_target_asm
|
|
; TargetLang = ml_target_il
|
|
),
|
|
unexpected(this_file,
|
|
"inline_target_code only works for lang_java")
|
|
)
|
|
;
|
|
AtomicStmt = outline_foreign_proc(_TargetLang, _Vs, _Lvals, _Code),
|
|
unexpected(this_file, "foreign language interfacing not implemented")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_target_code_component(java_out_info::in,
|
|
target_code_component::in, io::di, io::uo) is det.
|
|
|
|
output_target_code_component(Info, TargetCode, !IO) :-
|
|
(
|
|
TargetCode = user_target_code(CodeString, MaybeUserContext, _Attrs),
|
|
(
|
|
MaybeUserContext = yes(ProgContext),
|
|
output_context(Info, mlds_make_context(ProgContext), !IO)
|
|
;
|
|
MaybeUserContext = no
|
|
),
|
|
io.write_string(CodeString, !IO)
|
|
;
|
|
TargetCode = raw_target_code(CodeString, _Attrs),
|
|
io.write_string(CodeString, !IO)
|
|
;
|
|
TargetCode = target_code_input(Rval),
|
|
output_rval(Info, Rval, !IO)
|
|
;
|
|
TargetCode = target_code_output(Lval),
|
|
output_lval(Info, Lval, !IO)
|
|
;
|
|
TargetCode = target_code_type(Type),
|
|
output_type(Info, normal_style, Type, !IO)
|
|
;
|
|
TargetCode = target_code_name(Name),
|
|
output_maybe_qualified_name(Info, Name, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Output initial values of an object's fields as arguments for the
|
|
% object's class constructor.
|
|
%
|
|
:- pred output_init_args(java_out_info::in, list(mlds_rval)::in,
|
|
list(mlds_type)::in, io::di, io::uo) is det.
|
|
|
|
output_init_args(_, [], [], !IO).
|
|
output_init_args(_, [_ | _], [], _, _) :-
|
|
unexpected(this_file, "output_init_args: length mismatch.").
|
|
output_init_args(_, [], [_ | _], _, _) :-
|
|
unexpected(this_file, "output_init_args: length mismatch.").
|
|
output_init_args(Info, [Arg | Args], [_ArgType | ArgTypes], !IO) :-
|
|
output_rval(Info, Arg, !IO),
|
|
(
|
|
Args = []
|
|
;
|
|
Args = [_ | _],
|
|
io.write_string(", ", !IO)
|
|
),
|
|
output_init_args(Info, Args, ArgTypes, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output expressions.
|
|
%
|
|
|
|
:- pred output_lval(java_out_info::in, mlds_lval::in, io::di, io::uo) is det.
|
|
|
|
output_lval(Info, Lval, !IO) :-
|
|
(
|
|
Lval = ml_field(_MaybeTag, PtrRval, FieldId, FieldType, _),
|
|
(
|
|
FieldId = ml_field_offset(OffsetRval),
|
|
(
|
|
( FieldType = mlds_generic_type
|
|
; FieldType = mercury_type(type_variable(_, _), _, _)
|
|
)
|
|
->
|
|
true
|
|
;
|
|
% The field type for field(_, _, offset(_), _, _) lvals
|
|
% must be something that maps to MR_Box.
|
|
unexpected(this_file, "unexpected field type.")
|
|
),
|
|
% XXX We shouldn't need this cast here, but there are cases where
|
|
% it is needed and the MLDS doesn't seem to generate it.
|
|
io.write_string("((java.lang.Object[]) ", !IO),
|
|
output_rval(Info, PtrRval, !IO),
|
|
io.write_string(")[", !IO),
|
|
output_rval(Info, OffsetRval, !IO),
|
|
io.write_string("]", !IO)
|
|
;
|
|
FieldId = ml_field_named(FieldName, CtorType),
|
|
(
|
|
FieldName = qual(_, _, UnqualFieldName),
|
|
UnqualFieldName = "data_tag"
|
|
->
|
|
% If the field we are trying to access is just a `data_tag'
|
|
% then it is a member of the base class.
|
|
output_bracketed_rval(Info, PtrRval, !IO),
|
|
io.write_string(".", !IO)
|
|
;
|
|
PtrRval = ml_self(_)
|
|
->
|
|
% Suppress type cast on `this' keyword. This makes a
|
|
% difference when assigning to `final' member variables in
|
|
% constructor functions.
|
|
output_rval(Info, PtrRval, !IO),
|
|
io.write_string(".", !IO)
|
|
;
|
|
% Otherwise the field we are trying to access may be
|
|
% in a derived class. Objects are manipulated as instances
|
|
% of their base class, so we need to downcast to the derived
|
|
% class to access some fields.
|
|
|
|
io.write_string("((", !IO),
|
|
output_type(Info, normal_style, CtorType, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_bracketed_rval(Info, PtrRval, !IO),
|
|
io.write_string(").", !IO)
|
|
),
|
|
FieldName = qual(_, _, UnqualFieldName),
|
|
output_valid_mangled_name(UnqualFieldName, !IO)
|
|
)
|
|
;
|
|
Lval = ml_mem_ref(Rval, _Type),
|
|
output_bracketed_rval(Info, Rval, !IO)
|
|
;
|
|
Lval = ml_global_var_ref(GlobalVarRef),
|
|
GlobalVarRef = env_var_ref(EnvVarName),
|
|
io.write_string("mercury_envvar_", !IO),
|
|
io.write_string(EnvVarName, !IO)
|
|
;
|
|
Lval = ml_var(qual(ModName, QualKind, Name), _),
|
|
QualName = qual(ModName, QualKind, entity_data(mlds_data_var(Name))),
|
|
output_maybe_qualified_name(Info, QualName, !IO)
|
|
).
|
|
|
|
:- pred output_mangled_name(string::in, io::di, io::uo) is det.
|
|
|
|
output_mangled_name(Name, !IO) :-
|
|
MangledName = name_mangle(Name),
|
|
io.write_string(MangledName, !IO).
|
|
|
|
:- pred output_valid_mangled_name(string::in, io::di, io::uo) is det.
|
|
|
|
output_valid_mangled_name(Name, !IO) :-
|
|
MangledName = name_mangle(Name),
|
|
JavaSafeName = valid_java_symbol_name(MangledName),
|
|
io.write_string(JavaSafeName, !IO).
|
|
|
|
:- pred output_call_rval(java_out_info::in, mlds_rval::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_call_rval(Info, Rval, !IO) :-
|
|
(
|
|
Rval = ml_const(Const),
|
|
Const = mlconst_code_addr(CodeAddr)
|
|
->
|
|
IsCall = yes,
|
|
mlds_output_code_addr(Info, CodeAddr, IsCall, !IO)
|
|
;
|
|
output_bracketed_rval(Info, Rval, !IO)
|
|
).
|
|
|
|
:- pred output_bracketed_rval(java_out_info::in, mlds_rval::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_bracketed_rval(Info, Rval, !IO) :-
|
|
(
|
|
% If it's just a variable name, then we don't need parentheses.
|
|
( Rval = ml_lval(ml_var(_,_))
|
|
; Rval = ml_const(mlconst_code_addr(_))
|
|
)
|
|
->
|
|
output_rval(Info, Rval, !IO)
|
|
;
|
|
io.write_char('(', !IO),
|
|
output_rval(Info, Rval, !IO),
|
|
io.write_char(')', !IO)
|
|
).
|
|
|
|
:- pred output_rval(java_out_info::in, mlds_rval::in, io::di, io::uo) is det.
|
|
|
|
output_rval(Info, Rval, !IO) :-
|
|
(
|
|
Rval = ml_lval(Lval),
|
|
output_lval(Info, Lval, !IO)
|
|
;
|
|
Rval = ml_scalar_common(_),
|
|
unexpected(this_file, "output_rval: ml_scalar_common")
|
|
;
|
|
Rval = ml_vector_common_row(_, _),
|
|
unexpected(this_file, "output_rval: ml_vector_common_row")
|
|
;
|
|
Rval = ml_mkword(_, _),
|
|
unexpected(this_file, "output_rval: tags not supported in Java")
|
|
;
|
|
Rval = ml_const(Const),
|
|
output_rval_const(Info, Const, !IO)
|
|
;
|
|
Rval = ml_unop(Op, RvalA),
|
|
output_unop(Info, Op, RvalA, !IO)
|
|
;
|
|
Rval = ml_binop(Op, RvalA, RvalB),
|
|
output_binop(Info, Op, RvalA, RvalB, !IO)
|
|
;
|
|
Rval = ml_mem_addr(_Lval),
|
|
unexpected(this_file, "output_rval: mem_addr(_) not supported")
|
|
;
|
|
Rval = ml_self(_),
|
|
io.write_string("this", !IO)
|
|
).
|
|
|
|
:- pred output_unop(java_out_info::in, mlds_unary_op::in, mlds_rval::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_unop(Info, Unop, Expr, !IO) :-
|
|
(
|
|
Unop = cast(Type),
|
|
output_cast_rval(Info, Type, Expr, !IO)
|
|
;
|
|
Unop = box(Type),
|
|
output_boxed_rval(Info, Type, Expr, !IO)
|
|
;
|
|
Unop = unbox(Type),
|
|
output_unboxed_rval(Info, Type, Expr, !IO)
|
|
;
|
|
Unop = std_unop(StdUnop),
|
|
output_std_unop(Info, StdUnop, Expr, !IO)
|
|
).
|
|
|
|
:- pred output_cast_rval(java_out_info::in, mlds_type::in, mlds_rval::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_cast_rval(Info, Type, Expr, !IO) :-
|
|
% rtti_to_mlds.m generates casts from int to
|
|
% jmercury.runtime.PseudoTypeInfo, but for Java
|
|
% we need to treat these as constructions, not casts.
|
|
% Similarly for conversions from TypeCtorInfo to TypeInfo.
|
|
(
|
|
Type = mlds_pseudo_type_info_type,
|
|
Expr = ml_const(mlconst_int(N))
|
|
->
|
|
maybe_output_comment(Info, "cast", !IO),
|
|
( have_preallocated_pseudo_type_var(N) ->
|
|
io.write_string("jmercury.runtime.PseudoTypeInfo.K", !IO),
|
|
io.write_int(N, !IO)
|
|
;
|
|
io.write_string("new jmercury.runtime.PseudoTypeInfo(", !IO),
|
|
output_rval(Info, Expr, !IO),
|
|
io.write_string(")", !IO)
|
|
)
|
|
;
|
|
( Type = mercury_type(_, ctor_cat_system(cat_system_type_info), _)
|
|
; Type = mlds_type_info_type
|
|
)
|
|
->
|
|
% XXX We really should be able to tell if we are casting a
|
|
% TypeCtorInfo or a TypeInfo. Julien says that's probably going to
|
|
% be rather difficult as the compiler doesn't keep track of where
|
|
% type_ctor_infos are acting as type_infos properly.
|
|
maybe_output_comment(Info, "cast", !IO),
|
|
io.write_string("jmercury.runtime.TypeInfo_Struct.maybe_new(",
|
|
!IO),
|
|
output_rval(Info, Expr, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
java_builtin_type(Type, "int", _, _)
|
|
->
|
|
io.write_string("(int) ", !IO),
|
|
output_rval_maybe_with_enum(Info, Expr, !IO)
|
|
;
|
|
io.write_string("(", !IO),
|
|
output_type(Info, normal_style, Type, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_rval(Info, Expr, !IO)
|
|
).
|
|
|
|
:- pred have_preallocated_pseudo_type_var(int::in) is semidet.
|
|
|
|
have_preallocated_pseudo_type_var(N) :-
|
|
% Corresponds to static members in class PseudoTypeInfo.
|
|
N >= 1,
|
|
N =< 5.
|
|
|
|
:- pred output_boxed_rval(java_out_info::in, mlds_type::in, mlds_rval::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_boxed_rval(Info, Type, Expr, !IO) :-
|
|
( java_builtin_type(Type, _JavaName, JavaBoxedName, _) ->
|
|
io.write_string("new ", !IO),
|
|
io.write_string(JavaBoxedName, !IO),
|
|
io.write_string("(", !IO),
|
|
output_rval(Info, Expr, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
io.write_string("((java.lang.Object) (", !IO),
|
|
output_rval(Info, Expr, !IO),
|
|
io.write_string("))", !IO)
|
|
).
|
|
|
|
:- pred output_unboxed_rval(java_out_info::in, mlds_type::in, mlds_rval::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_unboxed_rval(Info, Type, Expr, !IO) :-
|
|
( java_builtin_type(Type, _, JavaBoxedName, UnboxMethod) ->
|
|
io.write_string("((", !IO),
|
|
io.write_string(JavaBoxedName, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_bracketed_rval(Info, Expr, !IO),
|
|
io.write_string(").", !IO),
|
|
io.write_string(UnboxMethod, !IO),
|
|
io.write_string("()", !IO)
|
|
;
|
|
io.write_string("((", !IO),
|
|
output_type(Info, normal_style, Type, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_rval(Info, Expr, !IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
% java_builtin_type(MLDS_Type, JavaUnboxedType, JavaBoxedType, UnboxMethod):
|
|
%
|
|
% For a given Mercury type, check if this corresponds to a Java type
|
|
% which has both unboxed (builtin) and boxed (class) versions, and if so,
|
|
% return their names, and the name of the method to get the unboxed value
|
|
% from the boxed type.
|
|
%
|
|
:- pred java_builtin_type(mlds_type::in, string::out, string::out, string::out)
|
|
is semidet.
|
|
|
|
java_builtin_type(Type, "int", "java.lang.Integer", "intValue") :-
|
|
Type = mlds_native_int_type.
|
|
java_builtin_type(Type, "int", "java.lang.Integer", "intValue") :-
|
|
Type = mercury_type(builtin_type(builtin_type_int), _, _).
|
|
java_builtin_type(Type, "double", "java.lang.Double", "doubleValue") :-
|
|
Type = mlds_native_float_type.
|
|
java_builtin_type(Type, "double", "java.lang.Double", "doubleValue") :-
|
|
Type = mercury_type(builtin_type(builtin_type_float), _, _).
|
|
java_builtin_type(Type, "char", "java.lang.Character", "charValue") :-
|
|
Type = mlds_native_char_type.
|
|
java_builtin_type(Type, "char", "java.lang.Character", "charValue") :-
|
|
Type = mercury_type(builtin_type(builtin_type_char), _, _).
|
|
java_builtin_type(Type, "boolean", "java.lang.Boolean", "booleanValue") :-
|
|
Type = mlds_native_bool_type.
|
|
|
|
% io.state and store.store(S) are dummy variables
|
|
% for which we pass an arbitrary integer. For this
|
|
% reason they should have the Java type `int'.
|
|
%
|
|
java_builtin_type(Type, "int", "java.lang.Integer", "intValue") :-
|
|
% The test for defined/3 is logically redundant since all dummy
|
|
% types are defined types, but enables the compiler to infer that
|
|
% this disjunction is a switch.
|
|
Type = mercury_type(defined_type(_, _, _), TypeCtorCat, _),
|
|
TypeCtorCat = ctor_cat_builtin_dummy.
|
|
|
|
:- pred output_std_unop(java_out_info::in, builtin_ops.unary_op::in,
|
|
mlds_rval::in, io::di, io::uo) is det.
|
|
|
|
% For the Java back-end, there are no tags, so all the tagging operators
|
|
% are no-ops, except for `tag', which always returns zero (a tag of zero
|
|
% means there's no tag).
|
|
%
|
|
output_std_unop(Info, UnaryOp, Expr, !IO) :-
|
|
( UnaryOp = tag ->
|
|
io.write_string("/* tag */ 0", !IO)
|
|
;
|
|
java_unary_prefix_op(UnaryOp, UnaryOpString),
|
|
io.write_string(UnaryOpString, !IO),
|
|
io.write_string("(", !IO),
|
|
output_rval(Info, Expr, !IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
:- pred output_binop(java_out_info::in, binary_op::in, mlds_rval::in,
|
|
mlds_rval::in, io::di, io::uo) is det.
|
|
|
|
output_binop(Info, Op, X, Y, !IO) :-
|
|
( Op = array_index(_Type) ->
|
|
output_bracketed_rval(Info, X, !IO),
|
|
io.write_string("[", !IO),
|
|
output_rval(Info, Y, !IO),
|
|
io.write_string("]", !IO)
|
|
; java_string_compare_op(Op, OpStr) ->
|
|
io.write_string("(", !IO),
|
|
output_rval(Info, X, !IO),
|
|
io.write_string(".compareTo(", !IO),
|
|
output_rval(Info, Y, !IO),
|
|
io.write_string(") ", !IO),
|
|
io.write_string(OpStr, !IO),
|
|
io.write_string(" 0)", !IO)
|
|
; rval_is_enum_object(X) ->
|
|
io.write_string("(", !IO),
|
|
output_rval(Info, X, !IO),
|
|
io.write_string(".MR_value ", !IO),
|
|
output_binary_op(Op, !IO),
|
|
io.write_string(" ", !IO),
|
|
output_rval(Info, Y, !IO),
|
|
io.write_string(".MR_value)", !IO)
|
|
;
|
|
io.write_string("(", !IO),
|
|
output_rval(Info, X, !IO),
|
|
io.write_string(" ", !IO),
|
|
output_binary_op(Op, !IO),
|
|
io.write_string(" ", !IO),
|
|
output_rval(Info, Y, !IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
% Output an Rval and if the Rval is an enumeration object append the string
|
|
% ".MR_value", so we can access its value field.
|
|
%
|
|
% XXX Note that this is necessary in some places, but not in others.
|
|
% For example, it is important to do so for switch statements, as the
|
|
% argument of a switch _must_ be an integer in Java. However, adding
|
|
% the .MR_value to assignments breaks some casting... At some point, we
|
|
% need to go through all the places where output_rval and
|
|
% output_rval_maybe_with_enum are called and make sure the correct one
|
|
% is being used.
|
|
%
|
|
:- pred output_rval_maybe_with_enum(java_out_info::in, mlds_rval::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_rval_maybe_with_enum(Info, Rval, !IO) :-
|
|
output_rval(Info, Rval, !IO),
|
|
( rval_is_enum_object(Rval) ->
|
|
io.write_string(".MR_value", !IO)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred output_binary_op(binary_op::in, io::di, io::uo) is det.
|
|
|
|
output_binary_op(Op, !IO) :-
|
|
% XXX why are these separated into three predicates?
|
|
( java_binary_infix_op(Op, OpStr) ->
|
|
io.write_string(OpStr, !IO)
|
|
; java_float_compare_op(Op, OpStr) ->
|
|
io.write_string(OpStr, !IO)
|
|
; java_float_op(Op, OpStr) ->
|
|
io.write_string(OpStr, !IO)
|
|
;
|
|
unexpected(this_file, "output_binary_op: invalid binary operator")
|
|
).
|
|
|
|
:- pred output_rval_const(java_out_info::in, mlds_rval_const::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_rval_const(Info, Const, !IO) :-
|
|
(
|
|
Const = mlconst_true,
|
|
io.write_string("true", !IO)
|
|
;
|
|
Const = mlconst_false,
|
|
io.write_string("false", !IO)
|
|
;
|
|
Const = mlconst_int(N),
|
|
output_int_const(N, !IO)
|
|
;
|
|
Const = mlconst_char(N),
|
|
io.write_string("((char) ", !IO),
|
|
output_int_const(N, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
Const = mlconst_enum(N, EnumType),
|
|
output_type(Info, normal_style, EnumType, !IO),
|
|
io.write_string(".K", !IO),
|
|
output_int_const(N, !IO)
|
|
;
|
|
Const = mlconst_foreign(Lang, Value, _Type),
|
|
expect(unify(Lang, lang_java), this_file,
|
|
"output_rval_const: language other than Java."),
|
|
% XXX Should we parenthesize this?
|
|
io.write_string(Value, !IO)
|
|
;
|
|
Const = mlconst_float(FloatVal),
|
|
c_util.output_float_literal(FloatVal, !IO)
|
|
;
|
|
Const = mlconst_string(String),
|
|
io.write_string("""", !IO),
|
|
c_util.output_quoted_string_lang(literal_java, String, !IO),
|
|
io.write_string("""", !IO)
|
|
;
|
|
Const = mlconst_multi_string(String),
|
|
io.write_string("""", !IO),
|
|
c_util.output_quoted_multi_string_lang(literal_java, String, !IO),
|
|
io.write_string("""", !IO)
|
|
;
|
|
Const = mlconst_named_const(NamedConst),
|
|
io.write_string(NamedConst, !IO)
|
|
;
|
|
Const = mlconst_code_addr(CodeAddr),
|
|
IsCall = no,
|
|
mlds_output_code_addr(Info, CodeAddr, IsCall, !IO)
|
|
;
|
|
Const = mlconst_data_addr(DataAddr),
|
|
mlds_output_data_addr(DataAddr, !IO)
|
|
;
|
|
Const = mlconst_null(Type),
|
|
Initializer = get_java_type_initializer(Type),
|
|
io.write_string(Initializer, !IO)
|
|
).
|
|
|
|
:- pred output_int_const(int::in, io::di, io::uo) is det.
|
|
|
|
output_int_const(N, !IO) :-
|
|
% The Mercury compiler could be using 64-bit integers but Java has 32-bit
|
|
% ints. A literal 0xffffffff in a source file would be interpreted by a
|
|
% 64-bit Mercury compiler as 4294967295. If it is written out in decimal a
|
|
% Java compiler would rightly complain because the integer is too large to
|
|
% fit in a 32-bit int. However, it won't complain if the literal is
|
|
% expressed in hexadecimal (nor as the negative decimal -1).
|
|
( N < 0 ->
|
|
io.write_int(N, !IO)
|
|
;
|
|
N >> 32 = 0,
|
|
N /\ 0x80000000 = 0x80000000
|
|
->
|
|
% The bit pattern fits in 32 bits, but is too large to write as a
|
|
% positive decimal. This branch is unreachable on a 32-bit compiler.
|
|
io.format("0x%x", [i(N /\ 0xffffffff)], !IO)
|
|
;
|
|
io.write_int(N, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred mlds_output_code_addr(java_out_info::in, mlds_code_addr::in, bool::in,
|
|
io::di, io::uo) is det.
|
|
|
|
mlds_output_code_addr(Info, CodeAddr, IsCall, !IO) :-
|
|
(
|
|
IsCall = no,
|
|
% Not a function call, so we are taking the address of the
|
|
% wrapper for that function (method).
|
|
io.write_string("new ", !IO),
|
|
AddrOfMap = Info ^ joi_addrof_map,
|
|
map.lookup(AddrOfMap, CodeAddr, CodeAddrWrapper),
|
|
CodeAddrWrapper = code_addr_wrapper(ClassName, MaybePtrNum),
|
|
io.write_string(ClassName, !IO),
|
|
io.write_string("_0(", !IO),
|
|
(
|
|
MaybePtrNum = yes(PtrNum),
|
|
io.write_int(PtrNum, !IO)
|
|
;
|
|
MaybePtrNum = no
|
|
),
|
|
io.write_string(")", !IO)
|
|
;
|
|
IsCall = yes,
|
|
(
|
|
CodeAddr = code_addr_proc(Label, _Sig),
|
|
output_fully_qualified_proc_label(Label, !IO)
|
|
;
|
|
CodeAddr = code_addr_internal(Label, SeqNum, _Sig),
|
|
output_fully_qualified_proc_label(Label, !IO),
|
|
io.write_string("_", !IO),
|
|
io.write_int(SeqNum, !IO)
|
|
)
|
|
).
|
|
|
|
:- pred mlds_output_proc_label(mlds_proc_label::in, io::di, io::uo) is det.
|
|
|
|
mlds_output_proc_label(mlds_proc_label(PredLabel, ProcId), !IO) :-
|
|
output_pred_label(PredLabel, !IO),
|
|
proc_id_to_int(ProcId, ModeNum),
|
|
io.format("_%d", [i(ModeNum)], !IO).
|
|
|
|
:- pred mlds_output_data_addr(mlds_data_addr::in, io::di, io::uo) is det.
|
|
|
|
mlds_output_data_addr(data_addr(ModuleQualifier, DataName), !IO) :-
|
|
SymName = mlds_module_name_to_sym_name(ModuleQualifier),
|
|
mangle_sym_name_for_java(SymName, module_qual, "__", ModuleName),
|
|
io.write_string(ModuleName, !IO),
|
|
io.write_string(".", !IO),
|
|
output_data_name(DataName, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Miscellaneous stuff to handle indentation and generation of
|
|
% source context annotations.
|
|
%
|
|
|
|
:- mutable(last_context, prog_context, context_init, ground,
|
|
[untrailed, attach_to_io_state]).
|
|
|
|
:- pred output_context(java_out_info::in, mlds_context::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_context(Info, Context, !IO) :-
|
|
LineNumbers = Info ^ joi_line_numbers,
|
|
(
|
|
LineNumbers = yes,
|
|
ProgContext = mlds_get_prog_context(Context),
|
|
get_last_context(LastContext, !IO),
|
|
term.context_file(ProgContext, File),
|
|
term.context_line(ProgContext, Line),
|
|
(
|
|
ProgContext \= LastContext,
|
|
Line > 0,
|
|
File \= ""
|
|
->
|
|
% Java doesn't have an equivalent of #line directives.
|
|
io.write_string("// ", !IO),
|
|
io.write_string(File, !IO),
|
|
io.write_string(":", !IO),
|
|
io.write_int(Line, !IO),
|
|
io.nl(!IO),
|
|
set_last_context(ProgContext, !IO)
|
|
;
|
|
true
|
|
)
|
|
;
|
|
LineNumbers = no
|
|
).
|
|
|
|
:- pred indent_line(java_out_info::in, mlds_context::in, indent::in,
|
|
io::di, io::uo) is det.
|
|
|
|
indent_line(Info, Context, N, !IO) :-
|
|
output_context(Info, Context, !IO),
|
|
indent_line(N, !IO).
|
|
|
|
% A value of type `indent' records the number of levels of indentation
|
|
% to indent the next piece of code. Currently we output two spaces
|
|
% for each level of indentation.
|
|
% XXX There is a small amount of code duplication with mlds_to_c.m here.
|
|
:- type indent == int.
|
|
|
|
:- pred indent_line(indent::in, io::di, io::uo) is det.
|
|
|
|
indent_line(N, !IO) :-
|
|
( N =< 0 ->
|
|
true
|
|
;
|
|
io.write_string(" ", !IO),
|
|
indent_line(N - 1, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type java_out_info
|
|
---> java_out_info(
|
|
joi_auto_comments :: bool,
|
|
joi_line_numbers :: bool,
|
|
joi_module_name :: mlds_module_name,
|
|
joi_addrof_map :: map(mlds_code_addr, code_addr_wrapper)
|
|
).
|
|
|
|
:- func init_java_out_info(module_info, map(mlds_code_addr, code_addr_wrapper))
|
|
= java_out_info.
|
|
|
|
init_java_out_info(ModuleInfo, AddrOfMap) = Info :-
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, auto_comments, AutoComments),
|
|
globals.lookup_bool_option(Globals, line_numbers, LineNumbers),
|
|
module_info_get_name(ModuleInfo, ModuleName),
|
|
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
|
|
Info = java_out_info(AutoComments, LineNumbers, MLDS_ModuleName,
|
|
AddrOfMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "mlds_to_java.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|