[m-rev.] for review: mmc --make, submodules and java

Peter Wang novalazy at gmail.com
Tue May 5 13:48:38 AEST 2009


Branches: main

Make `mmc --make' support submodules when compiling to Java.  Java files must
be placed in subdirectories named after the package that each class belongs to.

compiler/file_names.m:
        Rename `erlang_module_name' as it is now also used for Java.

        Make `module_name_to_file_name_general' return file names for `.java'
        and `.class' files that include package subdirectories.

compiler/mlds_to_java.m:
        Export a function to return mangled module name suitable for Java.
        This is needed as file names need to be named after classes.

compiler/make.program_target.m:
        Clean `.class' files on make clean.

compiler/mlds_to_il.m:
mdbcomp/prim_data.m:
        Move `sym_name_to_list' to mdbcomp.prim_data.

compiler/compile_target_code.m:
compiler/elds_to_erlang.m:
        Conform to changes.

diff --git a/compiler/compile_target_code.m b/compiler/compile_target_code.m
index c07670a..7f9ab9a 100644
--- a/compiler/compile_target_code.m
+++ b/compiler/compile_target_code.m
@@ -1345,7 +1345,7 @@ make_erlang_program_init_file(ErrorStream,
ModuleName, ModuleNames, Result,
     StdTraceInitFileNames = [],

     % We need to pass the module name to mkinit_erl.
-    ErlangModuleName = erlang_module_name(ModuleName),
+    ErlangModuleName = qualify_mercury_std_library_module_name(ModuleName),
     ModuleNameStr = sym_name_to_string_sep(ErlangModuleName, "__") ++ "_init",
     ModuleNameOption = " -m " ++ quote_arg(ModuleNameStr),

diff --git a/compiler/elds_to_erlang.m b/compiler/elds_to_erlang.m
index dd7e5e4..b2be5e8 100644
--- a/compiler/elds_to_erlang.m
+++ b/compiler/elds_to_erlang.m
@@ -1067,8 +1067,9 @@ erlang_special_proc_name(ThisModule, PredName,
ProcId, SpecialPred - TypeCtor,

 :- func erlang_module_name_to_str(module_name) = string.

-erlang_module_name_to_str(ModuleName) =
-    sym_name_to_string_sep(erlang_module_name(ModuleName), "__").
+erlang_module_name_to_str(ModuleName) = String :-
+    ErlangModuleName = qualify_mercury_std_library_module_name(ModuleName),
+    String = sym_name_to_string_sep(ErlangModuleName, "__").

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

diff --git a/compiler/file_names.m b/compiler/file_names.m
index 729bd71..514238a 100644
--- a/compiler/file_names.m
+++ b/compiler/file_names.m
@@ -27,13 +27,12 @@
     %
 :- pred mercury_std_library_module_name(module_name::in) is semidet.

-    % To avoid namespace collisions between Mercury standard modules and
-    % Erlang standard modules, we pretend the Mercury standard modules are in
-    % a "mercury" supermodule.  This function returns ModuleName with the
-    % extra qualifier if it is a standard library module.  Otherwise it
-    % returns it unchanged.
+    % qualify_mercury_std_library_module_name(ModuleName) = QualModuleName:
     %
-:- func erlang_module_name(module_name) = module_name.
+    % If ModuleName is a standard library module then return the module with an
+    % extra `mercury' prefix.  Otherwise, return the module name unchanged.
+    %
+:- func qualify_mercury_std_library_module_name(module_name) = module_name.

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

@@ -126,11 +125,13 @@

 :- implementation.

-:- import_module libs.globals.
-
 :- import_module libs.compiler_util.
+:- import_module libs.globals.
 :- import_module libs.handle_options.
 :- import_module libs.options.
+:- import_module mdbcomp.prim_data.
+:- import_module ml_backend.                % XXX unwanted dependency
+:- import_module ml_backend.mlds_to_java.   % XXX unwanted dependency
 :- import_module parse_tree.prog_util.
 :- import_module parse_tree.source_file_map.

@@ -152,11 +153,11 @@
mercury_std_library_module_name(qualified(Module, Name)) :-
     module_name_to_file_name(ModuleName, ModuleNameStr),
     mercury_std_library_module(ModuleNameStr).

-erlang_module_name(ModuleName) = ErlangModuleName :-
+qualify_mercury_std_library_module_name(ModuleName) = QualModuleName :-
     ( mercury_std_library_module_name(ModuleName) ->
-        ErlangModuleName= add_outermost_qualifier("mercury", ModuleName)
+        QualModuleName = add_outermost_qualifier("mercury", ModuleName)
     ;
-        ErlangModuleName= ModuleName
+        QualModuleName = ModuleName
     ).

 %-----------------------------------------------------------------------------%
@@ -173,36 +174,50 @@ module_name_to_search_file_name(ModuleName, Ext,
FileName, !IO) :-
     maybe_search::in, maybe_create_dirs::in, file_name::out, io::di, io::uo)
     is det.

-module_name_to_file_name_general(ModuleName0, Ext, Search, MkDir, FileName,
+module_name_to_file_name_general(ModuleName, Ext, Search, MkDir, FileName,
         !IO) :-
     ( Ext = ".m" ->
         % Look up the module in the module->file mapping.
-        source_file_map.lookup_module_source_file(ModuleName0, FileName, !IO)
+        source_file_map.lookup_module_source_file(ModuleName, FileName, !IO)
     ;
-        (
-            ( string.suffix(Ext, ".erl")
-            ; string.suffix(Ext, ".hrl")
-            ; string.suffix(Ext, ".beam")
-            )
-        ->
-            % Erlang uses `.' as a package separator and expects a module
-            % `a.b.c' to be in a file `a/b/c.erl'.  Rather than that, we use
-            % a flat namespace with `__' as module separators.
-            Sep = "__",
-            ModuleName = erlang_module_name(ModuleName0)
+        % Java files need to be placed in package subdirectories, e.g. the
+        % source file for `a.b.c' goes in `a_/b_/c.java'.
+        ( string.suffix(Ext, ".java")
+        ; string.suffix(Ext, ".class")
+        )
+    ->
+        JavaModuleName = java_module_name(ModuleName),
+        ( sym_name_get_module_name(JavaModuleName, ParentModules) ->
+            BaseParentDirs = sym_name_to_list(ParentModules)
         ;
-            Sep = ".",
-            ModuleName = ModuleName0
+            BaseParentDirs = []
         ),
-        BaseName = sym_name_to_string_sep(ModuleName, Sep) ++ Ext,
-        choose_file_name(ModuleName, BaseName, Ext, Search, MkDir, FileName,
-            !IO)
+        BaseName = unqualify_name(JavaModuleName) ++ Ext,
+        choose_file_name(ModuleName, BaseParentDirs, BaseName, Ext, Search,
+            do_create_dirs, FileName, !IO)
+    ;
+        % Erlang uses `.' as a package separator and expects a module
+        % `a.b.c' to be in a file `a/b/c.erl'.  Rather than that, we use
+        % a flat namespace with `__' as module separators.
+        ( string.suffix(Ext, ".erl")
+        ; string.suffix(Ext, ".hrl")
+        ; string.suffix(Ext, ".beam")
+        )
+    ->
+        ErlangModuleName = qualify_mercury_std_library_module_name(ModuleName),
+        BaseName = sym_name_to_string_sep(ErlangModuleName, "__") ++ Ext,
+        choose_file_name(ErlangModuleName, [], BaseName, Ext, Search, MkDir,
+            FileName, !IO)
+    ;
+        BaseName = sym_name_to_string_sep(ModuleName, ".") ++ Ext,
+        choose_file_name(ModuleName, [], BaseName, Ext, Search, MkDir,
+            FileName, !IO)
     ).

 module_name_to_lib_file_name(Prefix, ModuleName, Ext, MkDir, FileName, !IO) :-
     BaseFileName = sym_name_to_string(ModuleName),
     string.append_list([Prefix, BaseFileName, Ext], BaseName),
-    choose_file_name(ModuleName, BaseName, Ext, do_not_search, MkDir,
+    choose_file_name(ModuleName, [], BaseName, Ext, do_not_search, MkDir,
         FileName, !IO).

 fact_table_file_name(ModuleName, FactTableFileName, Ext, MkDir, FileName,
@@ -213,14 +228,21 @@ fact_table_file_name(ModuleName,
FactTableFileName, Ext, MkDir, FileName,
 extra_link_obj_file_name(ModuleName, ExtraLinkObjName, Ext, MkDir, FileName,
         !IO) :-
     BaseName = ExtraLinkObjName ++ Ext,
-    choose_file_name(ModuleName, BaseName, Ext, do_not_search, MkDir,
+    choose_file_name(ModuleName, [], BaseName, Ext, do_not_search, MkDir,
         FileName, !IO).

-:- pred choose_file_name(module_name::in, string::in, string::in,
-    maybe_search::in, maybe_create_dirs::in, file_name::out, io::di, io::uo)
-    is det.
+    % choose_file_name(ModuleName, BaseParentDirs, BaseName, Ext, Search,
+    %   MkDir, FileName, !IO)
+    %
+    % BaseParentDirs is usually empty.  For Java files, BaseParentDirs are the
+    % package directories that the file needs to be placed in.
+    %
+:- pred choose_file_name(module_name::in, list(string)::in, string::in,
+    string::in, maybe_search::in, maybe_create_dirs::in, file_name::out,
+    io::di, io::uo) is det.

-choose_file_name(_ModuleName, BaseName, Ext, Search, MkDir, FileName, !IO) :-
+choose_file_name(_ModuleName, BaseParentDirs, BaseName, Ext, Search, MkDir,
+        FileName, !IO) :-
     globals.io_get_globals(Globals, !IO),
     globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs),
     globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs),
@@ -385,7 +407,9 @@ choose_file_name(_ModuleName, BaseName, Ext,
Search, MkDir, FileName, !IO) :-
             string.append_list(["unknown extension `", Ext, "'"], ErrorMsg),
             unexpected(this_file, ErrorMsg)
         ),
-        make_file_name(SubDirName, Search, MkDir, BaseName, Ext, FileName, !IO)
+
+        make_file_name([SubDirName | BaseParentDirs], Search, MkDir, BaseName,
+            Ext, FileName, !IO)
     ).

 file_name_to_module_name(FileName, ModuleName) :-
@@ -397,10 +421,11 @@ module_name_to_file_name(ModuleName, FileName) :-
 module_name_to_make_var_name(ModuleName, MakeVarName) :-
     MakeVarName = sym_name_to_string(ModuleName).

-:- pred make_file_name(dir_name::in, maybe_search::in, maybe_create_dirs::in,
-    file_name::in, string::in, file_name::out, io::di, io::uo) is det.
+:- pred make_file_name(list(dir_name)::in, maybe_search::in,
+    maybe_create_dirs::in, file_name::in, string::in, file_name::out,
+    io::di, io::uo) is det.

-make_file_name(SubDirName, Search, MkDir, BaseName, Ext, FileName, !IO) :-
+make_file_name(SubDirNames, Search, MkDir, BaseName, Ext, FileName, !IO) :-
     globals.io_get_globals(Globals, !IO),
     globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs),
     globals.lookup_string_option(Globals, fullarch, FullArch),
@@ -429,9 +454,9 @@ make_file_name(SubDirName, Search, MkDir,
BaseName, Ext, FileName, !IO) :-
         % Mercury/<grade>/<fullarch>' to find the local `.opt' and `.mih'
         % files without messing up the search for the files for installed
         % libraries.
-        DirComponents = ["Mercury", Grade, FullArch, "Mercury", SubDirName]
+        DirComponents = ["Mercury", Grade, FullArch, "Mercury" | SubDirNames]
     ;
-        DirComponents = ["Mercury", SubDirName]
+        DirComponents = ["Mercury" | SubDirNames]
     ),
     (
         MkDir = do_create_dirs,
diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m
index 13842e3..20b11c5 100644
--- a/compiler/make.program_target.m
+++ b/compiler/make.program_target.m
@@ -1766,9 +1766,13 @@ make_module_clean(ModuleName, !Info, !IO) :-
         ), !IO),

     list.foldl2(make_remove_target_file(very_verbose, ModuleName),
-        [module_target_errors, module_target_c_code,
-        module_target_c_header(header_mih), module_target_il_code,
-        module_target_java_code, module_target_erlang_code,
+        [module_target_errors,
+        module_target_c_code,
+        module_target_c_header(header_mih),
+        module_target_il_code,
+        module_target_java_code,
+        module_target_java_class_code,
+        module_target_erlang_code,
         module_target_erlang_header,
         module_target_erlang_beam_code], !Info, !IO),

diff --git a/compiler/mlds_to_il.m b/compiler/mlds_to_il.m
index 86f974d..9ad348d 100644
--- a/compiler/mlds_to_il.m
+++ b/compiler/mlds_to_il.m
@@ -771,12 +771,6 @@ generate_parent_and_extends(DataRep, Kind,
Inherits) = Parent - Extends :-
 class_name(Module, Name)
     = append_toplevel_class_name(mlds_module_name_to_class_name(Module), Name).

-:- func sym_name_to_list(sym_name) = list(string).
-
-sym_name_to_list(unqualified(Name)) = [Name].
-sym_name_to_list(qualified(Module, Name))
-    = sym_name_to_list(Module) ++ [Name].
-
 :- func decl_flags_to_classattrs(mlds_decl_flags) = list(ilasm.classattr).

 decl_flags_to_classattrs(Flags) =
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index d18de80..338014d 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -72,6 +72,7 @@
 :- interface.

 :- import_module hlds.hlds_module.
+:- import_module mdbcomp.prim_data.
 :- import_module ml_backend.mlds.

 :- import_module io.
@@ -80,6 +81,10 @@

 :- pred output_mlds(module_info::in, mlds::in, io::di, io::uo) is det.

+    % Used in module_name_to_file_name to derive file names for Java files.
+    %
+:- func java_module_name(module_name) = module_name.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

@@ -97,7 +102,6 @@
 :- import_module libs.file_util.
 :- import_module libs.globals.
 :- import_module libs.options.
-:- import_module mdbcomp.prim_data.
 :- import_module ml_backend.java_util.
 :- import_module ml_backend.ml_code_util.  % for ml_gen_local_var_decl_flags.
 :- import_module ml_backend.ml_type_gen.   % for ml_gen_type_name
@@ -128,8 +132,7 @@ output_mlds(ModuleInfo, MLDS, !IO) :-
     % 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", do_create_dirs,
+    module_name_to_file_name(ModuleName, ".java", do_create_dirs,
         JavaSourceFile, !IO),
     Indent = 0,
     output_to_file(JavaSourceFile,
@@ -303,46 +306,56 @@ reverse_string(String0, String) :-
 :- pred mangle_mlds_sym_name_for_java(sym_name::in, mlds_qual_kind::in,
     string::in, package_name_mangling::in, string::out) is det.

-mangle_mlds_sym_name_for_java(unqualified(Name), QualKind, _QualifierOp,
-        _PackageNameMangling, JavaSafeName) :-
+mangle_mlds_sym_name_for_java(SymName, QualKind, QualifierOp,
+        PackageNameMangling, JavaSafeName) :-
+    mangle_mlds_sym_name_for_java_2(SymName, QualKind, PackageNameMangling,
+        MangledSymName),
+    JavaSafeName = sym_name_to_string_sep(MangledSymName, QualifierOp).
+
+:- pred mangle_mlds_sym_name_for_java_2(sym_name::in, mlds_qual_kind::in,
+    package_name_mangling::in, sym_name::out) is det.
+
+mangle_mlds_sym_name_for_java_2(SymName, QualKind, PackageNameMangling,
+        MangledSymName) :-
     (
-        QualKind = module_qual,
-        FlippedName = Name
+        SymName = unqualified(Name),
+        JavaSafeName = java_safe_name_component(QualKind, Name),
+        MangledSymName = unqualified(JavaSafeName)
     ;
-        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, PackageNameMangling, JavaSafeName) :-
-    mangle_mlds_sym_name_for_java(ModuleName0, module_qual, QualifierOp,
-        PackageNameMangling, MangledModuleName0),
-    (
-        PackageNameMangling = package_name_mangling,
-        MaybeUnderscore = should_append_underscore_for_package(ModuleName0),
+        SymName = qualified(ModuleName0, PlainName),
+        mangle_mlds_sym_name_for_java_2(ModuleName0, module_qual,
+            PackageNameMangling, MangledModuleName0),
         (
-            MaybeUnderscore = yes,
-            MangledModuleName = MangledModuleName0 ++ "_"
+            PackageNameMangling = package_name_mangling,
+            MaybeUnderscore =
should_append_underscore_for_package(ModuleName0),
+            (
+                MaybeUnderscore = yes,
+                MangledModuleName = append_underscore_sym_name(
+                    MangledModuleName0)
+            ;
+                MaybeUnderscore = no,
+                MangledModuleName = MangledModuleName0
+            )
         ;
-            MaybeUnderscore = no,
+            PackageNameMangling = no_package_name_mangling,
             MangledModuleName = MangledModuleName0
-        )
-    ;
-        PackageNameMangling = no_package_name_mangling,
-        MangledModuleName = MangledModuleName0
-    ),
+        ),
+        JavaSafePlainName = java_safe_name_component(QualKind, PlainName),
+        MangledSymName = qualified(MangledModuleName, JavaSafePlainName)
+    ).
+
+:- func java_safe_name_component(mlds_qual_kind, string) = string.
+
+java_safe_name_component(QualKind, Name) = JavaSafeName :-
     (
         QualKind = module_qual,
-        FlippedPlainName = PlainName
+        FlippedName = Name
     ;
         QualKind = type_qual,
-        FlippedPlainName = flip_initial_case(PlainName)
+        FlippedName = flip_initial_case(Name)
     ),
-    MangledPlainName = name_mangle(FlippedPlainName),
-    JavaSafePlainName = valid_symbol_name(MangledPlainName),
-    string.append_list([MangledModuleName, QualifierOp, JavaSafePlainName],
-        JavaSafeName).
+    MangledName = name_mangle(FlippedName),
+    JavaSafeName = valid_symbol_name(MangledName).

 :- func should_append_underscore_for_package(sym_name) = bool.

@@ -355,6 +368,22 @@ should_append_underscore_for_package(ModuleName)
= Append :-
         Append = yes
     ).

+:- func append_underscore_sym_name(sym_name) = sym_name.
+
+append_underscore_sym_name(SymName0) = SymName :-
+    (
+        SymName0 = unqualified(Name),
+        SymName = unqualified(Name ++ "_")
+    ;
+        SymName0 = qualified(ModuleSymName, Name),
+        SymName = qualified(ModuleSymName, Name ++ "_")
+    ).
+
+java_module_name(ModuleName) = JavaModuleName :-
+    QualModuleName = qualify_mercury_std_library_module_name(ModuleName),
+    mangle_mlds_sym_name_for_java_2(QualModuleName, module_qual,
+        package_name_mangling, JavaModuleName).
+
 %-----------------------------------------------------------------------------%
 %
 % Name mangling code to fix problem of mercury modules having the same name
diff --git a/mdbcomp/prim_data.m b/mdbcomp/prim_data.m
index 5ee9bf1..c00cb36 100644
--- a/mdbcomp/prim_data.m
+++ b/mdbcomp/prim_data.m
@@ -172,6 +172,12 @@
     %
 :- func sym_name_to_string(sym_name) = string.

+    % sym_name_to_list(SymName) = List:
+    %
+    % Convert a symbol name to a list of strings,
+    %
+:- func sym_name_to_list(sym_name) = list(string).
+
     % is_submodule(SymName1, SymName2):
     %
     % True iff SymName1 is a submodule of SymName2.
@@ -408,6 +414,10 @@ sym_name_to_string_sep(qualified(ModuleSym,
Name), Separator) = QualName :-

 sym_name_to_string(SymName) = sym_name_to_string_sep(SymName, ".").

+sym_name_to_list(unqualified(Name)) = [Name].
+sym_name_to_list(qualified(Module, Name))
+    = sym_name_to_list(Module) ++ [Name].
+
 unqualify_name(unqualified(Name)) = Name.
 unqualify_name(qualified(_ModuleName, Name)) = Name.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list