%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2008-2011 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: file_name.m. % % This module deals with the connections between % module names and file names. % %---------------------------------------------------------------------------% :- module parse_tree.file_names. :- interface. :- import_module libs. :- import_module libs.file_util. :- import_module libs.globals. :- import_module mdbcomp. :- import_module mdbcomp.sym_name. :- import_module io. %---------------------------------------------------------------------------% % % XXX This interface should be improved in two ways. % % - First, the implementation of this predicate effectively divides % the set of possible values of Ext into classes of extensions, % treating every extension in a given class the same way. % % We should replace the simple string Ext argument with a more % structured specification of the extension, one that puts a wrapper % around the actual suffix indicating what class the extension falls in, % as in e.g. ec_library(".dylib"). For some classes, maybe the majority, % the list of member extensions may be fixed; for these, it would % make sense to specify each member of the class by a value in an % extension-class-specific enum type, not by string. % % While the code handling some of classes accesses the filesystem, % the code handling some other classes does not. If we put the wrappers % for these two kinds of classes into two separate types, we could % have a version of this predicate for each type, one with and one % without an I/O state pair. % % Work along these lines has begun. % % - Second, calls which search for a source file for reading (that may not % exist) should be separated from calls that construct a file name % to write the file. % % XXX Given the wide variety of uses cases that choose_file_name has % to handle for its callers, the only way to ensure that a diff implementing % the above ideas handles *all* of those uses cases correctly is probably to % % - Gather a list of all the extensions choose_file_name is called with. % % - Set up a test environment with distinctively named directories in % all the relevant directory search options. % % - Invoke choose_file_name and module_name_to_file_name_ext % with all possible combinations of % % --use-grade-subdirs, --use-subdirs or neither % empty and distinctive nonempty base parent dirs % unqualified and qualified module names % extension % maybe_search % maybe_create_dirs % % and record the results as the baseline. % % - Repeat the exercise with the proposed replacement code, and % compare the results to the baseline. % If the proper place for a file is in a subdirectory (e.g. Mercury/css), % but the subdirectory does not exist, which in this case may mean either % % - that Mercury exists but Mercury/css does not, or % - that Mercury does not exist, which of course means that Mercury/css % does not exist either, % % values of this type tell the predicate they are given to whether it % should create any such missing directories. :- type maybe_create_dirs ---> do_create_dirs ; do_not_create_dirs. % For some kinds of files, we know exactly in which directory % they should be; for other kinds, we may have to search several % directories. For the latter, our clients will need to call the % module_name_to_search_file_name predicate, which internally sets % MaybeSearch to do_search. % % Note that do_create_dirs is not compatible with do_search; if you % know what one of several directories should contain a file, but don't % know which one, you have by definition no basis you can use to choose % which one to create. This invariant is enforced by the fact that % module_name_to_search_file_name always passes do_not_create_dirs % alongside do_search. % % This type is not used in the interface of this module, but it is used % by the *clients* of this module. % % Note that module_name_to_search_file_name constructs just the % *filename to search for*, and leaves the actual searching to be done % by some other system component. Usually, that component is % either module_name_to_search_file_name's caller, or *its* caller, etc. % However, in some cases (such as .mh/.mih files), we just output % the search file name, and leave it to the target language compiler % to do the searching. % % XXX This setup makes it hard to build a database of % % - which extensions are ever subject to search, and % - what the search path of each such extension is. :- type maybe_search ---> do_search ; do_not_search. % This type is intended to represent an extension at the end of a filename. % However, we currently also use it to represent an extension at the end % of the name of an mmake target. Some of those uses include references % to the values of mmake variables. % % We can partition the set of extensions we handle, along the lines % described above, by adding more function symbols to this type, % and specifying what suffixes correspond to each function symbol. :- type ext ---> ext_src % The extension string is ".m". ; ext_other(other_ext). % The general case. The extension string must not be covered % by any of the other cases above. :- type other_ext ---> other_ext(string). :- func extension_to_string(ext) = string. :- func other_extension_to_string(other_ext) = string. :- func make_module_dep_file_extension = other_ext is det. %---------------------% % XXX Most of the predicates below take a "from" string argument, % for which the caller is expected pass $pred or some other identification % of the call site. This is a temporary measure, intended to help debug % any problems that may arise during the process of slicing the space % of extensions into smaller and smaller pieces. % Return the file name of the Mercury source for the given module. % :- pred module_name_to_source_file_name(module_name::in, file_name::out, io::di, io::uo) is det. % module_name_to_file_name(Globals, Mkdir, Ext, Module, FileName, !IO): % % Convert a module name and file extension to the corresponding file name. % If `MkDir' is do_create_dirs, then create any directories needed. % % Currently we use the convention that the module `foo.bar.baz' should be % named `foo.bar.baz.m', and allow other naming conventions with the % `-f' option. % % Note that this predicate is also used to create some "phony" Makefile % targets that do not have corresponding files, e.g. `.clean'. % :- pred module_name_to_file_name(globals::in, string::in, maybe_create_dirs::in, ext::in, module_name::in, file_name::out, io::di, io::uo) is det. % module_name_to_search_file_name(Globals, Ext, Module, FileName, !IO): % % As above, but for a file which might be in an installed library, % not the current directory. % % With `--use-grade-subdirs', the current directory's `.mih' files are in % `Mercury///Mercury/mihs', and those for installed libraries % are in `/lib/mercury/lib///inc/Mercury/mihs'. % % handle_options.m sets up the `--c-include-directory' options so that % the name `.mih' should be used in a context which requires % searching for the `.mih files, for example in a C file. % % module_name_to_file_name would return % `Mercury///Mercury/mihs/.mihs', % which would be used when writing or removing the `.mih' file. % :- pred module_name_to_search_file_name(globals::in, string::in, ext::in, module_name::in, file_name::out, io::di, io::uo) is det. % module_name_to_lib_file_name(Globals, MkDir, Prefix, Ext, % Module, FileName, !IO): % % Like module_name_to_file_name, but also allows a prefix. % Used for creating library names, e.g. `lib.$A' and `lib.so'. % :- pred module_name_to_lib_file_name(globals::in, string::in, maybe_create_dirs::in, string::in, other_ext::in, module_name::in, file_name::out, io::di, io::uo) is det. % fact_table_file_name(Globals, MkDir, Ext, FactTableFileName, % FileName, !IO): % % Returns the filename to use when compiling fact table files. % If `MkDir' is do_create_dirs, then create any directories needed. % :- pred fact_table_file_name(globals::in, string::in, maybe_create_dirs::in, other_ext::in, file_name::in, file_name::out, io::di, io::uo) is det. %---------------------------------------------------------------------------% % Succeeds iff the module referred to by the module name is one % of the modules in the standard library. % :- pred mercury_std_library_module_name(module_name::in) is semidet. % qualify_mercury_std_library_module_name(ModuleName) = QualModuleName: % % 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. %---------------------------------------------------------------------------% % Convert a file name (excluding the trailing `.m') to the corresponding % module name. % :- pred file_name_to_module_name(file_name::in, module_name::out) is det. % Convert a module name to a file name stem (e.g. foo.bar.baz). % :- pred module_name_to_file_name_stem(module_name::in, file_name::out) is det. % Convert a module name to something that is suitable % for use as a variable name in makefiles. % :- pred module_name_to_make_var_name(module_name::in, string::out) is det. %---------------------------------------------------------------------------% % Return the name of the directory containing Java `.class' files. % :- pred get_class_dir_name(globals::in, string::out) is det. %---------------------------------------------------------------------------% % Convert an include_file reference to a filesystem path. % :- pred make_include_file_path(string::in, string::in, string::out) is det. %---------------------------------------------------------------------------% % This predicate is intended to output profiling data that can later % be used to improve the operation of this module. It appends to % /tmp/TRANSLATIONS_RECORD information about the frequency with which % this module is asked to translate file names with various suffixes, % provided that the gathering of this information has been enabled by % both the right trace flag at compile time and the right environment % variable at runtime. % :- pred write_translations_record_if_any(io::di, io::uo) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module libs.compute_grade. :- import_module libs.options. :- import_module parse_tree.java_names. :- import_module parse_tree.source_file_map. :- import_module bool. :- import_module dir. :- import_module int. :- import_module library. :- import_module list. :- import_module map. :- import_module maybe. :- import_module require. :- import_module string. %---------------------------------------------------------------------------% extension_to_string(Ext) = ExtStr :- ( Ext = ext_src, ExtStr = ".m" ; Ext = ext_other(OtherExt), ExtStr = other_extension_to_string(OtherExt) ). other_extension_to_string(OtherExt) = ExtStr :- OtherExt = other_ext(ExtStr). %---------------------------------------------------------------------------% :- pred valid_other_ext(other_ext::in) is semidet. valid_other_ext(other_ext(ExtStr)) :- % We define what string is valid as an argument of ext/1 negatively: % any extension string is valid as an argument of ext/1 *unless* % it has some other representation. not ( ExtStr = ".m" % ext_src ). %---------------------------------------------------------------------------% make_module_dep_file_extension = other_ext(".module_dep"). %---------------------------------------------------------------------------% module_name_to_source_file_name(ModuleName, SourceFileName, !IO) :- % Look up the module in the module->file mapping. source_file_map.lookup_module_source_file(ModuleName, MaybeFileName, !IO), ( MaybeFileName = yes(SourceFileName) ; MaybeFileName = no, % We get here only if % % - the source file map says that the default source file name % for ModuleName is actually being used to store a module % *other than* ModuleName, *and* % - the source file map itself does not know in which file ModuleName % is stored. % % This can happen only if either the source file map was built from % an incomplete list of source files, or if that list became incomplete % later, as new source files were added. % % XXX What we do here is *seriously* suboptimal. Any programmer % who is clueless enough to screw up the naming of source files % this badly will be even more confused by the mess resulting % from the code below. % % The old XXX suggested that we should propagate the fact that % no source file name is available for the given module back to % our caller, but I think it would be simpler for the code here % to print an error message % % - describing the problem, and % - suggest ways to fix it (put modules into files with non-colliding % names, or running mmc -f *.m), % % and then exit with an error status, *without* returning to our % caller. SourceFileName = "Mercury/.missing." ++ default_source_file_name(ModuleName) ). %---------------------------------------------------------------------------% module_name_to_file_name(Globals, From, MkDir, Ext, ModuleName, FileName, !IO) :- module_name_to_file_name_ext(Globals, From, do_not_search, MkDir, Ext, ModuleName, FileName, !IO). module_name_to_search_file_name(Globals, From, Ext, ModuleName, FileName, !IO) :- module_name_to_file_name_ext(Globals, From, do_search, do_not_create_dirs, Ext, ModuleName, FileName, !IO). module_name_to_lib_file_name(Globals, From, MkDir, Prefix, Ext, ModuleName, FileName, !IO) :- BaseFileName = sym_name_to_string(ModuleName), BaseNameNoExt = Prefix ++ BaseFileName, % Library files do not need the preprocessing that % module_name_to_file_name_ext does before calling choose_file_name. choose_file_name(Globals, From, do_not_search, Ext, [], BaseNameNoExt, DirComponents, FileName), maybe_create_dirs_on_path(MkDir, DirComponents, !IO). fact_table_file_name(Globals, From, MkDir, Ext, FactTableFileName, FileName, !IO) :- % Fact table files do not need the preprocessing that % module_name_to_file_name_ext does before calling choose_file_name. choose_file_name(Globals, From, do_not_search, Ext, [], FactTableFileName, DirComponents, FileName), maybe_create_dirs_on_path(MkDir, DirComponents, !IO). %---------------------------------------------------------------------------% % XXX The implementations of the following predicates, namely % module_name_to_file_name_ext and its subcontractors choose_file_name % and make_file_name, effectively divide the set of possible values % of Ext into classes of extensions, treating every extension % in a given class the same way. % % We should replace the simple Ext argument, which currently represents % all extensions using the same function symbol, with a more structured % specification of the extension, one which has several function symbols, % each indicating which class the extension falls in. For example, ext_src % would indicate source files (without need for storing the suffix), while % ext_obj(...) would indicate an object file, with its string argument could % be e.g. .o, .pic_o, .lpic_o etc to indicate what *kind* of object file. % Such function symbols could have other arguments to indicate e.g. the % presence or absence of "_init" between the base name of the file % and the extension itself. For some classes, maybe the majority, the list of % member extensions may be fixed. For these, it would make sense to specify % each member of the class by a value in an extension-class-specific enum type, % not by a string. And for a class containing only one extension, such as % source files, even that should not be needed. A possible difficulty is that % the strings of some extensions are not fixed, but are taken from compiler % options. However, for most, if not all of these options, the class that % the extension they represent falls into should be clear. % % The extension class should specify whether % % - the extensions in the class are (architecture or) grade dependent, % - if yes, what the name of the grade and non-grade directories are, % - if not, what the name of the non-grade directory is, and % - whether it is worth caching the translation (a translation that is % either trivially cheap or usually only done once per compiler invocation % is not worth caching). % % While the code handling some of classes accesses the filesystem, % the code handling some other classes does not. If we put the wrappers % for these two kinds of classes into two separate types, we could % have two versions of these predicates for each type, one with and one % without an I/O state pair. % % It may also be a good idea to also separate the representations of extensions % of filenames (which can also be mmake targets) vs strings whose *only* use % is as mmake targets (since they are not also filenames). This is because % it makes sense to search in the filesystem for filenames, but not for % mmake targets, and because mmake targets (should) never need directories % created for them. % % The classification does not need to include .tmp suffixes on extensions, % since (due to the behavior of the mercury_update_interface script, which % the .tmp suffixes are for) the .tmp suffix *always* goes directly after % the end of the corresponding non-.tmp filename, and can never be e.g. % found in a different directory in a search. Calls to the exported predicates % of this module should never specify .tmp as part of the extension; instead, % they should add the .tmp suffix to the filename they get back from those % predicates instead. :- pred module_name_to_file_name_ext(globals::in, string::in, maybe_search::in, maybe_create_dirs::in, ext::in, module_name::in, file_name::out, io::di, io::uo) is det. module_name_to_file_name_ext(Globals, From, Search, MkDir, Ext, ModuleName, FileName, !IO) :- ( Ext = ext_src, module_name_to_source_file_name(ModuleName, FileName, !IO) ; Ext = ext_other(OtherExt), decide_base_name_parent_dirs_other(OtherExt, ModuleName, BaseParentDirs, BaseNameNoExt), choose_file_name(Globals, From, Search, OtherExt, BaseParentDirs, BaseNameNoExt, DirComponents, FileName), maybe_create_dirs_on_path(MkDir, DirComponents, !IO) ), trace [compile_time(flag("file_name_translations")), runtime(env("FILE_NAME_TRANSLATIONS")), io(!TIO)] ( record_translation(Search, MkDir, Ext, ModuleName, FileName, !TIO) ). %---------------------% :- pred decide_base_name_parent_dirs_other(other_ext::in, module_name::in, list(string)::out, file_name::out) is det. decide_base_name_parent_dirs_other(OtherExt, ModuleName, BaseParentDirs, BaseNameNoExt) :- OtherExt = other_ext(ExtStr), expect(valid_other_ext(OtherExt), $pred, ExtStr ++ " is a not valid argument of ext/1"), ( if % Java files need to be placed into a package subdirectory % and may need mangling. ( string.suffix(ExtStr, ".java") ; string.suffix(ExtStr, ".class") ) then BaseParentDirs = ["jmercury"], mangle_sym_name_for_java(ModuleName, module_qual, "__", BaseNameNoExt) else BaseParentDirs = [], BaseNameNoExt = sym_name_to_string_sep(ModuleName, ".") ). %---------------------% % choose_file_name(Globals, Search, OtherExt, BaseParentDirs, BaseName, % 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(globals::in, string::in, maybe_search::in, other_ext::in, list(string)::in, string::in, list(string)::out, file_name::out) is det. choose_file_name(Globals, _From, Search, OtherExt, BaseParentDirs, BaseNameNoExt, DirComponents, FileName) :- globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs), OtherExt = other_ext(ExtStr), ( if % If we are searching for (rather than writing) a `.mih' file, % use the plain file name. This is so that searches for files % in installed libraries will work. `--c-include-directory' is set % so that searches for files in the current directory will work. Search = do_search, ExtStr = ".mih" then DirComponents = [], FileName = BaseNameNoExt ++ ExtStr else ( UseSubdirs = no, % Even if not putting files in a `Mercury' directory, % Java files will have non-empty BaseParentDirs (the package) % which may need to be created. % XXX We can never target Java while UseSubdirs = no. However, % while making dependencies, generate_d_file in write_deps_file.m % does call module_name_to_file_name with a .java suffix % without --use-subdirs being enabled, so insisting on % BaseParentDirs = [] here would cause an abort when making % dependencies. % XXX This indicates a deeper problem, which is that while % different backends use different settings of --use-subdirs % and --use-grade-subdirs, we are generating dependencies % for *all* backends with the *same* settings of these options. FileName = glue_dir_names_file_name(BaseParentDirs, BaseNameNoExt, ExtStr), DirComponents = BaseParentDirs ; UseSubdirs = yes, globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs), ( if % The source files, the final executables, library files % (including .init files) output files intended for use % by the user, and phony Mmake targets names go in the % current directory. not ( UseGradeSubdirs = yes, file_is_arch_or_grade_dependent(Globals, OtherExt) ), is_current_dir_extension(ExtStr) then DirComponents = [], FileName = BaseNameNoExt ++ ExtStr else choose_subdir_name(Globals, ExtStr, SubDirName), make_file_name(Globals, [SubDirName | BaseParentDirs], Search, BaseNameNoExt, OtherExt, DirComponents, FileName) ) ) ). :- pred is_current_dir_extension(string::in) is semidet. is_current_dir_extension(ExtStr) :- % Executable files. % XXX The Ext = "" here is wrong. While an empty extension % *can* mean we are building the name of an executable, % it can also mean we are building the name of a phony Mmakefile % target for a library, such as libmer_std in the library % directory. ( ExtStr = "" ; ExtStr = ".bat" ; ExtStr = ".exe" % Library files. ; ExtStr = ".a" ; ExtStr = ".$A" ; ExtStr = ".lib" ; ExtStr = ".so" ; ExtStr = ".dll" ; ExtStr = ".dylib" ; ExtStr = ".$(EXT_FOR_SHARED_LIB)" ; ExtStr = ".jar" ; ExtStr = ".init" % XXX Describe me. ; ExtStr = ".mh" % Output files intended for use by the user. % The MLDS dump files with extensions .c_dump* and .mih_dump* % also fit into this category, but their filenames are constructed % by getting the filenames for the .c and .mih extensions % and adding a suffix to that. ; ExtStr = ".err" ; ExtStr = ".ugly" ; ExtStr = ".hlds_dump" ; ExtStr = ".mlds_dump" ; ExtStr = ".dependency_graph" ; ExtStr = ".order" % Mmake targets. ; ExtStr = ".clean" ; ExtStr = ".realclean" ; ExtStr = ".depend" ; ExtStr = ".install_ints" ; ExtStr = ".install_opts" ; ExtStr = ".install_hdrs" ; ExtStr = ".install_grade_hdrs" ; ExtStr = ".check" ; ExtStr = ".ints" ; ExtStr = ".int3s" ; ExtStr = ".javas" ; ExtStr = ".classes" ; ExtStr = ".opts" ; ExtStr = ".trans_opts" ; ExtStr = ".all_ints" ; ExtStr = ".all_int3s" ; ExtStr = ".all_opts" ; ExtStr = ".all_trans_opts" ). % Decide which ext_other extensions go in which directories. % :- pred choose_subdir_name(globals::in, string::in, string::out) is det. choose_subdir_name(Globals, ExtStr, SubDirName) :- ( if ( ( ExtStr = ".dir/*.o" ; ExtStr = ".dir/*.$O" ), SubDirNamePrime = "dirs" ; % .$O, .pic_o and .lpic_o files need to go in the same directory, % so that using .$(EXT_FOR_PIC_OBJECTS) will work. ( ExtStr = ".o" ; ExtStr = ".$O" ; ExtStr = ".lpic_o" ; ExtStr = ".pic_o" ; ExtStr = "$(EXT_FOR_PIC_OBJECTS)" ; ExtStr = "_init.o" ; ExtStr = "_init.$O" ; ExtStr = "_init.lpic_o" ; ExtStr = "_init.pic_o" ; ExtStr = "_init.$(EXT_FOR_PIC_OBJECTS)" ), SubDirNamePrime = "os" ; % `.dv' files go in the `deps' subdirectory, % along with the `.dep' files. ExtStr = ".dv", SubDirNamePrime = "deps" ; % Launcher scripts go in the `bin' subdirectory. ExtStr = "", SubDirNamePrime = "bin" ) then SubDirName = SubDirNamePrime else if % _init.c, _init.cs, _init.o etc. files go in the cs, css, os etc % subdirectories. string.remove_prefix("_init.", ExtStr, ExtName) then SubDirName = ExtName ++ "s" else if globals.lookup_string_option(Globals, library_extension, LibExt), globals.lookup_string_option(Globals, shared_library_extension, SharedLibExt), % Static and shared libraries go in the `lib' subdirectory. ( ExtStr = LibExt ; ExtStr = SharedLibExt ) then SubDirName = "lib" else if % The usual case: `*.foo' files go in the `foos' subdirectory. string.remove_prefix(".", ExtStr, ExtName) then SubDirName = ExtName ++ "s" else unexpected($pred, "unknown extension `" ++ ExtStr ++ "'") ). :- pred make_file_name(globals::in, list(dir_name)::in, maybe_search::in, file_name::in, other_ext::in, list(string)::out, file_name::out) is det. make_file_name(Globals, SubDirNames, Search, BaseNameNoExt, OtherExt, DirComponents, FileName) :- globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs), globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs), OtherExt = other_ext(ExtStr), ( if UseGradeSubdirs = yes, file_is_arch_or_grade_dependent(Globals, OtherExt), % If we are searching for (rather than writing) the file, just search % in Mercury/s. This is so that searches for files in installed % libraries work. `--intermod-directories' is set so this will work. not ( Search = do_search, ( ExtStr= ".opt" ; ExtStr= ".trans_opt" ; ExtStr= ".analysis" ; ExtStr= ".imdg" ; ExtStr= ".request" ) ) then grade_directory_component(Globals, Grade), globals.lookup_string_option(Globals, target_arch, TargetArch), % The extra "Mercury" is needed so we can use `--intermod-directory % Mercury//' and `--c-include % Mercury//' to find the local `.opt' and `.mih' % files without messing up the search for the files for installed % libraries. DirComponents = ["Mercury", Grade, TargetArch, "Mercury" | SubDirNames] else if UseSubdirs = yes then DirComponents = ["Mercury" | SubDirNames] else DirComponents = SubDirNames ), FileName = glue_dir_names_file_name(DirComponents, BaseNameNoExt, ExtStr). :- func glue_dir_names_file_name(list(string), string, string) = string. glue_dir_names_file_name(DirComponents, BaseNameNoExt, ExtStr) = FileName :- ( DirComponents = [], FileName = BaseNameNoExt ++ ExtStr ; DirComponents = [_ | _], Components = DirComponents ++ [BaseNameNoExt ++ ExtStr], FileName = dir.relative_path_name_from_components(Components) ). %---------------------% :- pred file_is_arch_or_grade_dependent(globals::in, other_ext::in) is semidet. file_is_arch_or_grade_dependent(Globals, OtherExt) :- OtherExt = other_ext(ExtStr), ( file_is_arch_or_grade_dependent_2(ExtStr) ; globals.lookup_string_option(Globals, executable_file_extension, ExtStr) ; globals.lookup_string_option(Globals, library_extension, ExtStr) ; globals.lookup_string_option(Globals, shared_library_extension, ExtStr) ; some [ObjExtStr] ( ( globals.lookup_string_option(Globals, object_file_extension, ObjExtStr) ; globals.lookup_string_option(Globals, pic_object_file_extension, ObjExtStr) ), ( ExtStr = ObjExtStr ; ExtStr = "_init" ++ ObjExtStr ) ) ). :- pred file_is_arch_or_grade_dependent_2(string::in) is semidet. % The `.used' file isn't grade dependent itself, but it contains % information collected while compiling a grade-dependent `.c', `il', % etc file. file_is_arch_or_grade_dependent_2(""). file_is_arch_or_grade_dependent_2(".bat"). file_is_arch_or_grade_dependent_2(".used"). file_is_arch_or_grade_dependent_2(".opt"). file_is_arch_or_grade_dependent_2(".optdate"). file_is_arch_or_grade_dependent_2(".trans_opt"). file_is_arch_or_grade_dependent_2(".trans_opt_date"). file_is_arch_or_grade_dependent_2(".analysis"). file_is_arch_or_grade_dependent_2(".analysis_date"). file_is_arch_or_grade_dependent_2(".analysis_status"). file_is_arch_or_grade_dependent_2(".imdg"). file_is_arch_or_grade_dependent_2(".track_flags"). file_is_arch_or_grade_dependent_2(".init"). file_is_arch_or_grade_dependent_2(".request"). file_is_arch_or_grade_dependent_2(".mih"). file_is_arch_or_grade_dependent_2(".c"). file_is_arch_or_grade_dependent_2(".c_date"). file_is_arch_or_grade_dependent_2(".s"). file_is_arch_or_grade_dependent_2(".s_date"). file_is_arch_or_grade_dependent_2(".pic_s"). file_is_arch_or_grade_dependent_2(".pic_s_date"). file_is_arch_or_grade_dependent_2(".cs"). file_is_arch_or_grade_dependent_2(".cs_date"). file_is_arch_or_grade_dependent_2(".java"). file_is_arch_or_grade_dependent_2(".java_date"). file_is_arch_or_grade_dependent_2(".jar"). file_is_arch_or_grade_dependent_2(".class"). file_is_arch_or_grade_dependent_2(".dir"). file_is_arch_or_grade_dependent_2(".dll"). file_is_arch_or_grade_dependent_2(".$A"). file_is_arch_or_grade_dependent_2(".a"). file_is_arch_or_grade_dependent_2("_init.c"). file_is_arch_or_grade_dependent_2("_init.$O"). %---------------------------------------------------------------------------% mercury_std_library_module_name(ModuleName) :- ( ModuleName = unqualified(Name), mercury_std_library_module(Name) ; ModuleName = qualified(_ParentModule, _Name), ( module_name_to_file_name_stem(ModuleName, ModuleNameStr), mercury_std_library_module(ModuleNameStr) ; strip_outermost_qualifier(ModuleName, "mercury", StrippedModuleName), module_name_to_file_name_stem(StrippedModuleName, StrippedModuleNameStr), mercury_std_library_module(StrippedModuleNameStr) ) ). qualify_mercury_std_library_module_name(ModuleName) = QualModuleName :- ( if mercury_std_library_module_name(ModuleName) then QualModuleName = add_outermost_qualifier("mercury", ModuleName) else QualModuleName = ModuleName ). %---------------------------------------------------------------------------% file_name_to_module_name(FileName, ModuleName) :- ModuleName = string_to_sym_name(FileName). module_name_to_file_name_stem(ModuleName, FileName) :- FileName = sym_name_to_string(ModuleName). module_name_to_make_var_name(ModuleName, MakeVarName) :- MakeVarName = sym_name_to_string(ModuleName). %---------------------------------------------------------------------------% :- pred maybe_create_dirs_on_path(maybe_create_dirs::in, list(string)::in, io::di, io::uo) is det. maybe_create_dirs_on_path(MkDir, DirComponents, !IO) :- ( DirComponents = [] ; DirComponents = [_ | _], ( MkDir = do_create_dirs, DirName = dir.relative_path_name_from_components(DirComponents), make_directory(DirName, _, !IO), % XXX We should avoid trying to create a directory % if we have created it before, since a map lookup here % should be *much* cheaper than a system call. % % This goes not just for DirName, but for all the directories % between it and the current directory (i.e. for any initial % subsequence of DirComponents). trace [compile_time(flag("file_name_translations")), runtime(env("FILE_NAME_TRANSLATIONS")), io(!TIO)] ( record_mkdir(DirName, !TIO) ) ; MkDir = do_not_create_dirs ) ). %---------------------------------------------------------------------------% get_class_dir_name(Globals, ClassDirName) :- globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs), globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs), ( UseGradeSubdirs = yes, grade_directory_component(Globals, Grade), globals.lookup_string_option(Globals, target_arch, TargetArch), ClassDirName = "Mercury" / Grade / TargetArch / "Mercury" / "classs" ; UseGradeSubdirs = no, ( UseSubdirs = yes, ClassDirName = "Mercury" / "classs" ; UseSubdirs = no, ClassDirName = "." ) ). %---------------------------------------------------------------------------% make_include_file_path(ModuleSourceFileName, OrigFileName, Path) :- ( if path_name_is_absolute(OrigFileName) then Path = OrigFileName else % XXX This will throw an exception on Windows if OrigFileName is a path % "X:foo", i.e. relative to the current directory on the X: drive. % That seems a silly thing to write in a source file. Path = dirname(ModuleSourceFileName) / OrigFileName ). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% % % The rest of this file is concerned with gathering and writing out % statistical information for profiling. % % The profile we are building is a map from keys to values. Each key records % the parameters of each call to module_name_to_file_name_general: which % extension of which module are we trying to look up, and whether the process % of looking up involves searching or making directories. The values record % the filename that results from the lookup, and the number of times % we have done the exact same lookup. % % After the profile is dumped into a file, the information in it can then be % subject to different kinds of postprocessing. :- type record_key ---> record_key(module_name, ext, maybe_search, maybe_create_dirs). :- type record_value ---> record_value(string, int). :- mutable(translations, map(record_key, record_value), map.init, ground, [untrailed, attach_to_io_state]). :- pred record_translation(maybe_search::in, maybe_create_dirs::in, ext::in, module_name::in, string::in, io::di, io::uo) is det. record_translation(Search, MkDir, Ext, ModuleName, FileName, !IO) :- get_translations(Translations0, !IO), Key = record_key(ModuleName, Ext, Search, MkDir), ( if map.search(Translations0, Key, Value0) then Value0 = record_value(ValueFileName, Count0), expect(unify(FileName, ValueFileName), $module, "FileName != ValueFileName"), Value = record_value(ValueFileName, Count0 + 1), map.det_update(Key, Value, Translations0, Translations) else Value = record_value(FileName, 1), map.det_insert(Key, Value, Translations0, Translations) ), set_translations(Translations, !IO). %---------------------% :- mutable(mkdirs, map(string, int), map.init, ground, [untrailed, attach_to_io_state]). :- pred record_mkdir(string::in, io::di, io::uo) is det. record_mkdir(DirName, !IO) :- get_mkdirs(MkDirs0, !IO), ( if map.search(MkDirs0, DirName, Count0) then map.det_update(DirName, Count0 + 1, MkDirs0, MkDirs) else map.det_insert(DirName, 1, MkDirs0, MkDirs) ), set_mkdirs(MkDirs, !IO). %---------------------% write_translations_record_if_any(!IO) :- get_translations(Translations, !IO), get_mkdirs(MkDirs, !IO), ( if map.is_empty(Translations), map.is_empty(MkDirs) then true else map.foldl4(gather_translation_stats, Translations, 0, NumKeys, 0, NumLookups, map.init, ExtMap, map.init, ExtSchDirMap), io.open_append("/tmp/TRANSLATIONS_RECORD", Result, !IO), ( Result = ok(Stream), io.format(Stream, "overall_stats %d %d\n", [i(NumKeys), i(NumLookups)], !IO), map.foldl(write_out_ext_entry(Stream), ExtMap, !IO), map.foldl(write_out_ext_sch_dir_entry(Stream), ExtSchDirMap, !IO), map.foldl(write_out_mkdirs_entry(Stream), MkDirs, !IO), io.close_output(Stream, !IO) ; Result = error(_) ) ). %---------------------% :- type count_sum ---> count_sum(int, int). :- pred gather_translation_stats(record_key::in, record_value::in, int::in, int::out, int::in, int::out, map(string, count_sum)::in, map(string, count_sum)::out, map(string, count_sum)::in, map(string, count_sum)::out) is det. gather_translation_stats(Key, Value, !NumKeys, !NumLookups, !ExtMap, !ExtSchDirMap) :- !:NumKeys = !.NumKeys + 1, Value = record_value(_FileName, Count), !:NumLookups = !.NumLookups + Count, Key = record_key(_ModuleName, Ext0, Search, MkDir), ( Ext0 = ext_src, ExtStr = ".m" ; Ext0 = ext_other(other_ext(ExtStr0)), ( if ExtStr0 = "" then ExtStr = "no_suffix" else ExtStr = ExtStr0 ) ), ( Search = do_search, SearchStr = "_search" ; Search = do_not_search, SearchStr = "_nosearch" ), ( MkDir = do_create_dirs, MkDirStr = "_mkdir" ; MkDir = do_not_create_dirs, MkDirStr = "_nomkdir" ), ExtSchDir = ExtStr ++ SearchStr ++ MkDirStr, update_count_sum_map(ExtStr, Count, !ExtMap), update_count_sum_map(ExtSchDir, Count, !ExtSchDirMap). :- pred update_count_sum_map(T::in, int::in, map(T, count_sum)::in, map(T, count_sum)::out) is det. update_count_sum_map(Key, Count, !Map) :- ( if map.search(!.Map, Key, Entry0) then Entry0 = count_sum(Cnt0, Sum0), Entry = count_sum(Cnt0 + 1, Sum0 + Count), map.det_update(Key, Entry, !Map) else Entry = count_sum(1, Count), map.det_insert(Key, Entry, !Map) ). :- pred write_out_ext_entry(io.text_output_stream::in, string::in, count_sum::in, io::di, io::uo) is det. write_out_ext_entry(Stream, Ext, count_sum(Cnt, Sum), !IO) :- io.format(Stream, "ext %d %d %s\n", [i(Cnt), i(Sum), s(Ext)], !IO). :- pred write_out_ext_sch_dir_entry(io.text_output_stream::in, string::in, count_sum::in, io::di, io::uo) is det. write_out_ext_sch_dir_entry(Stream, ExtSchDir, count_sum(Cnt, Sum), !IO) :- io.format(Stream, "ext_sch_dir %d %d %s\n", [i(Cnt), i(Sum), s(ExtSchDir)], !IO). %---------------------% :- pred write_out_mkdirs_entry(io.text_output_stream::in, string::in, int::in, io::di, io::uo) is det. write_out_mkdirs_entry(Stream, DirName, Cnt, !IO) :- io.format(Stream, "dir_name %d %s\n", [i(Cnt), s(DirName)], !IO). %---------------------------------------------------------------------------% :- end_module parse_tree.file_names. %---------------------------------------------------------------------------%