diff --git a/compiler/generate_mmakefile_fragments.m b/compiler/generate_mmakefile_fragments.m index ea06b8003..d90b35402 100644 --- a/compiler/generate_mmakefile_fragments.m +++ b/compiler/generate_mmakefile_fragments.m @@ -48,7 +48,7 @@ % or (more rarely) with "mmc --generate-dependency-file", and % % - when the compiler is auto-updating the .d file of a module that - % it has build a HLDS for, usually for semantic analysis followed + % it has built a HLDS for, usually for semantic analysis followed % by target code generation. % % This module, d_file_deps.m and write_deps_file.m refer to the first @@ -246,7 +246,6 @@ :- import_module parse_tree.file_names. :- import_module parse_tree.get_dependencies. :- import_module parse_tree.maybe_error. -:- import_module parse_tree.module_cmds. :- import_module parse_tree.parse_error. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_data_foreign. @@ -255,6 +254,7 @@ :- import_module bool. :- import_module cord. +:- import_module dir. :- import_module library. :- import_module map. :- import_module one_or_more. @@ -1894,6 +1894,38 @@ generate_dep_file_exec_library_targets(Globals, ModuleName, add_mmake_fragment(MmakeFragmentSharedLib, !MmakeFile), add_mmake_entries([MmakeRuleLib, MmakeRuleJar], !MmakeFile). + % Given a `mmake' variable reference to a list of .class files, return a + % gmake expression that generates the list of arguments that `jar' can use + % to refer to that set of class files. + % + % This does a similar job to list_class_files_for_jar in + % link_target_code.m, but the details are completely different. + % +:- pred list_class_files_for_jar_mmake(globals::in, string::in, string::out) + is det. + +list_class_files_for_jar_mmake(Globals, ClassFiles, ListClassFiles) :- + % XXX LEGACY + get_java_dir_path(Globals, ext_cur_ngs_gs_java_class, + ClassSubDirPath, _ClassSubDirPathProposed), + ( + ClassSubDirPath = [], + ListClassFiles = ClassFiles + ; + ClassSubDirPath = [_ | _], + ClassSubDir = dir.relative_path_name_from_components(ClassSubDirPath), + % Here we use the `-C' option of jar to change directory during + % execution, then use sed to strip away the Mercury/classes/ prefix + % to the class files. + % Otherwise, the class files would be stored as + % Mercury/classes/*.class + % within the jar file, which is not what we want. + % XXX It would be nice to avoid this dependency on sed. + ListClassFiles = "-C " ++ ClassSubDir ++ " \\\n" ++ + "\t\t`echo "" " ++ ClassFiles ++ """" ++ + " | sed 's| '" ++ ClassSubDir ++ "/| |'`" + ). + %---------------------% :- pred generate_dep_file_init_targets(globals::in, diff --git a/compiler/link_target_code.m b/compiler/link_target_code.m index 0f490ba8b..905f1731d 100644 --- a/compiler/link_target_code.m +++ b/compiler/link_target_code.m @@ -188,9 +188,11 @@ :- import_module parse_tree.module_cmds. :- import_module dir. +:- import_module int. :- import_module io.file. :- import_module maybe. :- import_module require. +:- import_module set. :- import_module string. %---------------------------------------------------------------------------% @@ -1519,6 +1521,130 @@ create_exe_or_lib_for_java(Globals, ProgressStream, LinkedTargetType, Succeeded = Succeeded0 ). +%---------------------% + + % Given a list .class files, return the list of .class files that should be + % passed to `jar'. We need this because nested classes are in separate + % files which we don't know about, so we have to scan the directory to + % figure out which files were produced by `javac'. + % + % This does a similar job to list_class_files_for_jar_mmake in + % generate_mmakefile_fragments.m, but the details are completely different. + % +:- pred list_class_files_for_jar(globals::in, list(string)::in, string::out, + list(string)::out, io::di, io::uo) is det. + +list_class_files_for_jar(Globals, MainClassFiles, ClassSubDir, + ListClassFiles, !IO) :- + % XXX LEGACY + get_java_dir_path(Globals, ext_cur_ngs_gs_java_class, + ClassSubDirPath, _ClassSubDirPathProposed), + ClassSubDir = dir.relative_path_name_from_components(ClassSubDirPath), + + list.filter_map(make_nested_class_prefix, MainClassFiles, + NestedClassPrefixes), + NestedClassPrefixesSet = set.list_to_set(NestedClassPrefixes), + + SearchDir = ClassSubDir / "jmercury", + SubDir = enter_subdirs(follow_symlinks), + FoldParams = fold_params(SubDir, on_error_keep_going), + % Unfortunately, dir.general_foldl2 is not *quite* general enough + % that we could tell it to not even try to open any file or directory + % that does not start with a prefix in NestedClassPrefixesSet. + dir.general_foldl2(FoldParams, + accumulate_nested_class_files(NestedClassPrefixesSet), + SearchDir, [], NestedClassFiles, Errors, !IO), + list.filter(file_error_is_relevant(NestedClassPrefixesSet), + Errors, RelevantErrors), + ( + RelevantErrors = [], + AllClassFiles0 = MainClassFiles ++ NestedClassFiles, + % Remove the `Mercury/classes' prefix if present. + ( if ClassSubDir = dir.this_directory then + AllClassFiles = AllClassFiles0 + else + ClassSubDirSep = ClassSubDir / "", + AllClassFiles = list.map( + string.remove_prefix_if_present(ClassSubDirSep), + AllClassFiles0) + ), + list.sort(AllClassFiles, ListClassFiles) + ; + RelevantErrors = [file_error(_, _, Error) | _], + unexpected($pred, io.error_message(Error)) + ). + +:- pred make_nested_class_prefix(string::in, string::out) is semidet. + +make_nested_class_prefix(ClassFileName, ClassPrefix) :- + % Nested class files are named "Class$Nested_1$Nested_2.class". + string.remove_suffix(ClassFileName, ".class", BaseName), + ClassPrefix = BaseName ++ "$". + +:- pred accumulate_nested_class_files(set(string)::in, string::in, string::in, + io.file_type::in, bool::out, list(string)::in, list(string)::out, + io::di, io::uo) is det. + +accumulate_nested_class_files(NestedClassPrefixes, DirName, BaseName, + FileType, Continue, !Acc, IO, IO) :- + % The I/O state arguments, which we do not use, are required + % by dir.general_foldl2. + ( + % These file types may be .class files. + ( FileType = regular_file + ; FileType = symbolic_link + ), + IsNestedCF = + file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName), + ( + IsNestedCF = yes, + !:Acc = [DirName / BaseName | !.Acc] + ; + IsNestedCF = no + ) + ; + % These file types cannot be .class files. + ( FileType = directory + ; FileType = named_pipe + ; FileType = socket + ; FileType = character_device + ; FileType = block_device + ; FileType = message_queue + ; FileType = semaphore + ; FileType = shared_memory + ; FileType = unknown + ) + ), + Continue = yes. + +:- func file_is_nested_class_file(set(string), string, string) = bool. + +file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName) + = IsNestedCF :- + ( if + string.sub_string_search(BaseName, "$", Dollar), + BaseNameToDollar = string.left(BaseName, Dollar + 1), + set.contains(NestedClassPrefixes, DirName / BaseNameToDollar) + then + IsNestedCF = yes + else + IsNestedCF = no + ). + +:- pred file_error_is_relevant(set(string)::in, file_error::in) + is semidet. + +file_error_is_relevant(NestedClassPrefixes, FileError) :- + FileError = file_error(PathName, _Op, _IOError), + ( if split_name(PathName, DirName, BaseName) then + file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName) = yes + else + % If we cannot read the top level SearchDir, that error is relevant. + true + ). + +%---------------------% + :- pred write_jar_class_argument(io.text_output_stream::in, string::in, string::in, io::di, io::uo) is det. diff --git a/compiler/module_cmds.m b/compiler/module_cmds.m index c0cf8fc07..8a41dc0aa 100644 --- a/compiler/module_cmds.m +++ b/compiler/module_cmds.m @@ -159,27 +159,12 @@ :- pred maybe_set_exit_status(maybe_succeeded::in, io::di, io::uo) is det. %-----------------------------------------------------------------------------% + % Return the standard Mercury libraries needed for a Java program. - % Return the empty list if --mercury-standard-library-directory - % is not set. + % Return the empty list if --mercury-standard-library-directory is not set. % :- pred get_mercury_std_libs_for_java(globals::in, list(string)::out) is det. - % Given a list .class files, return the list of .class files that should be - % passed to `jar'. This is required because nested classes are in separate - % files which we don't know about, so we have to scan the directory to - % figure out which files were produced by `javac'. - % -:- pred list_class_files_for_jar(globals::in, list(string)::in, string::out, - list(string)::out, io::di, io::uo) is det. - - % Given a `mmake' variable reference to a list of .class files, return an - % expression that generates the list of arguments for `jar' to reference - % those class files. - % -:- pred list_class_files_for_jar_mmake(globals::in, string::in, string::out) - is det. - % Get the value of the Java class path from the environment. (Normally % it will be obtained from the CLASSPATH environment variable, but if % that isn't present, then we use the value of the java.class.path @@ -200,12 +185,9 @@ :- import_module bool. :- import_module dir. -:- import_module int. :- import_module io.environment. :- import_module io.file. :- import_module maybe. -:- import_module require. -:- import_module set. :- import_module string. %-----------------------------------------------------------------------------% @@ -438,137 +420,6 @@ get_mercury_std_libs_for_java(Globals, !:StdLibs) :- MaybeStdLibDir = no ). -list_class_files_for_jar(Globals, MainClassFiles, ClassSubDir, - ListClassFiles, !IO) :- - % XXX LEGACY - get_java_dir_path(Globals, ext_cur_ngs_gs_java_class, - ClassSubDirPath, _ClassSubDirPathProposed), - ClassSubDir = dir.relative_path_name_from_components(ClassSubDirPath), - - list.filter_map(make_nested_class_prefix, MainClassFiles, - NestedClassPrefixes), - NestedClassPrefixesSet = set.list_to_set(NestedClassPrefixes), - - SearchDir = ClassSubDir / "jmercury", - SubDir = enter_subdirs(follow_symlinks), - FoldParams = fold_params(SubDir, on_error_keep_going), - % Unfortunately, dir.general_foldl2 is not *quite* general enough - % that we could tell it to not even try to open any file or directory - % that does not start with a prefix in NestedClassPrefixesSet. - dir.general_foldl2(FoldParams, - accumulate_nested_class_files(NestedClassPrefixesSet), - SearchDir, [], NestedClassFiles, Errors, !IO), - list.filter(file_error_is_relevant(NestedClassPrefixesSet), - Errors, RelevantErrors), - ( - RelevantErrors = [], - AllClassFiles0 = MainClassFiles ++ NestedClassFiles, - % Remove the `Mercury/classes' prefix if present. - ( if ClassSubDir = dir.this_directory then - AllClassFiles = AllClassFiles0 - else - ClassSubDirSep = ClassSubDir / "", - AllClassFiles = list.map( - string.remove_prefix_if_present(ClassSubDirSep), - AllClassFiles0) - ), - list.sort(AllClassFiles, ListClassFiles) - ; - RelevantErrors = [file_error(_, _, Error) | _], - unexpected($pred, io.error_message(Error)) - ). - -list_class_files_for_jar_mmake(Globals, ClassFiles, ListClassFiles) :- - % XXX LEGACY - get_java_dir_path(Globals, ext_cur_ngs_gs_java_class, - ClassSubDirPath, _ClassSubDirPathProposed), - ( - ClassSubDirPath = [], - ListClassFiles = ClassFiles - ; - ClassSubDirPath = [_ | _], - ClassSubDir = dir.relative_path_name_from_components(ClassSubDirPath), - % Here we use the `-C' option of jar to change directory during - % execution, then use sed to strip away the Mercury/classes/ prefix - % to the class files. - % Otherwise, the class files would be stored as - % Mercury/classes/*.class - % within the jar file, which is not what we want. - % XXX It would be nice to avoid this dependency on sed. - ListClassFiles = "-C " ++ ClassSubDir ++ " \\\n" ++ - "\t\t`echo "" " ++ ClassFiles ++ """" ++ - " | sed 's| '" ++ ClassSubDir ++ "/| |'`" - ). - -:- pred make_nested_class_prefix(string::in, string::out) is semidet. - -make_nested_class_prefix(ClassFileName, ClassPrefix) :- - % Nested class files are named "Class$Nested_1$Nested_2.class". - string.remove_suffix(ClassFileName, ".class", BaseName), - ClassPrefix = BaseName ++ "$". - -:- pred accumulate_nested_class_files(set(string)::in, string::in, string::in, - io.file_type::in, bool::out, list(string)::in, list(string)::out, - io::di, io::uo) is det. - -accumulate_nested_class_files(NestedClassPrefixes, DirName, BaseName, - FileType, Continue, !Acc, IO, IO) :- - % The I/O state arguments, which we do not use, are required - % by dir.general_foldl2. - ( - % These file types may be .class files. - ( FileType = regular_file - ; FileType = symbolic_link - ), - IsNestedCF = - file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName), - ( - IsNestedCF = yes, - !:Acc = [DirName / BaseName | !.Acc] - ; - IsNestedCF = no - ) - ; - % These file types cannot be .class files. - ( FileType = directory - ; FileType = named_pipe - ; FileType = socket - ; FileType = character_device - ; FileType = block_device - ; FileType = message_queue - ; FileType = semaphore - ; FileType = shared_memory - ; FileType = unknown - ) - ), - Continue = yes. - -:- func file_is_nested_class_file(set(string), string, string) = bool. - -file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName) - = IsNestedCF :- - ( if - string.sub_string_search(BaseName, "$", Dollar), - BaseNameToDollar = string.left(BaseName, Dollar + 1), - set.contains(NestedClassPrefixes, DirName / BaseNameToDollar) - then - IsNestedCF = yes - else - IsNestedCF = no - ). - -:- pred file_error_is_relevant(set(string)::in, file_error::in) - is semidet. - -file_error_is_relevant(NestedClassPrefixes, FileError) :- - FileError = file_error(PathName, _Op, _IOError), - ( if split_name(PathName, DirName, BaseName) then - file_is_nested_class_file(NestedClassPrefixes, DirName, BaseName) = yes - else - % If we cannot read the top level SearchDir, that error is relevant. - true - ). - %-----------------------------------------------------------------------------% get_env_classpath(Classpath, !IO) :-