Files
mercury/compiler/mlds_to_java_class.m
Julien Fischer 153590a30f Update and fix more copyright notices.
compiler/*.m:
    As above.
2024-12-30 16:01:59 +11:00

522 lines
20 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2000-2012 The University of Melbourne.
% Copyright (C) 2013-2018, 2020, 2023 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% Output class declarations and definitions in Java.
%
%---------------------------------------------------------------------------%
:- module ml_backend.mlds_to_java_class.
:- interface.
:- import_module libs.
:- import_module libs.indent.
:- import_module ml_backend.mlds.
:- import_module ml_backend.mlds_to_java_util.
:- import_module io.
:- import_module map.
%---------------------------------------------------------------------------%
:- pred output_class_defn_for_java(java_out_info::in,
io.text_output_stream::in, indent::in, mlds_class_defn::in,
io::di, io::uo) is det.
:- pred output_enum_class_defn_for_java(java_out_info::in,
io.text_output_stream::in, indent::in, mlds_enum_class_defn::in,
io::di, io::uo) is det.
:- pred output_env_defn_for_java(java_out_info::in,
io.text_output_stream::in, indent::in, mlds_env_defn::in,
io::di, io::uo) is det.
:- pred output_struct_defn_for_java(java_out_info::in,
io.text_output_stream::in, indent::in, mlds_struct_defn::in,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% Rename class names which are too long. Each class results in a separate
% `.class' file, so a long class name may exceed filesystem limits.
% The long names tend to be automatically generated by the compiler.
%
:- pred maybe_shorten_long_class_name(
mlds_class_defn::in, mlds_class_defn::out,
map(mlds_class_name, mlds_class_name)::in,
map(mlds_class_name, mlds_class_name)::out) is det.
:- pred maybe_shorten_long_env_name(
mlds_env_defn::in, mlds_env_defn::out,
map(mlds_class_name, mlds_class_name)::in,
map(mlds_class_name, mlds_class_name)::out) is det.
%---------------------------------------------------------------------------%
% Succeeds iff a given string matches the unqualified interface name
% of a interface in Mercury's Java runtime system.
%
:- pred interface_is_special_for_java(string::in) is semidet.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.c_util.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.mlds_to_java_data.
:- import_module ml_backend.mlds_to_java_func.
:- import_module ml_backend.mlds_to_java_name.
:- import_module ml_backend.mlds_to_java_type.
:- import_module ml_backend.mlds_to_target_util.
:- import_module parse_tree.
:- import_module parse_tree.java_names.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_foreign.
:- import_module bool.
:- import_module char.
:- import_module int.
:- import_module list.
:- import_module maybe.
:- import_module require.
:- import_module string.
:- import_module term.
:- import_module uint.
%---------------------------------------------------------------------------%
%
% Code to output classes.
%
output_class_defn_for_java(Info0, Stream, Indent, ClassDefn, !IO) :-
ClassDefn = mlds_class_defn(ClassName, ClassArity, Context, Flags,
_Imports, Inherits, Implements, TypeParams,
MemberFields, MemberClasses, MemberMethods, Ctors),
indent_line_after_context(Stream, Info0 ^ joi_line_numbers,
marker_comment, Context, Indent, !IO),
output_class_decl_flags_for_java(Info0, Stream, Flags, !IO),
Info1 = Info0 ^ joi_univ_tvars := TypeParams,
% Use generics in the output of this predicate if this class represents
% a Mercury type. Note that we do NOT return Info1 or Info to our caller.
( if list.member(ml_java_mercury_type_interface, Implements) then
Info = Info1 ^ joi_output_generics := do_output_generics
else
Info = Info1
),
ClassNameStr = unqual_class_name_to_string_for_java(ClassName, ClassArity),
io.format(Stream, "class %s", [s(ClassNameStr)], !IO),
OutputGenerics = Info ^ joi_output_generics,
(
OutputGenerics = do_output_generics,
output_generic_tvars(Stream, TypeParams, !IO)
;
OutputGenerics = do_not_output_generics
),
io.nl(Stream, !IO),
Indent1 = Indent + 1u,
output_inherits_list(Info, Stream, Indent1, Inherits, !IO),
output_implements_list(Stream, Indent1, Implements, !IO),
IndentStr = indent2_string(Indent),
io.format(Stream, "%s{\n", [s(IndentStr)], !IO),
list.foldl(
output_field_var_defn_for_java(Info, Stream, Indent1),
MemberFields, !IO),
list.foldl(
output_class_defn_for_java(Info, Stream, Indent1),
MemberClasses, !IO),
list.foldl(
output_function_defn_for_java(Info, Stream, Indent1, oa_none),
MemberMethods, !IO),
io.nl(Stream, !IO),
list.foldl(
output_function_defn_for_java(Info, Stream, Indent1,
oa_cname(ClassName, ClassArity)),
Ctors, !IO),
io.format(Stream, "%s}\n\n", [s(IndentStr)], !IO).
output_enum_class_defn_for_java(Info0, Stream, Indent, EnumDefn, !IO) :-
EnumDefn = mlds_enum_class_defn(ClassName, ClassArity, Context,
Inherits, Implements, TypeParams, _ValueField, EnumConsts, Ctors),
Info1 = Info0 ^ joi_univ_tvars := TypeParams,
% Use generics in the output of this predicate if this class represents
% a Mercury type. Note that we do NOT return Info1 or Info to our caller.
( if
Implements = yes(Interface),
Interface = ml_java_mercury_type_interface
then
InterfaceStr = interface_to_string_for_java(Interface),
Info = Info1 ^ joi_output_generics := do_output_generics
else
unexpected($pred, "no ml_java_mercury_type_interface")
),
indent_line_after_context(Stream, Info0 ^ joi_line_numbers,
marker_comment, Context, Indent, !IO),
ClassNameStr = unqual_class_name_to_string_for_java(ClassName, ClassArity),
io.format(Stream, "public static class %s", [s(ClassNameStr)], !IO),
output_generic_tvars(Stream, TypeParams, !IO),
io.nl(Stream, !IO),
IndentStr = indent2_string(Indent),
Indent1 = Indent + 1u,
output_enum_inherits_list(Info, Stream, Indent1, Inherits, !IO),
io.format(Stream, "%simplements %s\n",
[s(IndentStr), s(InterfaceStr)], !IO),
io.format(Stream, "%s{\n", [s(IndentStr)], !IO),
list.foldl(
output_enum_constant_for_java(Stream, Indent1, ClassName, ClassArity),
EnumConsts, !IO),
io.nl(Stream, !IO),
output_enum_ctor_for_java(Stream, Indent1, ClassName, ClassArity, !IO),
ClassAux = oa_cname(ClassName, ClassArity),
list.foldl(
output_function_defn_for_java(Info, Stream, Indent1, ClassAux),
Ctors, !IO),
io.format(Stream, "%s}\n\n", [s(IndentStr)], !IO).
output_env_defn_for_java(Info, Stream, Indent, EnvDefn, !IO) :-
EnvDefn = mlds_env_defn(EnvName, Context, MemberFields),
IndentStr = indent2_string(Indent),
Indent1 = Indent + 1u,
Indent1Str = indent2_string(Indent1),
EnvNameStr = unqual_class_name_to_string_for_java(EnvName, 0),
BaseTypeStr = type_to_string_for_java(Info, mlds_generic_env_ptr_type),
indent_line_after_context(Stream, Info ^ joi_line_numbers,
marker_comment, Context, Indent, !IO),
io.format(Stream, "private static class %s\n", [s(EnvNameStr)], !IO),
io.format(Stream, "%sextends %s\n", [s(Indent1Str), s(BaseTypeStr)], !IO),
io.format(Stream, "%s{\n", [s(IndentStr)], !IO),
list.foldl(
output_field_var_defn_for_java(Info, Stream, Indent1),
MemberFields, !IO),
io.format(Stream, "%s}\n\n", [s(IndentStr)], !IO).
output_struct_defn_for_java(Info, Stream, Indent, StructDefn, !IO) :-
StructDefn = mlds_struct_defn(StructName, Context,
MemberFields, MaybeCtor),
(
MaybeCtor = no,
unexpected($pred, "MaybeCtor = no")
;
MaybeCtor = yes(Ctor)
),
StructNameStr = unqual_class_name_to_string_for_java(StructName, 0),
Indent1 = Indent + 1u,
IndentStr = indent2_string(Indent),
indent_line_after_context(Stream, Info ^ joi_line_numbers,
marker_comment, Context, Indent, !IO),
io.format(Stream, "private static final class %s\n",
[s(StructNameStr)], !IO),
io.format(Stream, "%s{\n", [s(IndentStr)], !IO),
list.foldl(
output_field_var_defn_for_java(Info, Stream, Indent1),
MemberFields, !IO),
io.nl(Stream, !IO),
output_function_defn_for_java(Info, Stream, Indent1,
oa_cname(StructName, 0), Ctor, !IO),
io.format(Stream, "%s}\n\n", [s(IndentStr)], !IO).
%---------------------------------------------------------------------------%
% Output superclass that this class extends. Java does not support
% multiple inheritance, so more than one superclass is an error.
%
:- pred output_inherits_list(java_out_info::in, io.text_output_stream::in,
indent::in, mlds_class_inherits::in, io::di, io::uo) is det.
output_inherits_list(Info, Stream, Indent, Inherits, !IO) :-
(
Inherits = inherits_nothing
;
Inherits = inherits_class(BaseClassId),
IndentStr = indent2_string(Indent),
BaseType = mlds_class_type(BaseClassId),
BaseTypeStr = type_to_string_for_java(Info, BaseType),
io.format(Stream, "%sextends %s\n",
[s(IndentStr), s(BaseTypeStr)], !IO)
).
:- pred output_enum_inherits_list(java_out_info::in, io.text_output_stream::in,
indent::in, mlds_enum_class_inherits::in, io::di, io::uo) is det.
output_enum_inherits_list(Info, Stream, Indent, Inherits, !IO) :-
(
Inherits = inherits_nothing
;
Inherits = inherits_class(BaseClassId),
BaseType = mlds_class_type(BaseClassId),
IndentStr = indent2_string(Indent),
BaseTypeStr = type_to_string_for_java(Info, BaseType),
io.format(Stream, "%sextends %s\n",
[s(IndentStr), s(BaseTypeStr)], !IO)
).
% Output list of interfaces that this class implements.
%
:- pred output_implements_list(io.text_output_stream::in, indent::in,
list(mlds_interface_id)::in, io::di, io::uo) is det.
output_implements_list(Stream, Indent, InterfaceList, !IO) :-
(
InterfaceList = []
;
InterfaceList = [_ | _],
IndentStr = indent2_string(Indent),
InterfaceStrs = list.map(interface_to_string_for_java, InterfaceList),
InterfacesStr = string.join_list(", ", InterfaceStrs),
io.format(Stream, "%simplements %s\n",
[s(IndentStr), s(InterfacesStr)], !IO)
).
:- func interface_to_string_for_java(mlds_interface_id) = string.
interface_to_string_for_java(Interface) = String :-
Interface = mlds_interface_id(ModuleName, ClassName),
SymName = mlds_module_name_to_sym_name(ModuleName),
mangle_sym_name_for_java(SymName, module_qual, ".", ModuleNameStr),
% Check if the interface is one of the ones in the runtime system.
% If it is, we don't need to output the arity.
( if interface_is_special_for_java(ClassName) then
string.format("%s.%s", [s(ModuleNameStr), s(ClassName)], String)
else
Arity = 0,
string.format("%s.%s%d", [s(ModuleNameStr), s(ClassName), i(Arity)],
String)
).
%---------------------------------------------------------------------------%
%
% Code for generating enumerations.
%
% Enumerations are a bit different from normal classes, because although
% the 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.
% Output a (Java) constructor for the class representing the enumeration.
%
:- pred output_enum_ctor_for_java(io.text_output_stream::in, indent::in,
mlds_class_name::in, arity::in, io::di, io::uo) is det.
output_enum_ctor_for_java(Stream, Indent, ClassName, ClassArity, !IO) :-
IndentStr = indent2_string(Indent),
Indent1Str = indent2_string(Indent + 1u),
UnqualClassnameStr =
unqual_class_name_to_string_for_java(ClassName, ClassArity),
io.format(Stream, "%sprivate %s(int val) {\n",
[s(IndentStr), s(UnqualClassnameStr)], !IO),
% Call the MercuryEnum constructor, which will set the MR_value field.
io.format(Stream, "%ssuper(val);\n", [s(Indent1Str)], !IO),
io.format(Stream, "%s}\n", [s(IndentStr)], !IO).
:- pred output_enum_constant_for_java(io.text_output_stream::in,
indent::in, mlds_class_name::in, arity::in, mlds_enum_const_defn::in,
io::di, io::uo) is det.
output_enum_constant_for_java(Stream, Indent, ClassName, ClassArity,
EnumConstDefn, !IO) :-
EnumConstDefn = mlds_enum_const_defn(FieldVarName, _Context, EnumConst),
% Make a static instance of the constant. The MLDS doesn't retain enum
% constructor names (that shouldn't be hard to change now) so it is
% easier to derive the name of the constant later by naming them after
% the integer values.
IndentStr = indent2_string(Indent),
UnqualClassNameStr =
unqual_class_name_to_string_for_java(ClassName, ClassArity),
FieldVarNameStr = field_var_name_to_string_for_java(FieldVarName),
(
EnumConst = mlds_enum_const_uint(EnumUInt),
io.format(Stream,
"%spublic static final %s K%u = new %s(%u); /* %s */\n",
[s(IndentStr), s(UnqualClassNameStr), u(EnumUInt),
s(UnqualClassNameStr), u(EnumUInt), s(FieldVarNameStr)], !IO)
;
EnumConst = mlds_enum_const_foreign(_Lang, _EnumNameStr, _Type),
% Foreign enums are not currently supported by the Java backend.
unexpected($pred, "not mlconst_enum")
).
%---------------------------------------------------------------------------%
:- pred output_field_var_decl_for_java(java_out_info::in,
io.text_output_stream::in, mlds_field_var_name::in, mlds_type::in,
io::di, io::uo) is det.
output_field_var_decl_for_java(Info, Stream, FieldVarName, Type, !IO) :-
TypeStr = type_to_string_for_java(Info, Type),
FieldVarNameStr = field_var_name_to_string_for_java(FieldVarName),
io.format(Stream, "%s %s", [s(TypeStr), s(FieldVarNameStr)], !IO).
:- pred output_field_var_defn_for_java(java_out_info::in,
io.text_output_stream::in, indent::in, mlds_field_var_defn::in,
io::di, io::uo) is det.
output_field_var_defn_for_java(Info, Stream, Indent, FieldVarDefn, !IO) :-
FieldVarDefn = mlds_field_var_defn(FieldVarName, Context, Flags, Type,
Initializer, _),
indent_line_after_context(Stream, Info ^ joi_line_numbers, marker_comment,
Context, Indent, !IO),
output_field_var_decl_flags_for_java(Stream, Flags, !IO),
output_field_var_decl_for_java(Info, Stream, FieldVarName, Type, !IO),
output_initializer_for_java(Info, Stream, oa_none, Indent + 1u,
Type, Initializer, ";", !IO).
%---------------------------------------------------------------------------%
%
% Code to output declaration specifiers.
%
:- pred output_field_var_decl_flags_for_java(io.text_output_stream::in,
mlds_field_var_decl_flags::in, io::di, io::uo) is det.
output_field_var_decl_flags_for_java(Stream, Flags, !IO) :-
Flags = mlds_field_var_decl_flags(PerInstance, Constness),
io.write_string(Stream, "public ", !IO),
(
PerInstance = per_instance
;
PerInstance = one_copy,
io.write_string(Stream, "static ", !IO)
),
output_overridability_constness_for_java(Stream, overridable,
Constness, !IO).
:- pred output_class_decl_flags_for_java(java_out_info::in,
io.text_output_stream::in, mlds_class_decl_flags::in,
io::di, io::uo) is det.
output_class_decl_flags_for_java(_Info, Stream, Flags, !IO) :-
Flags = mlds_class_decl_flags(Access, Overrability, Constness),
(
Access = class_public,
io.write_string(Stream, "public ", !IO)
;
Access = class_private,
io.write_string(Stream, "private ", !IO)
),
% PerInstance = one_copy,
io.write_string(Stream, "static ", !IO),
output_overridability_constness_for_java(Stream, Overrability,
Constness, !IO).
:- pred output_overridability_constness_for_java(io.text_output_stream::in,
overridability::in, constness::in, io::di, io::uo) is det.
output_overridability_constness_for_java(Stream, Overridability,
Constness, !IO) :-
( if
( Overridability = sealed
; Constness = const
)
then
io.write_string(Stream, "final ", !IO)
else
true
).
%---------------------------------------------------------------------------%
%
% Code to rename long class names.
%
maybe_shorten_long_class_name(!ClassDefn, !Renaming) :-
!.ClassDefn = mlds_class_defn(ClassName0, _ClassArity, _Context, Flags,
_Imports, _Inherits, _Implements, _TypeParams,
_MemberFields, _MemberClasses, _MemberMethods, _Ctors),
Flags = mlds_class_decl_flags(Access, _Overridability, _Constness),
(
% We only rename private classes for now.
Access = class_private,
ClassName = shorten_class_name(ClassName0),
( if ClassName = ClassName0 then
true
else
!ClassDefn ^ mcd_class_name := ClassName,
map.det_insert(ClassName0, ClassName, !Renaming)
)
;
Access = class_public
).
maybe_shorten_long_env_name(!EnvDefn, !Renaming) :-
!.EnvDefn = mlds_env_defn(EnvName0, Context, MemberFields),
% All environment definitions are private.
EnvName = shorten_class_name(EnvName0),
( if EnvName = EnvName0 then
true
else
!:EnvDefn = mlds_env_defn(EnvName, Context, MemberFields),
map.det_insert(EnvName0, EnvName, !Renaming)
).
:- func shorten_class_name(string) = string.
shorten_class_name(ClassName0) = ClassName :-
MangledClassName0 = name_mangle_no_leading_digit(ClassName0),
( if string.length(MangledClassName0) < 100 then
ClassName = ClassName0
else
% The new name must not require name mangling, as then the name may
% again be too long. We replace all non-alphanumeric or underscore
% characters by underscores. The s_ prefix avoids having f_ as the
% prefix which is used to indicate a mangled name.
Left = string.left(ClassName0, 44),
Middle = c_util.hex_hash32(ClassName0),
Right = string.right(ClassName0, 44),
GenName = string.format("s_%s_%s_%s", [s(Left), s(Middle), s(Right)]),
GenList = string.to_char_list(GenName),
FilterList = list.map(replace_non_alphanum_underscore, GenList),
ClassName = string.from_char_list(FilterList)
).
:- func replace_non_alphanum_underscore(char) = char.
replace_non_alphanum_underscore(Char) =
( if char.is_alnum_or_underscore(Char) then
Char
else
'_'
).
%---------------------------------------------------------------------------%
interface_is_special_for_java("MercuryType").
interface_is_special_for_java("MethodPtr").
interface_is_special_for_java("MethodPtr1").
interface_is_special_for_java("MethodPtr2").
interface_is_special_for_java("MethodPtr3").
interface_is_special_for_java("MethodPtr4").
interface_is_special_for_java("MethodPtr5").
interface_is_special_for_java("MethodPtr6").
interface_is_special_for_java("MethodPtr7").
interface_is_special_for_java("MethodPtr8").
interface_is_special_for_java("MethodPtr9").
interface_is_special_for_java("MethodPtr10").
interface_is_special_for_java("MethodPtr11").
interface_is_special_for_java("MethodPtr12").
interface_is_special_for_java("MethodPtr13").
interface_is_special_for_java("MethodPtr14").
interface_is_special_for_java("MethodPtr15").
interface_is_special_for_java("MethodPtrN").
%---------------------------------------------------------------------------%
:- end_module ml_backend.mlds_to_java_class.
%---------------------------------------------------------------------------%