mercury/compiler/mlds_to_java_class.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2000-2012 The University of Melbourne.
% Copyright (C) 2013-2018 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 ml_backend.mlds.
:- import_module ml_backend.mlds_to_java_util.
:- import_module ml_backend.mlds_to_target_util.

:- import_module io.
:- import_module map.

%---------------------------------------------------------------------------%

:- pred output_class_defn_for_java(java_out_info::in, indent::in,
    mlds_class_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.

%---------------------------------------------------------------------------%

    % 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 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 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 require.
:- import_module string.
:- import_module term.

%---------------------------------------------------------------------------%
%
% Code to output classes.
%

output_class_defn_for_java(!.Info, Indent, ClassDefn, !IO) :-
    ClassDefn = mlds_class_defn(ClassName, ClassArity, Context, Flags, Kind,
        _Imports, Inherits, Implements, TypeParams,
        MemberFields, MemberClasses, MemberMethods, Ctors),
    indent_line_after_context(!.Info ^ joi_line_numbers, marker_comment,
        Context, Indent, !IO),
    output_class_decl_flags_for_java(!.Info, Flags, !IO),

    !Info ^ joi_univ_tvars := TypeParams,

    % Use generics in the output if this class represents a Mercury type.
    ( if list.member(ml_java_mercury_type_interface, Implements) then
        !Info ^ joi_output_generics := do_output_generics
    else
        true
    ),

    output_class_kind_for_java(Kind, !IO),
    output_unqual_class_name_for_java(ClassName, ClassArity, !IO),
    OutputGenerics = !.Info ^ joi_output_generics,
    (
        OutputGenerics = do_output_generics,
        output_generic_tvars(TypeParams, !IO)
    ;
        OutputGenerics = do_not_output_generics
    ),
    io.nl(!IO),

    output_inherits_list(!.Info, Indent + 1, Inherits, !IO),
    output_implements_list(Indent + 1, Implements, !IO),
    output_n_indents(Indent, !IO),
    io.write_string("{\n", !IO),
    (
        ( Kind = mlds_class
        ; Kind = mlds_interface
        ),
        list.foldl(output_field_var_defn_for_java(!.Info, Indent + 1, oa_none),
            MemberFields, !IO),
        list.foldl(output_class_defn_for_java(!.Info, Indent + 1),
            MemberClasses, !IO),
        list.foldl(output_function_defn_for_java(!.Info, Indent + 1, oa_none),
            MemberMethods, !IO)
    ;
        Kind = mlds_struct,
        unexpected($pred, "structs not supported in Java")
    ;
        Kind = mlds_enum,
        list.filter(field_var_defn_is_enum_const,
            MemberFields, EnumConstFields),
        % XXX Why +2?
        output_enum_constants_for_java(!.Info, Indent + 2,
            ClassName, ClassArity, EnumConstFields, !IO),
        io.nl(!IO),
        % XXX Why +2?
        output_enum_ctor_for_java(Indent + 2, ClassName, ClassArity, !IO)
    ),
    io.nl(!IO),
    list.foldl(
        output_function_defn_for_java(!.Info, Indent + 1,
            oa_cname(ClassName, ClassArity)),
        Ctors, !IO),
    output_n_indents(Indent, !IO),
    io.write_string("}\n\n", !IO).

:- pred output_class_kind_for_java(mlds_class_kind::in, io::di, io::uo) is det.

output_class_kind_for_java(Kind, !IO) :-
    (
        Kind = mlds_interface,
        io.write_string("interface ", !IO)
    ;
        ( Kind = mlds_class
        ; Kind = mlds_enum
        ; Kind = mlds_struct
        ),
        io.write_string("class ", !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, indent::in,
    mlds_class_inherits::in, io::di, io::uo) is det.

output_inherits_list(Info, Indent, Inherits, !IO) :-
    (
        Inherits = inherits_nothing
    ;
        (
            Inherits = inherits_class(BaseClassId),
            BaseType = mlds_class_type(BaseClassId)
        ;
            Inherits = inherits_generic_env_ptr_type,
            BaseType = mlds_generic_env_ptr_type
        ),
        output_n_indents(Indent, !IO),
        io.write_string("extends ", !IO),
        output_type_for_java(Info, BaseType, !IO),
        io.nl(!IO)
    ).

    % 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 = [_ | _],
        output_n_indents(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_interface_id(QualClassName, Arity, _),
    QualClassName = qual_class_name(ModuleQualifier, QualKind, ClassName),
    SymName = mlds_module_name_to_sym_name(ModuleQualifier),
    mangle_sym_name_for_java(SymName, convert_qual_kind(QualKind),
        ".", ModuleNameStr),
    io.format("%s.%s", [s(ModuleNameStr), s(ClassName)], !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.
    ( if interface_is_special_for_java(ClassName) then
        true
    else
        io.format("%d", [i(Arity)], !IO)
    ).

%---------------------------------------------------------------------------%
%
% 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(indent::in, mlds_class_name::in, arity::in,
    io::di, io::uo) is det.

output_enum_ctor_for_java(Indent, ClassName, ClassArity, !IO) :-
    output_n_indents(Indent, !IO),
    io.write_string("private ", !IO),
    output_class_name_arity_for_java(ClassName, ClassArity, !IO),
    io.write_string("(int val) {\n", !IO),
    output_n_indents(Indent + 1, !IO),
    % Call the MercuryEnum constructor, which will set the MR_value field.
    io.write_string("super(val);\n", !IO),
    output_n_indents(Indent, !IO),
    io.write_string("}\n", !IO).

:- pred output_enum_constants_for_java(java_out_info::in, indent::in,
    mlds_class_name::in, arity::in, list(mlds_field_var_defn)::in,
    io::di, io::uo) is det.

output_enum_constants_for_java(Info, Indent, ClassName, ClassArity,
        EnumConsts, !IO) :-
    io.write_list(EnumConsts, "\n",
        output_enum_constant_for_java(Info, Indent, ClassName, ClassArity),
        !IO),
    io.nl(!IO).

:- pred output_enum_constant_for_java(java_out_info::in, indent::in,
    mlds_class_name::in, arity::in, mlds_field_var_defn::in,
    io::di, io::uo) is det.

output_enum_constant_for_java(_Info, Indent, ClassName, ClassArity,
        FieldVarDefn, !IO) :-
    FieldVarDefn = mlds_field_var_defn(FieldVarName, _Context, _Flags,
        _Type, Initializer, _GCStmt),
    % Make a static instance of the constant. The MLDS doesn't retain enum
    % constructor names (that shouldn't be hard to change now) so it is
    % easier to derive the name of the constant later by naming them after
    % the integer values.
    (
        Initializer = init_obj(Rval),
        ( if Rval = ml_const(mlconst_enum(N, _)) then
            output_n_indents(Indent, !IO),
            io.write_string("public static final ", !IO),
            output_class_name_arity_for_java(ClassName, ClassArity, !IO),
            io.format(" K%d = new ", [i(N)], !IO),
            output_class_name_arity_for_java(ClassName, ClassArity, !IO),
            io.format("(%d); ", [i(N)], !IO),

            io.write_string(" /* ", !IO),
            output_field_var_name_for_java(FieldVarName, !IO),
            io.write_string(" */", !IO)
        else
            unexpected($pred, "not mlconst_enum")
        )
    ;
        ( Initializer = no_initializer
        ; Initializer = init_struct(_, _)
        ; Initializer = init_array(_)
        ),
        unexpected($pred, "not mlconst_enum")
    ).

%---------------------------------------------------------------------------%

:- pred output_field_var_decl_for_java(java_out_info::in,
    mlds_field_var_name::in, mlds_type::in, io::di, io::uo) is det.

output_field_var_decl_for_java(Info, FieldVarName, Type, !IO) :-
    output_type_for_java(Info, Type, !IO),
    io.write_char(' ', !IO),
    output_field_var_name_for_java(FieldVarName, !IO).

:- pred output_field_var_defn_for_java(java_out_info::in, indent::in,
    output_aux::in, mlds_field_var_defn::in, io::di, io::uo) is det.

output_field_var_defn_for_java(Info, Indent, OutputAux, FieldVarDefn, !IO) :-
    FieldVarDefn = mlds_field_var_defn(FieldVarName, Context, Flags, Type,
        Initializer, _),
    indent_line_after_context(Info ^ joi_line_numbers, marker_comment,
        Context, Indent, !IO),
    output_field_var_decl_flags_for_java(Flags, !IO),
    % XXX MLDS_DEFN
    output_field_var_decl_for_java(Info, FieldVarName, Type, !IO),
    output_initializer_for_java(Info, OutputAux, Type, Initializer, !IO),
    io.write_string(";\n", !IO).

%---------------------------------------------------------------------------%
%
% Code to output declaration specifiers.
%

:- pred output_field_var_decl_flags_for_java(mlds_field_var_decl_flags::in,
    io::di, io::uo) is det.

output_field_var_decl_flags_for_java(Flags, !IO) :-
    Flags = mlds_field_var_decl_flags(PerInstance, Constness),
    io.write_string("public ", !IO),
    (
        PerInstance = per_instance
    ;
        PerInstance = one_copy,
        io.write_string("static ", !IO)
    ),
    output_overridability_constness_for_java(overridable, Constness, !IO).

:- pred output_class_decl_flags_for_java(java_out_info::in,
    mlds_class_decl_flags::in, io::di, io::uo) is det.

output_class_decl_flags_for_java(_Info, Flags, !IO) :-
    Flags = mlds_class_decl_flags(Access, Overrability, Constness),
    (
        Access = class_public,
        io.write_string("public ", !IO)
    ;
        Access = class_private,
        io.write_string("private ", !IO)
    ),
    % PerInstance = one_copy,
    io.write_string("static ", !IO),
    output_overridability_constness_for_java(Overrability, Constness, !IO).

:- pred output_overridability_constness_for_java(overridability::in,
    constness::in, io::di, io::uo) is det.

output_overridability_constness_for_java(Overridability, Constness, !IO) :-
    ( if
        ( Overridability = sealed
        ; Constness = const
        )
    then
        io.write_string("final ", !IO)
    else
        true
    ).

% :- pred output_virtuality_for_java(java_out_info::in, virtuality::in,
%     io::di, io::uo) is det.
%
% output_virtuality_for_java(Info, Virtual, !IO) :-
%     (
%         Virtual = virtual,
%         maybe_output_comment_for_java(Info, "virtual", !IO)
%     ;
%         Virtual = non_virtual
%     ).

% :- pred output_abstractness_for_java(abstractness::in,
%     io::di, io::uo) is det.
%
% output_abstractness_for_java(Abstractness, !IO) :-
%     (
%         Abstractness = abstract,
%         io.write_string("abstract ", !IO)
%     ;
%         Abstractness = concrete
%     ).

%---------------------------------------------------------------------------%
%
% Code to rename long class names.
%

maybe_shorten_long_class_name(!ClassDefn, !Renaming) :-
    !.ClassDefn = mlds_class_defn(ClassName0, _ClassArity, _Context, Flags,
        _ClassKind, _Imports, _Inherits, _Implements, _TypeParams,
        _MemberFields0, _MemberClasses0, _MemberMethods0, _Ctors0),
    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
    ).

:- 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),
        Right = string.right(ClassName0, 44),
        Hash = string.hash(ClassName0) /\ 0xffffffff,
        GenName = string.format("s_%s_%08x_%s", [s(Left), i(Hash), s(Right)]),
        GenList = string.to_char_list(GenName),
        FilterList = list.map(replace_non_alphanum_underscore, GenList),
        ClassName = string.from_char_list(FilterList)
    ).

:- func replace_non_alphanum_underscore(char) = char.

replace_non_alphanum_underscore(Char) =
    ( 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.
%---------------------------------------------------------------------------%