mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-18 07:15:19 +00:00
75a8a4a9b3
Estimated hours taken: 30
Branches: main
Add a new pragma, foreign_export_enum, that allows the names of constructors
of Mercury enumeration types to be exported across the foreign language
interface and referred to by code in the foreign language.
The new pragma is intended to be used to avoid a situation that frequently
occurs when creating Mercury bindings to foreign language libraries, namely
arguments and return values being passed across the foreign language boundary
as small integers. Exporting the names of enumeration values to foreign
languages should make this task less error prone and more portable.
Using the new construct programmers can either specify a foreign language name
for each enumeration constructor, or since this is tedious, there is also a
default mapping defined for each foreign language that should work in most
cases for that language. (In the cases where it does not work the compiler
requires the programmer to provide a valid name.)
Currently, pragma foreign_export_enum is only supported by the C backends.
compiler/prog_data.m:
compiler/prog_item.m:
Add a new item to the parse tree for representing
foreign_export_enum pragmas.
compiler/prog_io_pragma.m:
Parse the new pragma.
compiler/module_qual.m:
Handle foreign_export_enum pragmas.
Add a predicate to for module qualifying type_ctors, i.e. a
type identified by its sym_name and arity, for use by the
above.
compiler/mercury_to_mercury.m:
Write out foreign_export_enum pragmas.
compiler/hlds_module.m:
Add a type to represent exported enumerations.
Add a field to the module_info to hold information about
exported enumerations. Add access procedures for this.
compiler/make_hlds_passes.m:
compiler/add_pragma.m:
Handle foreign_export_enum pragmas: generate the set of foreign names
for each of the constructors of an enumeration type and check that
their validity in the foreign language. Attach this information to
the HLDS.
compiler/export.m:
Output #defined constants for C foreign_export_enum pragmas in
.mh files.
compiler/mlds.m:
Add an MLDS specific representation of exported enumerations.
compiler/ml_type_gen.m:
Convert the HLDS representation of exported enumerations into
an MLDS specific one.
compiler/mlds_to_c.m:
Output #defined constants for C foreign_export_enum pragmas in
.mih files.
compiler/ml_code_gen.m:
compiler/ml_elim_nested.m:
compiler/ml_tailcall.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_ilasm.m:
compiler/mlds_to_java.m:
compiler/mlds_to_managed.m:
Conform to the above changes to the MLDS.
compiler/mercury_compile.m:
Pass the list of export enumerations to the code that writes
out .mh files.
compiler/c_util.m:
Add a predicate that tests if a string is a valid C identifier.
compiler/modules.m:
compiler/recompilation.version.m:
Conform to the above changes.
doc/reference_manual.texi:
Document the new pragma.
tests/hard_coded/Mmakefile:
tests/hard_coded/ee_dummy.{m,exp}:
tests/hard_coded/ee_valid.{m,exp}:
Test valid uses of foreign_export_enum pragmas.
tests/invalid/Mmakefile:
tests/invalid/Mercury.options:
tests/invalid/ee_invalid.{m,err_exp}:
Check we generate error messages for invalid
foreign_export_enum pragmas.
NEWS:
Announce the new pragma.
vim/syntax/mercury.vim:
Highlight the new syntax.
3399 lines
127 KiB
Mathematica
3399 lines
127 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2000-2007 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.
|
|
%
|
|
% 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 Mmake and mmc --make (except for nested modules)
|
|
%
|
|
% TODO:
|
|
% - Fix problem with type names and constructor names that are the same
|
|
% (Java does not allow the name of a nested class to be the same as its
|
|
% enclosing class)
|
|
%
|
|
% - 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.)
|
|
%
|
|
% - Support for Java in Mmake and mmc --make, for Mercury code using
|
|
% nested modules.
|
|
%
|
|
% - Generate names of classes etc. correctly (mostly same as IL backend)
|
|
%
|
|
% - General code cleanup
|
|
%
|
|
% - handle static ground terms(?)
|
|
%
|
|
% - RTTI: XXX There are problems with the RTTI definitions for the Java
|
|
% back-end. Under the current system, the definitions are output as static
|
|
% variables with static initializers, ordered so that subdefinitions always
|
|
% appear before the definition which uses them. This is necessary because
|
|
% in Java, static initializers are performed at runtime in textual order,
|
|
% and if a definition relies on another static variable for its constructor
|
|
% but said variable has not been initialized, then it is treated as `null'
|
|
% by the JVM with no warning. The problem with this approach is that it
|
|
% won't work for cyclic definitions. e.g.:
|
|
%
|
|
% :- type foo ---> f(bar) ; g.
|
|
% :- type bar ---> f2(foo) ; g2
|
|
% At some point this should be changed so that initialization is performed
|
|
% by 2 phases: first allocate all of the objects, then fill in the fields.
|
|
%
|
|
% - 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_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 hlds.passes_aux.
|
|
:- import_module libs.compiler_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_type_gen. % for ml_gen_type_name
|
|
:- import_module ml_backend.ml_util.
|
|
:- import_module parse_tree.modules. % for mercury_std_library_name.
|
|
:- 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 int.
|
|
:- import_module library.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
output_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.
|
|
ModuleName = mlds_get_module_name(MLDS),
|
|
JavaSafeModuleName = valid_module_name(ModuleName),
|
|
module_name_to_file_name(JavaSafeModuleName, ".java", yes, JavaSourceFile,
|
|
!IO),
|
|
Indent = 0,
|
|
output_to_file(JavaSourceFile,
|
|
output_java_src_file(ModuleInfo, Indent, MLDS), !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Utility predicates for various purposes.
|
|
%
|
|
|
|
% Succeeds iff the given qualified name is part of the standard
|
|
% library (as listed in compiler/modules.m).
|
|
%
|
|
:- pred qualified_name_is_stdlib(mercury_module_name::in) is semidet.
|
|
|
|
qualified_name_is_stdlib(unqualified(_)) :- fail.
|
|
qualified_name_is_stdlib(qualified(Module, Name)) :-
|
|
(
|
|
mercury_std_library_module_name(qualified(Module, Name))
|
|
;
|
|
qualified_name_is_stdlib(Module)
|
|
).
|
|
|
|
% 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 type is a enumeration.
|
|
%
|
|
:- pred type_is_enum(mlds_type::in) is semidet.
|
|
|
|
type_is_enum(Type) :-
|
|
Type = mercury_type(_, Builtin, _),
|
|
Builtin = type_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(_, TypeCategory, _),
|
|
type_category_is_object(TypeCategory) = yes.
|
|
|
|
:- func type_category_is_object(type_category) = bool.
|
|
|
|
type_category_is_object(type_cat_int) = no.
|
|
type_category_is_object(type_cat_char) = no.
|
|
type_category_is_object(type_cat_string) = no.
|
|
type_category_is_object(type_cat_float) = no.
|
|
type_category_is_object(type_cat_higher_order) = no.
|
|
type_category_is_object(type_cat_tuple) = no.
|
|
type_category_is_object(type_cat_enum) = yes.
|
|
type_category_is_object(type_cat_dummy) = yes.
|
|
type_category_is_object(type_cat_variable) = yes.
|
|
type_category_is_object(type_cat_type_info) = yes.
|
|
type_category_is_object(type_cat_type_ctor_info) = yes.
|
|
type_category_is_object(type_cat_typeclass_info) = yes.
|
|
type_category_is_object(type_cat_base_typeclass_info) = yes.
|
|
type_category_is_object(type_cat_void) = no.
|
|
type_category_is_object(type_cat_user_ctor) = yes.
|
|
|
|
% Given an lval, return its type.
|
|
%
|
|
:- func mlds_lval_type(mlds_lval) = mlds_type.
|
|
|
|
mlds_lval_type(var(_, VarType)) = VarType.
|
|
mlds_lval_type(field(_, _, _, FieldType, _)) = FieldType.
|
|
mlds_lval_type(mem_ref(_, PtrType)) =
|
|
( PtrType = mlds_ptr_type(Type) ->
|
|
Type
|
|
;
|
|
unexpected(this_file, "mlds_lval_type: mem_ref of non-pointer")
|
|
).
|
|
mlds_lval_type(global_var_ref(_)) = _ :-
|
|
sorry(this_file, "mlds_lval_type: global_var_ref NYI").
|
|
|
|
% Succeeds iff the Rval represents an integer constant.
|
|
%
|
|
:- pred rval_is_int_const(mlds_rval::in) is semidet.
|
|
|
|
rval_is_int_const(Rval) :-
|
|
Rval = const(mlconst_int(_)).
|
|
|
|
% 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 = lval(Lval),
|
|
(
|
|
Lval = var(_, VarType),
|
|
type_is_enum(VarType)
|
|
;
|
|
Lval = 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("MethodPtr").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% 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).
|
|
|
|
:- pred mangle_mlds_sym_name_for_java(sym_name::in, mlds_qual_kind::in,
|
|
string::in, string::out) is det.
|
|
|
|
mangle_mlds_sym_name_for_java(unqualified(Name), QualKind, _QualifierOp,
|
|
JavaSafeName) :-
|
|
(
|
|
QualKind = module_qual,
|
|
FlippedName = Name
|
|
;
|
|
QualKind = type_qual,
|
|
FlippedName = flip_initial_case(Name)
|
|
),
|
|
MangledName = name_mangle(FlippedName),
|
|
JavaSafeName = valid_symbol_name(MangledName).
|
|
mangle_mlds_sym_name_for_java(qualified(ModuleName0, PlainName), QualKind,
|
|
QualifierOp, JavaSafeName) :-
|
|
mangle_mlds_sym_name_for_java(ModuleName0, module_qual, QualifierOp,
|
|
MangledModuleName),
|
|
(
|
|
QualKind = module_qual,
|
|
FlippedPlainName = PlainName
|
|
;
|
|
QualKind = type_qual,
|
|
FlippedPlainName = flip_initial_case(PlainName)
|
|
),
|
|
MangledPlainName = name_mangle(FlippedPlainName),
|
|
JavaSafePlainName = valid_symbol_name(MangledPlainName),
|
|
string.append_list([MangledModuleName, QualifierOp, JavaSafePlainName],
|
|
JavaSafeName).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Name mangling code to fix problem of mercury modules having the same name
|
|
% as reserved Java words such as `char' and `int'.
|
|
%
|
|
|
|
% If the given name conficts with a reserved Java word we must add a
|
|
% prefix to it to avoid compilation errors.
|
|
:- func valid_symbol_name(string) = string.
|
|
|
|
valid_symbol_name(SymName) = ValidSymName :-
|
|
Prefix = "mr_",
|
|
( java_is_keyword(SymName) ->
|
|
% This is a reserved Java word, add the above prefix.
|
|
ValidSymName = Prefix ++ SymName
|
|
; string.append(Prefix, Suffix, SymName) ->
|
|
% This name already contains the prefix we are adding to
|
|
% variables to avoid conficts, so add an additional '_'.
|
|
ValidSymName = Prefix ++ "_" ++ Suffix
|
|
;
|
|
% Normal name; do nothing.
|
|
ValidSymName = SymName
|
|
).
|
|
|
|
:- type java_module_name == sym_name.
|
|
|
|
:- func valid_module_name(java_module_name) = java_module_name.
|
|
|
|
valid_module_name(unqualified(String)) = ValidModuleName :-
|
|
ValidString = valid_symbol_name(String),
|
|
ValidModuleName = unqualified(ValidString).
|
|
valid_module_name(qualified(ModuleSpecifier, String)) = ValidModuleName :-
|
|
ValidModuleSpecifier = valid_module_name(ModuleSpecifier),
|
|
ValidString = valid_symbol_name(String),
|
|
ValidModuleName = qualified(ValidModuleSpecifier, ValidString).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% 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),
|
|
% We should always import the mercury.runtime classes.
|
|
io.write_string("import mercury.runtime.*;\n\n", !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),
|
|
JavaSafeSymName = valid_module_name(SymName),
|
|
File = sym_name_to_string(JavaSafeSymName),
|
|
% XXX Name mangling code should be put here when we start enforcing
|
|
% Java's naming conventions.
|
|
ClassFile = File,
|
|
% 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, Defns0,
|
|
_InitPreds, _FinalPreds, _ExportedEnums),
|
|
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(Defns0, [], CodeAddrs0),
|
|
CodeAddrs = list.sort_and_remove_dups(CodeAddrs0),
|
|
|
|
% Create wrappers in MLDS for all pointer addressed methods.
|
|
generate_code_addr_wrappers(Indent + 1, CodeAddrs, [], WrapperDefns),
|
|
Defns = WrapperDefns ++ Defns0,
|
|
|
|
% 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.
|
|
output_src_start(Indent, ModuleName, Imports, ForeignDecls, Defns, !IO),
|
|
io.write_list(ForeignBodyCode, "\n", output_java_body_code(Indent), !IO),
|
|
CtorData = none, % Not a constructor.
|
|
% XXX do we need to split this into RTTI and non-RTTI defns???
|
|
list.filter(defn_is_rtti_data, Defns, RttiDefns, NonRttiDefns),
|
|
output_defns(Indent + 1, ModuleInfo, MLDS_ModuleName, CtorData,
|
|
RttiDefns, !IO),
|
|
output_defns(Indent + 1, ModuleInfo, MLDS_ModuleName, CtorData,
|
|
NonRttiDefns, !IO),
|
|
output_exports(Indent + 1, ModuleInfo, MLDS_ModuleName, CtorData,
|
|
ExportDefns, !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(indent::in, foreign_decl_code::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_java_decl(Indent, DeclCode, !IO) :-
|
|
DeclCode = foreign_decl_code(Lang, _IsLocal, Code, Context),
|
|
( Lang = lang_java,
|
|
indent_line(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(indent::in, user_foreign_code::in, io::di,
|
|
io.state::uo) is det.
|
|
|
|
output_java_body_code(Indent, user_foreign_code(Lang, Code, Context), !IO) :-
|
|
% Only output Java code.
|
|
(
|
|
Lang = lang_java,
|
|
indent_line(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(indent::in, module_info::in, mlds_module_name::in,
|
|
ctor_data::in, list(mlds_pragma_export)::in, io::di, io::uo) is det.
|
|
|
|
output_exports(_, _, _, _, [], !IO).
|
|
output_exports(Indent, ModuleInfo, MLDS_ModuleName, CtorData,
|
|
[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(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(Indent + 1, MLDS_ModuleName, 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(Indent, ModuleInfo, MLDS_ModuleName, CtorData, Exports,
|
|
!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(mlds_defns::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(statements::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(block(Defns, Statements), !CodeAddrs) :-
|
|
method_ptrs_in_defns(Defns, !CodeAddrs),
|
|
method_ptrs_in_statements(Statements, !CodeAddrs).
|
|
method_ptrs_in_stmt(while(Rval, Statement, _Bool), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs),
|
|
method_ptrs_in_statement(Statement, !CodeAddrs).
|
|
method_ptrs_in_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(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(label(_), _, _) :-
|
|
unexpected(this_file,
|
|
"method_ptrs_in_stmt: labels not supported in Java.").
|
|
method_ptrs_in_stmt(goto(break), !CodeAddrs).
|
|
method_ptrs_in_stmt(goto(continue), !CodeAddrs).
|
|
method_ptrs_in_stmt(goto(label(_)), _, _) :-
|
|
unexpected(this_file,
|
|
"method_ptrs_in_stmt: goto label not supported in Java.").
|
|
method_ptrs_in_stmt(computed_goto(_, _), _, _) :-
|
|
unexpected(this_file,
|
|
"method_ptrs_in_stmt: computed gotos not supported in Java.").
|
|
method_ptrs_in_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(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(return(Rvals), !CodeAddrs) :-
|
|
method_ptrs_in_rvals(Rvals, !CodeAddrs).
|
|
method_ptrs_in_stmt(mlcall(_FuncSig, _Rval, _MaybeThis, Rvals, _ReturnVars,
|
|
_IsTailCall), !CodeAddrs) :-
|
|
% 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(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(mlds_switch_cases::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 = _Conditions - Statement,
|
|
method_ptrs_in_statement(Statement, !CodeAddrs),
|
|
method_ptrs_in_switch_cases(Cases, !CodeAddrs).
|
|
|
|
:- pred method_ptrs_in_defns(mlds_defns::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(lval(Lval), !CodeAddrs) :-
|
|
method_ptrs_in_lval(Lval, !CodeAddrs).
|
|
method_ptrs_in_rval(mkword(_Tag, Rval), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs).
|
|
method_ptrs_in_rval(const(RvalConst), !CodeAddrs) :-
|
|
( RvalConst = mlconst_code_addr(CodeAddr) ->
|
|
!:CodeAddrs = !.CodeAddrs ++ [CodeAddr]
|
|
;
|
|
true
|
|
).
|
|
method_ptrs_in_rval(unop(_UnaryOp, Rval), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval, !CodeAddrs).
|
|
method_ptrs_in_rval(binop(_BinaryOp, Rval1, Rval2), !CodeAddrs) :-
|
|
method_ptrs_in_rval(Rval1, !CodeAddrs),
|
|
method_ptrs_in_rval(Rval2, !CodeAddrs).
|
|
method_ptrs_in_rval(mem_addr(_Address), !CodeAddrs).
|
|
method_ptrs_in_rval(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(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(field(_MaybeTag, _Rval, _FieldId, _FieldType,
|
|
_PtrType), !CodeAddrs).
|
|
method_ptrs_in_lval(var(_Variable, _Type), !CodeAddrs).
|
|
method_ptrs_in_lval(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.
|
|
|
|
% Generates the MLDS to output the required wrapper classes
|
|
%
|
|
:- pred generate_code_addr_wrappers(indent::in, list(mlds_code_addr)::in,
|
|
mlds_defns::in, mlds_defns::out) is det.
|
|
|
|
generate_code_addr_wrappers(_, [], !Defns).
|
|
generate_code_addr_wrappers(Indent, [CodeAddr | CodeAddrs], !Defns) :-
|
|
% XXX We should fill in the Context properly. This would probably involve
|
|
% also returning context information for each "code_addr" returned by the
|
|
% "method_ptrs_*" predicates above.
|
|
Context = mlds_make_context(term.context_init),
|
|
InterfaceModuleName = mercury_module_name_to_mlds(
|
|
qualified(unqualified("mercury"), "runtime")),
|
|
Interface = qual(InterfaceModuleName, module_qual, "MethodPtr"),
|
|
generate_addr_wrapper_class(Interface, Context, CodeAddr, ClassDefn),
|
|
!:Defns = [ ClassDefn | !.Defns ],
|
|
generate_code_addr_wrappers(Indent, CodeAddrs, !Defns).
|
|
|
|
% Generate the MLDS wrapper class for a given code_addr.
|
|
%
|
|
:- pred generate_addr_wrapper_class(mlds_class::in,
|
|
mlds_context::in, mlds_code_addr::in, mlds_defn::out) is det.
|
|
|
|
generate_addr_wrapper_class(Interface, Context, CodeAddr, ClassDefn) :-
|
|
(
|
|
CodeAddr = code_addr_proc(ProcLabel, _FuncSig),
|
|
MaybeSeqNum = no
|
|
;
|
|
CodeAddr = code_addr_internal(ProcLabel, SeqNum, _FuncSig),
|
|
MaybeSeqNum = yes(SeqNum)
|
|
),
|
|
ProcLabel = qual(ModuleQualifier, QualKind,
|
|
mlds_proc_label(PredLabel, ProcID)),
|
|
PredName = make_pred_name_string(PredLabel, ProcID, MaybeSeqNum),
|
|
|
|
% Create class components.
|
|
ClassImports = [],
|
|
ClassExtends = [],
|
|
InterfaceDefn = mlds_class_type(Interface, 0, mlds_interface),
|
|
ClassImplements = [InterfaceDefn],
|
|
|
|
% Create a method that calls the original predicate.
|
|
generate_call_method(CodeAddr, MethodDefn),
|
|
|
|
% Create a name for this wrapper class based on the fully qualified method
|
|
% (predicate) name.
|
|
ModuleQualifierSym = mlds_module_name_to_sym_name(ModuleQualifier),
|
|
mangle_mlds_sym_name_for_java(ModuleQualifierSym, QualKind, "__",
|
|
ModuleNameStr),
|
|
ClassEntityName = "addrOf__" ++ ModuleNameStr ++ "__" ++ PredName,
|
|
MangledClassEntityName = name_mangle(ClassEntityName),
|
|
|
|
% Put it all together.
|
|
ClassMembers = [MethodDefn],
|
|
ClassCtors = [],
|
|
ClassName = entity_type(MangledClassEntityName, 0),
|
|
ClassContext = Context,
|
|
ClassFlags = ml_gen_type_decl_flags,
|
|
ClassBodyDefn = mlds_class_defn(mlds_class, ClassImports,
|
|
ClassExtends, ClassImplements, ClassCtors, ClassMembers),
|
|
ClassBody = mlds_class(ClassBodyDefn),
|
|
ClassDefn = mlds_defn(ClassName, ClassContext, ClassFlags, ClassBody).
|
|
|
|
% Generates a call methods which calls the original method we have
|
|
% created the wrapper for.
|
|
%
|
|
:- pred generate_call_method(mlds_code_addr::in, mlds_defn::out) is det.
|
|
|
|
generate_call_method(CodeAddr, MethodDefn) :-
|
|
(
|
|
CodeAddr = code_addr_proc(ProcLabel, OrigFuncSignature)
|
|
;
|
|
CodeAddr = code_addr_internal(ProcLabel, _SeqNum, OrigFuncSignature)
|
|
),
|
|
OrigFuncSignature = mlds_func_signature(OrigArgTypes, OrigRetTypes),
|
|
% XXX We should fill in the Context properly.
|
|
Context = mlds_make_context(term.context_init),
|
|
ModuleName = ProcLabel ^ mod_name,
|
|
PredID = hlds_pred.initial_pred_id,
|
|
ProcID = initial_proc_id,
|
|
|
|
% Create new method name.
|
|
Label = mlds_special_pred_label("call", no, "", 0),
|
|
MethodName = entity_function(Label, ProcID, no, PredID),
|
|
|
|
% Create method argument and return type.
|
|
% It will have the argument type java.lang.Object[]
|
|
% It will have the return type java.lang.Object
|
|
MethodArgVariable = mlds_var_name("args", no),
|
|
MethodArgType = mlds_argument(entity_data(var(MethodArgVariable)),
|
|
mlds_array_type(mlds_generic_type), gc_no_stmt),
|
|
MethodRetType = mlds_generic_type,
|
|
MethodArgs = [MethodArgType],
|
|
MethodRets = [MethodRetType],
|
|
|
|
% 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 = var(ReturnVar, ReturnVarType),
|
|
ReturnEntityName = entity_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),
|
|
ReturnVarDefn = mlds_defn(ReturnEntityName, Context, ReturnDecFlags,
|
|
ReturnEntityDefn),
|
|
MethodDefns = [ReturnVarDefn],
|
|
|
|
% Create the call to the original method.
|
|
CallArgLabel = qual(ModuleName, module_qual, MethodArgVariable),
|
|
generate_call_method_args(OrigArgTypes, CallArgLabel, 0, [], CallArgs),
|
|
CallRval = 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 = mlcall(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 = unop(box(ReturnVarType), lval(ReturnLval)),
|
|
Return = return([ReturnRval]),
|
|
ReturnStatement = statement(Return, Context),
|
|
|
|
Block = block(MethodDefns, [CallStatement, ReturnStatement]),
|
|
Statements = statement(Block, Context),
|
|
|
|
% Put it all together.
|
|
MethodParams = mlds_func_params(MethodArgs, MethodRets),
|
|
MethodMaybeID = no,
|
|
MethodAttribs = [],
|
|
MethodEnvVarNames = set.init,
|
|
MethodBody = mlds_function(MethodMaybeID, MethodParams,
|
|
body_defined_here(Statements), MethodAttribs, MethodEnvVarNames),
|
|
MethodFlags = ml_gen_special_member_decl_flags,
|
|
MethodDefn = mlds_defn(MethodName, Context, MethodFlags, MethodBody).
|
|
|
|
:- pred generate_call_method_args(list(mlds_type)::in, mlds_var::in, int::in,
|
|
list(mlds_rval)::in, list(mlds_rval)::out) is det.
|
|
|
|
generate_call_method_args([], _, _, Args, Args).
|
|
generate_call_method_args([Type | Types], Variable, Counter, Args0, Args) :-
|
|
ArrayRval = lval(var(Variable, mlds_native_int_type)),
|
|
IndexRval = const(mlconst_int(Counter)),
|
|
Rval = binop(array_index(elem_type_generic), ArrayRval, IndexRval),
|
|
UnBoxedRval = unop(unbox(Type), Rval),
|
|
Args1 = Args0 ++ [UnBoxedRval],
|
|
generate_call_method_args(Types, Variable, Counter + 1, Args1, Args).
|
|
|
|
:- func mlds_module_name_to_string(mlds_module_name) = string.
|
|
|
|
mlds_module_name_to_string(MldsModuleName) = ModuleNameStr :-
|
|
ModuleName = mlds_module_name_to_sym_name(MldsModuleName),
|
|
ModuleNameStr = symbol_name_to_string(ModuleName, "").
|
|
|
|
:- func symbol_name_to_string(sym_name, string) = string.
|
|
|
|
symbol_name_to_string(unqualified(SymName), SymNameStr0) = SymNameStr :-
|
|
SymNameStr = SymNameStr0 ++ SymName.
|
|
symbol_name_to_string(qualified(Qualifier, SymName), SymNameStr0)
|
|
= SymNameStr :-
|
|
SymNameStr1 = symbol_name_to_string(Qualifier, SymNameStr0),
|
|
SymNameStr = SymNameStr1 ++ "__" ++ SymName.
|
|
|
|
:- func make_pred_name_string(mlds_pred_label, proc_id,
|
|
maybe(mlds_func_sequence_num)) = string.
|
|
|
|
make_pred_name_string(PredLabel, ProcId, MaybeSeqNum) = NameStr :-
|
|
PredLabelStr = pred_label_string(PredLabel),
|
|
proc_id_to_int(ProcId, ModeNum),
|
|
NameStr0 = PredLabelStr ++ "_" ++ string.int_to_string(ModeNum),
|
|
(
|
|
MaybeSeqNum = yes(SeqNum),
|
|
NameStr = NameStr0 ++ "_" ++ string.int_to_string(SeqNum)
|
|
;
|
|
MaybeSeqNum = no,
|
|
NameStr = NameStr0
|
|
).
|
|
|
|
:- func pred_label_string(mlds_pred_label) = string.
|
|
|
|
pred_label_string(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule, Name,
|
|
PredArity, _CodeModel, _NonOutputFunc)) = PredLabelStr :-
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
Suffix = "p",
|
|
OrigArity = PredArity
|
|
;
|
|
PredOrFunc = pf_function,
|
|
Suffix = "f",
|
|
OrigArity = PredArity - 1
|
|
),
|
|
MangledName = name_mangle(Name),
|
|
PredLabelStr0 = MangledName ++ "_" ++ string.int_to_string(OrigArity)
|
|
++ "_" ++ Suffix,
|
|
(
|
|
MaybeDefiningModule = yes(DefiningModule),
|
|
MangledModuleName = sym_name_mangle(DefiningModule),
|
|
PredLabelStr = PredLabelStr0 ++ "_in__" ++ MangledModuleName
|
|
;
|
|
MaybeDefiningModule = no,
|
|
PredLabelStr = PredLabelStr0
|
|
).
|
|
pred_label_string(mlds_special_pred_label(PredName, MaybeTypeModule, TypeName,
|
|
TypeArity)) = PredLabelStr :-
|
|
MangledPredName = name_mangle(PredName),
|
|
MangledTypeName = name_mangle(TypeName),
|
|
PredLabelStr0 = MangledPredName ++ "__",
|
|
(
|
|
MaybeTypeModule = yes(TypeModule),
|
|
MangledModuleName = sym_name_mangle(TypeModule),
|
|
PredLabelStr1 = PredLabelStr0 ++ "__" ++ MangledModuleName
|
|
;
|
|
MaybeTypeModule = no,
|
|
PredLabelStr1 = PredLabelStr0
|
|
),
|
|
PredLabelStr = PredLabelStr1 ++ MangledTypeName ++ "_" ++
|
|
string.int_to_string(TypeArity).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output the start and end of a source file.
|
|
%
|
|
|
|
:- pred output_src_start(indent::in, mercury_module_name::in,
|
|
mlds_imports::in, list(foreign_decl_code)::in, mlds_defns::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_src_start(Indent, MercuryModuleName, Imports, ForeignDecls, Defns,
|
|
!IO) :-
|
|
MLDSModuleName = mercury_module_name_to_mlds(MercuryModuleName),
|
|
ModuleSymName = mlds_module_name_to_sym_name(MLDSModuleName),
|
|
JavaSafeModuleName = valid_module_name(ModuleSymName),
|
|
output_auto_gen_comment(MercuryModuleName, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("/* :- module ", !IO),
|
|
prog_out.write_sym_name(MercuryModuleName, !IO),
|
|
io.write_string(". */\n\n", !IO),
|
|
output_package_info(JavaSafeModuleName, !IO),
|
|
output_imports(Imports, !IO),
|
|
io.write_list(ForeignDecls, "\n", output_java_decl(Indent), !IO),
|
|
io.write_string("public class ", !IO),
|
|
ClassName = unqualify_name(JavaSafeModuleName),
|
|
io.write_string(ClassName, !IO),
|
|
io.write_string(" {\n", !IO),
|
|
maybe_write_main_driver(Indent + 1, JavaSafeModuleName, Defns, !IO).
|
|
|
|
% Output a `package' directive at the top of the Java source file,
|
|
% if necessary.
|
|
%
|
|
:- pred output_package_info(sym_name::in, io::di, io::uo) is det.
|
|
|
|
output_package_info(unqualified(_), !IO).
|
|
output_package_info(qualified(Module, _), !IO) :-
|
|
io.write_string("package ", !IO),
|
|
io.write_string(sym_name_to_string(Module), !IO),
|
|
io.write_string(";\n", !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. Save the command line arguments in the class
|
|
% variable `args' in the class `mercury.runtime.JavaInternal'.
|
|
%
|
|
:- pred maybe_write_main_driver(indent::in, java_module_name::in,
|
|
mlds_defns::in, io::di, io::uo) is det.
|
|
|
|
maybe_write_main_driver(Indent, JavaSafeModuleName, Defns, !IO) :-
|
|
( defns_contain_main(Defns) ->
|
|
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 `mercury.runtime.JavaInternal', as well as setting the default
|
|
% exit status.
|
|
ClassName = unqualify_name(JavaSafeModuleName),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("mercury.runtime.JavaInternal.progname = """, !IO),
|
|
io.write_string(ClassName, !IO),
|
|
io.write_string(""";\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("mercury.runtime.JavaInternal.args = args;\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("mercury.runtime.JavaInternal.exit_status = ", !IO),
|
|
io.write_string("0;\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
prog_out.write_sym_name(JavaSafeModuleName, !IO),
|
|
io.write_string(".main_2_p_0();\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("java.lang.System.exit", !IO),
|
|
io.write_string("(mercury.runtime.JavaInternal.exit_status);", !IO),
|
|
io.nl(!IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO)
|
|
;
|
|
true
|
|
),
|
|
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) :-
|
|
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).
|
|
|
|
% Output a Java comment saying that the file was automatically
|
|
% generated and give details such as the compiler version.
|
|
%
|
|
:- pred output_auto_gen_comment(mercury_module_name::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_auto_gen_comment(ModuleName, !IO) :-
|
|
library.version(Version),
|
|
module_name_to_file_name(ModuleName, ".m", no, 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.
|
|
%
|
|
|
|
% Discriminated union which allows us to 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.
|
|
%
|
|
:- type ctor_data
|
|
---> none % Not a constructor.
|
|
; cname(mlds_entity_name). % Constructor class name.
|
|
|
|
:- pred output_defns(indent::in, module_info::in, mlds_module_name::in,
|
|
ctor_data::in, mlds_defns::in, io::di, io::uo) is det.
|
|
|
|
output_defns(Indent, ModuleInfo, ModuleName, CtorData, Defns, !IO) :-
|
|
OutputDefn = output_defn(Indent, ModuleInfo, ModuleName, CtorData),
|
|
list.foldl(OutputDefn, Defns, !IO).
|
|
|
|
:- pred output_defn(indent::in, module_info::in, mlds_module_name::in,
|
|
ctor_data::in, mlds_defn::in, io::di, io::uo) is det.
|
|
|
|
output_defn(Indent, ModuleInfo, ModuleName, CtorData, Defn, !IO) :-
|
|
Defn = mlds_defn(Name, Context, Flags, DefnBody),
|
|
indent_line(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(Flags, Name, !IO),
|
|
output_defn_body(Indent, ModuleInfo,
|
|
qual(ModuleName, module_qual, Name), CtorData, Context, DefnBody,
|
|
!IO),
|
|
io.write_string("*/\n", !IO)
|
|
;
|
|
output_decl_flags(Flags, Name, !IO),
|
|
output_defn_body(Indent, ModuleInfo,
|
|
qual(ModuleName, module_qual, Name), CtorData, Context, DefnBody,
|
|
!IO)
|
|
).
|
|
|
|
:- pred output_defn_body(indent::in, module_info::in,
|
|
mlds_qualified_entity_name::in, ctor_data::in, mlds_context::in,
|
|
mlds_entity_defn::in, io::di, io::uo) is det.
|
|
|
|
output_defn_body(_, ModuleInfo, Name, _, _, mlds_data(Type, Initializer, _),
|
|
!IO) :-
|
|
output_data_defn(ModuleInfo, Name, Type, Initializer, !IO).
|
|
output_defn_body(Indent, ModuleInfo, Name, CtorData, Context,
|
|
mlds_function(MaybePredProcId, Signature, MaybeBody,
|
|
_Attributes, EnvVarNames), !IO) :-
|
|
expect(set.empty(EnvVarNames), this_file,
|
|
"output_defn_body: EnvVarNames"),
|
|
output_maybe(MaybePredProcId, output_pred_proc_id, !IO),
|
|
output_func(Indent, ModuleInfo, Name, CtorData, Context, Signature,
|
|
MaybeBody, !IO).
|
|
output_defn_body(Indent, ModuleInfo, Name, _, Context, mlds_class(ClassDefn),
|
|
!IO) :-
|
|
output_class(Indent, ModuleInfo, Name, Context, ClassDefn, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output classes.
|
|
%
|
|
|
|
:- pred output_class(indent::in, module_info::in,
|
|
mlds_qualified_entity_name::in, mlds_context::in, mlds_class_defn::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_class(Indent, ModuleInfo, Name, _Context, ClassDefn, !IO) :-
|
|
Name = qual(ModuleName, _QualKind, UnqualName),
|
|
(
|
|
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)
|
|
;
|
|
io.write_string("class ", !IO)
|
|
),
|
|
output_class_name_and_arity(ClassName, Arity, !IO),
|
|
io.nl(!IO),
|
|
output_extends_list(Indent + 1, BaseClasses, !IO),
|
|
output_implements_list(Indent + 1, Implements, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
output_class_body(Indent + 1, ModuleInfo, Kind, Name, AllMembers,
|
|
ModuleName, !IO),
|
|
io.nl(!IO),
|
|
output_defns(Indent + 1, ModuleInfo, ModuleName, 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(indent::in, list(mlds_class_id)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_extends_list(_, [], !IO).
|
|
output_extends_list(Indent, [SuperClass], !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("extends ", !IO),
|
|
output_type(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_mlds_sym_name_for_java(SymName, 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(indent::in, module_info::in, mlds_class_kind::in,
|
|
mlds_qualified_entity_name::in, mlds_defns::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_class_body(Indent, ModuleInfo, mlds_class, _, AllMembers, ModuleName,
|
|
!IO) :-
|
|
CtorData = none, % Not a constructor.
|
|
output_defns(Indent, ModuleInfo, ModuleName, CtorData, AllMembers, !IO).
|
|
|
|
output_class_body(_Indent, _, mlds_package, _Name, _AllMembers, _, _, _) :-
|
|
unexpected(this_file, "cannot use package as a type.").
|
|
|
|
output_class_body(Indent, ModuleInfo, mlds_interface, _, AllMembers,
|
|
ModuleName, !IO) :-
|
|
CtorData = none, % Not a constructor.
|
|
output_defns(Indent, ModuleInfo, ModuleName, CtorData, AllMembers, !IO).
|
|
|
|
output_class_body(_Indent, _, mlds_struct, _, _AllMembers, _, _, _) :-
|
|
unexpected(this_file, "output_class_body: structs not supported in Java.").
|
|
|
|
output_class_body(Indent, ModuleInfo, mlds_enum, Name, AllMembers, _, !IO) :-
|
|
list.filter(defn_is_const, AllMembers, EnumConsts),
|
|
Name = qual(ModuleName, _QualKind, UnqualName),
|
|
output_enum_constants(Indent + 1, ModuleInfo, ModuleName, EnumConsts, !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("public int value;\n\n", !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("public ", !IO),
|
|
output_name(UnqualName, !IO),
|
|
io.write_string("(int val) {\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
|
|
% The use of `value' is hardcoded into ml_type_gen.m. Any changes there
|
|
% should probably be reflected here.
|
|
io.write_string("this.value = val;\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
io.write_string("return;\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
:- pred output_enum_constants(indent::in, module_info::in,
|
|
mlds_module_name::in, mlds_defns::in, io::di, io::uo) is det.
|
|
|
|
output_enum_constants(Indent, ModuleInfo, EnumModuleName, EnumConsts, !IO) :-
|
|
io.write_list(EnumConsts, "\n",
|
|
output_enum_constant(Indent, ModuleInfo, EnumModuleName), !IO),
|
|
io.nl(!IO).
|
|
|
|
:- pred output_enum_constant(indent::in, module_info::in,
|
|
mlds_module_name::in, mlds_defn::in, io::di, io::uo) is det.
|
|
|
|
output_enum_constant(Indent, ModuleInfo, EnumModuleName, Defn, !IO) :-
|
|
Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
|
|
(
|
|
DefnBody = mlds_data(Type, Initializer, _GCStatement)
|
|
->
|
|
indent_line(Indent, !IO),
|
|
io.write_string("public static final int ", !IO),
|
|
output_name(Name, !IO),
|
|
output_initializer(ModuleInfo, EnumModuleName, Type, Initializer, !IO),
|
|
io.write_char(';', !IO)
|
|
;
|
|
unexpected(this_file,
|
|
"output_enum_constant: definition body was not data.")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output data declarations/definitions
|
|
%
|
|
|
|
:- pred output_data_decl(mlds_qualified_entity_name::in, mlds_type::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_data_decl(qual(_, _, Name), Type, !IO) :-
|
|
output_type(Type, !IO),
|
|
io.write_char(' ', !IO),
|
|
output_name(Name, !IO).
|
|
|
|
:- pred output_data_defn(module_info::in, mlds_qualified_entity_name::in,
|
|
mlds_type::in, mlds_initializer::in, io::di, io::uo) is det.
|
|
|
|
output_data_defn(ModuleInfo, Name, Type, Initializer, !IO) :-
|
|
output_data_decl(Name, Type, !IO),
|
|
output_initializer(ModuleInfo, Name ^ mod_name, 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(mercury_type(_, type_cat_int, _)) = "0".
|
|
get_java_type_initializer(mercury_type(_, type_cat_char, _)) = "0".
|
|
get_java_type_initializer(mercury_type(_, type_cat_float, _)) = "0".
|
|
get_java_type_initializer(mercury_type(_, type_cat_string, _)) = "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_void, _)) = "0".
|
|
get_java_type_initializer(mercury_type(_, type_cat_type_info, _)) = "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_type_ctor_info, _))
|
|
= "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_typeclass_info, _))
|
|
= "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_base_typeclass_info, _))
|
|
= "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_higher_order, _)) = "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_tuple, _)) = "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_enum, _)) = "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_dummy, _)) = "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_variable, _)) = "null".
|
|
get_java_type_initializer(mercury_type(_, type_cat_user_ctor, _)) = "null".
|
|
get_java_type_initializer(mlds_mercury_array_type(_)) = "null".
|
|
get_java_type_initializer(mlds_cont_type(_)) = "null".
|
|
get_java_type_initializer(mlds_commit_type) = "null".
|
|
get_java_type_initializer(mlds_native_bool_type) = "false".
|
|
get_java_type_initializer(mlds_native_int_type) = "0".
|
|
get_java_type_initializer(mlds_native_float_type) = "0".
|
|
get_java_type_initializer(mlds_native_char_type) = "0".
|
|
get_java_type_initializer(mlds_foreign_type(_)) = "null".
|
|
get_java_type_initializer(mlds_class_type(_, _, _)) = "null".
|
|
get_java_type_initializer(mlds_array_type(_)) = "null".
|
|
get_java_type_initializer(mlds_ptr_type(_)) = "null".
|
|
get_java_type_initializer(mlds_func_type(_)) = "null".
|
|
get_java_type_initializer(mlds_generic_type) = "null".
|
|
get_java_type_initializer(mlds_generic_env_ptr_type) = "null".
|
|
get_java_type_initializer(mlds_type_info_type) = "null".
|
|
get_java_type_initializer(mlds_pseudo_type_info_type) = "null".
|
|
get_java_type_initializer(mlds_rtti_type(_)) = "null".
|
|
get_java_type_initializer(mlds_tabling_type(_)) = "null".
|
|
get_java_type_initializer(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(module_info::in, mlds_module_name::in,
|
|
mlds_type::in, mlds_initializer::in, io::di, io::uo) is det.
|
|
|
|
output_initializer(ModuleInfo, ModuleName, Type, Initializer, !IO) :-
|
|
io.write_string(" = ", !IO),
|
|
( needs_initialization(Initializer) = yes ->
|
|
output_initializer_body(ModuleInfo, Initializer, yes(Type), ModuleName,
|
|
!IO)
|
|
;
|
|
% If we are not provided with an initializer we just, supply the
|
|
% default java values -- note: this is strictly only necessary for
|
|
% local variables, but it's not going to hurt anything else.
|
|
%
|
|
io.write_string(get_java_type_initializer(Type), !IO)
|
|
).
|
|
|
|
:- func needs_initialization(mlds_initializer) = bool.
|
|
|
|
needs_initialization(no_initializer) = no.
|
|
needs_initialization(init_obj(_)) = yes.
|
|
needs_initialization(init_struct(_Type, [])) = no.
|
|
needs_initialization(init_struct(_Type, [_ | _])) = yes.
|
|
needs_initialization(init_array(_)) = yes.
|
|
|
|
:- pred output_initializer_body(module_info::in, mlds_initializer::in,
|
|
maybe(mlds_type)::in, mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_initializer_body(_ModuleInfo, no_initializer, _, _, _, _) :-
|
|
unexpected(this_file, "output_initializer_body: no_initializer").
|
|
output_initializer_body(ModuleInfo, init_obj(Rval), MaybeType, ModuleName,
|
|
!IO) :-
|
|
(
|
|
MaybeType = yes(Type),
|
|
type_is_object(Type),
|
|
rval_is_int_const(Rval)
|
|
->
|
|
% If it is a enumeration object create new object.
|
|
io.write_string("new ", !IO),
|
|
output_type(Type, !IO),
|
|
io.write_char('(', !IO),
|
|
output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO),
|
|
io.write_char(')', !IO)
|
|
;
|
|
MaybeType = yes(Type)
|
|
->
|
|
% If it is an non-enumeration object, insert appropriate cast.
|
|
% XXX The logic of this is a bit wrong. Fixing it would eliminate
|
|
% some of the unecessary casting that happens.
|
|
io.write_string("(", !IO),
|
|
output_type(Type, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_rval(ModuleInfo, Rval, ModuleName, !IO)
|
|
;
|
|
output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO)
|
|
).
|
|
|
|
output_initializer_body(ModuleInfo, init_struct(StructType, FieldInits),
|
|
_MaybeType, ModuleName, !IO) :-
|
|
io.write_string("new ", !IO),
|
|
output_type(StructType, !IO),
|
|
IsArray = type_is_array(StructType),
|
|
io.write_string(if IsArray = yes then " {" else "(", !IO),
|
|
io.write_list(FieldInits, ",\n\t\t",
|
|
(pred(FieldInit::in, !.IO::di, !:IO::uo) is det :-
|
|
output_initializer_body(ModuleInfo, FieldInit, no, ModuleName, !IO)
|
|
), !IO),
|
|
io.write_char(if IsArray = yes then '}' else ')', !IO).
|
|
output_initializer_body(ModuleInfo, init_array(ElementInits), MaybeType,
|
|
ModuleName, !IO) :-
|
|
io.write_string("new ", !IO),
|
|
(
|
|
MaybeType = yes(Type),
|
|
output_type(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),
|
|
io.write_list(ElementInits, ",\n\t\t",
|
|
(pred(ElementInit::in, !.IO::di, !:IO::uo) is det :-
|
|
output_initializer_body(ModuleInfo, ElementInit, no, ModuleName,
|
|
!IO)),
|
|
!IO),
|
|
io.write_string("}", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output function declarations/definitions
|
|
%
|
|
|
|
:- pred output_pred_proc_id(pred_proc_id::in, io::di, io::uo) is det.
|
|
|
|
output_pred_proc_id(proc(PredId, ProcId), !IO) :-
|
|
globals.io_lookup_bool_option(auto_comments, AddComments, !IO),
|
|
(
|
|
AddComments = 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)
|
|
;
|
|
AddComments = no
|
|
).
|
|
|
|
:- pred output_func(indent::in, module_info::in,
|
|
mlds_qualified_entity_name::in, ctor_data::in, mlds_context::in,
|
|
mlds_func_params::in, mlds_function_body::in, io::di, io::uo) is det.
|
|
|
|
output_func(Indent, ModuleInfo, Name, CtorData, Context, Signature, MaybeBody,
|
|
!IO) :-
|
|
(
|
|
MaybeBody = body_defined_here(Body),
|
|
output_func_decl(Indent, Name, CtorData, Context, Signature, !IO),
|
|
io.write_string("\n", !IO),
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
FuncInfo = func_info(Name, Signature),
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Body, _ExitMethods,
|
|
!IO),
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("}\n", !IO) % end the function
|
|
;
|
|
MaybeBody = body_external
|
|
).
|
|
|
|
:- pred output_func_decl(indent::in, mlds_qualified_entity_name::in,
|
|
ctor_data::in, mlds_context::in, mlds_func_params::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_func_decl(Indent, QualifiedName, cname(CtorName), Context, Signature,
|
|
!IO) :-
|
|
Signature = mlds_func_params(Parameters, _RetTypes),
|
|
output_name(CtorName, !IO),
|
|
output_params(Indent, QualifiedName ^ mod_name, Context, Parameters, !IO).
|
|
|
|
output_func_decl(Indent, QualifiedName, none, Context, Signature, !IO) :-
|
|
Signature = mlds_func_params(Parameters, RetTypes),
|
|
(
|
|
RetTypes = [],
|
|
io.write_string("void", !IO)
|
|
;
|
|
RetTypes = [RetType],
|
|
output_type(RetType, !IO)
|
|
;
|
|
RetTypes = [_, _ | _],
|
|
% For multiple outputs, we return an array of objects.
|
|
io.write_string("java.lang.Object []", !IO)
|
|
),
|
|
io.write_char(' ', !IO),
|
|
QualifiedName = qual(ModuleName, _QualKind, Name),
|
|
output_name(Name, !IO),
|
|
output_params(Indent, ModuleName, Context, Parameters, !IO).
|
|
|
|
:- pred output_params(indent::in, mlds_module_name::in, mlds_context::in,
|
|
mlds_arguments::in, io::di, io::uo) is det.
|
|
|
|
output_params(Indent, ModuleName, Context, Parameters, !IO) :-
|
|
io.write_char('(', !IO),
|
|
(
|
|
Parameters = []
|
|
;
|
|
Parameters = [_ | _],
|
|
io.nl(!IO),
|
|
io.write_list(Parameters, ",\n",
|
|
output_param(Indent + 1, ModuleName, Context), !IO)
|
|
),
|
|
io.write_char(')', !IO).
|
|
|
|
:- pred output_param(indent::in, mlds_module_name::in, mlds_context::in,
|
|
mlds_argument::in, io::di, io::uo) is det.
|
|
|
|
output_param(Indent, _ModuleName, Context, Arg, !IO) :-
|
|
Arg = mlds_argument(Name, Type, _GCStatement),
|
|
indent_line(Context, Indent, !IO),
|
|
output_type(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(mlds_qualified_entity_name::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_maybe_qualified_name(QualifiedName, CurrentModuleName, !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),
|
|
( ModuleName = CurrentModuleName ->
|
|
output_name(Name, !IO)
|
|
;
|
|
output_fully_qualified(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(QualifiedName, output_name, ".", !IO).
|
|
|
|
:- pred output_fully_qualified_proc_label(mlds_qualified_proc_label::in,
|
|
string::in, io::di, io::uo) is det.
|
|
|
|
output_fully_qualified_proc_label(QualifiedName, Qualifier, !IO) :-
|
|
output_fully_qualified(QualifiedName, mlds_output_proc_label,
|
|
Qualifier, !IO).
|
|
|
|
:- pred output_fully_qualified(mlds_fully_qualified_name(T)::in,
|
|
pred(T, io, io)::pred(in, di, uo) is det, string::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_fully_qualified(qual(ModuleName, QualKind, Name), OutputFunc,
|
|
Qualifier, !IO) :-
|
|
SymName = mlds_module_name_to_sym_name(ModuleName),
|
|
mangle_mlds_sym_name_for_java(SymName, QualKind, Qualifier,
|
|
MangledModuleName),
|
|
io.write_string(MangledModuleName, !IO),
|
|
io.write_string(Qualifier, !IO),
|
|
OutputFunc(Name, !IO).
|
|
|
|
:- 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(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(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(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(var(VarName), !IO) :-
|
|
output_mlds_var_name(VarName, !IO).
|
|
output_data_name(mlds_common(Num), !IO) :-
|
|
io.write_string("common_", !IO),
|
|
io.write_int(Num, !IO).
|
|
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
|
|
%
|
|
|
|
:- pred output_type(mlds_type::in, io::di, io::uo) is det.
|
|
|
|
output_type(mercury_type(Type, TypeCategory, _), !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)
|
|
;
|
|
% 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(TypeCategory, SubstituteName)
|
|
->
|
|
io.write_string(SubstituteName, !IO)
|
|
;
|
|
output_mercury_type(Type, TypeCategory, !IO)
|
|
).
|
|
|
|
output_type(mlds_mercury_array_type(ElementType), !IO) :-
|
|
( ElementType = mercury_type(_, type_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)
|
|
;
|
|
output_type(ElementType, !IO),
|
|
io.write_string("[]", !IO)
|
|
).
|
|
output_type(mlds_native_int_type, !IO) :-
|
|
io.write_string("int", !IO).
|
|
output_type(mlds_native_float_type, !IO) :-
|
|
io.write_string("double", !IO).
|
|
output_type(mlds_native_bool_type, !IO) :-
|
|
io.write_string("boolean", !IO).
|
|
output_type(mlds_native_char_type, !IO) :-
|
|
io.write_string("char", !IO).
|
|
output_type(mlds_foreign_type(ForeignType), !IO) :-
|
|
(
|
|
ForeignType = java(java_type(Name)),
|
|
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")
|
|
).
|
|
output_type(mlds_class_type(Name, Arity, _ClassKind), !IO) :-
|
|
% We used to treat enumerations specially here, outputting
|
|
% them as "int", but now we do the same for all classes.
|
|
output_fully_qualified(Name, output_class_name, ".", !IO),
|
|
io.format("_%d", [i(Arity)], !IO).
|
|
output_type(mlds_ptr_type(Type), !IO) :-
|
|
% XXX should we report an error here, if the type pointed to
|
|
% is not a class type?
|
|
output_type(Type, !IO).
|
|
output_type(mlds_array_type(Type), !IO) :-
|
|
output_type(Type, !IO),
|
|
io.write_string("[]", !IO).
|
|
output_type(mlds_func_type(_FuncParams), !IO) :-
|
|
io.write_string("mercury.runtime.MethodPtr", !IO).
|
|
output_type(mlds_generic_type, !IO) :-
|
|
io.write_string("java.lang.Object", !IO).
|
|
output_type(mlds_generic_env_ptr_type, !IO) :-
|
|
io.write_string("/* env_ptr */ java.lang.Object", !IO).
|
|
output_type(mlds_type_info_type, !IO) :-
|
|
io.write_string("mercury.runtime.TypeInfo", !IO).
|
|
output_type(mlds_pseudo_type_info_type, !IO) :-
|
|
io.write_string("mercury.runtime.PseudoTypeInfo", !IO).
|
|
output_type(mlds_cont_type(_), !IO) :-
|
|
% XXX Should this actually be a class that extends MethodPtr?
|
|
io.write_string("mercury.runtime.MethodPtr", !IO).
|
|
output_type(mlds_commit_type, !IO) :-
|
|
io.write_string("mercury.runtime.Commit", !IO).
|
|
output_type(mlds_rtti_type(RttiIdMaybeElement), !IO) :-
|
|
rtti_id_maybe_element_java_type(RttiIdMaybeElement, JavaTypeName, IsArray),
|
|
io.write_string(JavaTypeName, !IO),
|
|
(
|
|
IsArray = yes,
|
|
io.write_string("[]", !IO)
|
|
;
|
|
IsArray = no
|
|
).
|
|
output_type(mlds_tabling_type(TablingId), !IO) :-
|
|
tabling_id_java_type(TablingId, JavaTypeName, IsArray),
|
|
io.write_string(JavaTypeName, !IO),
|
|
(
|
|
IsArray = yes,
|
|
io.write_string("[]", !IO)
|
|
;
|
|
IsArray = no
|
|
).
|
|
output_type(mlds_unknown_type, !IO) :-
|
|
unexpected(this_file, "output_type: unknown type").
|
|
|
|
:- pred output_mercury_type(mer_type::in, type_category::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_mercury_type(Type, TypeCategory, !IO) :-
|
|
(
|
|
TypeCategory = type_cat_char,
|
|
io.write_string("char", !IO)
|
|
;
|
|
TypeCategory = type_cat_int,
|
|
io.write_string("int", !IO)
|
|
;
|
|
TypeCategory = type_cat_string,
|
|
io.write_string("java.lang.String", !IO)
|
|
;
|
|
TypeCategory = type_cat_float,
|
|
io.write_string("double", !IO)
|
|
;
|
|
TypeCategory = type_cat_void,
|
|
% Shouldn't matter what we put here.
|
|
io.write_string("int", !IO)
|
|
;
|
|
TypeCategory = type_cat_type_info,
|
|
output_mercury_user_type(Type, type_cat_user_ctor, !IO)
|
|
;
|
|
TypeCategory = type_cat_type_ctor_info,
|
|
output_mercury_user_type(Type, type_cat_user_ctor, !IO)
|
|
;
|
|
TypeCategory = type_cat_typeclass_info,
|
|
output_mercury_user_type(Type, type_cat_user_ctor, !IO)
|
|
;
|
|
TypeCategory = type_cat_base_typeclass_info,
|
|
output_mercury_user_type(Type, type_cat_user_ctor, !IO)
|
|
;
|
|
TypeCategory = type_cat_variable,
|
|
io.write_string("java.lang.Object", !IO)
|
|
;
|
|
TypeCategory = type_cat_tuple,
|
|
io.write_string("/* tuple */ java.lang.Object[]", !IO)
|
|
;
|
|
TypeCategory = type_cat_higher_order,
|
|
io.write_string("/* closure */ java.lang.Object[]", !IO)
|
|
;
|
|
TypeCategory = type_cat_enum,
|
|
output_mercury_user_type(Type, TypeCategory, !IO)
|
|
;
|
|
TypeCategory = type_cat_dummy,
|
|
output_mercury_user_type(Type, TypeCategory, !IO)
|
|
;
|
|
TypeCategory = type_cat_user_ctor,
|
|
output_mercury_user_type(Type, TypeCategory, !IO)
|
|
).
|
|
|
|
:- pred output_mercury_user_type(mer_type::in, type_category::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_mercury_user_type(Type, TypeCategory, !IO) :-
|
|
( type_to_ctor_and_args(Type, TypeCtor, _ArgsTypes) ->
|
|
ml_gen_type_name(TypeCtor, ClassName, ClassArity),
|
|
( TypeCategory = type_cat_enum ->
|
|
MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_enum)
|
|
;
|
|
MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_class)
|
|
),
|
|
output_type(MLDS_Type, !IO)
|
|
;
|
|
unexpected(this_file, "output_mercury_user_type: not a user type")
|
|
).
|
|
|
|
% return yes if the corresponding Java type is an array type.
|
|
:- func type_is_array(mlds_type) = bool.
|
|
|
|
type_is_array(Type) = IsArray :-
|
|
( Type = mlds_array_type(_) ->
|
|
IsArray = yes
|
|
; Type = mlds_mercury_array_type(_) ->
|
|
IsArray = yes
|
|
; Type = mercury_type(_, TypeCategory, _) ->
|
|
IsArray = type_category_is_array(TypeCategory)
|
|
; Type = mlds_rtti_type(RttiIdMaybeElement) ->
|
|
rtti_id_maybe_element_java_type(RttiIdMaybeElement,
|
|
_JavaTypeName, IsArray)
|
|
;
|
|
IsArray = no
|
|
).
|
|
|
|
% Return yes if the corresponding Java type is an array type.
|
|
%
|
|
:- func type_category_is_array(type_category) = bool.
|
|
|
|
type_category_is_array(type_cat_int) = no.
|
|
type_category_is_array(type_cat_char) = no.
|
|
type_category_is_array(type_cat_string) = no.
|
|
type_category_is_array(type_cat_float) = no.
|
|
type_category_is_array(type_cat_higher_order) = yes.
|
|
type_category_is_array(type_cat_tuple) = yes.
|
|
type_category_is_array(type_cat_enum) = no.
|
|
type_category_is_array(type_cat_dummy) = no.
|
|
type_category_is_array(type_cat_variable) = no.
|
|
type_category_is_array(type_cat_type_info) = no.
|
|
type_category_is_array(type_cat_type_ctor_info) = no.
|
|
type_category_is_array(type_cat_typeclass_info) = yes.
|
|
type_category_is_array(type_cat_base_typeclass_info) = yes.
|
|
type_category_is_array(type_cat_void) = no.
|
|
type_category_is_array(type_cat_user_ctor) = no.
|
|
|
|
% 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_category::in, string::out) is semidet.
|
|
|
|
hand_defined_type(type_cat_type_info, "mercury.runtime.TypeInfo_Struct").
|
|
hand_defined_type(type_cat_type_ctor_info,
|
|
"mercury.runtime.TypeCtorInfo_Struct").
|
|
hand_defined_type(type_cat_base_typeclass_info,
|
|
"/* base_typeclass_info */ java.lang.Object[]").
|
|
hand_defined_type(type_cat_typeclass_info,
|
|
"/* typeclass_info */ java.lang.Object[]").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output declaration specifiers
|
|
%
|
|
|
|
:- pred output_decl_flags(mlds_decl_flags::in, mlds_entity_name::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_decl_flags(Flags, _Name, !IO) :-
|
|
output_access(access(Flags), !IO),
|
|
output_per_instance(per_instance(Flags), !IO),
|
|
output_virtuality(virtuality(Flags), !IO),
|
|
output_finality(finality(Flags), !IO),
|
|
output_constness(constness(Flags), !IO),
|
|
output_abstractness(abstractness(Flags), !IO).
|
|
|
|
:- pred output_access(access::in, io::di, io::uo) is det.
|
|
|
|
output_access(public, !IO) :- io.write_string("public ", !IO).
|
|
output_access(private, !IO) :- io.write_string("private ", !IO).
|
|
output_access(protected, !IO) :-io.write_string("protected ", !IO).
|
|
output_access(default, !IO) :- maybe_output_comment("default", !IO).
|
|
output_access(local, !IO).
|
|
|
|
:- pred output_per_instance(per_instance::in, io::di, io::uo) is det.
|
|
|
|
output_per_instance(per_instance, !IO).
|
|
output_per_instance(one_copy, !IO) :- io.write_string("static ", !IO).
|
|
|
|
:- pred output_virtuality(virtuality::in, io::di, io::uo) is det.
|
|
|
|
output_virtuality(virtual, !IO) :- maybe_output_comment("virtual", !IO).
|
|
output_virtuality(non_virtual, !IO).
|
|
|
|
:- pred output_finality(finality::in, io::di, io::uo) is det.
|
|
|
|
output_finality(final, !IO) :- io.write_string("final ", !IO).
|
|
output_finality(overridable, !IO).
|
|
|
|
:- pred output_constness(constness::in, io::di, io::uo) is det.
|
|
|
|
output_constness(const, !IO) :- maybe_output_comment("const", !IO).
|
|
output_constness(modifiable, !IO).
|
|
|
|
:- pred output_abstractness(abstractness::in, io::di, io::uo) is det.
|
|
|
|
output_abstractness(abstract, !IO) :- io.write_string("abstract ", !IO).
|
|
output_abstractness(concrete, !IO).
|
|
|
|
:- pred maybe_output_comment(string::in, io::di, io::uo) is det.
|
|
|
|
maybe_output_comment(Comment, !IO) :-
|
|
globals.io_lookup_bool_option(auto_comments, AddComments, !IO),
|
|
(
|
|
AddComments = yes,
|
|
io.write_string("/* ", !IO),
|
|
io.write_string(Comment, !IO),
|
|
io.write_string(" */", !IO)
|
|
;
|
|
AddComments = 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 func_info
|
|
---> func_info(
|
|
func_info_name :: mlds_qualified_entity_name,
|
|
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(indent::in, module_info::in, func_info::in,
|
|
list(statement)::in, exit_methods::out, io::di, io::uo) is det.
|
|
|
|
output_statements(_, _, _, [], set.make_singleton_set(can_fall_through), !IO).
|
|
output_statements(Indent, ModuleInfo, FuncInfo, [Statement | Statements],
|
|
ExitMethods, !IO) :-
|
|
output_statement(Indent, ModuleInfo, FuncInfo, Statement, StmtExitMethods,
|
|
!IO),
|
|
( set.member(can_fall_through, StmtExitMethods) ->
|
|
output_statements(Indent, ModuleInfo, 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(indent::in, module_info::in, func_info::in,
|
|
statement::in, exit_methods::out, io::di, io::uo) is det.
|
|
|
|
output_statement(Indent, ModuleInfo, FuncInfo,
|
|
statement(Statement, Context), ExitMethods, !IO) :-
|
|
output_context(Context, !IO),
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, Statement, Context, ExitMethods,
|
|
!IO).
|
|
|
|
:- pred output_stmt(indent::in, module_info::in, func_info::in, mlds_stmt::in,
|
|
mlds_context::in, exit_methods::out, io::di, io::uo) is det.
|
|
|
|
% sequence
|
|
%
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, block(Defns, Statements), Context,
|
|
ExitMethods, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
(
|
|
Defns = [_ | _],
|
|
ModuleName = FuncInfo ^ func_info_name ^ mod_name,
|
|
CtorData = none, % Not a constructor.
|
|
output_defns(Indent + 1, ModuleInfo, ModuleName, CtorData, Defns, !IO),
|
|
io.write_string("\n", !IO)
|
|
;
|
|
Defns = []
|
|
),
|
|
output_statements(Indent + 1, ModuleInfo, FuncInfo, Statements,
|
|
ExitMethods, !IO),
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
% iteration
|
|
%
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, while(Cond, Statement, no),
|
|
_, ExitMethods, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("while (", !IO),
|
|
output_rval(ModuleInfo, Cond, FuncInfo ^ func_info_name ^ mod_name, !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 = const(mlconst_false) ->
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{ /* Unreachable code */ }\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_fall_through)
|
|
;
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Statement,
|
|
StmtExitMethods, !IO),
|
|
ExitMethods = while_exit_methods(Cond, StmtExitMethods)
|
|
).
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, while(Cond, Statement, yes), Context,
|
|
ExitMethods, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("do\n", !IO),
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Statement,
|
|
StmtExitMethods, !IO),
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("while (", !IO),
|
|
output_rval(ModuleInfo, Cond, FuncInfo ^ func_info_name ^ mod_name, !IO),
|
|
io.write_string(");\n", !IO),
|
|
ExitMethods = while_exit_methods(Cond, StmtExitMethods).
|
|
|
|
% selection (if-then-else)
|
|
%
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, if_then_else(Cond, Then0, MaybeElse),
|
|
Context, ExitMethods, !IO) :-
|
|
% 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(if_then_else(_, _, no), ThenContext)
|
|
->
|
|
Then = statement(block([], [Then0]), ThenContext)
|
|
;
|
|
Then = Then0
|
|
),
|
|
|
|
indent_line(Indent, !IO),
|
|
io.write_string("if (", !IO),
|
|
output_rval(ModuleInfo, Cond, FuncInfo ^ func_info_name ^ mod_name, !IO),
|
|
io.write_string(")\n", !IO),
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Then, ThenExitMethods,
|
|
!IO),
|
|
(
|
|
MaybeElse = yes(Else),
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("else\n", !IO),
|
|
output_statement(Indent + 1, ModuleInfo, 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)
|
|
).
|
|
|
|
% selection (switch)
|
|
%
|
|
output_stmt(Indent, ModuleInfo, FuncInfo,
|
|
switch(_Type, Val, _Range, Cases, Default),
|
|
Context, ExitMethods, !IO) :-
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("switch (", !IO),
|
|
output_rval_maybe_with_enum(ModuleInfo, Val,
|
|
FuncInfo ^ func_info_name ^ mod_name, !IO),
|
|
io.write_string(") {\n", !IO),
|
|
output_switch_cases(Indent + 1, ModuleInfo, FuncInfo, Context, Cases,
|
|
Default, ExitMethods, !IO),
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
% transfer of control
|
|
%
|
|
output_stmt(_, _, _, label(_), _, _, _, _) :-
|
|
unexpected(this_file, "output_stmt: labels not supported in Java.").
|
|
output_stmt(_, _, _, goto(label(_)), _, _, _, _) :-
|
|
unexpected(this_file, "output_stmt: gotos not supported in Java.").
|
|
output_stmt(Indent, _, _FuncInfo, goto(break), _Context, ExitMethods, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("break;\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_break).
|
|
output_stmt(Indent, _, _FuncInfo, goto(continue), _Context, ExitMethods,
|
|
!IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("continue;\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_continue).
|
|
output_stmt(_, _, _, computed_goto(_, _), _, _, _, _) :-
|
|
unexpected(this_file,
|
|
"output_stmt: computed gotos not supported in Java.").
|
|
|
|
% function call/return
|
|
%
|
|
output_stmt(Indent, ModuleInfo, CallerFuncInfo, Call, Context, ExitMethods,
|
|
!IO) :-
|
|
Call = mlcall(Signature, FuncRval, MaybeObject, CallArgs, Results,
|
|
_IsTailCall),
|
|
Signature = mlds_func_signature(ArgTypes, RetTypes),
|
|
ModuleName = CallerFuncInfo ^ func_info_name ^ mod_name,
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
indent_line(Context, Indent + 1, !IO),
|
|
(
|
|
Results = []
|
|
;
|
|
Results = [Lval],
|
|
output_lval(ModuleInfo, Lval, ModuleName, !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 = const(mlconst_code_addr(_)) ->
|
|
% This is a standard method call.
|
|
(
|
|
MaybeObject = yes(Object),
|
|
output_bracketed_rval(ModuleInfo, Object, ModuleName, !IO),
|
|
io.write_string(".", !IO)
|
|
;
|
|
MaybeObject = no
|
|
),
|
|
% This is a standard function call.
|
|
output_call_rval(ModuleInfo, FuncRval, ModuleName, !IO),
|
|
io.write_string("(", !IO),
|
|
io.write_list(CallArgs, ", ",
|
|
(pred(CallArg::in, !.IO::di, !:IO::uo) is det :-
|
|
output_rval(ModuleInfo, CallArg, ModuleName, !IO)), !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(ModuleInfo, RetType, _, JavaBoxedName, _) ->
|
|
io.write_string("((", !IO),
|
|
io.write_string(JavaBoxedName, !IO),
|
|
io.write_string(") ", !IO)
|
|
;
|
|
io.write_string("((", !IO),
|
|
output_type(RetType, !IO),
|
|
io.write_string(") ", !IO)
|
|
)
|
|
;
|
|
RetTypes = [_, _ | _],
|
|
io.write_string("((java.lang.Object[]) ", !IO)
|
|
),
|
|
(
|
|
MaybeObject = yes(Object),
|
|
output_bracketed_rval(ModuleInfo, Object, ModuleName, !IO),
|
|
io.write_string(".", !IO)
|
|
;
|
|
MaybeObject = no
|
|
),
|
|
output_bracketed_rval(ModuleInfo, FuncRval, ModuleName, !IO),
|
|
io.write_string(".call___0_0(", !IO),
|
|
|
|
% We need to pass the arguments as a single array of java.lang.Object.
|
|
output_args_as_array(ModuleInfo, CallArgs, ArgTypes, ModuleName, !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(ModuleInfo, 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(ModuleInfo, Results, RetTypes, 0, ModuleName,
|
|
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).
|
|
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, return(Results0), _, ExitMethods,
|
|
!IO) :-
|
|
%
|
|
% XXX It's not right to just remove the dummy variables like this, but
|
|
% currently they do not seem to be included in the ReturnTypes of
|
|
% func_params by the MLDS, so the easiest thing to do here is just remove
|
|
% them.
|
|
%
|
|
% When this is resolved, the right way to handle it would be to check for
|
|
% `dummy_var' in the `var' clause for output_lval, and output a reference
|
|
% to a static variable `dummy_var' defined in a fixed class (e.g. some
|
|
% class in the mercury/java directory, or mercury.private_builtin).
|
|
%
|
|
Results = remove_dummy_vars(ModuleInfo, Results0),
|
|
(
|
|
Results = [],
|
|
indent_line(Indent, !IO),
|
|
io.write_string("return;\n", !IO)
|
|
;
|
|
Results = [Rval],
|
|
indent_line(Indent, !IO),
|
|
io.write_string("return ", !IO),
|
|
output_rval(ModuleInfo, Rval, FuncInfo ^ func_info_name ^ mod_name,
|
|
!IO),
|
|
io.write_string(";\n", !IO)
|
|
;
|
|
Results = [_, _ | _],
|
|
FuncInfo = func_info(FuncName, 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(ModuleInfo, Type, Result,
|
|
FuncName ^ mod_name, !IO)),
|
|
!IO),
|
|
io.write_string("\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("};\n", !IO)
|
|
),
|
|
ExitMethods = set.make_singleton_set(can_return).
|
|
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, do_commit(Ref), _, ExitMethods,
|
|
!IO) :-
|
|
indent_line(Indent, !IO),
|
|
output_rval(ModuleInfo, Ref, FuncInfo ^ func_info_name ^ mod_name, !IO),
|
|
io.write_string(" = new mercury.runtime.Commit();\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("throw ", !IO),
|
|
output_rval(ModuleInfo, Ref, FuncInfo ^ func_info_name ^ mod_name, !IO),
|
|
io.write_string(";\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_throw).
|
|
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, try_commit(_Ref, Stmt, Handler), _,
|
|
ExitMethods, !IO) :-
|
|
indent_line(Indent, !IO),
|
|
io.write_string("try\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Stmt, TryExitMethods0,
|
|
!IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("catch (mercury.runtime.Commit commit_variable)\n", !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
indent_line(Indent + 1, !IO),
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Handler,
|
|
CatchExitMethods, !IO),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO),
|
|
ExitMethods = (TryExitMethods0 `set.delete` can_throw)
|
|
`set.union` CatchExitMethods.
|
|
|
|
% exception handling
|
|
%
|
|
|
|
% XXX not yet implemented
|
|
|
|
% atomic statements
|
|
%
|
|
output_stmt(Indent, ModuleInfo, FuncInfo, atomic(AtomicStatement), Context,
|
|
ExitMethods, !IO) :-
|
|
output_atomic_stmt(Indent, ModuleInfo, FuncInfo, AtomicStatement, Context,
|
|
!IO),
|
|
ExitMethods = set.make_singleton_set(can_fall_through).
|
|
% Returns a set of exit_methods that describes whether the while
|
|
% statement can complete normally.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% 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 = 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(module_info::in, list(mlds_rval)::in,
|
|
list(mlds_type)::in, mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_args_as_array(ModuleInfo, CallArgs, CallArgTypes, ModuleName, !IO) :-
|
|
io.write_string("new java.lang.Object[] { ", !IO),
|
|
output_boxed_args(ModuleInfo, CallArgs, CallArgTypes, ModuleName, !IO),
|
|
io.write_string("} ", !IO).
|
|
|
|
:- pred output_boxed_args(module_info::in, list(mlds_rval)::in,
|
|
list(mlds_type)::in, mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_boxed_args(_, [], [], _, !IO).
|
|
output_boxed_args(_, [_ | _], [], _, _, _) :-
|
|
unexpected(this_file, "output_boxed_args: length mismatch.").
|
|
output_boxed_args(_, [], [_ | _], _, _, _) :-
|
|
unexpected(this_file, "output_boxed_args: length mismatch.").
|
|
output_boxed_args(ModuleInfo, [CallArg | CallArgs],
|
|
[CallArgType | CallArgTypes], ModuleName, !IO) :-
|
|
output_boxed_rval(ModuleInfo, CallArgType, CallArg, ModuleName, !IO),
|
|
(
|
|
CallArgs = []
|
|
;
|
|
CallArgs = [_ | _],
|
|
io.write_string(", ", !IO),
|
|
output_boxed_args(ModuleInfo, CallArgs, CallArgTypes, ModuleName, !IO)
|
|
).
|
|
|
|
:- func remove_dummy_vars(module_info, list(mlds_rval)) = list(mlds_rval).
|
|
|
|
remove_dummy_vars(_, []) = [].
|
|
remove_dummy_vars(ModuleInfo, [Var | Vars0]) = VarList :-
|
|
Vars = remove_dummy_vars(ModuleInfo, Vars0),
|
|
(
|
|
Var = lval(Lval),
|
|
Lval = var(_VarName, VarType),
|
|
VarType = mercury_type(ProgDataType, _, _),
|
|
is_dummy_argument_type(ModuleInfo, ProgDataType)
|
|
->
|
|
VarList = Vars
|
|
;
|
|
VarList = [Var | Vars]
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% 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(module_info::in, list(mlds_lval)::in,
|
|
list(mlds_type)::in, int::in, mlds_module_name::in, indent::in,
|
|
mlds_context::in, io::di, io::uo) is det.
|
|
|
|
output_assign_results(_, [], [], _, _, _, _, !IO).
|
|
output_assign_results(ModuleInfo, [Lval | Lvals], [Type | Types], ResultIndex,
|
|
ModuleName, Indent, Context, !IO) :-
|
|
indent_line(Context, Indent, !IO),
|
|
output_lval(ModuleInfo, Lval, ModuleName, !IO),
|
|
io.write_string(" = ", !IO),
|
|
output_unboxed_result(ModuleInfo, Type, ResultIndex, !IO),
|
|
io.write_string(";\n", !IO),
|
|
output_assign_results(ModuleInfo, Lvals, Types, ResultIndex + 1,
|
|
ModuleName, 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 lenght mismatch.").
|
|
|
|
:- pred output_unboxed_result(module_info::in, mlds_type::in, int::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_unboxed_result(ModuleInfo, Type, ResultIndex, !IO) :-
|
|
( java_builtin_type(ModuleInfo, 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(Type, !IO),
|
|
io.write_string(") ", !IO),
|
|
io.format("result[%d]", [i(ResultIndex)], !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Extra code for outputting switch statements
|
|
%
|
|
|
|
:- pred output_switch_cases(indent::in, module_info::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(Indent, ModuleInfo, FuncInfo, Context, [], Default,
|
|
ExitMethods, !IO) :-
|
|
output_switch_default(Indent, ModuleInfo, FuncInfo, Context, Default,
|
|
ExitMethods, !IO).
|
|
output_switch_cases(Indent, ModuleInfo, FuncInfo, Context, [Case | Cases],
|
|
Default, ExitMethods, !IO) :-
|
|
output_switch_case(Indent, ModuleInfo, FuncInfo, Context, Case,
|
|
CaseExitMethods0, !IO),
|
|
output_switch_cases(Indent, ModuleInfo, 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(indent::in, module_info::in, func_info::in,
|
|
mlds_context::in, mlds_switch_case::in, exit_methods::out,
|
|
io::di, io::uo) is det.
|
|
|
|
output_switch_case(Indent, ModuleInfo, FuncInfo, Context, Case, ExitMethods,
|
|
!IO) :-
|
|
Case = (Conds - Statement),
|
|
ModuleName = FuncInfo ^ func_info_name ^ mod_name,
|
|
list.foldl(output_case_cond(Indent, ModuleInfo, ModuleName, Context),
|
|
Conds, !IO),
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Statement,
|
|
StmtExitMethods, !IO),
|
|
( set.member(can_fall_through, StmtExitMethods) ->
|
|
indent_line(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(indent::in, module_info::in, mlds_module_name::in,
|
|
mlds_context::in, mlds_case_match_cond::in, io::di, io::uo) is det.
|
|
|
|
output_case_cond(Indent, ModuleInfo, ModuleName, Context, match_value(Val),
|
|
!IO) :-
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("case ", !IO),
|
|
output_rval(ModuleInfo, Val, ModuleName, !IO),
|
|
io.write_string(":\n", !IO).
|
|
output_case_cond(_Indent, _ModuleInfo, _ModuleName, _Context,
|
|
match_range(_, _), _, _) :-
|
|
unexpected(this_file,
|
|
"output_case_cond: cannot match ranges in Java cases").
|
|
|
|
:- pred output_switch_default(indent::in, module_info::in, func_info::in,
|
|
mlds_context::in, mlds_switch_default::in, exit_methods::out,
|
|
io::di, io::uo) is det.
|
|
|
|
output_switch_default(_Indent, _ModuleInfo, _FuncInfo, _Context,
|
|
default_do_nothing, ExitMethods, !IO) :-
|
|
ExitMethods = set.make_singleton_set(can_fall_through).
|
|
output_switch_default(Indent, ModuleInfo, FuncInfo, Context,
|
|
default_case(Statement), ExitMethods, !IO) :-
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("default:\n", !IO),
|
|
output_statement(Indent + 1, ModuleInfo, FuncInfo, Statement, ExitMethods,
|
|
!IO).
|
|
output_switch_default(Indent, _ModuleInfo, _FuncInfo, Context,
|
|
default_is_unreachable, ExitMethods, !IO) :-
|
|
indent_line(Context, Indent, !IO),
|
|
io.write_string("default: /*NOTREACHED*/\n", !IO),
|
|
indent_line(Context, Indent + 1, !IO),
|
|
io.write_string("throw new mercury.runtime.UnreachableDefault();\n", !IO),
|
|
ExitMethods = set.make_singleton_set(can_throw).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for outputting atomic statements.
|
|
%
|
|
|
|
:- pred output_atomic_stmt(indent::in, module_info::in, func_info::in,
|
|
mlds_atomic_statement::in, mlds_context::in, io::di, io::uo) is det.
|
|
|
|
% comments
|
|
%
|
|
output_atomic_stmt(Indent, _ModuleInfo, _FuncInfo, comment(Comment), _, !IO) :-
|
|
% 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).
|
|
|
|
% assignment
|
|
%
|
|
output_atomic_stmt(Indent, ModuleInfo, FuncInfo, assign(Lval, Rval), _, !IO) :-
|
|
ModuleName = FuncInfo ^ func_info_name ^ mod_name,
|
|
indent_line(Indent, !IO),
|
|
output_lval(ModuleInfo, Lval, ModuleName, !IO),
|
|
io.write_string(" = ", !IO),
|
|
(
|
|
LvalType = mlds_lval_type(Lval),
|
|
type_is_object(LvalType)
|
|
->
|
|
% If the Lval is an object.
|
|
( rval_is_int_const(Rval) ->
|
|
io.write_string("new ", !IO),
|
|
output_type(LvalType, !IO),
|
|
io.write_string("(", !IO),
|
|
output_rval(ModuleInfo, Rval, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
output_rval(ModuleInfo, Rval, ModuleName, !IO)
|
|
)
|
|
;
|
|
output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO)
|
|
),
|
|
io.write_string(";\n", !IO).
|
|
|
|
% heap management
|
|
%
|
|
output_atomic_stmt(_Indent, _, _FuncInfo, delete_object(_Lval), _, _, _) :-
|
|
unexpected(this_file, "delete_object not supported in Java.").
|
|
|
|
output_atomic_stmt(Indent, ModuleInfo, FuncInfo, NewObject, Context, !IO) :-
|
|
NewObject = new_object(Target, _MaybeTag, HasSecTag, Type,
|
|
_MaybeSize, MaybeCtorName, Args, ArgTypes, _MayUseAtomic),
|
|
ModuleName = FuncInfo ^ func_info_name ^ mod_name,
|
|
|
|
indent_line(Indent, !IO),
|
|
io.write_string("{\n", !IO),
|
|
indent_line(Context, Indent + 1, !IO),
|
|
output_lval(ModuleInfo, Target, ModuleName, !IO),
|
|
io.write_string(" = new ", !IO),
|
|
|
|
% Generate class constructor name.
|
|
(
|
|
MaybeCtorName = yes(QualifiedCtorId),
|
|
\+ (
|
|
Type = mercury_type(_, TypeCategory, _),
|
|
hand_defined_type(TypeCategory, _)
|
|
)
|
|
->
|
|
output_type(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(Type, !IO)
|
|
),
|
|
( type_is_array(Type) = yes ->
|
|
% The new object will be an array, so we need to initialise it
|
|
% using array literals syntax.
|
|
io.write_string(" {", !IO),
|
|
output_init_args(ModuleInfo, Args, ArgTypes, 0, HasSecTag, ModuleName,
|
|
!IO),
|
|
io.write_string("};\n", !IO)
|
|
;
|
|
% Generate constructor arguments.
|
|
io.write_string("(", !IO),
|
|
output_init_args(ModuleInfo, Args, ArgTypes, 0, HasSecTag, ModuleName,
|
|
!IO),
|
|
io.write_string(");\n", !IO)
|
|
),
|
|
indent_line(Indent, !IO),
|
|
io.write_string("}\n", !IO).
|
|
|
|
output_atomic_stmt(_Indent, _, _FuncInfo, gc_check, _, _, _) :-
|
|
unexpected(this_file, "gc_check not implemented.").
|
|
|
|
output_atomic_stmt(_Indent, _, _FuncInfo, mark_hp(_Lval), _, _, _) :-
|
|
unexpected(this_file, "mark_hp not implemented.").
|
|
|
|
output_atomic_stmt(_Indent, _, _FuncInfo, restore_hp(_Rval), _, _, _) :-
|
|
unexpected(this_file, "restore_hp not implemented.").
|
|
|
|
% Trail management.
|
|
%
|
|
output_atomic_stmt(_Indent, _, _FuncInfo, trail_op(_TrailOp), _, _, _) :-
|
|
unexpected(this_file, "trail_ops not implemented.").
|
|
|
|
% Foreign language interfacing.
|
|
%
|
|
output_atomic_stmt(Indent, ModuleInfo, FuncInfo,
|
|
inline_target_code(TargetLang, Components), Context, !IO) :-
|
|
(
|
|
TargetLang = ml_target_java,
|
|
indent_line(Indent, !IO),
|
|
ModuleName = FuncInfo ^ func_info_name ^ mod_name,
|
|
list.foldl(
|
|
output_target_code_component(ModuleInfo, ModuleName, Context),
|
|
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")
|
|
).
|
|
|
|
output_atomic_stmt(_Indent, _, _FuncInfo,
|
|
outline_foreign_proc(_TargetLang, _Vs, _Lvals, _Code),
|
|
_Context, _, _) :-
|
|
unexpected(this_file, "foreign language interfacing not implemented").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred output_target_code_component(module_info::in, mlds_module_name::in,
|
|
mlds_context::in, target_code_component::in, io::di, io::uo) is det.
|
|
|
|
output_target_code_component(_, _ModuleName, _Context,
|
|
user_target_code(CodeString, _MaybeUserContext, _Attrs), !IO) :-
|
|
% XXX Java does not have an equivalent of the C #line preprocessor
|
|
% directive. If it did, we should use it here.
|
|
io.write_string(CodeString, !IO).
|
|
output_target_code_component(_, _ModuleName, _Context,
|
|
raw_target_code(CodeString, _Attrs), !IO) :-
|
|
io.write_string(CodeString, !IO).
|
|
output_target_code_component(ModuleInfo, ModuleName, _Context,
|
|
target_code_input(Rval), !IO) :-
|
|
output_rval(ModuleInfo, Rval, ModuleName, !IO).
|
|
output_target_code_component(ModuleInfo, ModuleName, _Context,
|
|
target_code_output(Lval), !IO) :-
|
|
output_lval(ModuleInfo, Lval, ModuleName, !IO).
|
|
output_target_code_component(_, ModuleName, _Context, name(Name), !IO) :-
|
|
output_maybe_qualified_name(Name, ModuleName, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Output initial values of an object's fields as arguments for the
|
|
% object's class constructor.
|
|
%
|
|
:- pred output_init_args(module_info::in, list(mlds_rval)::in,
|
|
list(mlds_type)::in, int::in, bool::in, mlds_module_name::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(ModuleInfo, [Arg | Args], [_ArgType | ArgTypes], ArgNum,
|
|
HasSecTag, ModuleName, !IO) :-
|
|
(
|
|
ArgNum = 0,
|
|
HasSecTag = yes
|
|
->
|
|
% This first argument is a `data_tag', It is set by
|
|
% the class constructor so this argument can be discarded.
|
|
true
|
|
;
|
|
output_rval(ModuleInfo, Arg, ModuleName, !IO),
|
|
(
|
|
Args = []
|
|
;
|
|
Args = [_ | _],
|
|
io.write_string(", ", !IO)
|
|
)
|
|
),
|
|
output_init_args(ModuleInfo, Args, ArgTypes, ArgNum + 1, HasSecTag,
|
|
ModuleName, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code to output expressions
|
|
%
|
|
|
|
:- pred output_lval(module_info::in, mlds_lval::in, mlds_module_name::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_lval(ModuleInfo,
|
|
field(_MaybeTag, Rval, offset(OffsetRval), FieldType, _),
|
|
ModuleName, !IO) :-
|
|
(
|
|
( 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(ModuleInfo, Rval, ModuleName, !IO),
|
|
io.write_string(")[", !IO),
|
|
output_rval(ModuleInfo, OffsetRval, ModuleName, !IO),
|
|
io.write_string("]", !IO).
|
|
|
|
output_lval(ModuleInfo,
|
|
field(_, PtrRval, named_field(FieldName, CtorType), _, _),
|
|
ModuleName, !IO) :-
|
|
(
|
|
FieldName = qual(_, _, UnqualFieldName),
|
|
MangledFieldName = name_mangle(UnqualFieldName),
|
|
MangledFieldName = "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(ModuleInfo, PtrRval, ModuleName, !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(CtorType, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_bracketed_rval(ModuleInfo, PtrRval, ModuleName, !IO),
|
|
% The actual variable.
|
|
io.write_string(").", !IO)
|
|
),
|
|
FieldName = qual(_, _, UnqualFieldName),
|
|
output_valid_mangled_name(UnqualFieldName, !IO). % the field name
|
|
|
|
output_lval(ModuleInfo, mem_ref(Rval, _Type), ModuleName, !IO) :-
|
|
output_bracketed_rval(ModuleInfo, Rval, ModuleName, !IO).
|
|
|
|
output_lval(_ModuleInfo, global_var_ref(_), _ModuleName, !IO) :-
|
|
sorry(this_file, "output_lval: global_var_ref NYI").
|
|
|
|
output_lval(_, var(qual(ModName, QualKind, Name), _), CurrentModuleName,
|
|
!IO) :-
|
|
QualName = qual(ModName, QualKind, entity_data(var(Name))),
|
|
output_maybe_qualified_name(QualName, CurrentModuleName, !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_symbol_name(MangledName),
|
|
io.write_string(JavaSafeName, !IO).
|
|
|
|
:- pred output_call_rval(module_info::in, mlds_rval::in, mlds_module_name::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_call_rval(ModuleInfo, Rval, ModuleName, !IO) :-
|
|
(
|
|
Rval = const(Const),
|
|
Const = mlconst_code_addr(CodeAddr)
|
|
->
|
|
IsCall = yes,
|
|
mlds_output_code_addr(CodeAddr, IsCall, !IO)
|
|
;
|
|
output_bracketed_rval(ModuleInfo, Rval, ModuleName, !IO)
|
|
).
|
|
|
|
:- pred output_bracketed_rval(module_info::in, mlds_rval::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_bracketed_rval(ModuleInfo, Rval, ModuleName, !IO) :-
|
|
(
|
|
% If it's just a variable name, then we don't need parentheses.
|
|
( Rval = lval(var(_,_))
|
|
; Rval = const(mlconst_code_addr(_))
|
|
)
|
|
->
|
|
output_rval(ModuleInfo, Rval, ModuleName, !IO)
|
|
;
|
|
io.write_char('(', !IO),
|
|
output_rval(ModuleInfo, Rval, ModuleName, !IO),
|
|
io.write_char(')', !IO)
|
|
).
|
|
|
|
:- pred output_rval(module_info::in, mlds_rval::in, mlds_module_name::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_rval(ModuleInfo, lval(Lval), ModuleName, !IO) :-
|
|
output_lval(ModuleInfo, Lval, ModuleName, !IO).
|
|
|
|
output_rval(_, mkword(_, _), _, _, _) :-
|
|
unexpected(this_file, "output_rval: tags not supported in Java").
|
|
|
|
output_rval(_, const(Const), _, !IO) :-
|
|
output_rval_const(Const, !IO).
|
|
|
|
output_rval(ModuleInfo, unop(Op, Rval), ModuleName, !IO) :-
|
|
output_unop(ModuleInfo, Op, Rval, ModuleName, !IO).
|
|
|
|
output_rval(ModuleInfo, binop(Op, Rval1, Rval2), ModuleName, !IO) :-
|
|
output_binop(ModuleInfo, Op, Rval1, Rval2, ModuleName, !IO).
|
|
|
|
output_rval(_, mem_addr(_Lval), _, !IO) :-
|
|
unexpected(this_file, "output_rval: mem_addr(_) not supported").
|
|
|
|
output_rval(_, self(_), _, !IO) :-
|
|
io.write_string("this", !IO).
|
|
|
|
:- pred output_unop(module_info::in, mlds_unary_op::in, mlds_rval::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_unop(ModuleInfo, cast(Type), Exprn, ModuleName, !IO) :-
|
|
% rtti_to_mlds.m generates casts from int to
|
|
% mercury.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,
|
|
Exprn = const(mlconst_int(_))
|
|
->
|
|
maybe_output_comment("cast", !IO),
|
|
io.write_string("new mercury.runtime.PseudoTypeInfo(", !IO),
|
|
output_rval(ModuleInfo, Exprn, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
( Type = mercury_type(_, type_cat_type_info, _)
|
|
; Type = mlds_type_info_type
|
|
)
|
|
->
|
|
maybe_output_comment("cast", !IO),
|
|
io.write_string("new mercury.runtime.TypeInfo_Struct(", !IO),
|
|
output_rval(ModuleInfo, Exprn, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
output_cast_rval(ModuleInfo, Type, Exprn, ModuleName, !IO)
|
|
).
|
|
output_unop(ModuleInfo, box(Type), Exprn, ModuleName, !IO) :-
|
|
output_boxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO).
|
|
output_unop(ModuleInfo, unbox(Type), Exprn, ModuleName, !IO) :-
|
|
output_unboxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO).
|
|
output_unop(ModuleInfo, std_unop(Unop), Exprn, ModuleName, !IO) :-
|
|
output_std_unop(ModuleInfo, Unop, Exprn, ModuleName, !IO).
|
|
|
|
:- pred output_cast_rval(module_info::in, mlds_type::in, mlds_rval::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_cast_rval(ModuleInfo, Type, Exprn, ModuleName, !IO) :-
|
|
io.write_string("(", !IO),
|
|
output_type(Type, !IO),
|
|
io.write_string(") ", !IO),
|
|
( java_builtin_type(ModuleInfo, Type, "int", _, _) ->
|
|
output_rval_maybe_with_enum(ModuleInfo, Exprn, ModuleName, !IO)
|
|
;
|
|
output_rval(ModuleInfo, Exprn, ModuleName, !IO)
|
|
).
|
|
|
|
:- pred output_boxed_rval(module_info::in, mlds_type::in, mlds_rval::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_boxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO) :-
|
|
( java_builtin_type(ModuleInfo, Type, _JavaName, JavaBoxedName, _) ->
|
|
io.write_string("new ", !IO),
|
|
io.write_string(JavaBoxedName, !IO),
|
|
io.write_string("(", !IO),
|
|
output_rval(ModuleInfo, Exprn, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
io.write_string("((java.lang.Object) (", !IO),
|
|
output_rval(ModuleInfo, Exprn, ModuleName, !IO),
|
|
io.write_string("))", !IO)
|
|
).
|
|
|
|
:- pred output_unboxed_rval(module_info::in, mlds_type::in, mlds_rval::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_unboxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO) :-
|
|
( java_builtin_type(ModuleInfo, Type, _, JavaBoxedName, UnboxMethod) ->
|
|
io.write_string("((", !IO),
|
|
io.write_string(JavaBoxedName, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_bracketed_rval(ModuleInfo, Exprn, ModuleName, !IO),
|
|
io.write_string(").", !IO),
|
|
io.write_string(UnboxMethod, !IO),
|
|
io.write_string("()", !IO)
|
|
;
|
|
io.write_string("((", !IO),
|
|
output_type(Type, !IO),
|
|
io.write_string(") ", !IO),
|
|
output_rval(ModuleInfo, Exprn, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
% java_builtin_type(ModuleInfo, 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(module_info::in, 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_character), _, _).
|
|
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(ModuleInfo, 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(MercuryType @ defined_type(_, _, _), _, _),
|
|
is_dummy_argument_type(ModuleInfo, MercuryType).
|
|
|
|
:- pred output_std_unop(module_info::in, builtin_ops.unary_op::in,
|
|
mlds_rval::in, mlds_module_name::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(ModuleInfo, UnaryOp, Exprn, ModuleName, !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(ModuleInfo, Exprn, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
:- pred output_binop(module_info::in, binary_op::in, mlds_rval::in,
|
|
mlds_rval::in, mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_binop(ModuleInfo, Op, X, Y, ModuleName, !IO) :-
|
|
( Op = array_index(_Type) ->
|
|
output_bracketed_rval(ModuleInfo, X, ModuleName, !IO),
|
|
io.write_string("[", !IO),
|
|
output_rval(ModuleInfo, Y, ModuleName, !IO),
|
|
io.write_string("]", !IO)
|
|
; java_string_compare_op(Op, OpStr) ->
|
|
io.write_string("(", !IO),
|
|
output_rval(ModuleInfo, X, ModuleName, !IO),
|
|
io.write_string(".compareTo(", !IO),
|
|
output_rval(ModuleInfo, Y, ModuleName, !IO),
|
|
io.write_string(") ", !IO),
|
|
io.write_string(OpStr, !IO),
|
|
io.write_string(" 0)", !IO)
|
|
;
|
|
( java_float_compare_op(Op, OpStr1) ->
|
|
OpStr = OpStr1
|
|
; java_float_op(Op, OpStr2) ->
|
|
OpStr = OpStr2
|
|
;
|
|
fail
|
|
)
|
|
->
|
|
io.write_string("(", !IO),
|
|
output_rval_maybe_with_enum(ModuleInfo, X, ModuleName, !IO),
|
|
io.write_string(" ", !IO),
|
|
io.write_string(OpStr, !IO),
|
|
io.write_string(" ", !IO),
|
|
output_rval_maybe_with_enum(ModuleInfo, Y, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
io.write_string("(", !IO),
|
|
output_rval_maybe_with_enum(ModuleInfo, X, ModuleName, !IO),
|
|
io.write_string(" ", !IO),
|
|
output_binary_op(Op, !IO),
|
|
io.write_string(" ", !IO),
|
|
output_rval_maybe_with_enum(ModuleInfo, Y, ModuleName, !IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
% Output an Rval and if the Rval is an enumeration object append the string
|
|
% ".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 .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(module_info::in, mlds_rval::in,
|
|
mlds_module_name::in, io::di, io::uo) is det.
|
|
|
|
output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO) :-
|
|
output_rval(ModuleInfo, Rval, ModuleName, !IO),
|
|
( rval_is_enum_object(Rval) ->
|
|
io.write_string(".value", !IO)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred output_binary_op(binary_op::in, io::di, io::uo) is det.
|
|
|
|
output_binary_op(Op, !IO) :-
|
|
( java_binary_infix_op(Op, OpStr) ->
|
|
io.write_string(OpStr, !IO)
|
|
;
|
|
unexpected(this_file,
|
|
"output_binary_op: invalid binary operator")
|
|
).
|
|
|
|
:- pred output_rval_const(mlds_rval_const::in, io::di, io::uo) is det.
|
|
|
|
output_rval_const(mlconst_true, !IO) :-
|
|
io.write_string("true", !IO).
|
|
|
|
output_rval_const(mlconst_false, !IO) :-
|
|
io.write_string("false", !IO).
|
|
|
|
output_rval_const(mlconst_int(N), !IO) :-
|
|
io.write_int(N, !IO).
|
|
|
|
output_rval_const(mlconst_float(FloatVal), !IO) :-
|
|
c_util.output_float_literal(FloatVal, !IO).
|
|
|
|
output_rval_const(mlconst_string(String), !IO) :-
|
|
io.write_string("""", !IO),
|
|
c_util.output_quoted_string(String, !IO),
|
|
io.write_string("""", !IO).
|
|
|
|
output_rval_const(mlconst_multi_string(String), !IO) :-
|
|
io.write_string("""", !IO),
|
|
c_util.output_quoted_multi_string(String, !IO),
|
|
io.write_string("""", !IO).
|
|
|
|
output_rval_const(mlconst_code_addr(CodeAddr), !IO) :-
|
|
IsCall = no,
|
|
mlds_output_code_addr(CodeAddr, IsCall, !IO).
|
|
|
|
output_rval_const(mlconst_data_addr(DataAddr), !IO) :-
|
|
mlds_output_data_addr(DataAddr, !IO).
|
|
|
|
output_rval_const(mlconst_null(_), !IO) :-
|
|
io.write_string("null", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred mlds_output_code_addr(mlds_code_addr::in, bool::in, io::di,
|
|
io::uo) is det.
|
|
|
|
mlds_output_code_addr(code_addr_proc(Label, _Sig), 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 AddrOf__", !IO),
|
|
output_fully_qualified_proc_label(Label, "__", !IO),
|
|
io.write_string("_0()", !IO)
|
|
;
|
|
IsCall = yes,
|
|
output_fully_qualified_proc_label(Label, ".", !IO)
|
|
).
|
|
mlds_output_code_addr(code_addr_internal(Label, SeqNum, _Sig), 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 AddrOf__", !IO),
|
|
output_fully_qualified_proc_label(Label, "__", !IO),
|
|
io.write_string("_", !IO),
|
|
io.write_int(SeqNum, !IO),
|
|
io.write_string("_0()", !IO)
|
|
;
|
|
IsCall = yes,
|
|
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_mlds_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. (XXX This can probably be simplified
|
|
% since Java doesn't have an equivalent of #line directives.)
|
|
%
|
|
|
|
:- pred output_context(mlds_context::in, io::di, io::uo) is det.
|
|
|
|
output_context(_Context, !IO).
|
|
|
|
:- pred indent_line(mlds_context::in, indent::in, io::di, io::uo) is det.
|
|
|
|
indent_line(Context, N, !IO) :-
|
|
output_context(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)
|
|
).
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "mlds_to_java.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|