[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