[m-rev.] for review: fix conflicting type/constructor names in java

[Peter Wang]

Branches: main

Avoid a 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.  If we would violate that rule (when generating Java) then
add the prefix "mr_" to the constructor name.  The user can still trigger the
problem by naming a different constructor with the "mr_" prefix.

compiler/ml_type_gen.m:
        Add functions to generate constructor names that avoid the problem.

        Use the functions for naming d.u. constructors.

compiler/ml_unify_gen.m:
        Use the functions for naming d.u. constructors.

compiler/mlds_to_java.m:
        Delete TODO.

diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m
index 6686661..c906359 100644
--- a/compiler/ml_type_gen.m
+++ b/compiler/ml_type_gen.m
@@ -28,6 +28,8 @@

 :- import_module hlds.hlds_data.
 :- import_module hlds.hlds_module.
+:- import_module libs.globals.
+:- import_module mdbcomp.prim_data.
 :- import_module ml_backend.mlds.
 :- import_module parse_tree.prog_data.

@@ -46,6 +48,16 @@
     %
 :- pred ml_gen_type_name(type_ctor::in, mlds_class::out, arity::out) is det.

+    % Generate a data constructor name given the type constructor.
+    %
+:- func ml_gen_du_ctor_name(compilation_target, type_ctor, sym_name, int)
+    = string.
+
+    % As above but pass the unqualified type name directly.
+    %
+:- func ml_gen_du_ctor_name_unqual_type(compilation_target, string, int,
+    sym_name, int) = string.
+
     % Return the declaration flags appropriate for a type.
     %
 :- func ml_gen_type_decl_flags = mlds_decl_flags.
@@ -92,9 +104,7 @@
 :- import_module check_hlds.polymorphism.
 :- import_module hlds.hlds_pred.
 :- import_module libs.compiler_util.
-:- import_module libs.globals.
 :- import_module libs.options.
-:- import_module mdbcomp.prim_data.
 :- import_module ml_backend.ml_code_util.
 :- import_module ml_backend.ml_util.
 :- import_module parse_tree.prog_data.
@@ -109,6 +119,7 @@
 :- import_module maybe.
 :- import_module pair.
 :- import_module set.
+:- import_module string.
 :- import_module term.

 %-----------------------------------------------------------------------------%
@@ -450,7 +461,7 @@ ml_gen_du_parent_type(ModuleInfo, TypeCtor,
TypeDefn, Ctors, TagValues,
     % reserved_object representations, or fields and a constructor method
     % for the single_functor case.
     list.foldl2(ml_gen_du_ctor_member(ModuleInfo, BaseClassId,
-        BaseClassQualifier, TagClassId, TypeDefn, TagValues),
+        BaseClassQualifier, TagClassId, TypeCtor, TypeDefn, TagValues),
         Ctors, [], CtorMembers, [], BaseClassCtorMethods),

     % The base class doesn't import or inherit anything.
@@ -600,13 +611,13 @@ ml_gen_secondary_tag_class(MLDS_Context,
BaseClassQualifier, BaseClassId,
     %   a constructor method.
     %
 :- pred ml_gen_du_ctor_member(module_info::in, mlds_class_id::in,
-    mlds_module_name::in, mlds_class_id::in, hlds_type_defn::in,
+    mlds_module_name::in, mlds_class_id::in, type_ctor::in, hlds_type_defn::in,
     cons_tag_values::in, constructor::in,
     list(mlds_defn)::in, list(mlds_defn)::out,
     list(mlds_defn)::in, list(mlds_defn)::out) is det.

 ml_gen_du_ctor_member(ModuleInfo, BaseClassId, BaseClassQualifier,
-        SecondaryTagClassId, TypeDefn, ConsTagValues, Ctor,
+        SecondaryTagClassId, TypeCtor, TypeDefn, ConsTagValues, Ctor,
         MLDS_Members0, MLDS_Members, MLDS_CtorMethods0, MLDS_CtorMethods) :-
     Ctor = ctor(ExistQTVars, Constraints, CtorName, Args, _Ctxt),

@@ -616,8 +627,11 @@ ml_gen_du_ctor_member(ModuleInfo, BaseClassId,
BaseClassQualifier,
     MLDS_Context = mlds_make_context(Context),

     % Generate the class name for this constructor.
-    UnqualCtorName = unqualify_name(CtorName),
+    module_info_get_globals(ModuleInfo, Globals),
+    globals.get_target(Globals, Target),
     list.length(Args, CtorArity),
+    UnqualCtorName = ml_gen_du_ctor_name(Target, TypeCtor,
+        CtorName, CtorArity),

     TagVal = get_tagval(ConsTagValues, Ctor),
     ( tagval_is_reserved_addr(TagVal, ReservedAddr) ->
@@ -681,8 +695,6 @@ ml_gen_du_ctor_member(ModuleInfo, BaseClassId,
BaseClassQualifier,
         % Generate a constructor function to initialize the fields, if needed
         % (not all back-ends use constructor functions).
         MaybeSecTagVal = get_secondary_tag(TagVal),
-        module_info_get_globals(ModuleInfo, Globals),
-        globals.get_target(Globals, Target),
         UsesConstructors = target_uses_constructors(Target),
         (
             UsesConstructors = yes,
@@ -1004,6 +1016,29 @@ ml_gen_type_name(type_ctor(Name, Arity),
QualifiedTypeName, Arity) :-
     MLDS_Module = mercury_module_name_to_mlds(ModuleName),
     QualifiedTypeName = qual(MLDS_Module, module_qual, TypeName).

+ml_gen_du_ctor_name(CompilationTarget, TypeCtor, Name, Arity) = CtorName :-
+    TypeCtor = type_ctor(TypeName, TypeArity),
+    UnqualTypeName = unqualify_name(TypeName),
+    CtorName = ml_gen_du_ctor_name_unqual_type(CompilationTarget,
+        UnqualTypeName, TypeArity, Name, Arity).
+
+ml_gen_du_ctor_name_unqual_type(CompilationTarget, UnqualTypeName, TypeArity,
+        Name, Arity) = CtorName :-
+    UnqualName = unqualify_name(Name),
+    (
+        CompilationTarget = target_java,
+        UnqualName = UnqualTypeName,
+        Arity = TypeArity
+    ->
+        % In Java we must not generate a class with the same name as its
+        % enclosing class.  We add the prefix to avoid that situation arising.
+        % (A user may name another functor of the same type with "mr_" to
+        % trigger the problem.)
+        CtorName = "mr_" ++ UnqualName
+    ;
+        CtorName = UnqualName
+    ).
+
     % For interoperability, we ought to generate an `==' member for types
     % which have a user-defined equality, if the target language supports it
     % (as do e.g. C++, Java).
diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
index 4bf6a36..30f942b 100644
--- a/compiler/ml_unify_gen.m
+++ b/compiler/ml_unify_gen.m
@@ -297,7 +297,8 @@ ml_gen_construct_2(Tag, Type, Var, ConsId, Args,
ArgModes, TakeAddr,
         ; Tag = unshared_tag(_TagVal)
         ; Tag = shared_remote_tag(_PrimaryTag, _SecondaryTag)
         ),
-        ml_gen_compound(Tag, ConsId, Var, Args, ArgModes, TakeAddr,
+        type_to_ctor_and_args_det(Type, TypeCtor, _),
+        ml_gen_compound(Tag, TypeCtor, ConsId, Var, Args, ArgModes, TakeAddr,
             HowToConstruct, Context, Decls, Statements, !Info)
     ;
         % Constants.
@@ -577,13 +578,13 @@ ml_cons_id_to_tag(Info, ConsId, Type, Tag) :-

     % Generate code to construct a new object.
     %
-:- pred ml_gen_compound(cons_tag::in, cons_id::in, prog_var::in, prog_vars::in,
-    list(uni_mode)::in, list(int)::in, how_to_construct::in, prog_context::in,
-    list(mlds_defn)::out, list(statement)::out,
+:- pred ml_gen_compound(cons_tag::in, type_ctor::in, cons_id::in, prog_var::in,
+    prog_vars::in, list(uni_mode)::in, list(int)::in, how_to_construct::in,
+    prog_context::in, list(mlds_defn)::out, list(statement)::out,
     ml_gen_info::in, ml_gen_info::out) is det.

-ml_gen_compound(Tag, ConsId, Var, ArgVars, ArgModes, TakeAddr, HowToConstruct,
-        Context, Decls, Statements, !Info) :-
+ml_gen_compound(Tag, TypeCtor, ConsId, Var, ArgVars, ArgModes, TakeAddr,
+        HowToConstruct, Context, Decls, Statements, !Info) :-
     % Get the primary and secondary tags.
     ( get_primary_tag(Tag) = yes(PrimaryTag0) ->
         PrimaryTag = PrimaryTag0
@@ -592,11 +593,15 @@ ml_gen_compound(Tag, ConsId, Var, ArgVars,
ArgModes, TakeAddr, HowToConstruct,
     ),
     MaybeSecondaryTag = get_secondary_tag(Tag),

+    ml_gen_info_get_module_info(!.Info, ModuleInfo),
+    module_info_get_globals(ModuleInfo, Globals),
+
     % Figure out which class name to construct.
     ( ml_tag_uses_base_class(Tag) ->
         MaybeCtorName = no
     ;
-        ml_cons_name(ConsId, CtorName),
+        globals.get_target(Globals, CompilationTarget),
+        ml_cons_name(CompilationTarget, TypeCtor, ConsId, CtorName),
         MaybeCtorName = yes(CtorName)
     ),

@@ -610,8 +615,6 @@ ml_gen_compound(Tag, ConsId, Var, ArgVars,
ArgModes, TakeAddr, HowToConstruct,
         % With the low-level data representation, all fields -- even the
         % secondary tag -- are boxed, and so we need box it here.

-        ml_gen_info_get_module_info(!.Info, ModuleInfo),
-        module_info_get_globals(ModuleInfo, Globals),
         globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
         (
             HighLevelData = no,
@@ -923,7 +926,10 @@ get_type_for_cons_id(MLDS_Type, UsesBaseClass,
MaybeConsId, HighLevelData,
             % If so, append the name of the derived class to the name of the
             % base class for this type (since the derived class will also be
             % nested inside the base class).
-            CtorName = unqualify_name(CtorSymName),
+            globals.get_target(Globals, CompilationTarget),
+            QualTypeName = qual(_, _, UnqualTypeName),
+            CtorName = ml_gen_du_ctor_name_unqual_type(CompilationTarget,
+                UnqualTypeName, TypeArity, CtorSymName, CtorArity),
             QualTypeName = qual(MLDS_Module, _QualKind, TypeName),
             ClassQualifier = mlds_append_class_qualifier(MLDS_Module,
                 module_qual, Globals, TypeName, TypeArity),
@@ -1235,14 +1241,17 @@ ml_gen_static_const_addr(Info, Var, Type,
ConstAddrRval) :-
     ml_gen_var_lval(Info, ConstName, Type, ConstLval),
     ConstAddrRval = mem_addr(ConstLval).

-:- pred ml_cons_name(cons_id::in, ctor_name::out) is det.
+:- pred ml_cons_name(compilation_target::in, type_ctor::in,
+    cons_id::in, ctor_name::out) is det.

-ml_cons_name(HLDS_ConsId, QualifiedConsId) :-
+ml_cons_name(CompilationTarget, TypeCtor, HLDS_ConsId, QualifiedConsId) :-
     (
-        HLDS_ConsId = cons(SymName, Arity),
-        SymName = qualified(SymModuleName, ConsName)
+        HLDS_ConsId = cons(ConsSymName, ConsArity),
+        ConsSymName = qualified(SymModuleName, _)
     ->
-        ConsId = ctor_id(ConsName, Arity),
+        ConsName = ml_gen_du_ctor_name(CompilationTarget, TypeCtor,
+            ConsSymName, ConsArity),
+        ConsId = ctor_id(ConsName, ConsArity),
         ModuleName = mercury_module_name_to_mlds(SymModuleName)
     ;
         ConsName = hlds_out.cons_id_to_string(HLDS_ConsId),
@@ -1668,7 +1677,10 @@ ml_gen_unify_arg(ConsId, Arg, Mode, ArgType,
Field, VarType, VarLval,
         ;
             FieldName = ml_gen_field_name(MaybeFieldName, ArgNum),
             ( ConsId = cons(ConsName, ConsArity) ->
-                UnqualConsName = unqualify_name(ConsName),
+                globals.get_target(Globals, CompilationTarget),
+                type_to_ctor_and_args_det(VarType, TypeCtor, _),
+                UnqualConsName = ml_gen_du_ctor_name(CompilationTarget,
+                    TypeCtor, ConsName, ConsArity),
                 FieldId = ml_gen_field_id(VarType, Tag, UnqualConsName,
                     ConsArity, FieldName, Globals)
             ;
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 9c26ea5..6ffdc54 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -29,10 +29,6 @@
 %   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
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------